Dynamic & memoized

README.md

@@ -59,6 +59,13 @@ Like multimethods but multidecorators.
 (assert (= [] (func ::f)))
 ```
 
+## Memoization
+
+```clojure
+(defn -main []
+  (alter-var-root #'func md/memoize-multi))
+```
+
 ## Development
 
 ```

src/darkleaf/multidecorators.cljc

@@ -19,23 +19,49 @@
                (into (pop queue) tag-parents)))
       (distinct acc))))
 
+(defn- method [registry tag initial]
+  (let [tags (reversed-me-and-ancestors tag)]
+    (->> tags
+         (map registry)
+         (remove nil?)
+         (reduce (fn [acc decorator]
+                   (fn [obj & args]
+                     (apply decorator acc obj args)))
+                 initial))))
+
 (defn multi [dispatch initial]
-  (let [registry (atom {})]
+  (let [iregistry (atom {})]
     (fn
-      ([] registry)
+      ([] {:type      :dynamic
+           :iregistry iregistry
+           :dispatch  dispatch
+           :initial   initial})
       ([obj & args]
        (let [tag  (apply dispatch obj args)
-             tags (reversed-me-and-ancestors tag)
-             reg  @registry
-             f    (reduce (fn [acc tag]
-                            (if-some [decorator (reg tag)]
-                              (fn [obj & args]
-                                (apply decorator acc obj args))
-                              acc))
-                          initial
-                          tags)]
+             f    (method @iregistry tag initial)]
          (apply f obj args))))))
 
+(defn memoize-multi [multi]
+  (case (:type (multi))
+    :memoized multi
+    :dynamic  (let [{:keys [iregistry
+                            dispatch
+                            initial]} (multi)
+                    registry          @iregistry
+                    mem-method        (memoize method)]
+                (fn
+                  ([] {:type     :memoized
+                       :registry registry
+                       :initial  initial
+                       :dispatch dispatch})
+                  ([obj & args]
+                   (let [tag (apply dispatch obj args)
+                         f   (mem-method registry tag initial)]
+                     (apply f obj args)))))))
+
 (defn ^{:style/indent :defn} decorate [multi tag decorator]
-  (swap! (multi) assoc tag decorator)
-  multi)
+  (case (:type (multi))
+    :dynamic (let [state     (multi)
+                   iregistry (:iregistry state)]
+               (swap! iregistry assoc tag decorator)
+               multi)))

test/darkleaf/multidecorators_test.cljc

@@ -33,3 +33,21 @@
     (t/is (= [] (multi ::f)))
     (t/is (= [:a :b :c :d 's] (multi `s)))
     #?(:clj (t/is (= [:a :b :c :d :obj] (multi String))))))
+
+(t/deftest memoization
+  (let [multi (doto (md/multi identity (constantly []))
+                (md/decorate ::a (fn [super obj] (conj (super obj) :a)))
+                (md/decorate ::b (fn [super obj] (conj (super obj) :b)))
+                (md/decorate ::c (fn [super obj] (conj (super obj) :c)))
+                (md/decorate ::d (fn [super obj] (conj (super obj) :d)))
+                (md/decorate `s  (fn [super obj] (conj (super obj) 's)))
+                #?(:clj (md/decorate Object (fn [super obj] (conj (super obj) :obj)))))
+        mem-multi (md/memoize-multi multi)]
+    (doseq [_ (range 2)]
+      (t/is (= [:a] (mem-multi ::a)))
+      (t/is (= [:a :b] (mem-multi ::b)))
+      (t/is (= [:a :c] (mem-multi ::c)))
+      (t/is (= [:a :b :c :d] (mem-multi ::d)))
+      (t/is (= [] (mem-multi ::f)))
+      (t/is (= [:a :b :c :d 's] (mem-multi `s)))
+      #?(:clj (t/is (= [:a :b :c :d :obj] (mem-multi String)))))))