mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-17 06:04:49 +00:00
Code Issues 1 Releases Wiki Activity

Address #694 - Update doc-format with more features.

Browse Source 
Also allows having doc-format print in color with
(dyn :doc-color).
This commit is contained in:
Calvin Rose 2021-05-29 20:34:22 -05:00
parent 7c757ef3bf
commit c911f7c47e
3 changed files with 264 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CHANGELOG.md
View File

@ -3,7 +3,6 @@ All notable changes to this project will be documented in this file.
## ??? - Unreleased ## ??? - Unreleased
- Add `as-macro` to make using macros within quasiquote easier to do hygienically. - Add `as-macro` to make using macros within quasiquote easier to do hygienically.
- Add `module/add-syspath`
- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API. - Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other - Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
native libraries when building with jpm. native libraries when building with jpm.

512
src/boot/boot.janet
View File

@ -33,12 +33,12 @@
# Add function signature to docstring # Add function signature to docstring
(var index 0) (var index 0)
(def arglen (length args)) (def arglen (length args))
(def buf (buffer "(" name)) (def buf (buffer "`(" name))
(while (< index arglen) (while (< index arglen)
(buffer/push-string buf " ") (buffer/push-string buf " ")
(buffer/format buf "%j" (in args index)) (buffer/format buf "%j" (in args index))
(set index (+ index 1))) (set index (+ index 1)))
(array/push modifiers (string buf ")\n\n" docstr)) (array/push modifiers (string buf ")`\n\n" docstr))
# Build return value # Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start))))) ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
@ -538,19 +538,19 @@
Where `binding` is a binding as passed to def, `:verb` is one of a set of Where `binding` is a binding as passed to def, `:verb` is one of a set of
keywords, and `object` is any expression. The available verbs are: keywords, and `object` is any expression. The available verbs are:
* :iterate -- repeatedly evaluate and bind to the expression while it is * `:iterate` - repeatedly evaluate and bind to the expression while it is
truthy. truthy.
* :range -- loop over a range. The object should be a two-element tuple with * `:range` - loop over a range. The object should be a two-element tuple with
a start and end value, and an optional positive step. The range is half a start and end value, and an optional positive step. The range is half
open, [start, end). open, [start, end).
* :range-to -- same as :range, but the range is inclusive [start, end]. * `:range-to` - same as :range, but the range is inclusive [start, end].
* :down -- loop over a range, stepping downwards. The object should be a * `:down` - loop over a range, stepping downwards. The object should be a
two-element tuple with a start and (exclusive) end value, and an optional two-element tuple with a start and (exclusive) end value, and an optional
(positive!) step size. (positive!) step size.
* :down-to -- same as :down, but the range is inclusive [start, end]. * `:down-to` - same as :down, but the range is inclusive [start, end].
* :keys -- iterate over the keys in a data structure. * `:keys` - iterate over the keys in a data structure.
* :pairs -- iterate over the key-value pairs as tuples in a data structure. * `:pairs` - iterate over the key-value pairs as tuples in a data structure.
* :in -- iterate over the values in a data structure or fiber. * `:in` - iterate over the values in a data structure or fiber.
`loop` also accepts conditionals to refine the looping further. Conditionals are of `loop` also accepts conditionals to refine the looping further. Conditionals are of
the form: the form:
@ -566,6 +566,7 @@
* `:before form` - evaluates a form for a side effect before the next inner loop. * `:before form` - evaluates a form for a side effect before the next inner loop.
* `:after form` - same as `:before`, but the side effect happens after the next inner loop. * `:after form` - same as `:before`, but the side effect happens after the next inner loop.
* `:repeat n` - repeats the next inner loop `n` times. * `:repeat n` - repeats the next inner loop `n` times.
lets try putting a loop item on multiple lines.
* `:when condition` - only evaluates the loop body when condition is true. * `:when condition` - only evaluates the loop body when condition is true.
The `loop` macro always evaluates to nil. The `loop` macro always evaluates to nil.
@ -2128,17 +2129,18 @@
Returns (in environment :exit-value environment) when complete. Returns (in environment :exit-value environment) when complete.
opts is a table or struct of options. The options are as follows: opts is a table or struct of options. The options are as follows:
* :chunks - callback to read into a buffer - default is getline * `:chunks` - callback to read into a buffer - default is getline
* :on-parse-error - callback when parsing fails - default is bad-parse * `:on-parse-error` - callback when parsing fails - default is bad-parse
* :env - the environment to compile against - default is the current env * `:env` - the environment to compile against - default is the current env
* :source - string path of source for better errors - default is "<anonymous>" * `:source` - string path of source for better errors - default is "<anonymous>"
* :on-compile-error - callback when compilation fails - default is bad-compile * `:on-compile-error` - callback when compilation fails - default is bad-compile
* :evaluator - callback that executes thunks. Signature is (evaluator thunk source env where) * `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
* :on-status - callback when a value is evaluated - default is debug/stacktrace. * `:on-status` - callback when a value is evaluated - default is debug/stacktrace.
* :fiber-flags - what flags to wrap the compilation fiber with. Default is :ia. * `:fiber-flags` - what flags to wrap the compilation fiber with. Default is :ia.
* :expander - an optional function that is called on each top level form before being compiled. * `:expander` - an optional function that is called on each top level form before being compiled.
* :parser - provide a custom parser that implements the same interface as Janet's built-in parser. * `:parser` - provide a custom parser that implements the same interface as Janet's built-in parser.
* :read - optional function to get the next form, called like (read env source). Overrides all parsing. * `:read` - optional function to get the next form, called like `(read env source)`.
Overrides all parsing.
``` ```
[opts] [opts]
@ -2264,8 +2266,9 @@
nil) nil)
(defn eval-string (defn eval-string
`Evaluates a string in the current environment. If more control over the ``
environment is needed, use run-context.` Evaluates a string in the current environment. If more control over the
environment is needed, use `run-context`.``
[str] [str]
(var state (string str)) (var state (string str))
(defn chunks [buf _] (defn chunks [buf _]
@ -2289,8 +2292,8 @@
returnval) returnval)
(defn eval (defn eval
`Evaluates a form in the current environment. If more control over the ``Evaluates a form in the current environment. If more control over the
environment is needed, use run-context.` environment is needed, use `run-context`.``
[form] [form]
(def res (compile form (fiber/getenv (fiber/current)) "eval")) (def res (compile form (fiber/getenv (fiber/current)) "eval"))
(if (= (type res) :function) (if (= (type res) :function)
@ -2393,25 +2396,6 @@
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative]) (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths) module/paths)
(defn module/add-syspath
```
Creates duplicates module paths entries for module loader that loads from the syspath.
This lets a user add multiple alternative syspaths is a convenient way. The new paths will be insterted
directly after the last path that references :sys:.
```
[extra-path]
(def system-paths (seq [x :in module/paths
:when (string? (0 x))
:when (string/find ":sys:" (0 x))] x))
(def new-paths (seq [x :in system-paths]
(tuple (string/replace-all ":sys:" extra-path (0 x))
;(slice x 1))))
(def last-index
(- (length module/paths)
(find-index |(string/find ":sys:" ($0 0)) (reverse module/paths))))
(array/insert module/paths last-index ;new-paths)
module/paths)
(module/add-paths ":native:" :native) (module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source) (module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source) (module/add-paths ".janet" :source)
@ -2664,229 +2648,255 @@
`Reformat a docstring to wrap a certain width. Docstrings can either be plaintext `Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
or a subset of markdown. This allows a long single line of prose or formatted text to be or a subset of markdown. This allows a long single line of prose or formatted text to be
a well-formed docstring. Returns a buffer containing the formatted text.` a well-formed docstring. Returns a buffer containing the formatted text.`
[str &opt width indent] [str &opt width indent colorize]
(default indent 4) (default indent 4)
(def max-width (- (or width (dyn :doc-width 80)) 8)) (def max-width (- (or width (dyn :doc-width 80)) 8))
(def len (length str)) (def has-color (if (not= nil colorize)
(def res @"") colorize
(var pos 0) (dyn :doc-color)))
(def line @"")
(var line-width 0)
(def levels @[0])
(var leading 0)
(var c nil)
(set pos 0) # Terminal codes for emission/tokenization
(def delimiters
(if has-color
{:underline ["\e[4m" "\e[24m"]
:code ["\e[3;97m" "\e[39;23m"]
:italics ["\e[3m" "\e[23m"]
:bold ["\e[1m" "\e[22m"]}
{:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"]
:bold ["**" "**"]}))
(def modes @{})
(defn toggle [mode]
(def active (get modes mode))
(def delims (get delimiters mode))
(put modes mode (not active))
(delims (if active 1 0)))
(defn skip-line-indent [] # Parse state
(var pos* pos) (var cursor 0) # indexes into string for parsing
(set c (get str pos*)) (var stack @[]) # return value for this block.
(while (and c
(not= 10 c)
(= 32 c))
(set c (get str (++ pos*))))
(set leading (- pos* pos))
(set pos pos*))
(defn update-levels [] # Traversal helpers
(while (< leading (array/peek levels)) (defn c [] (get str cursor))
(array/pop levels) (defn cn [n] (get str (+ n cursor)))
(if (empty? levels) (break)))) (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))
(defn start-nl? [] # Detection helpers - return number of characters natched
(= 10 (get str pos))) (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)))
(defn start-fcb? [] # Parse helper
(and (= 96 (get str (+ pos))) # parse-* functions push nodes to `stack`, and return
(= 96 (get str (+ pos 1))) # the indentation they leave the cursor on.
(= 96 (get str (+ pos 2)))))
(defn end-fcb? [] (var parse-blocks nil) # mutual recursion
(and (= 96 (get str (+ pos))) (defn getslice [from to]
(= 96 (get str (+ pos 1))) (def to (min to (length str)))
(= 96 (get str (+ pos 2))) (string/slice str from to))
(= 10 (get str (+ pos 3))))) (defn push [x] (array/push stack x))
(defn start-icb? [] (defn parse-list [bullet-check initial indent]
(and (not= leading (array/peek levels)) (def temp-stack @[initial])
(or (= 4 leading) (def old-stack stack)
(= 4 (- leading (array/peek levels)))))) (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 start-ul? [] (defn add-codeblock [indent start end]
(var pos* pos) (def replace-chunk (string "\n" (string/repeat " " indent)))
(var c* (get str pos*)) (push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
(while (and c* (= 32 c*)) (skipline)
(set c* (get str (++ pos*)))) (skipwhite))
(and (or (= 42 c*)
(= 43 c*)
(= 45 c*))
(= 32 (get str (+ pos* 1)))))
(defn start-ol? [] (defn parse-fcb [indent]
(var pos* pos) (c+=n 3)
(var c* (get str pos*)) (skipline)
(while (and c* (= 32 c*)) (c+=n indent)
(set c* (get str (++ pos*)))) (def start cursor)
(while (and c* (var end cursor)
(<= 48 c*) (while (c)
(>= 57 c*)) (if (fcb?) (break))
(set c* (get str (++ pos*)))) (skipline)
(set c* (get str (-- pos*))) (set end cursor)
(and (<= 48 c*) (skipwhite))
(>= 57 c*) (add-codeblock indent start end))
(= 46 (get str (+ pos* 1)))
(= 32 (get str (+ pos* 2)))))
(defn push-line [] (defn parse-icb [indent]
(buffer/push-string res (buffer/new-filled indent 32)) (var current-indent indent)
(set c (get str pos)) (def start cursor)
(while (and c (not= 10 c)) (var end cursor)
(buffer/push-byte res c) (while (c)
(set c (get str (++ pos)))) (skipline)
(buffer/push-byte res 10) (set end cursor)
(++ pos)) (set current-indent (skipwhite))
(if (< current-indent indent) (break)))
(add-codeblock indent start end))
(defn push-bullet [] (defn tokenize-line [line]
(var pos* pos) (def tokens @[])
(buffer/push-string line (buffer/new-filled leading 32)) (def token @"")
(set c (get str pos*)) (var token-length 0)
# Add bullet (defn delim [mode]
(while (and c (not= 32 c)) (def d (toggle mode))
(buffer/push-byte line c) (if-not has-color (+= token-length (length d)))
(set c (get str (++ pos*)))) (buffer/push token d))
# Add item indentation (defn endtoken []
(while (= 32 c) (if (first token) (array/push tokens [(string token) token-length]))
(buffer/push-byte line c) (buffer/clear token)
(set c (get str (++ pos*)))) (set token-length 0))
# Record indentation if necessary (forv i 0 (length line)
(def item-indent (+ leading (- pos* pos))) (def b (get line i))
(when (not= item-indent (array/peek levels)) (cond
(array/push levels item-indent)) (or (= b (chr "\n")) (= b (chr " "))) (endtoken)
# Update line width (= b (chr `\`)) (do
(+= line-width item-indent) (++ token-length)
# Update position (buffer/push token (get line (++ i))))
(set pos pos*)) (= b (chr "_")) (delim :underline)
(= b (chr "`")) (delim :code)
(= b (chr "*"))
(if (= (chr "*") (get line (+ i 1)))
(do (++ i)
(delim :bold))
(delim :italics))
(do (++ token-length) (buffer/push token b))))
(endtoken)
(tuple/slice tokens))
(defn push-word [hang-indent] (set parse-blocks (fn parse-blocks [indent]
(def word @"") (var new-indent indent)
(var word-len 0) (var p-start nil)
# Build a word (var p-end nil)
(while (and c (defn p-line []
(not= 10 c) (unless p-start
(not= 32 c)) (set p-start cursor))
(buffer/push-byte word c) (skipline)
(++ word-len) (set p-end cursor)
(set c (get str (++ pos)))) (set new-indent (skipwhite)))
# Start new line if necessary (defn finish-p []
(when (> (+ line-width word-len) max-width) (when (and p-start (> p-end p-start))
# Push existing line (push (tokenize-line (getslice p-start p-end)))
(buffer/push-byte line 10) (set p-start nil)))
(buffer/push-string res line) (while (and (c) (>= new-indent indent))
(buffer/clear line) (cond
# Indent new line (nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
(buffer/push-string line (buffer/new-filled hang-indent 32)) (ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
(set line-width hang-indent)) (ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
# Add single space if not beginning of line (fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
(when (not= line-width hang-indent) (>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
(buffer/push-byte line 32) (p-line)))
(++ line-width)) (finish-p)
# Push word onto line new-indent))
(buffer/push-string line word)
(set line-width (+ line-width word-len)))
(defn push-nl [] (parse-blocks 0)
(when (< pos len)
(buffer/push-byte res 10)
(++ pos)))
(defn push-list [] # Emission state
(update-levels) (def buf @"")
# Indent first line (var current-column 0)
(buffer/push-string line (buffer/new-filled indent 32))
(set line-width indent)
# Add bullet
(push-bullet)
# Add words
(set c (get str pos))
(while (and c
(not= 10 c))
# Skip spaces
(while (= 32 c)
(set c (get str (++ pos))))
# Add word
(push-word (+ indent (array/peek levels)))
(def old-c c)
(set c (get str (++ pos)))
# Check if next line is a new item
(when (and (= 10 old-c)
(or (start-ul?)
(start-ol?)))
(set c (get str (-- pos)))))
# Add final line
(buffer/push-string res line)
(buffer/clear line)
# Move position back for newline
(-- pos)
(push-nl))
(defn push-fcb [] # Emission
(update-levels) (defn emit-indent [indent]
(push-line) (def delta (- indent current-column))
(while (and (< pos len) (not (end-fcb?))) (when (< 0 delta)
(push-line)) (buffer/push buf (string/repeat " " delta))
(push-line)) (set current-column indent)))
(defn push-icb [] (defn emit-nl [&opt indent]
(buffer/push-string res (buffer/new-filled leading 32)) (buffer/push buf "\n")
(push-line) (set current-column 0))
(while (and (< pos len) (not (start-nl?)))
(push-line))
(push-nl))
(defn push-p [] (defn emit-word [word indent &opt len]
(update-levels) (def last-byte (last buf))
# Set up the indentation (when (and
(def para-indent (+ indent (array/peek levels))) last-byte
# Indent first line (not= last-byte (chr "\n"))
(buffer/push-string line (buffer/new-filled para-indent 32)) (not= last-byte (chr " ")))
(set line-width para-indent) (buffer/push buf " ")
# Add words (++ current-column))
(set c (get str pos)) (default len (length word))
(while (and c (not= 10 c)) (when (and indent (> (+ 1 current-column len) max-width))
# Skip spaces (emit-nl)
(while (= 32 c) (emit-indent indent))
(set c (get str (++ pos)))) (buffer/push buf word)
# Add word (+= current-column len))
(push-word para-indent)
(set c (get str (++ pos))))
# Add final line
(buffer/push-string res line)
(buffer/clear line)
# Move position back for newline
(-- pos)
(push-nl)
(push-nl))
(while (< pos len) (defn emit-code
(skip-line-indent) [code indent]
(cond (def replacement (string "\n" (string/repeat " " (+ 4 indent))))
(start-nl?) (emit-indent (+ 4 indent))
(push-nl) (buffer/push buf (string/replace-all "\n" replacement code))
(if (= (chr "\n") (last code))
(set current-column 0)
(emit-nl)))
(start-ul?) (defn emit-node
(push-list) [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))))
(start-ol?) (each el stack
(push-list) (emit-nl)
(emit-node el indent))
(start-fcb?) buf)
(push-fcb)
(start-icb?)
(push-icb)
(push-p)))
res)
(defn- print-index (defn- print-index
"Print bindings in the current environment given a filter function" "Print bindings in the current environment given a filter function"
@ -2914,10 +2924,10 @@
(print "\n\n" (print "\n\n"
(when d bind-type) (when d bind-type)
(when-let [[path line col] sm] (when-let [[path line col] sm]
(string " " path (when (and line col) (string " on line " line ", column " col)) "\n")) (string " " path (when (and line col) (string " on line " line ", column " col))))
(when (or d sm) "\n") (when sm "\n")
(if d (doc-format d) " no documentation found.") (if d (doc-format d) "\n no documentation found.\n")
"\n\n")) "\n"))
(defn- print-special-form-entry (defn- print-special-form-entry
[x] [x]
@ -3147,12 +3157,13 @@
### ###
(defn repl (defn repl
`Run a repl. The first parameter is an optional function to call to ``Run a repl. The first parameter is an optional function to call to
get a chunk of source code that should return nil for end of file. get a chunk of source code that should return nil for end of file.
The second parameter is a function that is called when a signal is The second parameter is a function that is called when a signal is
caught. One can provide an optional environment table to run caught. One can provide an optional environment table to run
the repl in, as well as an optional parser or read function to pass the repl in, as well as an optional parser or read function to pass
to run-context.` to `run-context.`
``
[&opt chunks onsignal env parser read] [&opt chunks onsignal env parser read]
(default env (make-env)) (default env (make-env))
(default chunks (default chunks
@ -3478,6 +3489,7 @@
(getter (getprompt p) buf env)) (getter (getprompt p) buf env))
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q")) (setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
(setdyn :err-color (if *colorize* true)) (setdyn :err-color (if *colorize* true))
(setdyn :doc-color (if *colorize* true))
(repl getchunk nil env))))) (repl getchunk nil env)))))
### ###

4
src/core/string.c
View File

@ -589,14 +589,14 @@ static const JanetReg string_cfuns[] = {
}, },
{ {
"string/find", cfun_string_find, "string/find", cfun_string_find,
JDOC("(string/find patt str)\n\n" JDOC("(string/find patt str &opt start-index)\n\n"
"Searches for the first instance of pattern patt in string " "Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, " "str. Returns the index of the first character in patt if found, "
"otherwise returns nil.") "otherwise returns nil.")
}, },
{ {
"string/find-all", cfun_string_findall, "string/find-all", cfun_string_findall,
JDOC("(string/find-all patt str)\n\n" JDOC("(string/find-all patt str &opt start-index)\n\n"
"Searches for all instances of pattern patt in string " "Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping " "str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in str " "instances of the pattern are counted individually, meaning a byte in str "