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

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

5 files changed, 236 insertions, 114 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index ba39086..7c3e0a2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,4 +7,5 @@
                  (eval . (put 'if-some 'fennel-indent-function 1))
                  (eval . (put 'when-let 'fennel-indent-function 1))
                  (eval . (put 'if-let 'fennel-indent-function 1))
+                 (eval . (put 'fn& 'fennel-indent-function 'defun))
                  (eval . (put 'fn* 'fennel-indent-function 'defun)))))
diff --git a/README.org b/README.org
index 1322921..d58cc6f 100644
--- a/README.org
+++ b/README.org
@@ -62,6 +62,81 @@ Both variants support up to one arity with =& more=:
   (add 1 2 3 4) ;; => 10
 #+end_src
 
+One extra capability of =fn*= is that it is possible to declare namespaced functions and use those literally in the same scope, and withing the function itself.
+
+For example, imagene you want to create function =plus= in namespace =ns=, that sums arbitary amount of integers, and quickly test it before providing the namespace:
+
+#+begin_src fennel
+  (local clj (require :cljlib.core))
+  (import-macros {: fn*} :cljlib.macros.fn)
+
+  (local ns {})
+
+  (fn* ns.plus
+    ([] 0)
+    ([x] x)
+    ([x y] (+ x y))
+    ([x y & zs] (apply plus (+ x y) zs)))
+
+  (assert (= (plus) 0))
+  (assert (= (plus 1) 1))
+  (assert (= (plus 1 2) 3))
+  (assert (= (plus 1 2 3 4) 10))
+
+  ns
+#+end_src
+
+Note, that =plus= is used without =ns= part, e.g. not =namespace.plus=.
+If we =require= this code from file in the repl, we will see that our =ns= has single function =plus=:
+
+#+begin_src fennel
+  >> (local ns (require :module))
+  >> ns
+  {
+      add #<function 0xbada55code>
+  }
+#+end_src
+
+This is possible because =fn*= separates the namespace part from the function name, and creates a =local= variable with the same name as function, then defines the function within lexical scope of =do=, sets =namespace.foo= to it and returns the function object to the outer scope.
+
+#+begin_src fennel
+  (local plus
+         (do (fn plus [...]
+               ;; plus body
+               )
+             (set ns.plus plus)
+             plus))
+#+end_src
+
+See =core.fnl= for more examples.
+
+** =fn&=
+Works similarly to Fennel's =fn=, by creating ordinary function without arity semantics, except does the namespace automation like =fn*,= and has the same order of arguments as the latter:
+
+#+begin_src fennel
+  (local ns {})
+
+  ;; module & file-local functions
+  (fn& ns.double
+    "double the number"
+    [x]
+    (* x 2))
+
+  (fn& ns.triple
+    [x]
+    (* x 3))
+
+  ;; no namespace, file-local function
+  (fn& quadruple
+    [x]
+    (* x 4))
+
+  ;; anonymous file-local function
+  (fn& [x] (* x 5))
+
+  ns
+#+end_src
+
 See =core.fnl= for more examples.
 
 ** =if-let= and =when-let=
diff --git a/core.fnl b/core.fnl
index 0be0a48..acca17c 100644
--- a/core.fnl
+++ b/core.fnl
@@ -1,9 +1,11 @@
+(local core {})
+
 (local insert table.insert)
 (local unpack (or table.unpack _G.unpack))
-(import-macros {: fn*} :macros.fn)
+(import-macros {: fn* : fn&} :macros.fn)
 (import-macros {: when-some : if-some : when-let : into} :macros.core)
 
-(fn* apply
+(fn* core.apply
   "Apply `f' to the argument list formed by prepending intervening
 arguments to `args'."
   ([f args] (f (unpack args)))
@@ -19,114 +21,144 @@ arguments to `args'."
      (f a b c d (unpack flat-args)))))
 
 ;; predicate functions
-
-(fn map? [tbl]
+(fn& core.map? [tbl]
   "Check whether `tbl' is an associative table."
   (if (= (type tbl) :table)
       (let [(k _) (next tbl)]
         (and (~= k nil) (or (~= (type k) :number)
                             (~= k 1))))))
 
-(fn seq? [tbl]
+(fn& core.seq? [tbl]
   "Check whether `tbl' is an sequential table."
   (if (= (type tbl) :table)
       (let [(k _) (next tbl)]
         (and (~= k nil) (= (type k) :number) (= k 1)))))
 
-(fn nil? [x]
+
+(fn& core.nil? [x]
   "Test if value is nil."
   (= x nil))
 
-(fn zero? [x]
+(fn& core.zero? [x]
   "Test if value is zero."
   (= x 0))
 
-(fn pos? [x]
+(fn& core.pos? [x]
   "Test if `x' is greater than zero."
   (> x 0))
 
-(fn neg? [x]
+(fn& core.neg? [x]
   "Test if `x' is less than zero."
   (< x 0))
 
-(fn even? [x]
+(fn& core.even? [x]
   "Test if value is even."
   (= (% x 2) 0))
 
-(fn odd? [x]
+(fn& core.odd? [x]
   "Test if value is odd."
   (not (even? x)))
 
-(fn string? [x]
+(fn& core.string? [x]
   "Test if `x' is a string."
   (= (type x) :string))
 
-(fn int? [x]
+(fn& core.boolean? [x]
+  "Test if `x' is a Boolean"
+  (= (type x) :boolean))
+
+(fn& core.true? [x]
+  "Test if `x' is `true'"
+  (= x true))
+
+(fn& core.false? [x]
+  "Test if `x' is `false'"
+  (= x false))
+
+(fn& core.int? [x]
   "Test if `x' is a number without floating point data."
   (and (= (type x) :number)
        (= x (math.floor x))))
 
-(fn pos-int? [x]
+(fn& core.pos-int? [x]
   "Test if `x' is a positive integer."
   (and (int? x)
        (pos? x)))
 
-(fn neg-int? [x]
+(fn& core.neg-int? [x]
   "Test if `x' is a negetive integer."
   (and (int? x)
        (neg? x)))
 
-(fn double? [x]
+(fn& core.double? [x]
   "Test if `x' is a number with floating point data."
   (and (= (type x) :number)
        (~= x (math.floor x))))
 
-(fn empty? [x]
+(fn& core.empty? [x]
   "Check if collection is empty."
   (match (type x)
     :table (= (next x) nil)
     :string (= x "")
     _ (error "empty?: unsupported collection")))
 
-(fn not-empty [x]
+(fn& core.not-empty [x]
   "If `x' is empty, returns `nil', otherwise `x'."
   (if (not (empty? x))
       x))
 
 ;; sequence manipulating functions
 
-(fn seq [tbl]
+(fn& core.seq [tbl]
   "Create sequential table.
 Transforms original table to sequential table of key value pairs
 stored as sequential tables in linear time.  If `tbl' is an
 associative table, returns `[[key1 value1] ... [keyN valueN]]' table.
-If `tbl' is sequential table, leaves it unchanged."
+If `tbl' is sequential table, returns its shallow copy."
   (when-some [_ (and tbl (next tbl))]
     (var assoc? false)
-    (let [res []]
+    (let [assoc []
+          seq []]
       (each [k v (pairs tbl)]
         (if (and (not assoc?)
                  (not (= (type k) :number)))
             (set assoc? true))
-        (insert res [k v]))
-      (if assoc? res tbl))))
+        (insert assoc [k v])
+        (tset seq k v))
+      (if assoc? assoc seq))))
 
 (macro -safe-seq [tbl]
   "Create sequential table, or empty table if `seq' returned `nil'."
   `(or (seq ,tbl) []))
 
-(fn first [tbl]
+(fn& core.first [tbl]
   "Return first element of an indexed table."
-  (when-some [tbl tbl]
-    (. (seq tbl) 1)))
+  (when-some [tbl (seq tbl)]
+    (. tbl 1)))
 
-(fn rest [tbl]
+(fn& core.rest [tbl]
   "Returns table of all elements of indexed table but the first one."
-  (if-some [tbl tbl]
-    [(unpack (seq tbl) 2)]
+  (if-some [tbl (seq tbl)]
+    [(unpack tbl 2)]
     []))
 
-(fn* conj
+(fn& core.last [tbl]
+  (when-some [tbl (seq tbl)]
+    (var (i v) (next tbl))
+    (while i
+      (local (_i _v) (next tbl i))
+      (if _i (set v _v))
+      (set i _i))
+    v))
+
+(fn& core.butlast [tbl]
+  (when-some [tbl (seq tbl)]
+    (table.remove tbl (length tbl))
+    (when (not (empty? tbl))
+      tbl)))
+
+
+(fn* core.conj
   "Insert `x' as a last element of indexed table `tbl'. Modifies `tbl'"
   ([] [])
   ([tbl] tbl)
@@ -154,13 +186,13 @@ If `tbl' is sequential table, leaves it unchanged."
        (let [[y & xs] xs] (apply -consj (-consj tbl x) y xs))
        (-consj tbl x))))
 
-(fn cons [x tbl]
+(fn& core.cons [x tbl]
   "Insert `x' to `tbl' at the front. Modifies `tbl'."
   (when-some [x x]
     (doto (-safe-seq tbl)
       (insert 1 x))))
 
-(fn* concat
+(fn* core.concat
   "Concatenate tables."
   ([] nil)
   ([x] (-safe-seq x))
@@ -168,7 +200,7 @@ If `tbl' is sequential table, leaves it unchanged."
   ([x y & xs]
    (apply concat (into (-safe-seq x) (-safe-seq y)) xs)))
 
-(fn* reduce
+(fn* core.reduce
   "Reduce indexed table using function `f' and optional initial value `val'.
 
 ([f table])
@@ -199,7 +231,7 @@ val and f is not called."
            val))
      val)))
 
-(fn* reduce-kv
+(fn* core.reduce-kv
   "Reduces an associative table using function `f' and initial value `val'.
 
 ([f val table])
@@ -215,7 +247,7 @@ ordinals."  [f val tbl]
     (set res (f res k v)))
   res)
 
-(fn* mapv
+(fn* core.mapv
   "Maps function `f' over one or more tables.
 
 Accepts arbitrary amount of tables, calls `seq' on each of it.
@@ -269,21 +301,21 @@ ignored. Returns a table of results."
          (insert res tmp)))
      res)))
 
-(fn filter [pred tbl]
+(fn& core.filter [pred tbl]
   (when-let [tbl (seq tbl)]
     (let [f (first tbl) r (rest tbl)]
-          (if (pred f)
-              (cons f (filter pred r))
-              (filter pred r)))))
+      (if (pred f)
+          (cons f (filter pred r))
+          (filter pred r)))))
 
-(fn -kvseq [tbl]
+(fn& core.-kvseq [tbl]
   "Transforms any table kind to key-value sequence."
   (let [res []]
     (each [k v (pairs tbl)]
       (insert res [k v]))
     res))
 
-(fn* eq?
+(fn* core.eq?
   "Deep compare values."
   ([x] true)
   ([x y]
@@ -294,9 +326,9 @@ ignored. Returns a table of results."
   ([x y & xs]
    (reduce #(and $1 $2) (eq? x y) (mapv #(eq? x $) xs))))
 
-(fn identity [x] x)
+(fn& core.identity [x] x)
 
-(fn* comp
+(fn* core.comp
   ([] identity)
   ([f] f)
   ([f g]
@@ -309,20 +341,20 @@ ignored. Returns a table of results."
   ([f g & fs]
    (reduce comp (-consj fs g f))))
 
-(fn* every?
+(fn* core.every?
   [pred tbl]
   (if (empty? tbl) true
       (pred (first tbl)) (every? pred (rest tbl))
       false))
 
-(fn* some
+(fn* core.some
   [pred tbl]
   (when-let [tbl (seq tbl)]
     (or (pred (first tbl)) (some pred (rest tbl)))))
 
 (local not-any? (comp #(not $) some))
 
-(fn complement [f]
+(fn& core.complement [f]
   "Takes a function `f' and returns the function that takes the same
 amount of arguments as `f', has the same effect, and returns the
 oppisite truth value."
@@ -332,11 +364,11 @@ oppisite truth value."
     ([a b] (not (f a b)))
     ([a b & cs] (not (apply f a b cs)))))
 
-(fn constantly [x]
+(fn& core.constantly [x]
   "Returns a function that takes any number of arguments and returns `x'."
   (fn [...] x))
 
-(fn* range
+(fn* core.range
   "return range of of numbers from `lower' to `upper' with optional `step'."
   ([upper] (range 0 upper 1))
   ([lower upper] (range lower upper 1))
@@ -346,20 +378,19 @@ oppisite truth value."
        (insert res i))
      res)))
 
-(fn reverse [tbl]
+(fn& core.reverse [tbl]
   (when-some [tbl (seq tbl)]
     (reduce -consj [] tbl)))
 
-(fn inc [x] (+ x 1))
-(fn dec [x] (- x 1))
+(fn& core.inc [x] (+ x 1))
+(fn& core.dec [x] (- x 1))
 
-
-(fn* assoc
-  "Associate key `k' with value `v' in associative `tbl'."
+(fn* core.assoc
+  "Associate key `k' with value `v' in `tbl'."
   ([tbl k v] (doto tbl (tset k v)))
   ([tbl k v & kvs]
-   (tset tbl k v)
    (assert (zero? (% (length kvs) 2)) "expected even amount key-value args")
+   (tset tbl k v)
    (var [i k v] [1 nil nil])
    (var (i k) (next kvs))
    (while i
@@ -368,41 +399,4 @@ oppisite truth value."
      (set (i k) (next kvs i)))
    tbl))
 
-{: apply
- : seq
- : first
- : rest
- : conj
- : cons
- : concat
- : reduce
- : reduce-kv
- : mapv
- : filter
- : map?
- : seq?
- : nil?
- : zero?
- : pos?
- : neg?
- : even?
- : odd?
- : int?
- : pos-int?
- : neg-int?
- : double?
- : string?
- : empty?
- : not-empty
- : eq?
- : identity
- : comp
- : every?
- : some
- : complement
- : constantly
- : range
- : reverse
- : inc
- : dec
- : assoc}
+core
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