diff options
Diffstat (limited to 'macros')
| -rw-r--r-- | macros/core.fnl | 56 | ||||
| -rw-r--r-- | macros/fn.fnl | 156 |
2 files changed, 171 insertions, 41 deletions
diff --git a/macros/core.fnl b/macros/core.fnl new file mode 100644 index 0000000..e88d575 --- /dev/null +++ b/macros/core.fnl @@ -0,0 +1,56 @@ +(import-macros {: fn*} :macros.fn) +(local _unpack (or table.unpack unpack)) + +(fn check-bindings [bindings] + (assert-compile (sequence? bindings) "expected binding table + +* Try placing a table here in square brackets containing identifiers to bind." bindings) + (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings)) + +(fn* if-let + ([bindings then] + (if-let bindings then 'nil)) + ([bindings then else] + (check-bindings bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if tmp# + (let [,form tmp#] + ,then) + ,else))))) + +(fn* when-let + [bindings & body] + (check-bindings bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if tmp# + (let [,form tmp#] + ,(_unpack body)))))) + +(fn* if-some + ([bindings then] + (if-some bindings then 'nil)) + ([bindings then else] + (check-bindings bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if (= tmp# nil) + ,else + (let [,form tmp#] + ,then)))))) + +(fn* when-some + [bindings & body] + (check-bindings bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if (= tmp# nil) + nil + (let [,form tmp#] + ,(_unpack body)))))) + +{: if-let + : when-let + : if-some + : when-some} diff --git a/macros/fn.fnl b/macros/fn.fnl index 7d12008..7a3b027 100644 --- a/macros/fn.fnl +++ b/macros/fn.fnl @@ -5,55 +5,73 @@ (= (type x) "string")) (fn has-amp? [args] - "Check if arglist has `&' and return its position of `false'. -Performs additional checks for `&' usage in arglist." - + ;; Check if arglist has `&' and return its position of `false'. + ;; Performs additional checks for `&' and `...' usage in arglist. (var res false) (each [i s (ipairs args)] (if (= (tostring s) "&") (if res (assert-compile false "only one `&' can be specified in arglist." args) (set res i)) + (= (tostring s) "...") + (assert-compile false "use of `...' in `fn*' is not permitted." args) (and res (> i (+ res 1))) - (assert-compile false "only one `more' arg can be supplied after `&' in arglist." args))) + (assert-compile false "only one `more' argument can be supplied after `&' in arglist." args))) res) (fn gen-arity [[args & body]] - "Forms three values, representing data needed to create dispatcher: - -- the lengs of arglist; -- the body of the function we generate; -- position of `&' in the arglist. " + ;; Forms three values, representing data needed to create dispatcher: + ;; + ;; - the length of arglist; + ;; - the body of the function we generate; + ;; - position of `&' in the arglist if any. (assert-compile (sequence? args) "fn*: expected parameters table. + * Try adding function parameters as a list of identifiers in brackets." args) (values (length args) - (list 'let [args ['...]] (_unpack body)) + (list 'let [args ['...]] (list 'do (_unpack body))) (has-amp? args))) -(fn arity-dispatcher [len fixed amp-body name] - "Forms an `if' expression with all fixed arities first, then `&' -arity, if present, and default error message as last arity. - -`len' is a symbol, that represens the length of the current argumen -list, and is computed at runtime. - -`fixed' is a table of arities with fixed amount of arguments. These are put in this `if' as: -`(= len fixed-len)', where `fixed-len' is the length of current arity arglist, computed with `gen-arity'. - -`amp-body' stores size of fixed part of arglist, that is, everything up until `&'" +(fn arity-dispatcher [len fixed body& name] + ;; Forms an `if' expression with all fixed arities first, then `&' + ;; arity, if present, and default error message as last arity. + ;; + ;; `len' is a symbol, that represents the length of the current argument + ;; list, and is computed at runtime. + ;; + ;; `fixed' is a table of arities with fixed amount of arguments. + ;; These are put in this `if' as: `(= len fixed-len)', where + ;; `fixed-len' is the length of current arity arglist, computed with + ;; `gen-arity'. + ;; + ;; `body&' stores size of fixed part of arglist, that is, everything + ;; up until `&', and the body itself. When `body&' provided, the + ;; `(>= len more-len)' is added to the resulting `if' expression. + ;; + ;; Lastly the catchall branch is added to `if' expression, which + ;; ensures that only valid amount of arguments were passed to + ;; function, which are defined by previous branches. (let [bodies '(if)] - (each [i body (pairs (doto fixed))] - (insert bodies (list '= len i)) + (var max nil) + (each [fixed-len body (pairs (doto fixed))] + (when (or (not max) (> fixed-len max)) + (set max fixed-len)) + (insert bodies (list '= len fixed-len)) (insert bodies body)) - (when amp-body - (let [[i body] amp-body] - (insert bodies (list '>= len (- i 1))) + (when body& + (let [[more-len body arity] body&] + (assert-compile (not (and max (<= more-len max))) "fn*: arity with `& more' must have more arguments than maximum arity without `& more'. + +* Try adding more arguments before `&'" arity) + (insert bodies (list '>= len (- more-len 1))) (insert bodies body))) (insert bodies (list 'error (.. "wrong argument amount" - (if name (.. " for " name) "")) 3)) + (if name (.. " for " name) "")) 2)) bodies)) (fn single-arity-body [args fname] + ;; Produces arglist and body for single-arity function. + ;; For more info check `gen-arity' documentation. (let [[args & body] args (arity body amp) (gen-arity [args (_unpack body)])] `(let [len# (length [...])] @@ -64,28 +82,82 @@ list, and is computed at runtime. fname)))) (fn multi-arity-body [args fname] - (let [bodies {} - amp-bodies {}] + ;; Produces arglist and all body forms for multi-arity function. + ;; For more info check `gen-arity' documentation. + (let [bodies {} ;; bodies of fixed arity + bodies& []] ;; bodies where arglist contains `&' (each [_ arity (ipairs args)] (let [(n body amp) (gen-arity arity)] (if amp - (do (insert amp-bodies amp) - (insert amp-bodies body) - (insert amp-bodies arity)) + (insert bodies& [amp body arity]) (tset bodies n body)))) - (assert-compile (<= (length amp-bodies) 3) - "fn* must have only one arity with &:" - (. amp-bodies (length amp-bodies))) + (assert-compile (<= (length bodies&) 1) + "fn* must have only one arity with `&':" + (. bodies& (length bodies&))) `(let [len# (length [...])] ,(arity-dispatcher 'len# bodies - (if (~= (next amp-bodies) nil) - amp-bodies) + (if (~= (next bodies&) nil) + (. bodies& 1)) fname)))) (fn fn* [name doc? ...] - (assert-compile (not (string? name)) "fn* expects symbol as function name" name) + "Create (anonymous) function of fixed arity. +Supports multiple arities by defining bodies as lists: + +Named function of fixed arity 2: +(fn* f [a b] (+ a b)) + +Function of fixed arities 1 and 2: +(fn* ([x] x) + ([x y] (+ x y))) + +Named function of 2 arities, one of which accepts 0 arguments, and the +other one or more arguments: +(fn* f + ([] nil) + ([x & xs] + (print x) + (f (unpack xs)))) + +Note, that this function is recursive, and calls itself with less and +less amount of arguments until there's no arguments, and the +zero-arity body is called. + +Named functions accept additional documentation string before the +argument list: + +(fn* cube + \"raise `x' to power of 3\" + [x] + (^ x 3)) + +(fn* greet + \"greet a `person', optionally specifying default `greeting'.\" + ([person] (print (.. \"Hello, \" person \"!\"))) + ([greeting person] (print (.. greeting \", \" person \"!\")))) + +Note that functions created with `fn*' when inspected with `doc' +command will always show its arguments as `...', because the +resulting function actually accepts variable amount of arguments, but +we check the amount and doing destructuring in runtime. + +(doc greet) + +(greet ...) + greet a `person', optionally specifying default `greeting'. + +When defining multi-arity functions it is handy to include accepted +arities in the docstring. + +Argument lists follow the same destruction rules as in `let'. +Variadic arguments with `...' are not supported. + +Passing `nil' as an argument to such function breaks arity checks, +because result of calling `length' on a indexed table with `nil' in it +is unpredictable." + (assert-compile (not (string? name)) "fn* expects symbol, vector, or list as first argument" name) (let [docstring (if (string? doc?) doc? nil) fname (if (sym? name) (tostring name)) args (if (sym? name) @@ -94,12 +166,14 @@ list, and is computed at runtime. [x] args body (if (sequence? x) (single-arity-body args fname) (list? x) (multi-arity-body args fname) - (assert-compile false "fn* expects vector as its arguments" x))] + (assert-compile false "fn*: expected parameters table. + +* Try adding function parameters as a list of identifiers in brackets." x))] (if (sym? name) `(fn ,name [...] ,docstring ,body) `(fn [...] ,docstring ,body)))) {: fn*} -;; (import-macros {: fn*} :fn) -;; (fn* f ([a] a) ([a b] (+ a b))) +;; LocalWords: arglist fn runtime arities arity multi destructuring +;; LocalWords: docstring Variadic LocalWords |