From 09e9899bf771d70dbc6378c9d2d30e195b038688 Mon Sep 17 00:00:00 2001 From: Andrey Orst Date: Tue, 20 Oct 2020 22:49:46 +0300 Subject: initial commit --- fn.fnl | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 fn.fnl (limited to 'fn.fnl') diff --git a/fn.fnl b/fn.fnl new file mode 100644 index 0000000..e937878 --- /dev/null +++ b/fn.fnl @@ -0,0 +1,42 @@ +(fn string? [x] + (= (type x) "string")) + +(fn has-amp? [args] + (var res false) + (each [_ s (ipairs args)] + (when (= (tostring s) "&") + (set res true))) + res) + +(fn gen-arity [[args & body]] + (assert-compile (sequence? args) "fn* expects vector as it's parameter list. +Try wrapping arguments in square brackets." args) + (let [arg-length (if (has-amp? args) (sym "_") (length args)) + body (list 'let [args [(sym "...")]] (unpack body))] + (list arg-length body))) + +(fn fn* [name doc? ...] + (assert-compile (not (string? name)) "fn* expects symbol as function name" name) + (let [docstring (if (string? doc?) doc? nil) + args (if (sym? name) + (if (string? doc?) [...] [doc? ...]) + [name doc? ...]) + [x & xs] args] + (if (sequence? x) + ;; Ordinary function + (let [[args & body] args] + (if (sym? name) + `(fn ,name ,args ,docstring ,(unpack body)) + `(fn ,args ,docstring ,(unpack body)))) + ;; Multi-arity function + (list? x) + (let [bodies []] + (each [_ arity (ipairs args)] + (let [[arity body] (gen-arity arity)] + (table.insert bodies arity) + (table.insert bodies body))) + `(fn ,name [...] ,docstring (match (length [...]) ,(unpack bodies))))))) + +{: fn*} + +;; (import-macros {: fn*} :fn) (macrodebug (fn* f ([a] a))) -- cgit v1.2.3