From 0d046860d08f7e9f4532b0b236249c3fdb0db845 Mon Sep 17 00:00:00 2001
From: Braden Shepherdson <braden@metabase.com>
Date: Wed, 31 Jul 2024 12:48:12 -0400
Subject: [PATCH 1/4] Attempt at widening the arities for multimethod calls

There's a lot of `apply`/`RestFn`/`invoke` etc. dynamic call machinery
in Methodical's stack traces. This is an attempt to remove some of it
by going up to 7 direct args for multimethod calls. (And dispatch
functions.)

This hasn't removed much of the `apply` overhead in practice because
`with-meta` on a function wraps it with a naive function subclass that
always does a dynamic call. There are probably still some places that
more dynamic calls are creeping in, but I ran out of time to dig
deeper.

This may not go anywhere until I get back, but I wanted to publish this
just in case.
---
 src/methodical/impl/combo/clos.clj            | 43 ++++++---
 src/methodical/impl/combo/common.clj          | 91 ++++++++++++++++++-
 src/methodical/impl/combo/threaded.clj        | 41 +++++----
 src/methodical/impl/dispatcher/everything.clj | 15 +--
 .../impl/dispatcher/multi_default.clj         | 15 +--
 src/methodical/impl/dispatcher/standard.clj   | 15 +--
 src/methodical/impl/standard.clj              | 25 ++++-
 src/methodical/interface.clj                  |  5 +-
 8 files changed, 194 insertions(+), 56 deletions(-)

diff --git a/src/methodical/impl/combo/clos.clj b/src/methodical/impl/combo/clos.clj
index 2449fc4..a184dfc 100644
--- a/src/methodical/impl/combo/clos.clj
+++ b/src/methodical/impl/combo/clos.clj
@@ -22,34 +22,49 @@
     combined-method
     (fn
       ([]
-       (doseq [f befores]
-         (f))
+       (doseq [before befores]
+         (before))
        (combined-method))
 
       ([a]
-       (doseq [f befores]
-         (f a))
+       (doseq [before befores]
+         (before a))
        (combined-method a))
 
       ([a b]
-       (doseq [f befores]
-         (f a b))
+       (doseq [before befores]
+         (before a b))
        (combined-method a b))
 
       ([a b c]
-       (doseq [f befores]
-         (f a b c))
+       (doseq [before befores]
+         (before a b c))
        (combined-method a b c))
 
       ([a b c d]
-       (doseq [f befores]
-         (f a b c d))
+       (doseq [before befores]
+         (before a b c d))
        (combined-method a b c d))
 
-      ([a b c d & more]
-       (doseq [f befores]
-         (apply f a b c d more))
-       (apply combined-method a b c d more)))))
+      ([a b c d e]
+       (doseq [before befores]
+         (before a b c d e))
+       (combined-method a b c d e))
+
+      ([a b c d e f]
+       (doseq [before befores]
+         (before a b c d e f))
+       (combined-method a b c d e f))
+
+      ([a b c d e f g]
+       (doseq [before befores]
+         (before a b c d e f g))
+       (combined-method a b c d e f g))
+
+      ([a b c d e f g & more]
+       (doseq [before befores]
+         (apply before a b c d e f g more))
+       (apply combined-method a b c d e f g more)))))
 
 (defn- apply-afters [combined-method afters]
   (if (empty? afters)
diff --git a/src/methodical/impl/combo/common.clj b/src/methodical/impl/combo/common.clj
index 9016967..04043b9 100644
--- a/src/methodical/impl/combo/common.clj
+++ b/src/methodical/impl/combo/common.clj
@@ -1,6 +1,91 @@
 (ns methodical.impl.combo.common
   "Utility functions for implementing method combinations.")
 
+(defn partial*
+  "[[clojure.core/partial]] but with more direct arities."
+  ([inner] inner)
+  ([inner a]
+   (fn
+     ([]                          (inner a))
+     ([p]                         (inner a p))
+     ([p q]                       (inner a p q))
+     ([p q r]                     (inner a p q r))
+     ([p q r s]                   (inner a p q r s))
+     ([p q r s t]                 (inner a p q r s t))
+     ([p q r s t u]               (inner a p q r s t u))
+     ([p q r s t u v]             (inner a p q r s t u v))
+     ([p q r s t u v x]           (inner a p q r s t u v x))
+     ([p q r s t u v x y]         (inner a p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a p q r s t u v x y z))))
+  ([inner a b]
+   (fn
+     ([]                          (inner a b))
+     ([p]                         (inner a b p))
+     ([p q]                       (inner a b p q))
+     ([p q r]                     (inner a b p q r))
+     ([p q r s]                   (inner a b p q r s))
+     ([p q r s t]                 (inner a b p q r s t))
+     ([p q r s t u]               (inner a b p q r s t u))
+     ([p q r s t u v]             (inner a b p q r s t u v))
+     ([p q r s t u v x]           (inner a b p q r s t u v x))
+     ([p q r s t u v x y]         (inner a b p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a b p q r s t u v x y z))))
+  ([inner a b c]
+   (fn
+     ([]                          (inner a b c))
+     ([p]                         (inner a b c p))
+     ([p q]                       (inner a b c p q))
+     ([p q r]                     (inner a b c p q r))
+     ([p q r s]                   (inner a b c p q r s))
+     ([p q r s t]                 (inner a b c p q r s t))
+     ([p q r s t u]               (inner a b c p q r s t u))
+     ([p q r s t u v]             (inner a b c p q r s t u v))
+     ([p q r s t u v x]           (inner a b c p q r s t u v x))
+     ([p q r s t u v x y]         (inner a b c p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a b c p q r s t u v x y z))))
+  ([inner a b c d]
+   (fn
+     ([]                          (inner a b c d))
+     ([p]                         (inner a b c d p))
+     ([p q]                       (inner a b c d p q))
+     ([p q r]                     (inner a b c d p q r))
+     ([p q r s]                   (inner a b c d p q r s))
+     ([p q r s t]                 (inner a b c d p q r s t))
+     ([p q r s t u]               (inner a b c d p q r s t u))
+     ([p q r s t u v]             (inner a b c d p q r s t u v))
+     ([p q r s t u v x]           (inner a b c d p q r s t u v x))
+     ([p q r s t u v x y]         (inner a b c d p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a b c d p q r s t u v x y z))))
+  ([inner a b c d e]
+   (fn
+     ([]                          (inner a b c d e))
+     ([p]                         (inner a b c d e p))
+     ([p q]                       (inner a b c d e p q))
+     ([p q r]                     (inner a b c d e p q r))
+     ([p q r s]                   (inner a b c d e p q r s))
+     ([p q r s t]                 (inner a b c d e p q r s t))
+     ([p q r s t u]               (inner a b c d e p q r s t u))
+     ([p q r s t u v]             (inner a b c d e p q r s t u v))
+     ([p q r s t u v x]           (inner a b c d e p q r s t u v x))
+     ([p q r s t u v x y]         (inner a b c d e p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a e b c d p q r s t u v x y z))))
+  ([inner a b c d e f]
+   (fn
+     ([]                          (inner a b c d e f))
+     ([p]                         (inner a b c d e f p))
+     ([p q]                       (inner a b c d e f p q))
+     ([p q r]                     (inner a b c d e f p q r))
+     ([p q r s]                   (inner a b c d e f p q r s))
+     ([p q r s t]                 (inner a b c d e f p q r s t))
+     ([p q r s t u]               (inner a b c d e f p q r s t u))
+     ([p q r s t u v]             (inner a b c d e f p q r s t u v))
+     ([p q r s t u v x]           (inner a b c d e f p q r s t u v x))
+     ([p q r s t u v x y]         (inner a b c d e f p q r s t u v x y))
+     ([p q r s t u v x y & z]     (apply inner a e f b c d p q r s t u v x y z))))
+  ([inner a b c d e f & more]
+   (fn [& args]
+     (inner a b c d e f (concat more args)))))
+
 (defn combine-primary-methods
   "Combine all `primary-methods` into a single combined method. Each method is partially bound with a `next-method`
   arg."
@@ -8,7 +93,7 @@
   (when (seq primary-methods)
     (reduce
      (fn [next-method primary-method]
-       (with-meta (partial primary-method next-method) (meta primary-method)))
+       (with-meta (partial* primary-method next-method) (meta primary-method)))
      nil
      (reverse primary-methods))))
 
@@ -19,7 +104,7 @@
   [combined-method around-methods]
   (reduce
    (fn [combined-method around-method]
-     (with-meta (partial around-method combined-method) (meta around-method)))
+     (with-meta (partial* around-method combined-method) (meta around-method)))
    combined-method
    around-methods))
 
@@ -36,7 +121,7 @@
     (apply f fn-tail)
 
     (vector? (ffirst fn-tail))
-    (map (partial transform-fn-tail f) fn-tail)
+    (map (partial* transform-fn-tail f) fn-tail)
 
     :else
     (throw (ex-info (format "Invalid fn tail: %s. Expected ([arg*] & body) or (([arg*] & body)+)"
diff --git a/src/methodical/impl/combo/threaded.clj b/src/methodical/impl/combo/threaded.clj
index ccd8962..26569e0 100644
--- a/src/methodical/impl/combo/threaded.clj
+++ b/src/methodical/impl/combo/threaded.clj
@@ -38,12 +38,15 @@
            optimized-one-arg-fn (apply comp (reverse methods))]
        (combo.common/apply-around-methods
         (-> (fn
-              ([]               (optimized-one-arg-fn))
-              ([a]              (optimized-one-arg-fn a))
-              ([a b]            (threaded-fn a b))
-              ([a b c]          (threaded-fn a b c))
-              ([a b c d]        (threaded-fn a b c d))
-              ([a b c d & more] (apply threaded-fn a b c d more)))
+              ([]                     (optimized-one-arg-fn))
+              ([a]                    (optimized-one-arg-fn a))
+              ([a b]                  (threaded-fn a b))
+              ([a b c]                (threaded-fn a b c))
+              ([a b c d]              (threaded-fn a b c d))
+              ([a b c d e]            (threaded-fn a b c d e))
+              ([a b c d e f]          (threaded-fn a b c d e f))
+              ([a b c d e f g]        (threaded-fn a b c d e f g))
+              ([a b c d e f g & more] (apply threaded-fn a b c d e f g more)))
             (vary-meta assoc :methodical/combined-method? true))
         around)))))
 
@@ -59,21 +62,27 @@
 (defmethod threading-invoker :thread-first
   [_]
   (fn
-    ([a b]            [a (fn [method a*] (method a* b))])
-    ([a b c]          [a (fn [method a*] (method a* b c))])
-    ([a b c d]        [a (fn [method a*] (method a* b c d))])
-    ([a b c d & more] [a (fn [method a*] (apply method a* b c d more))])))
+    ([a b]                  [a (fn [method a*] (method a* b))])
+    ([a b c]                [a (fn [method a*] (method a* b c))])
+    ([a b c d]              [a (fn [method a*] (method a* b c d))])
+    ([a b c d e]            [a (fn [method a*] (method a* b c d e))])
+    ([a b c d e f]          [a (fn [method a*] (method a* b c d e f))])
+    ([a b c d e f g]        [a (fn [method a*] (method a* b c d e f g))])
+    ([a b c d e f g & more] [a (fn [method a*] (apply method a* b c d e f g more))])))
 
 (defmethod threading-invoker :thread-last
   [_]
   (fn
-    ([a b]     [b (fn [method b*] (method a b*))])
-    ([a b c]   [c (fn [method c*] (method a b c*))])
-    ([a b c d] [d (fn [method d*] (method a b c d*))])
-
-    ([a b c d & more]
+    ([a b]           [b (fn [method b*] (method a b*))])
+    ([a b c]         [c (fn [method c*] (method a b c*))])
+    ([a b c d]       [d (fn [method d*] (method a b c d*))])
+    ([a b c d e]     [e (fn [method e*] (method a b c d e*))])
+    ([a b c d e f]   [f (fn [method f*] (method a b c d e f*))])
+    ([a b c d e f g] [g (fn [method g*] (method a b c d e f g*))])
+
+    ([a b c d e f g & more]
      (let [last-val (last more)
-           butlast* (vec (concat [a b c d] (butlast more)))]
+           butlast* (vec (concat [a b c d e f g] (butlast more)))]
        [last-val
         (fn [method last*]
           (apply method (conj butlast* last*)))]))))
diff --git a/src/methodical/impl/dispatcher/everything.clj b/src/methodical/impl/dispatcher/everything.clj
index dd41c0e..7e6930c 100644
--- a/src/methodical/impl/dispatcher/everything.clj
+++ b/src/methodical/impl/dispatcher/everything.clj
@@ -32,12 +32,15 @@
         (= prefs (.prefs another))))))
 
   Dispatcher
-  (dispatch-value [_]                   nil)
-  (dispatch-value [_ _a]                nil)
-  (dispatch-value [_ _a _b]             nil)
-  (dispatch-value [_ _a _b _c]          nil)
-  (dispatch-value [_ _a _b _c _d]       nil)
-  (dispatch-value [_ _a _b _c _d _more] nil)
+  (dispatch-value [_]                            nil)
+  (dispatch-value [_ _a]                         nil)
+  (dispatch-value [_ _a _b]                      nil)
+  (dispatch-value [_ _a _b _c]                   nil)
+  (dispatch-value [_ _a _b _c _d]                nil)
+  (dispatch-value [_ _a _b _c _d _e]             nil)
+  (dispatch-value [_ _a _b _c _d _e _f]          nil)
+  (dispatch-value [_ _a _b _c _d _e _f _g]       nil)
+  (dispatch-value [_ _a _b _c _d _e _f _g _more] nil)
 
   (matching-primary-methods [_ method-table _]
     (let [primary-methods (i/primary-methods method-table)
diff --git a/src/methodical/impl/dispatcher/multi_default.clj b/src/methodical/impl/dispatcher/multi_default.clj
index c6387e3..4ae3465 100644
--- a/src/methodical/impl/dispatcher/multi_default.clj
+++ b/src/methodical/impl/dispatcher/multi_default.clj
@@ -155,12 +155,15 @@
         (= prefs         (.prefs another))))))
 
   Dispatcher
-  (dispatch-value [_]              (dispatch-fn))
-  (dispatch-value [_ a]            (dispatch-fn a))
-  (dispatch-value [_ a b]          (dispatch-fn a b))
-  (dispatch-value [_ a b c]        (dispatch-fn a b c))
-  (dispatch-value [_ a b c d]      (dispatch-fn a b c d))
-  (dispatch-value [_ a b c d more] (apply dispatch-fn a b c d more))
+  (dispatch-value [_]                    (dispatch-fn))
+  (dispatch-value [_ a]                  (dispatch-fn a))
+  (dispatch-value [_ a b]                (dispatch-fn a b))
+  (dispatch-value [_ a b c]              (dispatch-fn a b c))
+  (dispatch-value [_ a b c d]            (dispatch-fn a b c d))
+  (dispatch-value [_ a b c d e]          (dispatch-fn a b c d e))
+  (dispatch-value [_ a b c d e f]        (dispatch-fn a b c d e f))
+  (dispatch-value [_ a b c d e f g]      (dispatch-fn a b c d e f g))
+  (dispatch-value [_ a b c d e f g more] (apply dispatch-fn a b c d e f g more))
 
   (matching-primary-methods [_ method-table dispatch-value]
     (matching-primary-methods
diff --git a/src/methodical/impl/dispatcher/standard.clj b/src/methodical/impl/dispatcher/standard.clj
index f6368cb..0c5b3f9 100644
--- a/src/methodical/impl/dispatcher/standard.clj
+++ b/src/methodical/impl/dispatcher/standard.clj
@@ -131,12 +131,15 @@
         (= prefs         (.prefs another))))))
 
   Dispatcher
-  (dispatch-value [_]              (dispatch-fn))
-  (dispatch-value [_ a]            (dispatch-fn a))
-  (dispatch-value [_ a b]          (dispatch-fn a b))
-  (dispatch-value [_ a b c]        (dispatch-fn a b c))
-  (dispatch-value [_ a b c d]      (dispatch-fn a b c d))
-  (dispatch-value [_ a b c d more] (apply dispatch-fn a b c d more))
+  (dispatch-value [_]                    (dispatch-fn))
+  (dispatch-value [_ a]                  (dispatch-fn a))
+  (dispatch-value [_ a b]                (dispatch-fn a b))
+  (dispatch-value [_ a b c]              (dispatch-fn a b c))
+  (dispatch-value [_ a b c d]            (dispatch-fn a b c d))
+  (dispatch-value [_ a b c d e]          (dispatch-fn a b c d e))
+  (dispatch-value [_ a b c d e f]        (dispatch-fn a b c d e f))
+  (dispatch-value [_ a b c d e f g]      (dispatch-fn a b c d e f g))
+  (dispatch-value [_ a b c d e f g more] (apply dispatch-fn a b c d e f g more))
 
   (matching-primary-methods [_ method-table dispatch-value]
     (matching-primary-methods
diff --git a/src/methodical/impl/standard.clj b/src/methodical/impl/standard.clj
index 924efd8..f71b597 100644
--- a/src/methodical/impl/standard.clj
+++ b/src/methodical/impl/standard.clj
@@ -60,9 +60,20 @@
   ([^MultiFnImpl impl mta a b c d]
    (invoke-multi impl mta a b c d))
 
-  ([^MultiFnImpl impl mta a b c d & more]
+  ([^MultiFnImpl impl mta a b c d e]
+   #_(println "invoke-multifn 5-arity")
+   (invoke-multi impl mta a b c d e))
+
+  ([^MultiFnImpl impl mta a b c d e f]
+   (invoke-multi impl mta a b c d e f))
+
+  ([^MultiFnImpl impl mta a b c d e f g]
+   (invoke-multi impl mta a b c d e f g))
+
+  ([^MultiFnImpl impl mta a b c d e f g & more]
    ;; TODO: possible to use the macro somehow in this case?
-   (try (apply (effective-method impl (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d more)) a b c d more)
+   (try (apply (effective-method impl (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d e f g more))
+               a b c d e f g more)
         (catch Exception e
           (handle-effective-method-exception e mta)))))
 
@@ -109,8 +120,14 @@
     (.dispatch-value ^Dispatcher (.dispatcher impl) a b c))
   (dispatch-value [_ a b c d]
     (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d))
-  (dispatch-value [_ a b c d more]
-    (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d more))
+  (dispatch-value [_ a b c d e]
+    (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d e))
+  (dispatch-value [_ a b c d e f]
+    (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d e f))
+  (dispatch-value [_ a b c d e f g]
+    (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d e f g))
+  (dispatch-value [_ a b c d e f g more]
+    (.dispatch-value ^Dispatcher (.dispatcher impl) a b c d e f g more))
 
   (matching-primary-methods [_ method-table dispatch-value]
     (i/matching-primary-methods (.dispatcher impl) method-table dispatch-value))
diff --git a/src/methodical/interface.clj b/src/methodical/interface.clj
index 7d491fb..d0be981 100644
--- a/src/methodical/interface.clj
+++ b/src/methodical/interface.clj
@@ -72,7 +72,10 @@
     [dispatcher a b]
     [dispatcher a b c]
     [dispatcher a b c d]
-    [dispatcher a b c d more]
+    [dispatcher a b c d e]
+    [dispatcher a b c d e f]
+    [dispatcher a b c d e f g]
+    [dispatcher a b c d e f g more]
     "Return an appropriate dispatch value for args passed to a multimethod. (This method is equivalent in purpose to
     the dispatch function of vanilla Clojure multimethods.)")
 

From 3fc564eaf1a4db7d9b7eadd9ad4b87de17708683 Mon Sep 17 00:00:00 2001
From: Oleksandr Yakushev <alex@bytopia.org>
Date: Wed, 7 Aug 2024 18:23:53 +0300
Subject: [PATCH 2/4] Fix tests after widening arities

marg
---
 src/methodical/util.clj                | 13 ++++++----
 test/methodical/impl/standard_test.clj |  7 +++--
 test/methodical/util/trace_test.clj    | 26 +++++++++++--------
 test/methodical/util_test.clj          | 36 +++++++++++++++-----------
 4 files changed, 49 insertions(+), 33 deletions(-)

diff --git a/src/methodical/util.clj b/src/methodical/util.clj
index 1774238..5e00891 100644
--- a/src/methodical/util.clj
+++ b/src/methodical/util.clj
@@ -112,11 +112,14 @@
   ;; since protocols can't define varargs, we have to wrap the `dispatch-value` method from the protocol and apply
   ;; varargs for > 4 args. The various < 4 args arities are there as an optimization because it's a little faster than
   ;; calling apply every time.
-  ([multifn a]              (i/dispatch-value multifn a))
-  ([multifn a b]            (i/dispatch-value multifn a b))
-  ([multifn a b c]          (i/dispatch-value multifn a b c))
-  ([multifn a b c d]        (i/dispatch-value multifn a b c d))
-  ([multifn a b c d & more] (i/dispatch-value multifn a b c d more)))
+  ([multifn a]                    (i/dispatch-value multifn a))
+  ([multifn a b]                  (i/dispatch-value multifn a b))
+  ([multifn a b c]                (i/dispatch-value multifn a b c))
+  ([multifn a b c d]              (i/dispatch-value multifn a b c d))
+  ([multifn a b c d e]            (i/dispatch-value multifn a b c d e))
+  ([multifn a b c d e f]          (i/dispatch-value multifn a b c d e f))
+  ([multifn a b c d e f g]        (i/dispatch-value multifn a b c d e f g))
+  ([multifn a b c d e f g & more] (i/dispatch-value multifn a b c d e f g more)))
 
 (defn dispatch-fn
   "Return a function that can be used to calculate dispatch values of given arg(s)."
diff --git a/test/methodical/impl/standard_test.clj b/test/methodical/impl/standard_test.clj
index 937177b..df8ae24 100644
--- a/test/methodical/impl/standard_test.clj
+++ b/test/methodical/impl/standard_test.clj
@@ -176,5 +176,8 @@
       2 (i/dispatch-value f :a :b)
       3 (i/dispatch-value f :a :b :c)
       4 (i/dispatch-value f :a :b :c :d)
-      5 (i/dispatch-value f :a :b :c :d [:e])
-      6 (i/dispatch-value f :a :b :c :d [:e :f]))))
+      5 (i/dispatch-value f :a :b :c :d :e)
+      6 (i/dispatch-value f :a :b :c :d :e :f)
+      7 (i/dispatch-value f :a :b :c :d :e :f :g)
+      8 (i/dispatch-value f :a :b :c :d :e :f :g [:h])
+      9 (i/dispatch-value f :a :b :c :d :e :f :g [:h :i]))))
diff --git a/test/methodical/util/trace_test.clj b/test/methodical/util/trace_test.clj
index 6e0468c..b4df9ab 100644
--- a/test/methodical/util/trace_test.clj
+++ b/test/methodical/util/trace_test.clj
@@ -80,17 +80,17 @@
 
 (def ^:private lots-of-args-multifn
   (-> (m/default-multifn
-       (fn [a b c d e _f] [a (class b) c d e]))
+       (fn [a b c d e _f _g _h _i _j] [a (class b) c d e]))
       (m/add-primary-method :default
-                            (fn [_ a _ _ _ _ f] {:a a, :f f}))
+                            (fn [_ a _ _ _ _ _ _ _ _ j] {:a a, :j j}))
       (m/add-primary-method [::x :default :default :default :default]
-                            (fn [_ a _ _ _ _ f] {:x a, :f f}))))
+                            (fn [_ a _ _ _ _ _ _ _ _ j] {:x a, :j j}))))
 
 (t/deftest lots-of-args-test
-  (t/testing "> 4 args"
-    (t/is (= {:x ::x, :f :f}
-             (lots-of-args-multifn ::x :b :c :d :e :f)))
-    (t/is (= ["0: (lots-of-args-multifn :methodical.util.trace-test/x :b :c :d :e :f)"
+  (t/testing "> 7 args"
+    (t/is (= {:x ::x, :j :j}
+             (lots-of-args-multifn ::x :b :c :d :e :f :g :h :i :j)))
+    (t/is (= ["0: (lots-of-args-multifn :methodical.util.trace-test/x :b :c :d :e :f :g :h :i :j)"
               "  1: (#primary-method<[:methodical.util.trace-test/x :default :default :default :default]>"
               "      #primary-method<:default>"
               "      :methodical.util.trace-test/x"
@@ -98,10 +98,14 @@
               "      :c"
               "      :d"
               "      :e"
-              "      :f)"
-              "  1> {:f :f, :x :methodical.util.trace-test/x}"
-              "0> {:f :f, :x :methodical.util.trace-test/x}"]
-             (trace-output lots-of-args-multifn ::x :b :c :d :e :f)))))
+              "      :f"
+              "      :g"
+              "      :h"
+              "      :i"
+              "      :j)"
+              "  1> {:j :j, :x :methodical.util.trace-test/x}"
+              "0> {:j :j, :x :methodical.util.trace-test/x}"]
+             (trace-output lots-of-args-multifn ::x :b :c :d :e :f :g :h :i :j)))))
 
 (m/defmulti my=
   {:arglists '([x y])}
diff --git a/test/methodical/util_test.clj b/test/methodical/util_test.clj
index 95ee094..b09dc8f 100644
--- a/test/methodical/util_test.clj
+++ b/test/methodical/util_test.clj
@@ -128,24 +128,24 @@
 
 (def ^:private lots-of-args-multifn
   (-> (m/default-multifn
-       (fn [a b c d e _f] [a (class b) c d e]))
+       (fn [a b c d e _f _g _h _i _j] [a (class b) c d e]))
       (m/add-primary-method :default
-                            (fn [_ a _ _ _ _ f] {:a a, :f f}))
+                            (fn [_ a _ _ _ _ _ _ _ _ j] {:a a, :j j}))
       (m/add-primary-method [::x :default :default :default :default]
-                            (fn [_ a _ _ _ _ f] {:x a, :f f}))))
+                            (fn [_ a _ _ _ _ _ _ _ _ j] {:x a, :j j}))))
 
 (t/deftest lots-of-args-test
-  (t/is (= {:a :a, :f :f}
-           (lots-of-args-multifn :a :b :c :d :e :f)))
-  (t/is (= {:x ::x, :f :f}
-           (lots-of-args-multifn ::x :b :c :d :e :f))))
+  (t/is (= {:a :a, :j :j}
+           (lots-of-args-multifn :a :b :c :d :e :f :g :h :i :j)))
+  (t/is (= {:x ::x, :j :j}
+           (lots-of-args-multifn ::x :b :c :d :e :f :g :h :i :j))))
 
 (t/deftest dispatch-value-test
   (t/testing "dispatch-value should return the dispatch value of arg(s)"
     (let [f (m/default-multifn keyword)]
       (t/is (= :wow
                (u/dispatch-value f "wow"))))
-    (t/testing "2-4 args"
+    (t/testing "2-7 args"
       (let [f (-> (m/default-multifn vector)
                   (m/add-primary-method :default (fn [& args] (vec args))))]
         (t/is (= [:a]
@@ -155,10 +155,16 @@
         (t/is (= [:a :b :c]
                  (u/dispatch-value f :a :b :c)))
         (t/is (= [:a :b :c :d]
-                 (u/dispatch-value f :a :b :c :d)))))
-    (t/testing "> 4 args"
-      (t/is [::x clojure.lang.Keyword :c :d :e]
-            (u/dispatch-value lots-of-args-multifn ::x :b :c :d :e :f)))))
+                 (u/dispatch-value f :a :b :c :d)))
+        (t/is (= [:a :b :c :d :e]
+                 (u/dispatch-value f :a :b :c :d :e)))
+        (t/is (= [:a :b :c :d :e :f]
+                 (u/dispatch-value f :a :b :c :d :e :f)))
+        (t/is (= [:a :b :c :d :e :f :g]
+                 (u/dispatch-value f :a :b :c :d :e :f :g)))))
+    (t/testing "> 7 args"
+      (t/is [::x clojure.lang.Keyword :c :d :e :f :g :h]
+            (u/dispatch-value lots-of-args-multifn ::x :b :c :d :e :f :g :h :i :j)))))
 
 (t/deftest effective-dispatch-value-test
   (doseq [default-method? [true false]]
@@ -227,8 +233,8 @@
                (m/effective-dispatch-value f [:default ::shoe])
                (m/effective-dispatch-value f [nil ::shoe])))))
   (t/testing "> 4 args"
-    (t/is [::x :default :default :default :default]
-          (->> (u/dispatch-value lots-of-args-multifn ::x :b :c :d :e :f)
+    (t/is [::x :default :default :default :default :default :default :default :default :default]
+          (->> (u/dispatch-value lots-of-args-multifn ::x :b :c :d :e :f :g :h :i :j)
                (u/effective-dispatch-value lots-of-args-multifn)))))
 
 (t/deftest dispatch-fn-test
@@ -238,7 +244,7 @@
                ((u/dispatch-fn f) "wow"))))
     (t/testing "> 4 args"
       (t/is [::x clojure.lang.Keyword :c :d :e]
-            ((u/dispatch-fn lots-of-args-multifn) ::x :b :c :d :e :f)))))
+            ((u/dispatch-fn lots-of-args-multifn) ::x :b :c :d :e :f :g :h :i :j)))))
 
 (t/deftest primary-methods-test
   (let [m1 (constantly [:char-sequence])

From 6968c26836233c8a0654227c3e14e1c4dffba776 Mon Sep 17 00:00:00 2001
From: Oleksandr Yakushev <alex@bytopia.org>
Date: Fri, 2 Aug 2024 15:13:26 +0300
Subject: [PATCH 3/4] Introduce custom FnWithMeta to attach metadata to
 functions

---
 .clj-kondo/config.edn                         |  3 +-
 src/methodical/impl/combo/common.clj          |  9 ++--
 src/methodical/impl/combo/threaded.clj        |  3 +-
 src/methodical/impl/dispatcher/everything.clj |  5 +-
 src/methodical/impl/dispatcher/standard.clj   |  7 +--
 src/methodical/impl/method_table/standard.clj |  9 ++--
 src/methodical/impl/multifn/standard.clj      |  3 +-
 src/methodical/macros.clj                     |  4 +-
 src/methodical/util.clj                       | 53 ++++++++++++++++++-
 src/methodical/util/trace.clj                 |  8 +--
 .../impl/dispatcher/standard_test.clj         | 21 ++++----
 .../impl/method_table/standard_test.clj       | 11 ++--
 test/methodical/macros_test.clj               |  2 +-
 test/methodical/test_utils.clj                |  9 ++++
 test/methodical/util_test.clj                 | 21 ++++----
 15 files changed, 120 insertions(+), 48 deletions(-)
 create mode 100644 test/methodical/test_utils.clj

diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn
index 64d5fdf..caaa7e8 100644
--- a/.clj-kondo/config.edn
+++ b/.clj-kondo/config.edn
@@ -22,7 +22,8 @@
 
   :unresolved-symbol
   {:exclude
-   [(clojure.test/is [macroexpansion-spec-error?])]}
+   [->FnWithMeta FnWithMeta
+    (clojure.test/is [macroexpansion-spec-error?])]}
 
   :consistent-alias
   {:aliases
diff --git a/src/methodical/impl/combo/common.clj b/src/methodical/impl/combo/common.clj
index 04043b9..03351c2 100644
--- a/src/methodical/impl/combo/common.clj
+++ b/src/methodical/impl/combo/common.clj
@@ -1,5 +1,6 @@
 (ns methodical.impl.combo.common
-  "Utility functions for implementing method combinations.")
+  "Utility functions for implementing method combinations."
+  (:require [methodical.util :as u]))
 
 (defn partial*
   "[[clojure.core/partial]] but with more direct arities."
@@ -93,7 +94,8 @@
   (when (seq primary-methods)
     (reduce
      (fn [next-method primary-method]
-       (with-meta (partial* primary-method next-method) (meta primary-method)))
+       (u/fn-with-meta (partial* (u/unwrap-fn-with-meta primary-method) next-method)
+                       (meta primary-method)))
      nil
      (reverse primary-methods))))
 
@@ -104,7 +106,8 @@
   [combined-method around-methods]
   (reduce
    (fn [combined-method around-method]
-     (with-meta (partial* around-method combined-method) (meta around-method)))
+     (u/fn-with-meta (partial* (u/unwrap-fn-with-meta around-method) combined-method)
+                     (meta around-method)))
    combined-method
    around-methods))
 
diff --git a/src/methodical/impl/combo/threaded.clj b/src/methodical/impl/combo/threaded.clj
index 26569e0..396e2b7 100644
--- a/src/methodical/impl/combo/threaded.clj
+++ b/src/methodical/impl/combo/threaded.clj
@@ -4,6 +4,7 @@
    [clojure.core.protocols :as clojure.protocols]
    [methodical.impl.combo.common :as combo.common]
    [methodical.interface]
+   [methodical.util :as u]
    [methodical.util.describe :as describe]
    [pretty.core :as pretty])
   (:import
@@ -47,7 +48,7 @@
               ([a b c d e f]          (threaded-fn a b c d e f))
               ([a b c d e f g]        (threaded-fn a b c d e f g))
               ([a b c d e f g & more] (apply threaded-fn a b c d e f g more)))
-            (vary-meta assoc :methodical/combined-method? true))
+            (u/fn-vary-meta assoc :methodical/combined-method? true))
         around)))))
 
 (defmulti threading-invoker
diff --git a/src/methodical/impl/dispatcher/everything.clj b/src/methodical/impl/dispatcher/everything.clj
index 7e6930c..2aa223b 100644
--- a/src/methodical/impl/dispatcher/everything.clj
+++ b/src/methodical/impl/dispatcher/everything.clj
@@ -4,6 +4,7 @@
    [clojure.core.protocols :as clojure.protocols]
    [methodical.impl.dispatcher.common :as dispatcher.common]
    [methodical.interface :as i]
+   [methodical.util :as u]
    [methodical.util.describe :as describe]
    [pretty.core :as pretty])
   (:import
@@ -46,7 +47,7 @@
     (let [primary-methods (i/primary-methods method-table)
           comparatorr     (dispatcher.common/domination-comparator (deref hierarchy-var) prefs)]
       (for [[dispatch-value method] (sort-by first comparatorr primary-methods)]
-        (vary-meta method assoc :dispatch-value dispatch-value))))
+        (u/fn-vary-meta method assoc :dispatch-value dispatch-value))))
 
   (matching-aux-methods [_ method-table _]
     (let [aux-methods (i/aux-methods method-table)
@@ -54,7 +55,7 @@
       (into {} (for [[qualifier dispatch-value->methods] aux-methods]
                  [qualifier (for [[dispatch-value methods] (sort-by first comparatorr dispatch-value->methods)
                                   method                   methods]
-                              (vary-meta method assoc :dispatch-value dispatch-value))]))))
+                              (u/fn-vary-meta method assoc :dispatch-value dispatch-value))]))))
 
   (default-dispatch-value [_]
     nil)
diff --git a/src/methodical/impl/dispatcher/standard.clj b/src/methodical/impl/dispatcher/standard.clj
index 0c5b3f9..036aa98 100644
--- a/src/methodical/impl/dispatcher/standard.clj
+++ b/src/methodical/impl/dispatcher/standard.clj
@@ -6,6 +6,7 @@
    [clojure.core.protocols :as clojure.protocols]
    [methodical.impl.dispatcher.common :as dispatcher.common]
    [methodical.interface :as i]
+   [methodical.util :as u]
    [methodical.util.describe :as describe]
    [pretty.core :as pretty])
   (:import
@@ -71,10 +72,10 @@
                          (get (i/primary-methods method-table) default-value))]
     (concat
      (for [[dispatch-value method] pairs]
-       (vary-meta method assoc :dispatch-value dispatch-value))
+       (u/fn-vary-meta method assoc :dispatch-value dispatch-value))
      (when (and default-method
                 (not (contains? (set (map first pairs)) default-value)))
-       [(vary-meta default-method assoc :dispatch-value default-value)]))))
+       [(u/fn-vary-meta default-method assoc :dispatch-value default-value)]))))
 
 (defn- matching-aux-pairs-excluding-default
   "Return pairs of `[dispatch-value method]` of applicable aux methods, *excluding* default aux methods. Pairs are
@@ -106,7 +107,7 @@
                  :let        [pairs (matching-aux-pairs qualifier opts)]
                  :when       (seq pairs)]
              [qualifier (for [[dispatch-value method] pairs]
-                          (vary-meta method assoc :dispatch-value dispatch-value))])))
+                          (u/fn-vary-meta method assoc :dispatch-value dispatch-value))])))
 
 (deftype StandardDispatcher [dispatch-fn hierarchy-var default-value prefs]
   pretty/PrettyPrintable
diff --git a/src/methodical/impl/method_table/standard.clj b/src/methodical/impl/method_table/standard.clj
index 4aa1266..38d144c 100644
--- a/src/methodical/impl/method_table/standard.clj
+++ b/src/methodical/impl/method_table/standard.clj
@@ -3,6 +3,7 @@
    [clojure.core.protocols :as clojure.protocols]
    [methodical.impl.method-table.common :as method-table.common]
    [methodical.interface]
+   [methodical.util :as u]
    [methodical.util.describe :as describe]
    [pretty.core :as pretty])
   (:import
@@ -49,7 +50,7 @@
     aux)
 
   (add-primary-method [this dispatch-val method]
-    (let [new-primary (assoc primary dispatch-val (vary-meta method assoc :dispatch-value dispatch-val))]
+    (let [new-primary (assoc primary dispatch-val (u/fn-vary-meta method assoc :dispatch-value dispatch-val))]
       (if (= primary new-primary)
         this
         (StandardMethodTable. new-primary aux))))
@@ -67,7 +68,7 @@
                                (if (contains? (set existing-methods) method)
                                  existing-methods
                                  (conj (vec existing-methods)
-                                       (vary-meta method assoc :dispatch-value dispatch-value)))))]
+                                       (u/fn-vary-meta method assoc :dispatch-value dispatch-value)))))]
       (if (= aux new-aux)
         this
         (StandardMethodTable. primary new-aux))))
@@ -75,7 +76,9 @@
   (remove-aux-method [this qualifier dispatch-value method]
     (let [xforms  [(fn [aux]
                      (update-in aux [qualifier dispatch-value] (fn [defined-methods]
-                                                                 (remove #(= % method) defined-methods))))
+                                                                 (remove #(or (= % method)
+                                                                              (= (u/unwrap-fn-with-meta %) method))
+                                                                         defined-methods))))
                    (fn [aux]
                      (cond-> aux
                        (empty? (get-in aux [qualifier dispatch-value]))
diff --git a/src/methodical/impl/multifn/standard.clj b/src/methodical/impl/multifn/standard.clj
index f40104e..6157bd5 100644
--- a/src/methodical/impl/multifn/standard.clj
+++ b/src/methodical/impl/multifn/standard.clj
@@ -5,6 +5,7 @@
    [clojure.datafy :as datafy]
    [methodical.impl.dispatcher.common :as dispatcher.common]
    [methodical.interface :as i]
+   [methodical.util :as u]
    [methodical.util.describe :as describe]
    [pretty.core :as pretty])
   (:import
@@ -102,7 +103,7 @@
   (let [primary-methods (i/matching-primary-methods dispatcher method-table dispatch-value)
         aux-methods     (i/matching-aux-methods dispatcher method-table dispatch-value)]
     (some-> (i/combine-methods method-combination primary-methods aux-methods)
-            (with-meta {:dispatch-value (effective-dispatch-value dispatcher dispatch-value primary-methods aux-methods)}))))
+            (u/fn-with-meta {:dispatch-value (effective-dispatch-value dispatcher dispatch-value primary-methods aux-methods)}))))
 
 (deftype StandardMultiFnImpl [^MethodCombination combo
                               ^Dispatcher dispatcher
diff --git a/src/methodical/macros.clj b/src/methodical/macros.clj
index cc7b033..51778df 100644
--- a/src/methodical/macros.clj
+++ b/src/methodical/macros.clj
@@ -322,7 +322,7 @@
          ~@(when docstring
              [docstring])
          ~@(i/transform-fn-tail multifn nil fn-tail))
-       (u/add-primary-method! (var ~multifn-symb) ~dispatch-value (vary-meta ~fn-symb merge (meta (var ~fn-symb)))))))
+       (u/add-primary-method! (var ~multifn-symb) ~dispatch-value (u/fn-vary-meta ~fn-symb merge (meta (var ~fn-symb)))))))
 
 (defn- emit-aux-method
   "Impl for [[defmethod]] for aux methods."
@@ -337,7 +337,7 @@
        (u/add-aux-method-with-unique-key! (var ~multifn-symb)
                                           ~qualifier
                                           ~dispatch-value
-                                          (vary-meta ~fn-symb merge (meta (var ~fn-symb)))
+                                          (u/fn-vary-meta ~fn-symb merge (meta (var ~fn-symb)))
                                           ~unique-key))))
 
 (defn- defmethod-args-spec [multifn]
diff --git a/src/methodical/util.clj b/src/methodical/util.clj
index 5e00891..384090a 100644
--- a/src/methodical/util.clj
+++ b/src/methodical/util.clj
@@ -14,6 +14,55 @@
   [x]
   (impl.standard/multifn? x))
 
+(declare unwrap-fn-with-meta)
+
+(defmacro generate-FnWithMeta
+  "Generate FnWithMeta deftype declaration."
+  []
+  (let [make-args (fn [arity]
+                    (mapv #(symbol (str "a" (inc %)))
+                          (range 0 arity)))]
+    `(deftype ~'FnWithMeta [~(with-meta 'fn {:tag 'clojure.lang.IFn}) ~'mta]
+       ~'Object
+       (~'equals [~'_ ~'o]
+        (= ~'fn (unwrap-fn-with-meta ~'o)))
+
+       clojure.lang.IObj
+       (~'meta [~'_] ~'mta)
+       (~'withMeta [~'_ ~'newMta] (~'FnWithMeta. ~'fn ~'newMta))
+
+       clojure.lang.Fn
+       clojure.lang.IFn
+       ~@(for [arity (range 0 21)]
+           (let [args (make-args arity)]
+             (list 'invoke (vec (cons '_ args))
+                   (list* '.invoke 'fn args))))
+       (~'invoke ~(vec (cons '_ (conj (make-args 20) 'rest)))
+        (~'.invoke ~'fn ~(conj (make-args 20) 'rest)))
+
+       (~'applyTo [~'_ ~'arglist]
+        (clojure.lang.AFn/applyToHelper ~'fn ~'arglist)))))
+
+(generate-FnWithMeta)
+
+(defn unwrap-fn-with-meta
+  "If the provided argument is a FnWithMeta object, extract the function it wraps, otherwise return the argument."
+  [fun]
+  (if (instance? FnWithMeta fun)
+    (.fn ^FnWithMeta fun)
+    fun))
+
+(defn fn-with-meta
+  "Construct a new FnWithMeta from the provided arguments. Unwrap `fun` if it an FnWithMeta too."
+  [fun mta]
+  (->FnWithMeta (unwrap-fn-with-meta fun) mta))
+
+(defn fn-vary-meta
+  "Construct a new FnWithMeta with the same underlying function (possibly unwrapped) but with the meta that is the result
+  of `(apply f (meta obj) args)`."
+  [fun f & args]
+  (fn-with-meta (unwrap-fn-with-meta fun) (apply f (meta fun) args)))
+
 (defn primary-method
   "Get the primary method *explicitly specified* for `dispatch-value`. This function does not return methods that would
   otherwise still be applicable (e.g., methods for ancestor dispatch values) -- just the methods explicitly defined
@@ -51,7 +100,7 @@
   [multifn dispatch-val]
   (let [[most-specific-primary-method :as primary-methods] (matching-primary-methods multifn dispatch-val)]
     (some-> (i/combine-methods multifn primary-methods nil)
-            (with-meta (meta most-specific-primary-method)))))
+            (fn-with-meta (meta most-specific-primary-method)))))
 
 (defn aux-methods
   "Get all auxiliary methods *explicitly specified* for `dispatch-value`. This function does not include methods that
@@ -186,7 +235,7 @@
   {:pre [(some? multifn)]}
   (-> multifn
       (remove-aux-method-with-unique-key qualifier dispatch-val unique-key)
-      (i/add-aux-method qualifier dispatch-val (vary-meta f assoc :methodical/unique-key unique-key))))
+      (i/add-aux-method qualifier dispatch-val (fn-vary-meta f assoc :methodical/unique-key unique-key))))
 
 (defn remove-all-methods
   "Remove all primary and auxiliary methods, including default implementations."
diff --git a/src/methodical/util/trace.clj b/src/methodical/util/trace.clj
index a090866..c6d9b71 100644
--- a/src/methodical/util/trace.clj
+++ b/src/methodical/util/trace.clj
@@ -92,19 +92,19 @@
 
 (defn- trace-primary-method [primary-method]
   (-> (trace-method primary-method)
-      (with-meta (meta primary-method))))
+      (u/fn-with-meta (meta primary-method))))
 
 (defn- trace-primary-methods [primary-methods]
   (map trace-primary-method primary-methods))
 
 (defn- trace-aux-method [aux-method]
   (-> (trace-method aux-method)
-      (with-meta (meta aux-method))))
+      (u/fn-with-meta (meta aux-method))))
 
 (defn- trace-aux-methods [qualifier->ms]
   (into {} (for [[qualifier aux-methods] qualifier->ms]
              [qualifier (for [aux-method aux-methods]
-                          (trace-aux-method (vary-meta aux-method assoc :qualifier qualifier)))])))
+                          (trace-aux-method (u/fn-vary-meta aux-method assoc :qualifier qualifier)))])))
 
 (defn trace*
   "Function version of [[trace]] macro. The only difference is this doesn't capture the form of `multifn` passed to
@@ -114,7 +114,7 @@
         primary-methods (trace-primary-methods (u/matching-primary-methods multifn dispatch-value))
         aux-methods     (trace-aux-methods (u/matching-aux-methods multifn dispatch-value))
         combined        (-> (i/combine-methods multifn primary-methods aux-methods)
-                            (with-meta (meta multifn))
+                            (u/fn-with-meta (meta multifn))
                             trace-method)]
     (apply combined args)))
 
diff --git a/test/methodical/impl/dispatcher/standard_test.clj b/test/methodical/impl/dispatcher/standard_test.clj
index b651d01..bc65a56 100644
--- a/test/methodical/impl/dispatcher/standard_test.clj
+++ b/test/methodical/impl/dispatcher/standard_test.clj
@@ -3,7 +3,8 @@
    [clojure.test :as t]
    [methodical.core :as m]
    [methodical.impl :as impl]
-   [methodical.interface :as i])
+   [methodical.interface :as i]
+   [methodical.test-utils :as tu])
   (:import
    (methodical.interface MethodTable)))
 
@@ -32,10 +33,10 @@
     (t/testing "matching-primary-methods should return all matches in order of specificity."
       (let [method-table (method-table {:child 'child, :parent 'parent, :grandparent 'grandparent} nil)]
         (t/is (= '[child parent grandparent]
-                 (i/matching-primary-methods dispatcher method-table :child)))
+                 (tu/unwrap-fns-with-meta (i/matching-primary-methods dispatcher method-table :child))))
 
         (t/is (= '[parent grandparent]
-                 (i/matching-primary-methods dispatcher method-table :parent)))))
+                 (tu/unwrap-fns-with-meta (i/matching-primary-methods dispatcher method-table :parent))))))
 
     (t/testing "default primary methods"
       (let [method-table (method-table {:child       'child
@@ -44,14 +45,14 @@
                                         :default     'default} nil)]
         (t/testing "default methods should be included if they exist"
           (t/is (= '[parent grandparent default]
-                   (i/matching-primary-methods dispatcher method-table :parent)))
+                   (tu/unwrap-fns-with-meta (i/matching-primary-methods dispatcher method-table :parent))))
           (t/testing "should return ^:dispatch-value metadata"
             (t/is (= [{:dispatch-value :parent} {:dispatch-value :grandparent} {:dispatch-value :default}]
                      (map meta (i/matching-primary-methods dispatcher method-table :parent))))))
 
         (t/testing "If there are otherwise no matches, default should be returned (but nothing else)"
           (t/is (= '[default]
-                   (i/matching-primary-methods dispatcher method-table :cousin)))
+                   (tu/unwrap-fns-with-meta (i/matching-primary-methods dispatcher method-table :cousin))))
           (t/testing "should return ^:dispatch-value metadata"
             (t/is (= [{:dispatch-value :default}]
                      (map meta (i/matching-primary-methods dispatcher method-table :cousin))))))
@@ -61,7 +62,7 @@
                                                  :hierarchy #'basic-hierarchy
                                                  :default-value :grandparent)]
             (t/is (= '[parent grandparent]
-                     (i/matching-primary-methods dispatcher-with-custom-default method-table :parent)))
+                     (tu/unwrap-fns-with-meta (i/matching-primary-methods dispatcher-with-custom-default method-table :parent))))
             (t/testing "should return ^:dispatch-value metadata"
               (t/is (= [{:dispatch-value :parent} {:dispatch-value :grandparent}]
                        (map meta (i/matching-primary-methods
@@ -82,7 +83,7 @@
         (let [dispatcher (impl/standard-dispatcher keyword
                                                    :hierarchy #'basic-hierarchy)]
           (t/is (= {:before '[default]}
-                   (i/matching-aux-methods dispatcher method-table :cousin)))
+                   (tu/unwrap-fns-with-meta (i/matching-aux-methods dispatcher method-table :cousin))))
           (t/testing "should return ^:dispatch-value metadata"
             (t/is (= {:before [{:dispatch-value :default}]}
                      (aux-methods-metadata (i/matching-aux-methods dispatcher method-table :cousin)))))))
@@ -92,7 +93,7 @@
                                                    :hierarchy #'basic-hierarchy
                                                    :default-value :grandparent)]
           (t/is (= {:before '[parent grandparent]}
-                   (i/matching-aux-methods dispatcher method-table :parent)))
+                   (tu/unwrap-fns-with-meta (i/matching-aux-methods dispatcher method-table :parent))))
           (t/testing "should return ^:dispatch-value metadata"
             (t/is (= {:before [{:dispatch-value :parent} {:dispatch-value :grandparent}]}
                      (aux-methods-metadata (i/matching-aux-methods dispatcher method-table :parent))))))))))
@@ -130,10 +131,10 @@
         (catch Exception e
           (t/is (= {:method-1 {:ns             (the-ns 'methodical.impl.dispatcher.standard-test)
                                :file           "methodical/impl/dispatcher/standard_test.clj"
-                               :line           106
+                               :line           107
                                :dispatch-value ::parrot}
                     :method-2 {:ns             (the-ns 'methodical.impl.dispatcher.standard-test)
                                :file           "methodical/impl/dispatcher/standard_test.clj"
-                               :line           110
+                               :line           111
                                :dispatch-value ::friend}}
                    (ex-data e))))))))
diff --git a/test/methodical/impl/method_table/standard_test.clj b/test/methodical/impl/method_table/standard_test.clj
index 082f4a9..69e8fcf 100644
--- a/test/methodical/impl/method_table/standard_test.clj
+++ b/test/methodical/impl/method_table/standard_test.clj
@@ -3,7 +3,8 @@
    [clojure.test :as t]
    [clojure.tools.reader.edn :as edn]
    [methodical.impl.method-table.standard :as method-table.standard]
-   [methodical.interface :as i]))
+   [methodical.interface :as i]
+   [methodical.test-utils :as tu]))
 
 (t/deftest print-test
   (t/is (= "(standard-method-table)"
@@ -32,17 +33,17 @@
                     (i/add-aux-method :before :x 'f))]
       (t/testing "primary method"
         (t/is (= {[:x :y] 'f}
-                 (i/primary-methods table)))
+                 (tu/unwrap-fns-with-meta (i/primary-methods table))))
         (let [method (-> (i/primary-methods table) vals first)]
           (t/is (= 'f
-                   method))
+                   (tu/unwrap-fns-with-meta method)))
           (t/is (= {:dispatch-value [:x :y]}
                    (meta method)))))
       (t/testing "aux method"
         (let [method (-> (i/aux-methods table) :before vals ffirst)]
           (t/is (= {:before {:x ['f]}}
-                   (i/aux-methods table)))
+                   (tu/unwrap-fns-with-meta (i/aux-methods table))))
           (t/is (= 'f
-                   method))
+                   (tu/unwrap-fns-with-meta method)))
           (t/is (= {:dispatch-value :x}
                    (meta method))))))))
diff --git a/test/methodical/macros_test.clj b/test/methodical/macros_test.clj
index 472bbe0..97f9a1c 100644
--- a/test/methodical/macros_test.clj
+++ b/test/methodical/macros_test.clj
@@ -294,7 +294,7 @@
           (-> (impl/multifn impl nil (impl/watching-cache
                                       (impl/simple-cache)
                                       [#'clojure.core/global-hierarchy]))
-              (i/add-primary-method :x (u/primary-method mf1 :x)))]
+              (i/add-primary-method :x (u/unwrap-fn-with-meta (u/primary-method mf1 :x))))]
       (t/testing "Sanity check"
         (t/testing 'mf1
           (t/is (= 1
diff --git a/test/methodical/test_utils.clj b/test/methodical/test_utils.clj
new file mode 100644
index 0000000..4785df5
--- /dev/null
+++ b/test/methodical/test_utils.clj
@@ -0,0 +1,9 @@
+(ns methodical.test-utils
+  (:require
+   [clojure.walk :as walk]
+   [methodical.util :as u]))
+
+(defn unwrap-fns-with-meta
+  "Walk the object and unwrap all encountered FnWithMeta's."
+  [coll]
+  (walk/postwalk u/unwrap-fn-with-meta coll))
diff --git a/test/methodical/util_test.clj b/test/methodical/util_test.clj
index b09dc8f..49033b2 100644
--- a/test/methodical/util_test.clj
+++ b/test/methodical/util_test.clj
@@ -5,6 +5,7 @@
    [methodical.core :as m]
    [methodical.impl :as impl]
    [methodical.interface :as i]
+   [methodical.test-utils :as tu]
    [methodical.util :as u]))
 
 (t/deftest multifn?-test
@@ -29,7 +30,7 @@
     (t/testing "primary-method"
       (t/testing "primary-method should return primary methods with exactly the same dispatch value."
         (t/is (= 'm1
-                 (u/primary-method f CharSequence))))
+                 (tu/unwrap-fns-with-meta (u/primary-method f CharSequence)))))
       (t/testing "`primary-method` should not return default or parent primary methods -- just the exact match."
         (t/is (= nil
                  (u/primary-method f String))))
@@ -41,7 +42,7 @@
   (let [f (test-multifn)]
     (t/testing "applicable-primary-method should give you the primary method that will be used for a dispatch value."
       (t/is (= 'm1
-               (u/applicable-primary-method f String)))
+               (tu/unwrap-fns-with-meta (u/applicable-primary-method f String))))
       (t/testing "Should include dispatch value metadata"
         (t/is (= {:dispatch-value CharSequence}
                  (meta (u/applicable-primary-method f String))))
@@ -120,7 +121,7 @@
                    (m/add-aux-method :before :default 'm4)
                    (m/add-aux-method :before :default 'm5))]
         (t/is (= {:before ['m4 'm5]}
-                 (u/default-aux-methods f')))))
+                 (tu/unwrap-fns-with-meta (u/default-aux-methods f'))))))
 
     (t/testing "default-effective-method"
       (t/is (= [:default]
@@ -299,7 +300,7 @@
     (t/testing "remove-all-aux-methods-for-dispatch-val"
       (t/is (= {:before {Object ['m2]}
                 :after  {Object ['m2 'm4]}}
-               (m/aux-methods (u/remove-all-aux-methods-for-dispatch-val f String)))))
+               (tu/unwrap-fns-with-meta (m/aux-methods (u/remove-all-aux-methods-for-dispatch-val f String))))))
     ;; TODO
 
     (t/testing "remove-all-aux-methods!"
@@ -316,7 +317,7 @@
                 :after  {String ['m2 'm3]
                          Object ['m2 'm4]}
                 :around {String ['m1]}}
-               (m/aux-methods add-aux-method-multifn))))
+               (tu/unwrap-fns-with-meta (m/aux-methods add-aux-method-multifn)))))
 
     (t/testing "remove-aux-method!"
       (def ^:private remove-aux-method-multifn f)
@@ -325,13 +326,13 @@
                          Object ['m2]}
                 :after  {String ['m3]
                          Object ['m2 'm4]}}
-               (m/aux-methods remove-aux-method-multifn)))
+               (tu/unwrap-fns-with-meta (m/aux-methods remove-aux-method-multifn))))
 
       (u/remove-aux-method! #'remove-aux-method-multifn :before String 'm1)
       (t/is (= {:before {Object ['m2]}
                 :after  {String ['m3]
                          Object ['m2 'm4]}}
-               (m/aux-methods remove-aux-method-multifn))
+               (tu/unwrap-fns-with-meta (m/aux-methods remove-aux-method-multifn)))
             "Removing the last method for the dispatch value should remove that dispatch value entirely."))
 
     (t/testing "remove-all-aux-methods-for-dispatch-val!"
@@ -339,13 +340,13 @@
       (u/remove-all-aux-methods-for-dispatch-val! #'remove-all-aux-methods-for-dispatch-val-multifn String)
       (t/is (= {:before {Object ['m2]}
                 :after  {Object ['m2 'm4]}}
-               (m/aux-methods remove-all-aux-methods-for-dispatch-val-multifn))))
+               (tu/unwrap-fns-with-meta (m/aux-methods remove-all-aux-methods-for-dispatch-val-multifn)))))
 
     (t/testing "matching-aux-methods"
       (t/is (= {:before '[m1 m2]
                 :after  '[m2 m3 m2 m4]}
-               (u/matching-aux-methods f String)
-               (u/matching-aux-methods f f String))))))
+               (tu/unwrap-fns-with-meta (u/matching-aux-methods f String))
+               (tu/unwrap-fns-with-meta (u/matching-aux-methods f f String)))))))
 
 (t/deftest aux-methods-unique-key-test
   (t/testing "non-destructive operations")

From 0d75db1dc8bd7b3adf2f313717807c74cdbaa2b4 Mon Sep 17 00:00:00 2001
From: Oleksandr Yakushev <alex@bytopia.org>
Date: Wed, 7 Aug 2024 18:28:25 +0300
Subject: [PATCH 4/4] Reimplement threaded combinator with explicit first/last
 separation

---
 src/methodical/impl/combo/threaded.clj       | 135 ++++++++-----------
 test/methodical/impl/combo/threaded_test.clj |  27 ----
 2 files changed, 59 insertions(+), 103 deletions(-)

diff --git a/src/methodical/impl/combo/threaded.clj b/src/methodical/impl/combo/threaded.clj
index 396e2b7..ad21e26 100644
--- a/src/methodical/impl/combo/threaded.clj
+++ b/src/methodical/impl/combo/threaded.clj
@@ -14,80 +14,61 @@
 
 (comment methodical.interface/keep-me)
 
-(defn reducer-fn
-  "Reduces a series of before/combined-primary/after methods, threading the resulting values to the next method by
-  calling the `invoke` function, which is generated by `threaded-invoker`."
-  [before-primary-after-methods]
-  (fn [[initial-value invoke]]
-    (reduce
-     (fn [last-result method]
-       (invoke method last-result))
-     initial-value
-     before-primary-after-methods)))
-
-(defn combine-with-threader
-  "Combine primary and auxiliary methods using a threading invoker, i.e. something you'd get by calling
-  `threading-invoker`. The way these methods are combined/reduced is the same, regardless of how args are threaded;
-  thus, various strategies such as `:thread-first` and `:thread-last` can both share the same `reducer-fn`."
-  ([threader before-primary-afters]
-   (comp (reducer-fn before-primary-afters) threader))
-
-  ([threader primary-methods {:keys [before after around]}]
-   (when-let [primary (combo.common/combine-primary-methods primary-methods)]
-     (let [methods              (concat before [primary] (reverse after))
-           threaded-fn          (combine-with-threader threader methods)
-           optimized-one-arg-fn (apply comp (reverse methods))]
-       (combo.common/apply-around-methods
-        (-> (fn
-              ([]                     (optimized-one-arg-fn))
-              ([a]                    (optimized-one-arg-fn a))
-              ([a b]                  (threaded-fn a b))
-              ([a b c]                (threaded-fn a b c))
-              ([a b c d]              (threaded-fn a b c d))
-              ([a b c d e]            (threaded-fn a b c d e))
-              ([a b c d e f]          (threaded-fn a b c d e f))
-              ([a b c d e f g]        (threaded-fn a b c d e f g))
-              ([a b c d e f g & more] (apply threaded-fn a b c d e f g more)))
-            (u/fn-vary-meta assoc :methodical/combined-method? true))
-        around)))))
-
-(defmulti threading-invoker
-  "Define a new 'threading invoker', which define how before/combined-primary/after methods should thread values to
-  subsequent methods. These methods take the initial values used to invoke a multifn, then return a pair like
-  `[initial-value threading-fn]`. The threading function is used to invoke any subsequent methods using only q single
-  value, the result of the previous method; if effectively partially binds subsequent methods so that they are always
-  invoked with the initial values of this invocation, excluding the threaded value."
-  {:arglists '([threading-type])}
-  keyword)
-
-(defmethod threading-invoker :thread-first
-  [_]
-  (fn
-    ([a b]                  [a (fn [method a*] (method a* b))])
-    ([a b c]                [a (fn [method a*] (method a* b c))])
-    ([a b c d]              [a (fn [method a*] (method a* b c d))])
-    ([a b c d e]            [a (fn [method a*] (method a* b c d e))])
-    ([a b c d e f]          [a (fn [method a*] (method a* b c d e f))])
-    ([a b c d e f g]        [a (fn [method a*] (method a* b c d e f g))])
-    ([a b c d e f g & more] [a (fn [method a*] (apply method a* b c d e f g more))])))
-
-(defmethod threading-invoker :thread-last
-  [_]
-  (fn
-    ([a b]           [b (fn [method b*] (method a b*))])
-    ([a b c]         [c (fn [method c*] (method a b c*))])
-    ([a b c d]       [d (fn [method d*] (method a b c d*))])
-    ([a b c d e]     [e (fn [method e*] (method a b c d e*))])
-    ([a b c d e f]   [f (fn [method f*] (method a b c d e f*))])
-    ([a b c d e f g] [g (fn [method g*] (method a b c d e f g*))])
-
-    ([a b c d e f g & more]
-     (let [last-val (last more)
-           butlast* (vec (concat [a b c d e f g] (butlast more)))]
-       [last-val
-        (fn [method last*]
-          (apply method (conj butlast* last*)))]))))
-
+(defn combine-methods-thread-first
+  "Combine primary and auxiliary methods using a thread-first threading type."
+  [primary-methods {:keys [before after around]}]
+  (when-let [primary (combo.common/combine-primary-methods primary-methods)]
+    (combo.common/apply-around-methods
+     (if (and (empty? before) (empty? after))
+       ;; If there is only the combined primary method, skip the wrapping dance and just return it.
+       primary
+
+       (let [methods       (concat before [primary] (reverse after))]
+         (-> (reduce
+              (fn [current nxt]
+                (let [nxt (u/unwrap-fn-with-meta nxt)]
+                  (fn combined-method-thread-first
+                    ([]                     (current) (nxt))
+                    ([a]                    (nxt (current a)))
+                    ([a b]                  (nxt (current a b) b))
+                    ([a b c]                (nxt (current a b c) b c))
+                    ([a b c d]              (nxt (current a b c d) b c d))
+                    ([a b c d e]            (nxt (current a b c d e) b c d e))
+                    ([a b c d e f]          (nxt (current a b c d e f) b c d e f))
+                    ([a b c d e f g]        (nxt (current a b c d e f g) b c d e f g))
+                    ([a b c d e f g & more] (apply nxt (apply current a b c d e f g more) b c d e f g more)))))
+              (u/unwrap-fn-with-meta (first methods))
+              (rest methods))
+             (u/fn-vary-meta assoc :methodical/combined-method? true))))
+     around)))
+
+(defn combine-methods-thread-last
+  "Combine primary and auxiliary methods using a thread-last threading type."
+  [primary-methods {:keys [before after around]}]
+  (when-let [primary (combo.common/combine-primary-methods primary-methods)]
+    (combo.common/apply-around-methods
+     (if (and (empty? before) (empty? after))
+       ;; If there is only the combined primary method, skip the wrapping dance and just return it.
+       primary
+
+       (let [methods (concat before [primary] (reverse after))]
+         (-> (reduce
+              (fn [current nxt]
+                (let [nxt (u/unwrap-fn-with-meta nxt)]
+                  (fn combined-method-thread-last
+                    ([]                     (current) (nxt))
+                    ([a]                    (nxt (current a)))
+                    ([a b]                  (nxt a (current a b)))
+                    ([a b c]                (nxt a b (current a b c)))
+                    ([a b c d]              (nxt a b c (current a b c d)))
+                    ([a b c d e]            (nxt a b c d (current a b c d e)))
+                    ([a b c d e f]          (nxt a b c d e (current a b c d e f)))
+                    ([a b c d e f g]        (nxt a b c d e f (current a b c d e f g)))
+                    ([a b c d e f g & more] (apply nxt a b c d e f g (concat (butlast more) [(apply current a b c d e f g more)]))))))
+              (u/unwrap-fn-with-meta (first methods))
+              (rest methods))
+             (u/fn-vary-meta assoc :methodical/combined-method? true))))
+     around)))
 
 (deftype ThreadingMethodCombination [threading-type]
   pretty/PrettyPrintable
@@ -105,7 +86,9 @@
     #{nil :before :after :around})
 
   (combine-methods [_ primary-methods aux-methods]
-    (combine-with-threader (threading-invoker threading-type) primary-methods aux-methods))
+    (case threading-type
+      :thread-first (combine-methods-thread-first primary-methods aux-methods)
+      :thread-last (combine-methods-thread-last primary-methods aux-methods)))
 
   (transform-fn-tail [_ qualifier fn-tail]
     (combo.common/add-implicit-next-method-args qualifier fn-tail))
@@ -125,5 +108,5 @@
   "Create a new `ThreadingMethodCombination` using the keyword `threading-type` strategy, e.g. `:thread-first` or
   `:thread-last`."
   [threading-type]
-  {:pre [(get-method threading-invoker threading-type)]}
+  {:pre [(#{:thread-first :thread-last} threading-type)]}
   (ThreadingMethodCombination. threading-type))
diff --git a/test/methodical/impl/combo/threaded_test.clj b/test/methodical/impl/combo/threaded_test.clj
index 7a2b709..0420667 100644
--- a/test/methodical/impl/combo/threaded_test.clj
+++ b/test/methodical/impl/combo/threaded_test.clj
@@ -3,33 +3,6 @@
             [methodical.impl.combo.threaded :as combo.threaded]
             [methodical.interface :as i]))
 
-(t/deftest threading-invoker-test
-  (t/are [threading expected-2 expected-3 expected-4 expected-5]
-      (let [invoker (comp second (combo.threaded/threading-invoker threading))]
-        (t/is (= expected-2
-                 ((invoker :a :b) list 'acc)))
-
-        (t/is (= expected-3
-                 ((invoker :a :b :c) list 'acc)))
-
-        (t/is (= expected-4
-                 ((invoker :a :b :c :d) list 'acc)))
-
-        (t/is (= expected-5
-                 ((invoker :a :b :c :d :e) list 'acc))))
-
-    :thread-first
-    ['acc :b]
-    ['acc :b :c]
-    ['acc :b :c :d]
-    ['acc :b :c :d :e]
-
-    :thread-last
-    [:a 'acc]
-    [:a :b 'acc]
-    [:a :b :c 'acc]
-    [:a :b :c :d 'acc]))
-
 (defn- combine-methods [threading-type primary-methods aux-methods]
   (i/combine-methods (combo.threaded/threading-method-combination threading-type) primary-methods aux-methods))