memoize-multi

Author: darkleaf

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

@@ -41,8 +41,27 @@
              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]
-  (let [state     (multi)
-        iregistry (:iregistry state)]
-    (swap! iregistry 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)))))))