diff options
| -rw-r--r-- | macros/core.fnl | 40 | ||||
| -rw-r--r-- | macros/fn.fnl | 53 |
2 files changed, 60 insertions, 33 deletions
diff --git a/macros/core.fnl b/macros/core.fnl index 31ac1ae..b073d27 100644 --- a/macros/core.fnl +++ b/macros/core.fnl @@ -152,6 +152,19 @@ (fn string? [x] (= (type x) :string)) +(fn* core.with-meta [val meta] + `(let [val# ,val + (res# fennel#) (pcall require :fennel)] + (if res# + (each [k# v# (pairs ,meta)] + (fennel#.metadata:set val# k# v#))) + val#)) + +(fn* core.meta [v] + `(let [(res# fennel#) (pcall require :fennel)] + (if res# + (. fennel#.metadata ,v)))) + (fn* core.defmulti [name & opts] (let [docstring (if (string? (first opts)) (first opts)) @@ -162,7 +175,7 @@ `(local ,name (let [multimethods# {}] (setmetatable - {} + ,(with-meta {} {:fnl/docstring docstring}) {:__call (fn [_# ...] ,docstring @@ -186,25 +199,24 @@ (fn* core.def ([name expr] (def {} name expr)) ([attr-map name expr] - (if (not (or (table? attr-map) - (string? attr-map))) - (error "def: expected keyword or literal table as first argument" 2)) - (let [(s multi) (multisym->sym name) - f (if (if (table? attr-map) - (. attr-map :dynamic) - (if (= attr-map :dynamic) - true - (error (.. "unsupported attribute keyword: :" attr-map) 2))) - 'var 'local)] + (let [attr-map (if (table? attr-map) attr-map + (string? attr-map) {attr-map true} + (error "def: expected keyword or literal table as first argument" 2)) + (s multi) (multisym->sym name) + docstring (or (. attr-map :doc) + (. attr-map :fnl/docstring)) + f (if (. attr-map :dynamic) 'var 'local)] (if multi - `(,f ,s (do (,f ,s ,expr) (set ,name ,s) ,s)) - `(,f ,name ,expr))))) + `(,f ,s (do (,f ,s ,expr) + (set ,name ,s) + ,(with-meta s {:fnl/docstring docstring}))) + `(,f ,name ,(with-meta expr {:fnl/docstring docstring})))))) (fn* core.defonce ([name expr] (defonce {} name expr)) ([attr-map name expr] - (if (in-scope? (if (table? attr-map) name attr-map)) + (if (in-scope? name) nil (def attr-map name expr)))) diff --git a/macros/fn.fnl b/macros/fn.fnl index b26de32..2d4a753 100644 --- a/macros/fn.fnl +++ b/macros/fn.fnl @@ -2,6 +2,31 @@ (local insert table.insert) (local sort table.sort) +(fn with-meta [val meta] + `(let [val# ,val + (res# fennel#) (pcall require :fennel)] + (if res# + (each [k# v# (pairs ,meta)] + (fennel#.metadata:set val# k# v#))) + val#)) + +(fn gen-arglist-doc [args] + (if (list? (. args 1)) + (let [arglist [] + open (if (> (length args) 1) "\n [" "") + close (if (= open "") "" "]")] + (each [i v (ipairs args)] + (table.insert + arglist + (.. open (table.concat (gen-arglist-doc v) " ") close))) + arglist) + + (sequence? (. args 1)) + (let [arglist []] + (each [_ v (ipairs (. args 1))] + (table.insert arglist (tostring v))) + arglist))) + (fn multisym->sym [s] (if (multi-sym? s) (values (sym (string.gsub (tostring s) ".*[.]" "")) true) @@ -169,19 +194,6 @@ argument list: ([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. @@ -214,7 +226,9 @@ and `g' respectively." args (if (sym? name-wo-namespace) (if (string? doc?) [...] [doc? ...]) [name-wo-namespace doc? ...]) + arglist-doc (gen-arglist-doc args) [x] args + body (if (sequence? x) (single-arity-body args fname) (list? x) (multi-arity-body args fname) (assert-compile false "fn*: expected parameters table. @@ -226,9 +240,9 @@ and `g' respectively." (do (fn ,name-wo-namespace [...] ,docstring ,body) (set ,name ,name-wo-namespace) - ,name-wo-namespace)) - `(fn ,name [...] ,docstring ,body)) - `(fn [...] ,docstring ,body)))) + ,(with-meta name-wo-namespace `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring}))) + `(local ,name ,(with-meta `(fn ,name [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring}))) + (with-meta `(fn [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring})))) (fn fn& [name doc? args ...] "Create (anonymous) function. @@ -240,6 +254,7 @@ namespaced functions. See `fn*' for more info." arg-list (if (sym? name-wo-namespace) (if (string? doc?) args doc?) name-wo-namespace) + arglist-doc (gen-arglist-doc arg-list) body (if (sym? name) (if (string? doc?) [doc? ...] @@ -251,9 +266,9 @@ namespaced functions. See `fn*' for more info." (do (fn ,name-wo-namespace ,arg-list ,(unpack body)) (set ,name ,name-wo-namespace) - ,name-wo-namespace)) - `(fn ,name ,arg-list ,(unpack body))) - `(fn ,arg-list ,(unpack body))))) + ,(with-meta name-wo-namespace `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring}))) + `(local ,name ,(with-meta `(fn ,name ,arg-list ,(unpack body)) `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring}))) + (with-meta `(fn ,arg-list ,(unpack body)) `{:fnl/arglist ,arglist-doc :fnl/docstring ,docstring})))) {: fn* : fn&} |