mirror of
https://github.com/janet-lang/janet
synced 2025-07-03 18:42:54 +00:00
Add defdyn
macro to allow docs and checking for dyns.
Using keywords for the names of dynamic bindings emphasized their dynamic nature and how they actually work, but is opaque when it comes to documentation and error detection. Janet uses early binding for name resolution by default in most places, dyns should be no different. The `defdyn` macro allows one to create aliases for keywords that can have docstrings, be imported and exported, etc. The aliases _must_ follow the usual lisp convention of earmuffs - this is not restricting since the underlying keyword lookup mechanism is still completely accessible to users. Example: (defdyn *my-dynamic-binding* "Sends the plumbus to the thingamizer when enabled") The above creates a normal binding (as created with `def`) for `*my-dynamic-binding*` that is bound to the keyword `:my-dynamic-binding`. There is an optional prefix for defdyns that can be used to avoid name collisions - *defdyn-prefix* Example: (setdyn *defdyn-prefix* "mylib/") (defdyn *my-dynamic-binding* "Plumbus thingamizer") (pp *my-dynamic-binding*) > :mylib/my-dynamic-binding
This commit is contained in:
parent
2f068b91d8
commit
461576e7a2
@ -1155,12 +1155,36 @@
|
|||||||
(array/push parts (tuple apply f $args)))
|
(array/push parts (tuple apply f $args)))
|
||||||
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
||||||
|
|
||||||
|
(defmacro defdyn
|
||||||
|
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||||
|
alias is a normal, lexically scoped binding that can be used instead of
|
||||||
|
a keyword to prevent typos. Defdyn does not set dynamic bindings or otherwise
|
||||||
|
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
|
||||||
|
called "earmuffs".``
|
||||||
|
[alias & more]
|
||||||
|
(assert (symbol? alias) "alias must be a symbol")
|
||||||
|
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
|
||||||
|
(def prefix (dyn :defdyn-prefix))
|
||||||
|
(def kw (keyword prefix (slice alias 1 -2)))
|
||||||
|
~(def ,alias :dyn ,;more ,kw))
|
||||||
|
|
||||||
|
(defdyn *defdyn-prefix* "Optional namespace prefix to add to keywords declared with `defdyn`.
|
||||||
|
Use this to prevent keyword collisions between dynamic bindings.")
|
||||||
|
(defdyn *out* "Where normal print functions print output to.")
|
||||||
|
(defdyn *err* "Where error printing prints output to.")
|
||||||
|
|
||||||
|
(defdyn *macro-form*
|
||||||
|
"Inside a macro, is bound to the source form that invoked the macro")
|
||||||
|
|
||||||
|
(defdyn *current-file*
|
||||||
|
"Bound to the name of the currently compiling file.")
|
||||||
|
|
||||||
(defmacro tracev
|
(defmacro tracev
|
||||||
`Print a value and a description of the form that produced that value to
|
`Print a value and a description of the form that produced that value to
|
||||||
stderr. Evaluates to x.`
|
stderr. Evaluates to x.`
|
||||||
[x]
|
[x]
|
||||||
(def [l c] (tuple/sourcemap (dyn :macro-form ())))
|
(def [l c] (tuple/sourcemap (dyn *macro-form* ())))
|
||||||
(def cf (dyn :current-file))
|
(def cf (dyn *current-file*))
|
||||||
(def fmt-1 (if cf (string/format "trace [%s]" cf) "trace"))
|
(def fmt-1 (if cf (string/format "trace [%s]" cf) "trace"))
|
||||||
(def fmt-2 (if (or (neg? l) (neg? c)) ":" (string/format " on line %d, column %d:" l c)))
|
(def fmt-2 (if (or (neg? l) (neg? c)) ":" (string/format " on line %d, column %d:" l c)))
|
||||||
(def fmt (string fmt-1 fmt-2 " %j is "))
|
(def fmt (string fmt-1 fmt-2 " %j is "))
|
||||||
@ -1655,10 +1679,13 @@
|
|||||||
(file/close f)
|
(file/close f)
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
(defdyn *pretty-format*
|
||||||
|
"Format specifier for the `pp` function")
|
||||||
|
|
||||||
(defn pp
|
(defn pp
|
||||||
`Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
|
`Pretty print to stdout or (dyn *out*). The format string used is (dyn *pretty-format* "%q").`
|
||||||
[x]
|
[x]
|
||||||
(printf (dyn :pretty-format "%q") x)
|
(printf (dyn *pretty-format* "%q") x)
|
||||||
(flush))
|
(flush))
|
||||||
|
|
||||||
###
|
###
|
||||||
@ -1882,13 +1909,17 @@
|
|||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
|
||||||
|
(defdyn *macro-lints*
|
||||||
|
"Bound to an array of lint messgae that will be reported by the compiler inside a macro.
|
||||||
|
To indicate an error or warning, a macro author should use `maclintf`.")
|
||||||
|
|
||||||
(defn maclintf
|
(defn maclintf
|
||||||
``When inside a macro, call this function to add a linter warning. Takes
|
``When inside a macro, call this function to add a linter warning. Takes
|
||||||
a `fmt` argument like `string/format` which is used to format the message.``
|
a `fmt` argument like `string/format` which is used to format the message.``
|
||||||
[level fmt & args]
|
[level fmt & args]
|
||||||
(def lints (dyn :macro-lints))
|
(def lints (dyn *macro-lints*))
|
||||||
(when lints
|
(when lints
|
||||||
(def form (dyn :macro-form))
|
(def form (dyn *macro-form*))
|
||||||
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
|
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
|
||||||
(def l (if-not (= -1 l) l))
|
(def l (if-not (= -1 l) l))
|
||||||
(def c (if-not (= -1 c) c))
|
(def c (if-not (= -1 c) c))
|
||||||
@ -1983,7 +2014,7 @@
|
|||||||
(def m? (in entry :macro))
|
(def m? (in entry :macro))
|
||||||
(cond
|
(cond
|
||||||
s (s t)
|
s (s t)
|
||||||
m? (do (setdyn :macro-form t) (m ;(tuple/slice t 1)))
|
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
|
||||||
(tuple/slice (map recur t))))
|
(tuple/slice (map recur t))))
|
||||||
|
|
||||||
(def ret
|
(def ret
|
||||||
@ -2191,10 +2222,13 @@
|
|||||||
(def newenv (table/setproto @{} parent))
|
(def newenv (table/setproto @{} parent))
|
||||||
newenv)
|
newenv)
|
||||||
|
|
||||||
|
(defdyn *err-color*
|
||||||
|
"Whether or not to turn on error coloring in stacktraces and other error messages.")
|
||||||
|
|
||||||
(defn bad-parse
|
(defn bad-parse
|
||||||
"Default handler for a parse error."
|
"Default handler for a parse error."
|
||||||
[p where]
|
[p where]
|
||||||
(def ec (dyn :err-color))
|
(def ec (dyn *err-color*))
|
||||||
(def [line col] (:where p))
|
(def [line col] (:where p))
|
||||||
(eprint
|
(eprint
|
||||||
(if ec "\e[31m" "")
|
(if ec "\e[31m" "")
|
||||||
@ -2231,7 +2265,7 @@
|
|||||||
(defn warn-compile
|
(defn warn-compile
|
||||||
"Default handler for a compile warning"
|
"Default handler for a compile warning"
|
||||||
[msg level where &opt line col]
|
[msg level where &opt line col]
|
||||||
(def ec (dyn :err-color))
|
(def ec (dyn *err-color*))
|
||||||
(eprin
|
(eprin
|
||||||
(if ec "\e[33m" "")
|
(if ec "\e[33m" "")
|
||||||
where
|
where
|
||||||
@ -2249,7 +2283,7 @@
|
|||||||
(defn bad-compile
|
(defn bad-compile
|
||||||
"Default handler for a compile error."
|
"Default handler for a compile error."
|
||||||
[msg macrof where &opt line col]
|
[msg macrof where &opt line col]
|
||||||
(def ec (dyn :err-color))
|
(def ec (dyn *err-color*))
|
||||||
(eprin
|
(eprin
|
||||||
(if ec "\e[31m" "")
|
(if ec "\e[31m" "")
|
||||||
where
|
where
|
||||||
@ -2329,7 +2363,7 @@
|
|||||||
(var where default-where)
|
(var where default-where)
|
||||||
|
|
||||||
(if (string? where)
|
(if (string? where)
|
||||||
(put env :current-file where))
|
(put env *current-file* where))
|
||||||
|
|
||||||
# Evaluate 1 source form in a protected manner
|
# Evaluate 1 source form in a protected manner
|
||||||
(def lints @[])
|
(def lints @[])
|
||||||
@ -2411,7 +2445,7 @@
|
|||||||
(do
|
(do
|
||||||
(set where new-where)
|
(set where new-where)
|
||||||
(if (string? new-where)
|
(if (string? new-where)
|
||||||
(put env :current-file new-where)))
|
(put env *current-file* new-where)))
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(var pindex 0)
|
(var pindex 0)
|
||||||
@ -2669,7 +2703,7 @@
|
|||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
(put env :exit true)
|
(put env :exit true)
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
(with-dyns [:err buf :err-color false]
|
(with-dyns [*err* buf *err-color* false]
|
||||||
(bad-parse x y))
|
(bad-parse x y))
|
||||||
(set exit-error (string/slice buf 0 -2)))
|
(set exit-error (string/slice buf 0 -2)))
|
||||||
(defn bc [&opt x y z a b]
|
(defn bc [&opt x y z a b]
|
||||||
@ -2678,7 +2712,7 @@
|
|||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
(put env :exit true)
|
(put env :exit true)
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
(with-dyns [:err buf :err-color false]
|
(with-dyns [*err* buf *err-color* false]
|
||||||
(bad-compile x nil z a b))
|
(bad-compile x nil z a b))
|
||||||
(set exit-error (string/slice buf 0 -2))
|
(set exit-error (string/slice buf 0 -2))
|
||||||
(set exit-fiber y))
|
(set exit-fiber y))
|
||||||
@ -2827,6 +2861,12 @@
|
|||||||
[&opt env local]
|
[&opt env local]
|
||||||
(env-walk keyword? env local))
|
(env-walk keyword? env local))
|
||||||
|
|
||||||
|
(defdyn *doc-width*
|
||||||
|
"Width in columns to print documentation printed with `doc-format`")
|
||||||
|
|
||||||
|
(defdyn *doc-color*
|
||||||
|
"Whether or not to colorize documentation printed with `doc-format`.")
|
||||||
|
|
||||||
(defn doc-format
|
(defn doc-format
|
||||||
`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
|
||||||
@ -2834,10 +2874,10 @@
|
|||||||
[str &opt width indent colorize]
|
[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 has-color (if (not= nil colorize)
|
(def has-color (if (not= nil colorize)
|
||||||
colorize
|
colorize
|
||||||
(dyn :doc-color)))
|
(dyn *doc-color*)))
|
||||||
|
|
||||||
# Terminal codes for emission/tokenization
|
# Terminal codes for emission/tokenization
|
||||||
(def delimiters
|
(def delimiters
|
||||||
@ -3200,7 +3240,7 @@
|
|||||||
"Print the current fiber stack"
|
"Print the current fiber stack"
|
||||||
[]
|
[]
|
||||||
(print)
|
(print)
|
||||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) (.signal) ""))
|
(with-dyns [*err-color* false] (debug/stacktrace (.fiber) (.signal) ""))
|
||||||
(print))
|
(print))
|
||||||
|
|
||||||
(defn .frame
|
(defn .frame
|
||||||
@ -3554,6 +3594,7 @@
|
|||||||
(debug/stacktrace f e "")))
|
(debug/stacktrace f e "")))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### CLI Tool Main
|
### CLI Tool Main
|
||||||
@ -3570,12 +3611,22 @@
|
|||||||
(let [thunk (compile [main ;subargs] env arg)]
|
(let [thunk (compile [main ;subargs] env arg)]
|
||||||
(if (function? thunk) (thunk) (error (thunk :error))))))
|
(if (function? thunk) (thunk) (error (thunk :error))))))
|
||||||
|
|
||||||
|
(defdyn *args*
|
||||||
|
"Dynamic bindings that will contain command line arguments at program start")
|
||||||
|
|
||||||
|
(defdyn *executable*
|
||||||
|
"Name of the interpreter executable used to execute this program. Corresponds to argv[0] in the call to
|
||||||
|
int main(int argc, char **argv);")
|
||||||
|
|
||||||
|
(defdyn *profilepath*
|
||||||
|
"Path to profile file loaded when starting up the repl.")
|
||||||
|
|
||||||
(defn cli-main
|
(defn cli-main
|
||||||
`Entrance for the Janet CLI tool. Call this function with the command line
|
`Entrance for the Janet CLI tool. Call this function with the command line
|
||||||
arguments as an array or tuple of strings to invoke the CLI interface.`
|
arguments as an array or tuple of strings to invoke the CLI interface.`
|
||||||
[args]
|
[args]
|
||||||
|
|
||||||
(setdyn :args args)
|
(setdyn *args* args)
|
||||||
|
|
||||||
(var should-repl false)
|
(var should-repl false)
|
||||||
(var no-file true)
|
(var no-file true)
|
||||||
@ -3591,7 +3642,7 @@
|
|||||||
(var expect-image false)
|
(var expect-image false)
|
||||||
|
|
||||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
|
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
|
||||||
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile))
|
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
|
||||||
|
|
||||||
(defn- get-lint-level
|
(defn- get-lint-level
|
||||||
[i]
|
[i]
|
||||||
@ -3601,7 +3652,7 @@
|
|||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers
|
(def handlers
|
||||||
{"h" (fn [&]
|
{"h" (fn [&]
|
||||||
(print "usage: " (dyn :executable "janet") " [options] script args...")
|
(print "usage: " (dyn *executable* "janet") " [options] script args...")
|
||||||
(print
|
(print
|
||||||
```
|
```
|
||||||
Options are:
|
Options are:
|
||||||
@ -3663,7 +3714,7 @@
|
|||||||
"d" (fn [&] (set debug-flag true) 1)
|
"d" (fn [&] (set debug-flag true) 1)
|
||||||
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
||||||
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
||||||
"R" (fn [&] (setdyn :profilepath nil) 1)})
|
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
||||||
|
|
||||||
(defn- dohandler [n i &]
|
(defn- dohandler [n i &]
|
||||||
(def h (in handlers n))
|
(def h (in handlers n))
|
||||||
@ -3719,7 +3770,7 @@
|
|||||||
(file/flush stdout)
|
(file/flush stdout)
|
||||||
(file/read stdin :line buf))
|
(file/read stdin :line buf))
|
||||||
(def env (make-env))
|
(def env (make-env))
|
||||||
(when-let [profile.janet (dyn :profilepath)]
|
(when-let [profile.janet (dyn *profilepath*)]
|
||||||
(def new-env (dofile profile.janet :exit true))
|
(def new-env (dofile profile.janet :exit true))
|
||||||
(merge-module env new-env "" false))
|
(merge-module env new-env "" false))
|
||||||
(when debug-flag
|
(when debug-flag
|
||||||
|
Loading…
x
Reference in New Issue
Block a user