fix(macros): fix multimethods which use tables as the dispatch value

2 files changed, 44 insertions, 4 deletions

diff --git a/macros/core.fnl b/macros/core.fnl
index df3f8b8..ad555fb 100644
--- a/macros/core.fnl
+++ b/macros/core.fnl
@@ -179,6 +179,21 @@
     `(let [(res# fennel#) (pcall require :fennel)]
        (if res# (. fennel#.metadata ,v)))))
 
+(fn eq-fn []
+  `(fn eq# [a# b#]
+     (if (and (= (type a#) :table) (= (type b#) :table))
+         (do (var [res# count-a# count-b#] [true 0 0])
+             (each [k# v# (pairs a#)]
+               (set res# (eq# v# (. b# k#)))
+               (set count-a# (+ count-a# 1))
+               (when (not res#) (lua :break)))
+             (when res#
+               (each [_# _# (pairs b#)]
+                 (set count-b# (+ count-b# 1)))
+               (set res# (and res# (= count-a# count-b#))))
+             res#)
+         (= a# b#))))
+
 (fn* core.defmulti
   [name & opts]
   (let [docstring (if (string? (first opts)) (first opts))
@@ -193,14 +208,25 @@
                    {:__call
                     (fn [_# ...]
                       ,docstring
-                      (let [dispatch-value# (,dispatch-fn ...)]
+                      (let [dispatch-value# (,dispatch-fn ...)
+                            (res# view#) (pcall require :fennelview)]
                         ((or (. multimethods# dispatch-value#)
                              (. multimethods# :default)
                              (error (.. "No method in multimethod '"
                                         ,(tostring name)
                                         "' for dispatch value: "
-                                        dispatch-value#) 2)) ...)))
-                    :multimethods multimethods#}))))))
+                                        ((if res# view# tostring) dispatch-value#))
+                                    2)) ...)))
+                    :multimethods (setmetatable multimethods#
+                                                {:__index
+                                                 (fn [tbl# key#]
+                                                   (let [eq# ,(eq-fn)]
+                                                     (var res# nil)
+                                                     (each [k# v# (pairs tbl#)]
+                                                       (when (eq# k# key#)
+                                                         (set res# v#)
+                                                         (lua :break)))
+                                                     res#))})}))))))
 
 (fn* core.defmethod
   [multifn dispatch-val & fn-tail]
diff --git a/test/macros.fnl b/test/macros.fnl
index ae7ab40..4d4ac57 100644
--- a/test/macros.fnl
+++ b/test/macros.fnl
@@ -92,7 +92,21 @@
     (assert-eq (send-message {:protocol :http :message "ваыв"})
                "sending ваыв over HTTP")
     (assert-eq (send-message {:protocol :icap :message 42})
-               "sending 42 over ICAP")))
+               "sending 42 over ICAP"))
+
+  (testing "defmulti with dispatch on tables"
+    (defmulti encounter (fn [x y] [(. x :species) (. y :species)]))
+    (defmethod encounter [:bunny :lion] [_ _] :run)
+    (defmethod encounter [:lion :bunny] [_ _] :eat)
+    (defmethod encounter [:lion :lion] [_ _] :fight)
+    (defmethod encounter [:bunny :bunny] [_ _] :mate)
+
+    (let [l {:species :lion}
+          b {:species :bunny}]
+      (assert-eq (encounter b b) :mate)
+      (assert-eq (encounter l l) :fight)
+      (assert-eq (encounter b l) :run)
+      (assert-eq (encounter l b) :eat))))
 
 (deftest def-macros
   (testing "def"