Skip to content

Instantly share code, notes, and snippets.

@sogaiu

sogaiu/docstring.janet

Last active April 25, 2025 11:33
Show Gist options
  • Save sogaiu/d2e10696582735a93900ded1b6f7acf2 to your computer and use it in GitHub Desktop.
Save sogaiu/d2e10696582735a93900ded1b6f7acf2 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
docstring.janet
# XXX:
#
# * spork/pm.janet's resolve-bundle has a docstring that looks like
# it might eventually end up with a nested list.
#
# * could a nested list item end up looking like an ordinary "indented"
# line?
# assumes source has been formatted with doc-format such that there is
# no indentation and no color (which implies list item markers have
# been normalized to single asterisks).
#
# afaiu, under these assumptions, plus observations and evidence:
#
# * there are no nested lists so far.
#
# * only unordered lists have been used so far.
#
# * each list item begins with a single asterisk at the beginning of a
# line.
#
# * no janet docstring currently has more than one paragraph per list
# item.
#
# * the first list item in a list is always preceded by two newlines
#
# * the last list item in a list is either followed by two newlines or
# no newline (end of file / string)
(defn parse-ds
[source]
(def chunks
# preprocess by replacing each line that is all leading whitespace
# followed by a newline, with just a newline. this happens a couple
# of times in loop's docstring.
(->> (peg/replace-all ~(sequence "\n" (some " ") "\n")
"\n\n"
source)
(string/split "\n\n")))
#
(var curr-ul nil)
(def nodes @[])
#
(defn init-ul []
(set curr-ul @{:tag "ul" :content @[]}))
(defn end-and-reset-ul []
(array/push nodes curr-ul)
(set curr-ul nil))
#
(defn handle-code-maybe [cntnt]
# only if there is a backtick, should the return value be an array
(if (string/find "`" cntnt)
(let [parsed
(peg/match ~{:main (some (choice :code :non-code -1))
:code (cmt (sequence "`" (capture (to "`")) "`")
,|@{:tag "code" :content $
"class" "mendoza-code"})
:non-code (capture (to (choice "`" -1)))}
cntnt)]
(assertf parsed "failed to find matching backtick in: %s" cntnt)
parsed)
cntnt))
#
(defn handle-li [ck]
# at least drop leading *
(def processed (handle-code-maybe (string/slice ck 1)))
(def p-cntnt {:tag "p" :content processed})
(array/push (get curr-ul :content)
# loose list
{:tag "li" :content p-cntnt}
# tight list
#{:tag "li" :content processed}
))
#
(defn handle-ul [ck]
# also drop leading * and any trailing newline
(def pieces (string/split "\n*" (string/slice (string/trimr ck) 1)))
(def lis
# tight list
(map |{:tag "li" :content (handle-code-maybe $)}
pieces))
#
(array/push nodes {:tag "ul" :content lis}))
#
(defn handle-p [ck]
(def p-cntnt
(handle-code-maybe
(if (string/has-prefix? " " ck)
# XXX: hacks because   didn't work
# U+2800 braille pattern blank
#(string (string/repeat "⠀" 4)
# U_2008 punctuation space
(string (string/repeat " " 8)
(string/slice ck 4))
ck)))
(array/push nodes {:tag "p" :content p-cntnt}))
#
(each ck chunks
(if (string/has-prefix? "*" ck)
(if (string/find "\n*" ck)
# entire list
(do
(when curr-ul (end-and-reset-ul))
(handle-ul ck))
# individual list item
(do
(when (not curr-ul) (init-ul))
(handle-li ck)))
# paragraph
(do
(when curr-ul (end-and-reset-ul))
(handle-p ck))))
# handle unfinished business if needed
(when curr-ul (end-and-reset-ul))
#
nodes)
(comment
# (doc-format <doc-string> 120 0 false)
(def signal-ds
``
(signal what x)
Raise a signal with payload x. `what` can be an integer from 0 through 7 indicating user(0-7), or one
of:
* :ok
* :error
* :debug
* :yield
* :user(0-7)
* :interrupt
* :await
``)
(parse-ds signal-ds)
# =>
@[{:content "(signal what x)" :tag "p"}
{:content (string "Raise a signal with payload x. `what` can be an "
"integer from 0 through 7 indicating user(0-7), or "
"one \nof:")
:tag "p"}
{:content @[{:content " :ok" :tag "li"}
{:content " :error" :tag "li"}
{:content " :debug" :tag "li"}
{:content " :yield" :tag "li"}
{:content " :user(0-7)" :tag "li"}
{:content " :interrupt" :tag "li"}
{:content " :await" :tag "li"}] :tag "ul"}]
(def file-read-ds
``
(file/read f what &opt buf)
Read a number of bytes from a file `f` into a buffer. A buffer `buf` can be provided as an optional third
argument, otherwise a new buffer is created. `what` can either be an integer or a keyword. Returns the buffer
with file contents. Values for `what`:
* :all - read the whole file
* :line - read up to and including the next newline character
* n (integer) - read up to n bytes from the file
``)
(parse-ds file-read-ds)
# =>
@[{:content "(file/read f what &opt buf)" :tag "p"}
{:content
@["Read a number of bytes from a file "
@{"class" "mendoza-code" :content "f" :tag "code"}
" into a buffer. A buffer "
@{"class" "mendoza-code" :content "buf" :tag "code"}
(string " can be provided as an optional third \n"
"argument, otherwise a new buffer is created. ")
@{"class" "mendoza-code" :content "what" :tag "code"}
(string " can either be an integer or a keyword. Returns the buffer \n"
"with file contents. Values for ")
@{"class" "mendoza-code" :content "what" :tag "code"} ":"]
:tag "p"}
@{:content
@[{:content
{:content " :all - read the whole file" :tag "p"}
:tag "li"}
{:content
{:content " :line - read up to and including the next newline character"
:tag "p"}
:tag "li"}
{:content
{:content " n (integer) - read up to n bytes from the file" :tag "p"}
:tag "li"}]
:tag "ul"}]
(def fiber-new-ds
``
(fiber/new func &opt sigmask env)
Create a new fiber with function body func. Can optionally take a set
of signals `sigmask` to capture from child fibers, and an environment
table `env`. The mask is specified as a keyword where each character
is used to indicate a signal to block. If the ev module is enabled,
and this fiber is used as an argument to `ev/go`, these "blocked"
signals will result in messages being sent to the supervisor
channel. The default sigmask is :y. For example,
(fiber/new myfun :e123)
blocks error signals and user signals 1, 2 and 3. The signals are as
follows:
* :a - block all signals
* :d - block debug signals
* :e - block error signals
* :t - block termination signals: error + user[0-4]
* :u - block user signals
* :y - block yield signals
* :w - block await signals (user9)
* :r - block interrupt signals (user8)
* :0-9 - block a specific user signal
The sigmask argument also can take environment flags. If any mutually
exclusive flags are present, the last flag takes precedence.
* :i - inherit the environment from the current fiber
* :p - the environment table's prototype is the current environment table
``)
(parse-ds fiber-new-ds)
# =>
@[{:content "(fiber/new func &opt sigmask env)" :tag "p"}
{:content
@[(string "Create a new fiber with function body func. Can optionally "
"take a set\nof signals ")
@{"class" "mendoza-code" :content "sigmask" :tag "code"}
" to capture from child fibers, and an environment\ntable "
@{"class" "mendoza-code" :content "env" :tag "code"}
(string ". The mask is specified as a keyword where each character\n"
"is used to indicate a signal to block. If the ev module is "
"enabled,\nand this fiber is used as an argument to ")
@{"class" "mendoza-code" :content "ev/go" :tag "code"}
(string ", these \"blocked\"\nsignals will result in messages being "
"sent to the supervisor\nchannel. The default sigmask is :y. "
"For example,")]
:tag "p"}
{:content (string "\xE2\x80\x88\xE2\x80\x88\xE2\x80\x88\xE2\x80\x88"
"\xE2\x80\x88\xE2\x80\x88\xE2\x80\x88\xE2\x80\x88"
"(fiber/new myfun :e123)") :tag "p"}
{:content (string "blocks error signals and user signals 1, 2 and 3. "
"The signals are as\nfollows:" )
:tag "p"}
{:content
@[{:content " :a - block all signals" :tag "li"}
{:content " :d - block debug signals" :tag "li"}
{:content " :e - block error signals" :tag "li"}
{:content " :t - block termination signals: error + user[0-4]"
:tag "li"}
{:content " :u - block user signals" :tag "li"}
{:content " :y - block yield signals" :tag "li"}
{:content " :w - block await signals (user9)" :tag "li"}
{:content " :r - block interrupt signals (user8)" :tag "li"}
{:content " :0-9 - block a specific user signal" :tag "li"}]
:tag "ul"}
{:content (string "The sigmask argument also can take environment "
"flags. If any mutually\nexclusive flags are "
"present, the last flag takes precedence." )
:tag "p"}
{:content
@[{:content " :i - inherit the environment from the current fiber"
:tag "li"}
{:content (string " :p - the environment table's prototype is the "
"current environment table")
:tag "li"}]
:tag "ul"}]
(print (doc-format2 (get (dyn 'fiber/new):doc) 120 0 false))
)
# based on doc-format in boot.janet
(defn doc-parse
```
Parse a docstring.
Docstrings can either be plaintext or a subset of markdown. This
allows a long single line of prose or formatted text to be a
well-formed docstring.
Returns a stack of parsed content.
```
[str]
(def delimiters
{:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]})
(def modes @{})
(defn toggle-mode [mode]
(def active (get modes mode))
(def delims (get delimiters mode))
(put modes mode (not active))
(delims (if active 1 0)))
# Parse state
(var cursor 0) # indexes into string for parsing
(var stack @[]) # return value for this block.
# Traversal helpers
(defn c [] (get str cursor))
(defn cn [n] (get str (+ n cursor)))
# XXX: return values for next two never seem to be used in code below?
(defn c++ [] (let [ret (get str cursor)] (++ cursor) ret))
(defn c+=n [n] (let [ret (get str cursor)] (+= cursor n) ret))
# skip* functions return number of characters matched and advance the cursor.
(defn skipwhite []
(def x cursor)
(while (= (c) (chr " ")) (++ cursor))
(- cursor x))
(defn skipline []
(def x cursor)
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
(c++)
(- cursor x))
# Detection helpers - return number of characters matched
(defn ul? []
(let [x (c) x1 (cn 1)]
(and
(= x1 (chr " "))
(or (= x (chr "*")) (= x (chr "-")))
2)))
(defn ol? []
(def old cursor)
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (c++))
(let [c1 (c) c2 (cn 1) c* cursor]
(set cursor old)
(if (and (= c1 (chr ".")) (= c2 (chr " ")))
(- c* cursor -2))))
(defn fcb? [] (if (= (chr "`") (c) (cn 1) (cn 2)) 3))
(defn nl? [] (= (chr "\n") (c)))
# Parse helper
# parse-* functions push nodes to `stack`, and return
# the indentation they leave the cursor on.
(var parse-blocks nil) # mutual recursion
(defn getslice [from to]
(def to (min to (length str)))
(string/slice str from to))
(defn push [x] (array/push stack x))
(defn parse-list [bullet-check initial indent]
(def temp-stack @[initial])
(def old-stack stack)
(set stack temp-stack)
(var current-indent indent)
(while (and (c) (>= current-indent indent))
(def item-indent
(when-let [x (bullet-check)]
(c+=n x)
(+ indent (skipwhite) x)))
(unless item-indent
(set current-indent (skipwhite))
(break))
(def item-stack @[])
(set stack item-stack)
(set current-indent (parse-blocks item-indent))
(set stack temp-stack)
(push item-stack))
(set stack old-stack)
(push temp-stack)
current-indent)
(defn add-codeblock [indent start end]
(def replace-chunk (string "\n" (string/repeat " " indent)))
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(skipline)
(skipwhite))
(defn parse-fcb [indent]
(c+=n 3)
(skipline)
(c+=n indent)
(def start cursor)
(var end cursor)
(while (c)
(if (fcb?) (break))
(skipline)
(set end cursor)
(skipwhite))
(add-codeblock indent start end))
(defn parse-icb [indent]
(var current-indent indent)
(def start cursor)
(var end cursor)
(while (c)
(skipline)
(set end cursor)
(set current-indent (skipwhite))
(if (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn tokenize-line [line]
(def tokens @[])
(def token @"")
(var token-length 0)
(defn delim [mode]
(def d (toggle-mode mode))
# XXX: verify appropriate - removed check for no has-color
(+= token-length (length d))
(buffer/push token d))
(defn endtoken []
(if (first token) (array/push tokens [(string token) token-length]))
(buffer/clear token)
(set token-length 0))
(forv i 0 (length line)
(def b (get line i))
(cond
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
(= b (chr "`")) (delim :code)
(not (modes :code))
(cond
(= b (chr `\`)) (do
(++ token-length)
(buffer/push token (get line (++ i))))
(= b (chr "_")) (delim :underline)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(do (++ token-length) (buffer/push token b)))
(do (++ token-length) (buffer/push token b))))
(endtoken)
(tuple/slice tokens))
(set
parse-blocks
(fn parse-blocks [indent]
(var new-indent indent)
(var p-start nil)
(var p-end nil)
(defn p-line []
(unless p-start
(set p-start cursor))
(skipline)
(set p-end cursor)
(set new-indent (skipwhite)))
(defn finish-p []
(when (and p-start (> p-end p-start))
(push (tokenize-line (getslice p-start p-end)))
(set p-start nil)))
(while (and (c) (>= new-indent indent))
(cond
(nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
(ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
(ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
(fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
(>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
(p-line)))
(finish-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skipline)
(def first-line (string/slice str 0 (- cursor 1)))
(push [[first-line (length first-line)]]))
(parse-blocks 0)
stack)
(comment
(def file-read-ds
``
(file/read f what &opt buf)
Read a number of bytes from a file `f` into a buffer. A buffer `buf` can be provided as an optional third
argument, otherwise a new buffer is created. `what` can either be an integer or a keyword. Returns the buffer
with file contents. Values for `what`:
* :all - read the whole file
* :line - read up to and including the next newline character
* n (integer) - read up to n bytes from the file
``)
# XXX: result seems off...should only have one ul?
(doc-parse (get (dyn 'file/read):doc))
# =>
'@[[("(file/read f what &opt buf)" 27)]
[("Read" 4) ("a" 1) ("number" 6) ("of" 2) ("bytes" 5) ("from" 4)
("a" 1) ("file" 4) ("`f`" 3) ("into" 4) ("a" 1) ("buffer." 7)
("A" 1) ("buffer" 6) ("`buf`" 5) ("can" 3) ("be" 2) ("provided" 8)
("as" 2) ("an" 2) ("optional" 8) ("third" 5) ("argument," 9)
("otherwise" 9) ("a" 1) ("new" 3) ("buffer" 6) ("is" 2)
("created." 8) ("`what`" 6) ("can" 3) ("either" 6) ("be" 2)
("an" 2) ("integer" 7) ("or" 2) ("a" 1) ("keyword." 8)
("Returns" 7) ("the" 3) ("buffer" 6) ("with" 4) ("file" 4)
("contents." 9) ("Values" 6) ("for" 3) ("`what`:" 7)]
@[:ul
@[[(":all" 4) ("-" 1) ("read" 4) ("the" 3) ("whole" 5) ("file" 4)]]]
@[:ul
@[[(":line" 5) ("-" 1) ("read" 4) ("up" 2) ("to" 2) ("and" 3)
("including" 9) ("the" 3) ("next" 4) ("newline" 7)
("character" 9)]]]
@[:ul
@[[("n" 1) ("(integer)" 9) ("-" 1) ("read" 4) ("up" 2) ("to" 2)
("n" 1) ("bytes" 5) ("from" 4) ("the" 3) ("file" 4)]]]]
)
(defn doc-emit
```
Emit a formatted docstring based on `stack`, typically produced by
`doc-parse`.
Returns a buffer containing the formatted text.
```
[stack &opt width indent]
(default indent 4)
(def max-width (- (or width (dyn *doc-width* 80)) 8))
# Emission state
(def buf @"")
(var current-column 0)
# Emission
(defn emit-indent [indent]
(def delta (- indent current-column))
(when (< 0 delta)
(buffer/push buf (string/repeat " " delta))
(set current-column indent)))
(defn emit-nl [&opt indent]
(buffer/push buf "\n")
(set current-column 0))
(defn emit-word [word indent &opt len]
(def last-byte (last buf))
(when (and
last-byte
(not= last-byte (chr "\n"))
(not= last-byte (chr " ")))
(buffer/push buf " ")
(++ current-column))
(default len (length word))
(when (and indent (> (+ 1 current-column len) max-width))
(emit-nl)
(emit-indent indent))
(buffer/push buf word)
(+= current-column len))
(defn emit-code
[code indent]
(def replacement (string "\n" (string/repeat " " (+ 4 indent))))
(emit-indent (+ 4 indent))
(buffer/push buf (string/replace-all "\n" replacement code))
(if (= (chr "\n") (last code))
(set current-column 0)
(emit-nl)))
(defn emit-node
[el indent]
(emit-indent indent)
(if (tuple? el)
(let [rep (string "\n" (string/repeat " " indent))]
(each [word len] el
(emit-word
(string/replace-all "\n" rep word)
indent
len))
(emit-nl))
(case (first el)
:ul (for i 1 (length el)
(if (> i 1) (emit-indent indent))
(emit-word "* " nil)
(each subel (get el i) (emit-node subel (+ 2 indent))))
:ol (for i 1 (length el)
(if (> i 1) (emit-indent indent))
(def lab (string/format "%d. " i))
(emit-word lab nil)
(each subel (get el i) (emit-node subel (+ (length lab) indent))))
:cb (emit-code (get el 1) indent))))
(each el stack
(emit-nl)
(emit-node el indent))
buf)
(defn doc-parse-2
```
Parse a docstring.
Docstrings can either be plaintext or a subset of markdown. This
allows a long single line of prose or formatted text to be a
well-formed docstring.
Returns a stack of parsed content.
```
[str]
(def modes @{})
(defn toggle-mode [mode]
(def active (get modes mode))
(def delims
(get {:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]} mode))
(put modes mode (not active))
(delims (if active 1 0)))
# Parse state
(var cursor 0) # indexes into string for parsing
(var stack @[]) # return value for this block.
# Traversal helpers
(defn c [] (get str cursor))
# fetch a byte that is n positions ahead of the cursor
(defn cn [n] (get str (+ n cursor)))
# skip* functions return number of characters matched and advance the cursor.
(defn skip-1 [] (++ cursor) 1)
(defn skip-n [n] (+= cursor n) n)
(defn skip-white []
(def old cursor)
(while (= (c) (chr " ")) (++ cursor))
(- cursor old))
(defn skip-line []
(def old cursor)
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
(skip-1)
(- cursor old))
# Detection helpers - return number of characters matched
(defn ul? []
(def [x x1] [(c) (cn 1)])
(and (= x1 (chr " "))
# XXX: could support + too?
(or (= x (chr "*")) (= x (chr "-")))
2))
(defn ol? []
(def old cursor)
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (skip-1))
(def [c1 c2 c*] [(c) (cn 1) cursor])
(set cursor old)
(when (and (= c1 (chr ".")) (= c2 (chr " ")))
(- c* cursor -2)))
(defn fcb? [] (when (= (chr "`") (c) (cn 1) (cn 2)) 3))
(defn nl? [] (when (= (chr "\n") (c)) 1))
# Parse helper
# parse-* functions push nodes to `stack`, and return
# the indentation they leave the cursor on.
(var parse-blocks nil) # mutual recursion
(defn getslice [from to]
(def to (min to (length str)))
(string/slice str from to))
(defn push [x] (array/push stack x))
(defn parse-list [bullet-check initial indent]
(def temp-stack @[initial])
(def old-stack stack)
(set stack temp-stack)
(var current-indent indent)
(while (and (c) (>= current-indent indent))
(def item-indent
(when-let [x (bullet-check)]
(skip-n x)
# XXX: why not indent x (skip-white)?
(+ indent (skip-white) x)))
(unless item-indent
(set current-indent (skip-white))
(break))
(def item-stack @[])
(set stack item-stack)
(set current-indent (parse-blocks item-indent))
(set stack temp-stack)
(push item-stack))
(set stack old-stack)
(push temp-stack)
current-indent)
(defn add-codeblock [indent start end]
(def replace-chunk (string "\n" (string/repeat " " indent)))
# remove indent worth of leading whitespace from lines of code block(?)
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(skip-line)
(skip-white))
(defn parse-fcb [indent]
(skip-n 3)
(skip-line)
(skip-n indent)
(def start cursor)
(var end cursor)
(while (c)
(when (fcb?) (break))
(skip-line)
(set end cursor)
(skip-white))
(add-codeblock indent start end))
(defn parse-icb [indent]
(var current-indent indent)
(def start cursor)
(var end cursor)
(while (c)
(skip-line)
(set end cursor)
(set current-indent (skip-white))
(when (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn tokenize-line [line]
(def tokens @[])
(def token @"")
(var token-length 0)
(defn delim [mode]
(def d (toggle-mode mode))
# XXX: verify appropriate - removed check for no has-color
(+= token-length (length d))
(buffer/push token d))
(defn endtoken []
(when (first token) (array/push tokens [(string token) token-length]))
(buffer/clear token)
(set token-length 0))
(forv i 0 (length line)
(def b (get line i))
(cond
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
(= b (chr "`")) (delim :code)
(not (modes :code))
(cond
(= b (chr `\`)) (do
(++ token-length)
(buffer/push token (get line (++ i))))
(= b (chr "_")) (delim :underline)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(do (++ token-length) (buffer/push token b)))
(do (++ token-length) (buffer/push token b))))
(endtoken)
(tuple/slice tokens))
(set
parse-blocks
(fn parse-blocks [indent]
(var new-indent indent)
(var p-start nil)
(var p-end nil)
(defn p-line []
(unless p-start
(set p-start cursor))
(skip-line)
(set p-end cursor)
(skip-white))
(defn end-p []
(when (and p-start (> p-end p-start))
(push (tokenize-line (getslice p-start p-end)))
(set p-start nil)))
(while (and (c) (>= new-indent indent))
(set new-indent
(cond
(nl?) (do (end-p) (skip-1) (skip-white))
(ul?) (do (end-p) (parse-list ul? :ul new-indent))
(ol?) (do (end-p) (parse-list ol? :ol new-indent))
(fcb?) (do (end-p) (parse-fcb new-indent))
(>= new-indent (+ 4 indent)) (do (end-p) (parse-icb new-indent))
(p-line))))
(end-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skip-line)
(def first-line (string/slice str 0 (- cursor 1)))
(push [[first-line (length first-line)]]))
(parse-blocks 0)
stack)
(defn doc-emit-2
```
Emit a formatted docstring based on `stack`, typically produced by
`doc-parse`.
Returns a buffer containing the formatted text.
```
[stack &opt width indent]
(default indent 4)
(def max-width (- (or width (dyn *doc-width* 80)) 8))
# Emission state
(def buf @"")
(var current-column 0)
# Emission
(defn emit-indent [indent]
(def delta (- indent current-column))
(when (< 0 delta)
(buffer/push buf (string/repeat " " delta))
(set current-column indent)))
(defn emit-nl []
(buffer/push buf "\n")
(set current-column 0))
(defn emit-word [word indent &opt len]
(def last-byte (last buf))
(when (and
last-byte
(not= last-byte (chr "\n"))
(not= last-byte (chr " ")))
(buffer/push buf " ")
(++ current-column))
(default len (length word))
(when (and indent (> (+ 1 current-column len) max-width))
(emit-nl)
(emit-indent indent))
(buffer/push buf word)
(+= current-column len))
(defn emit-code
[code indent]
(def replacement (string "\n" (string/repeat " " (+ 4 indent))))
(emit-indent (+ 4 indent))
(buffer/push buf (string/replace-all "\n" replacement code))
(if (= (chr "\n") (last code))
(set current-column 0)
(emit-nl)))
(defn emit-node
[el indent]
(emit-indent indent)
(if (tuple? el)
(let [rep (string "\n" (string/repeat " " indent))]
(each [word len] el
(emit-word
(string/replace-all "\n" rep word)
indent
len))
(emit-nl))
(case (first el)
:ul (for i 1 (length el)
(when (> i 1) (emit-indent indent))
(emit-word "* " nil)
(each subel (get el i) (emit-node subel (+ 2 indent))))
:ol (for i 1 (length el)
(when (> i 1) (emit-indent indent))
(def lab (string/format "%d. " i))
(emit-word lab nil)
(each subel (get el i) (emit-node subel (+ (length lab) indent))))
:cb (emit-code (get el 1) indent))))
(each el stack
(emit-nl)
(emit-node el indent))
buf)
(defn doc-format-1
[str &opt width indent]
(doc-emit (doc-parse str) width indent))
(defn doc-format-2
[str &opt width indent]
(doc-emit-2 (doc-parse-2 str) width indent))
(comment
(def signal-ds
``
(signal what x)
Raise a signal with payload x. `what` can be an integer from 0 through 7 indicating user(0-7), or one
of:
* :ok
* :error
* :debug
* :yield
* :user(0-7)
* :interrupt
* :await
``)
(print (doc-format-2 (get (dyn 'signal) :doc) 120 0))
(doc-parse-2 (get (dyn 'signal) :doc))
# =>
'@[[("(signal what x)" 15)]
[("Raise" 5) ("a" 1) ("signal" 6) ("with" 4) ("payload" 7) ("x." 2)
("`what`" 6) ("can" 3) ("be" 2) ("an" 2) ("integer" 7) ("from" 4)
("0" 1) ("through" 7) ("7" 1) ("indicating" 10) ("user(0-7)," 10)
("or" 2) ("one" 3) ("of:" 3)]
@[:ul
@[((":ok" 3))]
@[((":error" 6))]
@[((":debug" 6))]
@[((":yield" 6))]
@[((":user(0-7)" 10))]
@[((":interrupt" 10))]
@[((":await" 6))]]]
# XXX: blank line between:
#
# line ending "...keys:" and
# line beginning " * `:url`..."
#
# causes nesting to fail
#
# docstring below has been modified from the original
# (which didn't express nesting of one list within
# another) for experimental purposes. original from
# spork/pm.janet.
(def resolve-bundle-ds
```
Convert any bundle string/table to the normalized table form. `bundle` can be any of the following forms:
* A short name that indicates a package from the package listing.
* A URL or path to a git repository
* A URL or path to a .tar.gz archive
* A string of 2 parts separated by "::" - {type}::{path-or-url}
* A string of 3 parts separated by "::" - {type}::{path-or-url}::{tag}
* A table or struct with the following keys:
* `:url` or `:repo` - the URL or path of the git repository or of the .tar.gz file. Required.
* `:tag`, `:sha`, `:commit`, or `:ref` - The revision to checkout from version control. Optional.
* `:type` - The dependency type, either `:git`, `:tar`, or `:file`. The default is `:git`. Optional.
```)
(print (doc-format-1 resolve-bundle-ds 120 0))
(doc-parse-2 resolve-bundle-ds)
# =>
'@[[("Convert" 7) ("any" 3) ("bundle" 6) ("string/table" 12) ("to" 2)
("the" 3) ("normalized" 10) ("table" 5) ("form." 5) ("`bundle`" 8)
("can" 3) ("be" 2) ("any" 3) ("of" 2) ("the" 3) ("following" 9)
("forms:" 6)]
@[:ul
@[[("A" 1) ("short" 5) ("name" 4) ("that" 4) ("indicates" 9)
("a" 1) ("package" 7) ("from" 4) ("the" 3) ("package" 7)
("listing." 8)]]
@[[("A" 1) ("URL" 3) ("or" 2) ("path" 4) ("to" 2) ("a" 1) ("git" 3)
("repository" 10)]]
@[[("A" 1) ("URL" 3) ("or" 2) ("path" 4) ("to" 2) ("a" 1)
(".tar.gz" 7) ("archive" 7)]]
@[[("A" 1) ("string" 6) ("of" 2) ("2" 1) ("parts" 5)
("separated" 9) ("by" 2) ("\"::\"" 4) ("-" 1)
("{type}::{path-or-url}" 21)]]
@[[("A" 1) ("string" 6) ("of" 2) ("3" 1) ("parts" 5)
("separated" 9) ("by" 2) ("\"::\"" 4) ("-" 1)
("{type}::{path-or-url}::{tag}" 28)]]
@[[("A" 1) ("table" 5) ("or" 2) ("struct" 6) ("with" 4) ("the" 3)
("following" 9) ("keys:" 5)]
@[:ul
@[[("`:url`" 6) ("or" 2) ("`:repo`" 7) ("-" 1) ("the" 3)
("URL" 3) ("or" 2) ("path" 4) ("of" 2) ("the" 3) ("git" 3)
("repository" 10) ("or" 2) ("of" 2) ("the" 3) (".tar.gz" 7)
("file." 5) ("Required." 9)]]
@[[("`:tag`," 7) ("`:sha`," 7) ("`:commit`," 10) ("or" 2)
("`:ref`" 6) ("-" 1) ("The" 3) ("revision" 8) ("to" 2)
("checkout" 8) ("from" 4) ("version" 7) ("control." 8)
("Optional." 9)]]
@[[("`:type`" 7) ("-" 1) ("The" 3) ("dependency" 10)
("type," 5) ("either" 6) ("`:git`," 7) ("`:tar`," 7)
("or" 2) ("`:file`." 8) ("The" 3) ("default" 7) ("is" 2)
("`:git`." 7) ("Optional." 9)]]]]]]
(def fiber-new-ds
``
(fiber/new func &opt sigmask env)
Create a new fiber with function body func. Can optionally take a set
of signals `sigmask` to capture from child fibers, and an environment
table `env`. The mask is specified as a keyword where each character
is used to indicate a signal to block. If the ev module is enabled,
and this fiber is used as an argument to `ev/go`, these "blocked"
signals will result in messages being sent to the supervisor
channel. The default sigmask is :y. For example,
(fiber/new myfun :e123)
blocks error signals and user signals 1, 2 and 3. The signals are as
follows:
* :a - block all signals
* :d - block debug signals
* :e - block error signals
* :t - block termination signals: error + user[0-4]
* :u - block user signals
* :y - block yield signals
* :w - block await signals (user9)
* :r - block interrupt signals (user8)
* :0-9 - block a specific user signal
The sigmask argument also can take environment flags. If any mutually
exclusive flags are present, the last flag takes precedence.
* :i - inherit the environment from the current fiber
* :p - the environment table's prototype is the current environment table
``)
(doc-parse-2 fiber-new-ds)
# =>
'@[[("(fiber/new func &opt sigmask env)" 33)]
[("Create" 6) ("a" 1) ("new" 3) ("fiber" 5) ("with" 4) ("function" 8)
("body" 4) ("func." 5) ("Can" 3) ("optionally" 10) ("take" 4)
("a" 1) ("set" 3) ("of" 2) ("signals" 7) ("`sigmask`" 9) ("to" 2)
("capture" 7) ("from" 4) ("child" 5) ("fibers," 7) ("and" 3) ("an" 2)
("environment" 11) ("table" 5) ("`env`." 6) ("The" 3) ("mask" 4)
("is" 2) ("specified" 9) ("as" 2) ("a" 1) ("keyword" 7) ("where" 5)
("each" 4) ("character" 9) ("is" 2) ("used" 4) ("to" 2)
("indicate" 8) ("a" 1) ("signal" 6) ("to" 2) ("block." 6) ("If" 2)
("the" 3) ("ev" 2) ("module" 6) ("is" 2) ("enabled," 8) ("and" 3)
("this" 4) ("fiber" 5) ("is" 2) ("used" 4) ("as" 2) ("an" 2)
("argument" 8) ("to" 2) ("`ev/go`," 8) ("these" 5) ("\"blocked\"" 9)
("signals" 7) ("will" 4) ("result" 6) ("in" 2) ("messages" 8)
("being" 5) ("sent" 4) ("to" 2) ("the" 3) ("supervisor" 10)
("channel." 8) ("The" 3) ("default" 7) ("sigmask" 7) ("is" 2)
(":y." 3) ("For" 3) ("example," 8)]
@[:cb "(fiber/new myfun :e123)\n"]
[("blocks" 6) ("error" 5) ("signals" 7) ("and" 3) ("user" 4)
("signals" 7) ("1," 2) ("2" 1) ("and" 3) ("3." 2) ("The" 3)
("signals" 7) ("are" 3) ("as" 2) ("follows:" 8)]
@[:ul
@[[(":a" 2) ("-" 1) ("block" 5) ("all" 3) ("signals" 7)]]
@[[(":d" 2) ("-" 1) ("block" 5) ("debug" 5) ("signals" 7)]]
@[[(":e" 2) ("-" 1) ("block" 5) ("error" 5) ("signals" 7)]]
@[[(":t" 2) ("-" 1) ("block" 5) ("termination" 11) ("signals:" 8)
("error" 5) ("+" 1) ("user[0-4]" 9)]]
@[[(":u" 2) ("-" 1) ("block" 5) ("user" 4) ("signals" 7)]]
@[[(":y" 2) ("-" 1) ("block" 5) ("yield" 5) ("signals" 7)]]
@[[(":w" 2) ("-" 1) ("block" 5) ("await" 5) ("signals" 7)
("(user9)" 7)]]
@[[(":r" 2) ("-" 1) ("block" 5) ("interrupt" 9) ("signals" 7)
("(user8)" 7)]]
@[[(":0-9" 4) ("-" 1) ("block" 5) ("a" 1) ("specific" 8) ("user" 4)
("signal" 6)]]]
[("The" 3) ("sigmask" 7) ("argument" 8) ("also" 4) ("can" 3)
("take" 4) ("environment" 11) ("flags." 6) ("If" 2) ("any" 3)
("mutually" 8) ("exclusive" 9) ("flags" 5) ("are" 3) ("present," 8)
("the" 3) ("last" 4) ("flag" 4) ("takes" 5) ("precedence." 11)]
@[:ul
@[[(":i" 2) ("-" 1) ("inherit" 7) ("the" 3) ("environment" 11)
("from" 4) ("the" 3) ("current" 7) ("fiber" 5)]]
@[[(":p" 2) ("-" 1) ("the" 3) ("environment" 11) ("table's" 7)
("prototype" 9) ("is" 2) ("the" 3) ("current" 7)
("environment" 11) ("table" 5)]]]]
)
(defn doc-parse-3
```
Parse a docstring.
Docstrings can either be plaintext or a subset of markdown. This
allows a long single line of prose or formatted text to be a
well-formed docstring.
Returns a stack of parsed content.
```
[str]
(def modes @{})
(defn toggle-mode [mode]
(def active (get modes mode))
(def delims
(get {:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]} mode))
(put modes mode (not active))
(delims (if active 1 0)))
# Parse state
(var cursor 0) # indexes into string for parsing
(var stack @[]) # return value for this block.
# Traversal helpers
(defn c [] (get str cursor))
# fetch a byte that is n positions ahead of the cursor
(defn cn [n] (get str (+ n cursor)))
# skip* functions return number of characters matched and advance the cursor.
(defn skip-1 [] (++ cursor) 1)
(defn skip-n [n] (+= cursor n) n)
(defn skip-white []
(def old cursor)
(while (= (c) (chr " ")) (++ cursor))
(- cursor old))
(defn skip-line []
(def old cursor)
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
(skip-1)
(- cursor old))
# Detection helpers - return number of characters matched
(defn ul? []
(def [x x1] [(c) (cn 1)])
(and (= x1 (chr " "))
# XXX: could support + too?
(or (= x (chr "*")) (= x (chr "-")))
2))
(defn ol? []
(def old cursor)
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (skip-1))
(def [c1 c2 c*] [(c) (cn 1) cursor])
(set cursor old)
(when (and (= c1 (chr ".")) (= c2 (chr " ")))
(- c* cursor -2)))
(defn fcb? [] (when (= (chr "`") (c) (cn 1) (cn 2)) 3))
(defn nl? [] (when (= (chr "\n") (c)) 1))
# Parse helper
# parse-* functions push nodes to `stack`, and return
# the indentation they leave the cursor on.
(var parse-blocks nil) # mutual recursion
(defn getslice [from to]
(def to (min to (length str)))
(string/slice str from to))
(defn push [x] (array/push stack x))
(defn parse-list [bullet-check initial indent]
(def temp-stack @[initial])
(def old-stack stack)
(set stack temp-stack)
(var current-indent indent)
(while (and (c) (>= current-indent indent))
(def item-indent
(when-let [x (bullet-check)]
(skip-n x)
# XXX: why not indent x (skip-white)?
(+ indent (skip-white) x)))
(unless item-indent
(set current-indent (skip-white))
(break))
(def item-stack @[])
(set stack item-stack)
(set current-indent (parse-blocks item-indent))
(set stack temp-stack)
(push item-stack))
(set stack old-stack)
(push temp-stack)
current-indent)
(defn add-codeblock [indent start end]
(def replace-chunk (string "\n" (string/repeat " " indent)))
# remove indent worth of leading whitespace from lines of code block(?)
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(skip-line)
(skip-white))
(defn parse-fcb [indent]
(skip-n 3)
(skip-line)
(skip-n indent)
(def start cursor)
(var end cursor)
(while (c)
(when (fcb?) (break))
(skip-line)
(set end cursor)
(skip-white))
(add-codeblock indent start end))
(defn parse-icb [indent]
(var current-indent indent)
(def start cursor)
(var end cursor)
(while (c)
(skip-line)
(set end cursor)
(set current-indent (skip-white))
(when (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn tokenize-line [line]
(def tokens @[])
(def token @"")
(var token-length 0)
(defn delim [mode]
(def d (toggle-mode mode))
(buffer/push token d))
(defn endtoken []
(when (first token) (array/push tokens (string token)))
(buffer/clear token))
(forv i 0 (length line)
(def b (get line i))
(cond
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
(= b (chr "`")) (delim :code)
(not (modes :code))
(cond
(= b (chr `\`)) (buffer/push token (get line (++ i)))
(= b (chr "_")) (delim :underline)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(buffer/push token b))
(buffer/push token b)))
(endtoken)
(tuple/slice tokens))
(set
parse-blocks
(fn parse-blocks [indent]
(var new-indent indent)
(var p-start nil)
(var p-end nil)
(defn p-line []
(unless p-start
(set p-start cursor))
(skip-line)
(set p-end cursor)
(skip-white))
(defn end-p []
(when (and p-start (> p-end p-start))
(push (tokenize-line (getslice p-start p-end)))
(set p-start nil)))
(while (and (c) (>= new-indent indent))
(set new-indent
(cond
(nl?) (do (end-p) (skip-1) (skip-white))
(ul?) (do (end-p) (parse-list ul? :ul new-indent))
(ol?) (do (end-p) (parse-list ol? :ol new-indent))
(fcb?) (do (end-p) (parse-fcb new-indent))
(>= new-indent (+ 4 indent)) (do (end-p) (parse-icb new-indent))
(p-line))))
(end-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skip-line)
(def first-line (string/slice str 0 (- cursor 1)))
(push [first-line]))
(parse-blocks 0)
stack)
(comment
(def signal-ds
``
(signal what x)
Raise a signal with payload x. `what` can be an integer from 0 through 7 indicating user(0-7), or one
of:
* :ok
* :error
* :debug
* :yield
* :user(0-7)
* :interrupt
* :await
``)
(doc-parse-3 (get (dyn 'signal) :doc))
# =>
'@[["(signal what x)"]
["Raise" "a" "signal" "with" "payload" "x." "`what`" "can" "be"
"an" "integer" "from" "0" "through" "7" "indicating" "user(0-7),"
"or" "one" "of:"]
@[:ul
@[[":ok"]]
@[[":error"]]
@[[":debug"]]
@[[":yield"]]
@[[":user(0-7)"]]
@[[":interrupt"]]
@[[":await"]]]]
(def file-read-ds
``
(file/read f what &opt buf)
Read a number of bytes from a file `f` into a buffer. A buffer `buf` can be provided as an optional third
argument, otherwise a new buffer is created. `what` can either be an integer or a keyword. Returns the buffer
with file contents. Values for `what`:
* :all - read the whole file
* :line - read up to and including the next newline character
* n (integer) - read up to n bytes from the file
``)
(doc-parse-3 (get (dyn 'file/read) :doc))
# =>
'@[["(file/read f what &opt buf)"]
["Read" "a" "number" "of" "bytes" "from" "a" "file" "`f`" "into"
"a" "buffer." "A" "buffer" "`buf`" "can" "be" "provided" "as"
"an" "optional" "third" "argument," "otherwise" "a" "new" "buffer"
"is" "created." "`what`" "can" "either" "be" "an" "integer" "or"
"a" "keyword." "Returns" "the" "buffer" "with" "file" "contents."
"Values" "for" "`what`:"]
@[:ul
@[[":all" "-" "read" "the" "whole" "file"]]]
@[:ul
@[[":line" "-" "read" "up" "to" "and" "including" "the" "next"
"newline" "character"]]]
@[:ul
@[["n" "(integer)" "-" "read" "up" "to" "n" "bytes" "from" "the"
"file"]]]]
# XXX: blank line between:
#
# line ending "...keys:" and
# line beginning " * `:url`..."
#
# causes nesting to fail
#
# docstring below has been modified from the original
# (which didn't express nesting of one list within
# another) for experimental purposes. original from
# spork/pm.janet.
(def resolve-bundle-ds
```
Convert any bundle string/table to the normalized table form. `bundle` can be any of the following forms:
* A short name that indicates a package from the package listing.
* A URL or path to a git repository
* A URL or path to a .tar.gz archive
* A string of 2 parts separated by "::" - {type}::{path-or-url}
* A string of 3 parts separated by "::" - {type}::{path-or-url}::{tag}
* A table or struct with the following keys:
* `:url` or `:repo` - the URL or path of the git repository or of the .tar.gz file. Required.
* `:tag`, `:sha`, `:commit`, or `:ref` - The revision to checkout from version control. Optional.
* `:type` - The dependency type, either `:git`, `:tar`, or `:file`. The default is `:git`. Optional.
```)
(doc-parse-3 resolve-bundle-ds)
# =>
'@[["Convert" "any" "bundle" "string/table" "to" "the" "normalized"
"table" "form." "`bundle`" "can" "be" "any" "of" "the" "following"
"forms:"]
@[:ul
@[["A" "short" "name" "that" "indicates" "a" "package" "from"
"the" "package" "listing."]]
@[["A" "URL" "or" "path" "to" "a" "git" "repository"]]
@[["A" "URL" "or" "path" "to" "a" ".tar.gz" "archive"]]
@[["A" "string" "of" "2" "parts" "separated" "by" "\"::\"" "-"
"{type}::{path-or-url}"]]
@[["A" "string" "of" "3" "parts" "separated" "by" "\"::\"" "-"
"{type}::{path-or-url}::{tag}"]]
@[["A" "table" "or" "struct" "with" "the" "following" "keys:"]
@[:ul
@[["`:url`" "or" "`:repo`" "-" "the" "URL" "or" "path" "of"
"the" "git" "repository" "or" "of" "the" ".tar.gz" "file."
"Required."]]
@[["`:tag`," "`:sha`," "`:commit`," "or" "`:ref`" "-" "The"
"revision" "to" "checkout" "from" "version" "control."
"Optional."]]
@[["`:type`" "-" "The" "dependency" "type," "either" "`:git`,"
"`:tar`," "or" "`:file`." "The" "default" "is" "`:git`."
"Optional."]]]]]]
(def fiber-new-ds
``
(fiber/new func &opt sigmask env)
Create a new fiber with function body func. Can optionally take a set
of signals `sigmask` to capture from child fibers, and an environment
table `env`. The mask is specified as a keyword where each character
is used to indicate a signal to block. If the ev module is enabled,
and this fiber is used as an argument to `ev/go`, these "blocked"
signals will result in messages being sent to the supervisor
channel. The default sigmask is :y. For example,
(fiber/new myfun :e123)
blocks error signals and user signals 1, 2 and 3. The signals are as
follows:
* :a - block all signals
* :d - block debug signals
* :e - block error signals
* :t - block termination signals: error + user[0-4]
* :u - block user signals
* :y - block yield signals
* :w - block await signals (user9)
* :r - block interrupt signals (user8)
* :0-9 - block a specific user signal
The sigmask argument also can take environment flags. If any mutually
exclusive flags are present, the last flag takes precedence.
* :i - inherit the environment from the current fiber
* :p - the environment table's prototype is the current environment table
``)
(doc-parse-3 fiber-new-ds)
# =>
'@[["(fiber/new func &opt sigmask env)"]
["Create" "a" "new" "fiber" "with" "function" "body" "func."
"Can" "optionally" "take" "a" "set" "of" "signals" "`sigmask`"
"to" "capture" "from" "child" "fibers," "and" "an" "environment"
"table" "`env`." "The" "mask" "is" "specified" "as" "a" "keyword"
"where" "each" "character" "is" "used" "to" "indicate" "a"
"signal" "to" "block." "If" "the" "ev" "module" "is" "enabled,"
"and" "this" "fiber" "is" "used" "as" "an" "argument" "to"
"`ev/go`," "these" "\"blocked\"" "signals" "will" "result" "in"
"messages" "being" "sent" "to" "the" "supervisor" "channel." "The"
"default" "sigmask" "is" ":y." "For" "example,"]
@[:cb "(fiber/new myfun :e123)\n"]
["blocks" "error" "signals" "and" "user" "signals" "1," "2" "and"
"3." "The" "signals" "are" "as" "follows:"]
@[:ul
@[[":a" "-" "block" "all" "signals"]]
@[[":d" "-" "block" "debug" "signals"]]
@[[":e" "-" "block" "error" "signals"]]
@[[":t" "-" "block" "termination" "signals:" "error" "+"
"user[0-4]"]]
@[[":u" "-" "block" "user" "signals"]]
@[[":y" "-" "block" "yield" "signals"]]
@[[":w" "-" "block" "await" "signals" "(user9)"]]
@[[":r" "-" "block" "interrupt" "signals" "(user8)"]]
@[[":0-9" "-" "block" "a" "specific" "user" "signal"]]]
["The" "sigmask" "argument" "also" "can" "take" "environment"
"flags." "If" "any" "mutually" "exclusive" "flags" "are"
"present," "the" "last" "flag" "takes" "precedence."]
@[:ul
@[[":i" "-" "inherit" "the" "environment" "from" "the" "current"
"fiber"]]
@[[":p" "-" "the" "environment" "table's" "prototype" "is" "the"
"current" "environment" "table"]]]]
)
(defn doc-parse-4
```
Parse a docstring.
Docstrings can either be plaintext or a subset of markdown. This
allows a long single line of prose or formatted text to be a
well-formed docstring.
Returns a stack of parsed content.
```
[str]
(def modes @{})
(defn toggle-mode [mode]
(def active (get modes mode))
(def delims
(get {:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]} mode))
(put modes mode (not active))
(delims (if active 1 0)))
# Parse state
(var cursor 0) # indexes into string for parsing
(var stack @[]) # return value for this block.
# Traversal helpers
(defn c [] (get str cursor))
# fetch a byte that is n positions ahead of the cursor
(defn cn [n] (get str (+ n cursor)))
# skip* functions return number of characters matched and advance the cursor.
(defn skip-1 [] (++ cursor) 1)
(defn skip-n [n] (+= cursor n) n)
(defn skip-white []
(def old cursor)
(while (= (c) (chr " ")) (++ cursor))
(- cursor old))
(defn skip-line []
(def old cursor)
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
(skip-1)
(- cursor old))
# Detection helpers - return number of characters matched
(defn ul? []
(def [x x1] [(c) (cn 1)])
(and (= x1 (chr " "))
# XXX: could support + too?
(or (= x (chr "*")) (= x (chr "-")))
2))
(defn ol? []
(def old cursor)
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (skip-1))
(def [c1 c2 c*] [(c) (cn 1) cursor])
(set cursor old)
(when (and (= c1 (chr ".")) (= c2 (chr " ")))
(- c* cursor -2)))
(defn fcb? [] (when (= (chr "`") (c) (cn 1) (cn 2)) 3))
(defn nl? [] (when (= (chr "\n") (c)) 1))
# Parse helper
# parse-* functions push nodes to `stack`, and return
# the indentation they leave the cursor on.
(var parse-blocks nil) # mutual recursion
(defn getslice [from to]
(def to (min to (length str)))
(string/slice str from to))
(defn push [x] (array/push stack x))
(defn parse-list [bullet-check initial indent]
(def temp-stack @[initial])
(def old-stack stack)
(set stack temp-stack)
(var current-indent indent)
(while (and (c) (>= current-indent indent))
(def item-indent
(when-let [x (bullet-check)]
(skip-n x)
# XXX: why not indent x (skip-white)?
(+ indent (skip-white) x)))
(unless item-indent
(set current-indent (skip-white))
(break))
(def item-stack @[])
(set stack item-stack)
(set current-indent (parse-blocks item-indent))
(set stack temp-stack)
(push item-stack))
(set stack old-stack)
(push temp-stack)
current-indent)
(defn add-codeblock [indent start end]
(def replace-chunk (string "\n" (string/repeat " " indent)))
# remove indent worth of leading whitespace from lines of code block(?)
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(skip-line)
(skip-white))
(defn parse-fcb [indent]
(skip-n 3)
(skip-line)
(skip-n indent)
(def start cursor)
(var end cursor)
(while (c)
(when (fcb?) (break))
(skip-line)
(set end cursor)
(skip-white))
(add-codeblock indent start end))
(defn parse-icb [indent]
(var current-indent indent)
(def start cursor)
(var end cursor)
(while (c)
(skip-line)
(set end cursor)
(set current-indent (skip-white))
(when (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn tokenize-line [line]
(def tokens @[])
(def token @"")
(var token-length 0)
(defn delim [mode]
(def d (toggle-mode mode))
(buffer/push token d))
(defn endtoken []
(when (first token) (array/push tokens (string token)))
(buffer/clear token))
(forv i 0 (length line)
(def b (get line i))
(cond
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
(= b (chr "`")) (delim :code)
(not (modes :code))
(cond
(= b (chr `\`)) (buffer/push token (get line (++ i)))
(= b (chr "_")) (delim :underline)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(buffer/push token b))
(buffer/push token b)))
(endtoken)
(tuple/slice tokens))
(set
parse-blocks
(fn parse-blocks [indent]
(var new-indent indent)
(var p-start nil)
(var p-end nil)
(defn p-line []
(unless p-start
(set p-start cursor))
(skip-line)
(set p-end cursor)
(skip-white))
(defn end-p []
(when (and p-start (> p-end p-start))
(push (tokenize-line (getslice p-start p-end)))
(set p-start nil)))
(while (and (c) (>= new-indent indent))
(set new-indent
(cond
(nl?) (do (end-p) (skip-1) (skip-white))
(ul?) (do (end-p) (parse-list ul? :ul new-indent))
(ol?) (do (end-p) (parse-list ol? :ol new-indent))
(fcb?) (do (end-p) (parse-fcb new-indent))
(>= new-indent (+ 4 indent)) (do (end-p) (parse-icb new-indent))
(p-line))))
(end-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skip-line)
(def first-line (string/slice str 0 (- cursor 1)))
(push [first-line]))
(parse-blocks 0)
stack)
(comment
(def fiber-new-ds
``
(fiber/new func &opt sigmask env)
Create a new fiber with function body func. Can optionally take a set
of signals `sigmask` to capture from child fibers, and an environment
table `env`. The mask is specified as a keyword where each character
is used to indicate a signal to block. If the ev module is enabled,
and this fiber is used as an argument to `ev/go`, these "blocked"
signals will result in messages being sent to the supervisor
channel. The default sigmask is :y. For example,
(fiber/new myfun :e123)
blocks error signals and user signals 1, 2 and 3. The signals are as
follows:
* :a - block all signals
* :d - block debug signals
* :e - block error signals
* :t - block termination signals: error + user[0-4]
* :u - block user signals
* :y - block yield signals
* :w - block await signals (user9)
* :r - block interrupt signals (user8)
* :0-9 - block a specific user signal
The sigmask argument also can take environment flags. If any mutually
exclusive flags are present, the last flag takes precedence.
* :i - inherit the environment from the current fiber
* :p - the environment table's prototype is the current environment table
``)
(def os-compiler-ds
``
(os/compiler)
Get the compiler used to compile the interpreter. Returns one of:
* :gcc
* :clang
* :msvc
* :unknown
``)
# XXX: how about attributes in elements?
(doc-parse-4 fiber-new-ds)
# =>
'@[# XXX: should this be a :p thing too?
["(fiber/new func &opt sigmask env)"]
[:p
(string
"Create a new fiber with function body func."
"Can optionally take a set of signals")
[:code "sigmask"]
"to capture from child fibers, and an environment table"
[:code "env"]
(string
"."
"The mask is specified as a keyword where each character is "
"used to indicate a signal to block. "
"If the ev module is enabled, and this fiber is used as an "
"argument to")
[:code "ev/go"]
(string
", these \"blocked\" signals will result in messages being"
"sent to the supervisor channel."
"The default sigmask is :y."
"For example,")]
@[:cb "(fiber/new myfun :e123)\n"]
[:p
(string
"blocks error signals and user signals 1, 2 and 3."
"The signals are as follows:")]
@[:ul
@[:li ":a - block all signals"]
@[:li ":d - block debug signals"]
@[:li ":e - block error signals"]
@[:li ":t - block termination signals: error + user[0-4]"]
@[:li ":u - block user signals"]
@[:li ":y - block yield signals"]
@[:li ":w - block await signals (user9)"]
@[:li ":r - block interrupt signals (user8)"]
@[:li ":0-9 - block a specific user signal"]]
[:p
(string
"The sigmask argument also can take environment flags."
"If any mutually exclusive flags are present, the last"
"flag takes precedence.")]
@[:ul
@[:li ":i - inherit the environment from the current fiber"]
@[:li (string
":p - the environment table's prototype is the current "
"environment table")]]]
)
(defn doc-parse-5
```
Parse a docstring.
Docstrings can either be plaintext or a subset of markdown. This
allows a long single line of prose or formatted text to be a
well-formed docstring.
Returns a stack of parsed content.
```
[str]
(def modes @{})
(defn toggle-mode [mode]
(def active (get modes mode))
(def delims
(get {:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]} mode))
(put modes mode (not active))
(delims (if active 1 0)))
# Parse state
(var cursor 0) # indexes into string for parsing
(var stack @[]) # return value for this block.
# Traversal helpers
(defn c [] (get str cursor))
# fetch a byte that is n positions ahead of the cursor
(defn cn [n] (get str (+ n cursor)))
# skip* functions return number of characters matched and advance the cursor.
(defn skip-1 [] (++ cursor) 1)
(defn skip-n [n] (+= cursor n) n)
(defn skip-white []
(def old cursor)
(while (= (c) (chr " ")) (++ cursor))
(- cursor old))
(defn skip-line []
(def old cursor)
(while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
(skip-1)
(- cursor old))
# Detection helpers - return number of characters matched
(defn ul? []
(def [x x1] [(c) (cn 1)])
(and (= x1 (chr " "))
# XXX: could support + too?
(or (= x (chr "*")) (= x (chr "-")))
2))
(defn ol? []
(def old cursor)
(while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (skip-1))
(def [c1 c2 c*] [(c) (cn 1) cursor])
(set cursor old)
(when (and (= c1 (chr ".")) (= c2 (chr " ")))
(- c* cursor -2)))
(defn fcb? [] (when (= (chr "`") (c) (cn 1) (cn 2)) 3))
(defn nl? [] (when (= (chr "\n") (c)) 1))
# Parse helper
# parse-* functions push nodes to `stack`, and return
# the indentation they leave the cursor on.
(var parse-blocks nil) # mutual recursion
(defn getslice [from to]
(def to (min to (length str)))
(string/slice str from to))
(defn push [x] (array/push stack x))
(defn parse-list [bullet-check initial indent]
(def temp-stack @[initial])
(def old-stack stack)
(set stack temp-stack)
(var current-indent indent)
(while (and (c) (>= current-indent indent))
(def item-indent
(when-let [x (bullet-check)]
(skip-n x)
# XXX: why not indent x (skip-white)?
(+ indent (skip-white) x)))
(unless item-indent
(set current-indent (skip-white))
(break))
(def item-stack @[])
(set stack item-stack)
(set current-indent (parse-blocks item-indent))
(set stack temp-stack)
(push item-stack))
(set stack old-stack)
(push temp-stack)
current-indent)
(defn add-codeblock [indent start end]
(def replace-chunk (string "\n" (string/repeat " " indent)))
# remove indent worth of leading whitespace from lines of code block(?)
(push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(skip-line)
(skip-white))
(defn parse-fcb [indent]
(skip-n 3)
(skip-line)
(skip-n indent)
(def start cursor)
(var end cursor)
(while (c)
(when (fcb?) (break))
(skip-line)
(set end cursor)
(skip-white))
(add-codeblock indent start end))
(defn parse-icb [indent]
(var current-indent indent)
(def start cursor)
(var end cursor)
(while (c)
(skip-line)
(set end cursor)
(set current-indent (skip-white))
(when (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn tokenize-line [line]
(def tokens @[])
(def token @"")
(var token-length 0)
(defn delim [mode]
(def d (toggle-mode mode))
(buffer/push token d))
(defn endtoken []
(when (first token) (array/push tokens (string token)))
(buffer/clear token))
(forv i 0 (length line)
(def b (get line i))
(cond
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
(= b (chr "`")) (delim :code)
(not (modes :code))
(cond
(= b (chr `\`)) (buffer/push token (get line (++ i)))
(= b (chr "_")) (delim :underline)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(buffer/push token b))
(buffer/push token b)))
(endtoken)
(tuple/slice tokens))
(set
parse-blocks
(fn parse-blocks [indent]
(var new-indent indent)
(var p-start nil)
(var p-end nil)
(defn p-line []
(unless p-start
(set p-start cursor))
(skip-line)
(set p-end cursor)
(skip-white))
(defn end-p []
(when (and p-start (> p-end p-start))
(push (tokenize-line (getslice p-start p-end)))
(set p-start nil)))
# XXX: pyrmont's (or (nil?) ...) change applied for nested lists
(while (and (c)
(or (nl?) (>= new-indent indent)))
(set new-indent
(cond
(nl?) (do (end-p) (skip-1) (skip-white))
(ul?) (do (end-p) (parse-list ul? :ul new-indent))
(ol?) (do (end-p) (parse-list ol? :ol new-indent))
(fcb?) (do (end-p) (parse-fcb new-indent))
(>= new-indent (+ 4 indent)) (do (end-p) (parse-icb new-indent))
(p-line))))
(end-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skip-line)
(def first-line (string/slice str 0 (- cursor 1)))
(push [first-line]))
(parse-blocks 0)
stack)
(comment
# XXX: indented the last three list items to create a nested list
# (presumably that was the intent originally)
(def resolve-bundle-alt-ds
``
Convert any bundle string/table to the normalized table form. `bundle` can be any of the following forms:
* A short name that indicates a package from the package listing.
* A URL or path to a git repository
* A URL or path to a .tar.gz archive
* A string of 2 parts separated by "::" - {type}::{path-or-url}
* A string of 3 parts separated by "::" - {type}::{path-or-url}::{tag}
* A table or struct with the following keys:
* `:url` or `:repo` - the URL or path of the git repository or of the .tar.gz file. Required.
* `:tag`, `:sha`, `:commit`, or `:ref` - The revision to checkout from version control. Optional.
* `:type` - The dependency type, either `:git`, `:tar`, or `:file`. The default is `:git`. Optional.
``)
(doc-parse-5 resolve-bundle-alt-ds)
# =>
'@[["Convert" "any" "bundle" "string/table" "to" "the"
"normalized" "table" "form." "`bundle`" "can" "be" "any"
"of" "the" "following" "forms:"]
@[:ul
@[["A" "short" "name" "that" "indicates" "a" "package"
"from" "the" "package" "listing."]]
@[["A" "URL" "or" "path" "to" "a" "git" "repository"]]
@[["A" "URL" "or" "path" "to" "a" ".tar.gz" "archive"]]
@[["A" "string" "of" "2" "parts" "separated" "by" "\"::\""
"-" "{type}::{path-or-url}"]]
@[["A" "string" "of" "3" "parts" "separated" "by" "\"::\""
"-" "{type}::{path-or-url}::{tag}"]]
@[["A" "table" "or" "struct" "with" "the" "following" "keys:"]
@[:ul
@[["`:url`" "or" "`:repo`" "-" "the" "URL" "or" "path"
"of" "the" "git" "repository" "or" "of" "the"
".tar.gz" "file." "Required."]]
@[["`:tag`," "`:sha`," "`:commit`," "or" "`:ref`" "-"
"The" "revision" "to" "checkout" "from" "version"
"control." "Optional."]]
@[["`:type`" "-" "The" "dependency" "type," "either"
"`:git`," "`:tar`," "or" "`:file`." "The" "default"
"is" "`:git`." "Optional."]]]]]]
)
(comment
# candidate tree - paragraph, code span, code block, tight unordered list
'@{:tag "doc"
:content
@[@{:tag "p" :content @["(fiber/new func &opt sigmask env)"]}
@{:tag "p"
:content
@[(string
"Create a new fiber with function body func."
"Can optionally take a set of signals")
@{:tag "code" :content @["sigmask"]}
"to capture from child fibers, and an environment table"
@{:tag "code" :content @["env"]}
(string
"."
"The mask is specified as a keyword where each character is "
"used to indicate a signal to block. "
"If the ev module is enabled, and this fiber is used as an "
"argument to")
@[:tag "code" :content @["ev/go"]]
(string
", these \"blocked\" signals will result in messages being"
"sent to the supervisor channel."
"The default sigmask is :y."
"For example,")]}
# XXX: content value ends with \n or not...
@{:tag "cb" :content @["(fiber/new myfun :e123)\n"]}
@{:tag "p"
:content @[(string
"blocks error signals and user signals 1, 2 and 3."
"The signals are as follows:")]}
@{:tag "ul"
:content
@[@{:tag "li" :content @[":a - block all signals"]}
@{:tag "li" :content @[":d - block debug signals"]}
@{:tag "li" :content @[":e - block error signals"]}
@{:tag "li"
:content
@[":t - block termination signals: error + user[0-4]"]}
@{:tag "li" :content @[":u - block user signals"]}
@{:tag "li" :content @[":y - block yield signals"]}
@{:tag "li" :content @[":w - block await signals (user9)"]}
@{:tag "li"
:content @[":r - block interrupt signals (user8)"]}
@{:tag "li"
:content @[":0-9 - block a specific user signal"]}]}
@{:tag "p"
:content @[(string
"The sigmask argument also can take environment "
"flags. If any mutually exclusive flags are "
"present, the last flag takes precedence.")]}
@[:tag "ul"
:content
@[@{:tag "li"
:content
@[":i - inherit the environment from the current fiber"]}
@{:tag "li"
:content @[(string
":p - the environment table's prototype is "
"the current environment table")]}]]]}
# candidate tree - paragraph, loose unordered list
'@{:tag "doc"
:content
@[@{:tag "p" :content @["(os/compiler)"]}
@{:tag "p"
:content @[(string
"Get the compiler used to compile the interpreter. "
"Returns one of:")]}
@{:tag "ul"
:content
@[@{:tag "li" :content @[@{:tag "p" :content @[":gcc"]}]}
@{:tag "li" :content @[@{:tag "p" :content @[":clang"]}]}
@{:tag "li" :content @[@{:tag "p" :content @[":msvc"]}]}
@{:tag "li" :content @[@{:tag "p" :content @[":unknown"]}]}]}]}
# candidate tree - paragraph, nested list
'@{:tag "doc"
:content
@[@{:tag "p"
:content @[(string
"Convert any bundle string/table to the"
"normalized table form. `bundle` can be any"
"of the following forms:")]}
@{:tag ":ul"
:content
@[@{:tag "li"
:content @[(string "A short name that indicates a package"
"from the package listing.")]}
@{:tag "li"
:content @["A URL or path to a git repository"]}
@{:tag "li"
:content @["A URL or path to a .tar.gz archive"]}
@{:tag "li"
:content @[(string "A string of 2 parts separated by \"::\""
"- {type}::{path-or-url}")]}
@{:tag "li"
:content @[(string "A string of 3 parts separated by \"::\""
"- {type}::{path-or-url}::{tag}")]}
@{:tag "li"
:content
@["A table or struct with the following keys:"
@{:tag "ul"
:content
@[{:tag "li"
:content
@[(string
"`:url` or `:repo` - the URL or path of the git "
"repository or of the .tar.gz file. Required.")]}
@{:tag "li"
:content
@[(string
"`:tag`, `:sha`, `:commit`, or `:ref` - The "
"revision to checkout from version control. "
"Optional.")]}
@{:tag "li"
:content
@[(string
"`:type` - The dependency type, either `:git`, "
"`:tar`, or `:file`. The default is `:git`. "
"Optional.")]}]}]}]}]}
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment