From 35a47b437a9487fdde1f419340d7880be9008720 Mon Sep 17 00:00:00 2001
From: Andrey Orst <andreyorst@gmail.com>
Date: Tue, 26 Jan 2021 09:30:07 +0300
Subject: fix: allow defining methods with fn*

---
 .dir-locals.el |  8 ++++++-
 macros.fnl     | 18 +++++++++++----
 tests/fn.fnl   | 69 +++++++++++++++++++++++++++++++++++++++++-----------------
 3 files changed, 70 insertions(+), 25 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index abb24bb..9bdfd0f 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -19,7 +19,13 @@
                                              "def"
                                              "defmulti"
                                              "defmethod"
-                                             "defonce"))
+                                             "defonce"
+                                             "deftest"
+                                             "testing"
+                                             "assert-eq"
+                                             "assert-ne"
+                                             "assert-is"
+                                             "assert-not"))
                                   word-end)
                              1 'font-lock-keyword-face))))
                  (eval . (put 'when-meta 'fennel-indent-function 'defun))
diff --git a/macros.fnl b/macros.fnl
index 3f5eb5f..c009144 100644
--- a/macros.fnl
+++ b/macros.fnl
@@ -3,6 +3,9 @@
 (fn first [tbl]
   (. tbl 1))
 
+(fn last [tbl]
+  (. tbl (length tbl)))
+
 (fn rest [tbl]
   [((or table.unpack _G.unpack) tbl 2)])
 
@@ -19,9 +22,10 @@
   ;; (multisym->sym a.b.c) ;; => (c true)
   ;; (multisym->sym a)     ;; => (a false)
   ;; ```
-  (if (multi-sym? s)
-      (values (sym (string.gsub (tostring s) ".*%." "")) true)
-      (values s false)))
+  (let [parts (multi-sym? s)]
+    (if parts
+        (values (sym (last parts)) true)
+        (values s false))))
 
 (fn contains? [tbl x]
   ;; Checks if `x` is stored in `tbl` in linear time.
@@ -388,6 +392,12 @@ returns the value without additional metadata.
              (. amp-bodies 1))
          fname))))
 
+(fn demethodize [s]
+  (-> s
+      tostring
+      (string.gsub ":" ".")
+      sym))
+
 (fn fn* [name doc? ...]
   "Create (anonymous) function of fixed arity.
 Accepts optional `name` and `docstring?` as first two arguments,
@@ -517,12 +527,12 @@ from `ns.strings`, so the latter must be fully qualified
   (let [docstring (if (string? doc?) doc? nil)
         (name-wo-namespace namespaced?) (multisym->sym name)
         fname (if (sym? name-wo-namespace) (tostring name-wo-namespace))
+        name (demethodize name)
         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.
diff --git a/tests/fn.fnl b/tests/fn.fnl
index 63a5802..40dda8b 100644
--- a/tests/fn.fnl
+++ b/tests/fn.fnl
@@ -6,42 +6,71 @@
     (fn* f
       "docstring"
       [x] x)
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([x])"]}))
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([x])"]}))
     (fn* f
       "docstring"
       [])
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([])"]}))
-
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([])"]}))
     (fn* f
       "docstring"
       ([x] x))
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([x])"]}))
-
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([x])"]}))
     (fn* f
       "docstring"
       ([x] x)
       ([x y] (+ x y)))
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([x])"
-                                                  "([x y])"]}))
-
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([x])"
+                                         "([x y])"]}))
     (fn* f
       "docstring"
       ([])
       ([x y] (+ x y)))
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([])"
-                                                  "([x y])"]}))
-
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([])"
+                                         "([x y])"]}))
     (fn* f
       "docstring"
       ([x] x)
       ([x y] (+ x y))
       ([x y & z] (+ x y)))
-    (assert-eq (meta f) (when-meta {:fnl/docstring "docstring"
-                                    :fnl/arglist ["([x])"
-                                                  "([x y])"
-                                                  "([x y & z])"]}))))
+    (assert-eq (meta f)
+               (when-meta {:fnl/docstring "docstring"
+                           :fnl/arglist ["([x])"
+                                         "([x y])"
+                                         "([x y & z])"]})))
+
+  (testing "fn* doc destructuring"
+    (fn* f [[a b c]])
+    (assert-eq (meta f)
+               (when-meta {:fnl/arglist ["([[a b c]])"]}))
+    (fn* f ([[a b c]]) ([{: a}]) ([[{:a [a b c]}]]))
+    (assert-eq (meta f)
+               (when-meta {:fnl/arglist ["([[a b c]])"
+                                         "([{:a a}])"
+                                         "([[{:a [a b c]}]])"]})))
+
+  (testing "fn* methods"
+    (local ns {:a 1 :b 2})
+
+    (fn* ns:foo [self]
+      (+ self.a self.b))
+    (assert-eq (ns:foo) 3)
+    (assert-not (pcall #(ns:foo 1)))
+    (assert-not (pcall #(ns:foo 1 2)))
+
+    (fn* ns:bar
+      ([self x] (+ self.a x))
+      ([self x y] (+ self.b x y)))
+    (assert-eq (ns:bar -1) 0)
+    (assert-eq (ns:bar 10 20) 32)
+    (assert-not (pcall #(ns:bar)))
+    (assert-not (pcall #(ns:bar 1 2 3)))))
-- 
cgit v1.2.3