feature(core): implement auto namespacing for fn* and create fn&

Redefining everything in terms of fn* and fn* breaks coverage.sh

2 files changed, 73 insertions, 21 deletions

diff --git a/macros/core.fnl b/macros/core.fnl
index ed147ed..c954f77 100644
--- a/macros/core.fnl
+++ b/macros/core.fnl
@@ -1,4 +1,5 @@
-(import-macros {: fn*} :macros.fn)
+(import-macros {: fn* : fn&} :macros.fn)
+(local core {})
 (local unpack (or table.unpack _G.unpack))
 (local insert table.insert)
 
@@ -6,7 +7,7 @@
   (and (assert-compile (sequence? bindings) "expected binding table" [])
        (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings)))
 
-(fn* if-let
+(fn* core.if-let
   ([bindings then]
    (if-let bindings then nil))
   ([bindings then else]
@@ -18,7 +19,7 @@
               ,then)
             ,else)))))
 
-(fn* when-let
+(fn* core.when-let
   [bindings & body]
   (-check-bindings bindings)
   (let [[form test] bindings]
@@ -27,7 +28,7 @@
            (let [,form tmp#]
              ,(unpack body))))))
 
-(fn* if-some
+(fn* core.if-some
   ([bindings then]
    (if-some bindings then nil))
   ([bindings then else]
@@ -39,7 +40,7 @@
             (let [,form tmp#]
               ,then))))))
 
-(fn* when-some
+(fn* core.when-some
   [bindings & body]
   (-check-bindings bindings)
   (let [[form test] bindings]
@@ -56,7 +57,7 @@
       :else))
 
 ;; based on `seq' from `core.fnl'
-(fn into [to from]
+(fn& core.into [to from]
   (local to-type (-table-type to))
   (local from-type (-table-type from))
   `(let [to# ,to
@@ -106,9 +107,4 @@
        :else (error "expected table as first argument"))
      to#))
 
-
-{: if-let
- : when-let
- : if-some
- : when-some
- : into}
+core
diff --git a/macros/fn.fnl b/macros/fn.fnl
index cdd3636..fe9d839 100644
--- a/macros/fn.fnl
+++ b/macros/fn.fnl
@@ -1,6 +1,11 @@
 (local unpack (or table.unpack _G.unpack))
 (local insert table.insert)
 
+(fn multisym->sym [s]
+  (if (multi-sym? s)
+      (values (sym (string.gsub (tostring s) ".*[.]" "")) true)
+      (values s false)))
+
 (fn string? [x]
   (= (type x) "string"))
 
@@ -154,26 +159,77 @@ 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."
+If function name contains namespace part, defines local variable
+without namespace part, then creates function with this name, sets
+this function to the namespace, and returns it.  This roughly means,
+that instead of writing this:
+
+(local namespace {})
+(fn f [x]
+  (if (> x 0) (f (- x 1))))
+(set namespace.f f)
+(fn g [x] (f (* x 100)))
+(set namespace.g g)
+
+It is possible to write:
+
+(local namespace {})
+(fn* namespace.f [x]
+  (if (> x 0) (f (- x 1))))
+(fn* namespace.g [x] (f (* x 100)))
+
+Note that it is still possible to call `f' and `g' in current scope
+without namespace part.  `Namespace' will hold both functions as `f'
+and `g' respectively."
   (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)
+        (name-wo-namespace namespaced?) (multisym->sym name)
+        fname (if (sym? name-wo-namespace) (tostring name-wo-namespace))
+        args (if (sym? name-wo-namespace)
                  (if (string? doc?) [...] [doc? ...])
-                 [name doc? ...])
+                 [name-wo-namespace doc? ...])
         [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.
 
 * Try adding function parameters as a list of identifiers in brackets." x))]
-    (if (sym? name)
-        `(fn ,name [...] ,docstring ,body)
+    (if (sym? name-wo-namespace)
+        (if namespaced?
+            `(local ,name-wo-namespace
+                    (do
+                      (fn ,name-wo-namespace [...] ,docstring ,body)
+                      (set ,name ,name-wo-namespace)
+                      ,name-wo-namespace))
+            `(fn ,name [...] ,docstring ,body))
         `(fn [...] ,docstring ,body))))
 
-{: fn*}
+(fn fn& [name doc? args ...]
+  "Create (anonymous) function.
+Works the same as plain `fn' except supports automatic declaration of
+namespaced functions.  See `fn*' for more info."
+  (assert-compile (not (string? name)) "fn* expects symbol, vector, or list as first argument" name)
+  (let [docstring (if (string? doc?) doc? nil)
+        (name-wo-namespace namespaced?) (multisym->sym name)
+        arg-list (if (sym? name-wo-namespace)
+                 (if (string? doc?) args doc?)
+                 name-wo-namespace)
+        body (if (sym? name)
+                 (if (string? doc?)
+                     [doc? ...]
+                     [args ...])
+                 [doc? args ...])]
+    (if (sym? name-wo-namespace)
+        (if namespaced?
+            `(local ,name-wo-namespace
+                    (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)))))
+
+{: fn* : fn&}
 
 ;; LocalWords:  arglist fn runtime arities arity multi destructuring
 ;; LocalWords:  docstring Variadic LocalWords