Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[dispatcher] Optimize primary method calculation #152

Merged
merged 1 commit into from
Sep 19, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 14 additions & 10 deletions src/methodical/impl/dispatcher/common.clj
Original file line number Diff line number Diff line change
Expand Up @@ -65,13 +65,17 @@

(defn distinct-by
"Like `distinct`, but uses value of `(f item)` to determine whether to keep each `item` in the resulting collection."
[f coll]
(first
(reduce
(fn [[items already-seen? :as acc] item]
(let [v (f item)]
(if (already-seen? v)
acc
[(conj items item) (conj already-seen? v)])))
[[] #{}]
coll)))
([f]
(fn [rf]
(let [seen (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [v (f input)]
(if (contains? @seen v)
result
(do (vswap! seen conj v)
(rf result input)))))))))
([f coll]
(into [] (distinct-by f) coll)))
39 changes: 17 additions & 22 deletions src/methodical/impl/dispatcher/multi_default.clj
Original file line number Diff line number Diff line change
Expand Up @@ -34,12 +34,13 @@
;; 1 | 01 | [:default :y]
;; 0 | 00 | [:default :default]
(let [cnt (count dispatch-value)]
(for [i (reverse (range (dec (int (Math/pow 2 cnt)))))]
(vec
(for [j (reverse (range 0 cnt))]
(if (pos? (bit-and i (bit-shift-left 1 j)))
(nth dispatch-value (- cnt j 1))
default-value))))))
(mapv (fn [i]
(mapv (fn [j]
(if (pos? (bit-and i (bit-shift-left 1 j)))
(nth dispatch-value (- cnt j 1))
default-value))
(range (dec cnt) -1 -1)))
(range (- (int (Math/pow 2 cnt)) 2) -1 -1))))

(defn partially-specialized-default-dispatch-values
"Return a sequence of all partially-specialized default dispatch values for a given `dispatch-value` and
Expand All @@ -57,27 +58,21 @@
(not (sequential? default-value)))
(partially-specialized-default-dispatch-values* dispatch-value default-value)))

(defn- matching-partially-specialized-default-primary-method-pairs*
[{:keys [default-value dispatch-value unambiguous-pairs-seq-fn]
:or {unambiguous-pairs-seq-fn dispatcher.standard/unambiguous-pairs-seq}
:as opts}]
(mapcat
(fn [partial-default]
(let [pairs (dispatcher.standard/matching-primary-pairs-excluding-default
(assoc opts :dispatch-value partial-default))]
(unambiguous-pairs-seq-fn opts pairs)))
(partially-specialized-default-dispatch-values dispatch-value default-value)))

(defn matching-partially-specialized-default-primary-method-pairs
"Return pairs of `[dispatch-value method]` for all matching partially-specialized default methods, sorted from
most-specific to least-specific"
;; TODO - this is too many args!
[opts standard-dispatch-vals]
(->> (matching-partially-specialized-default-primary-method-pairs* opts)
(dispatcher.common/distinct-by first)
(remove
(fn [[dispatch-val]]
(contains? standard-dispatch-vals dispatch-val)))))
(let [{:keys [default-value dispatch-value unambiguous-pairs-seq-fn]
:or {unambiguous-pairs-seq-fn dispatcher.standard/unambiguous-pairs-seq}} opts]
(into []
(comp (mapcat (fn [partial-default]
(let [pairs (dispatcher.standard/matching-primary-pairs-excluding-default
(assoc opts :dispatch-value partial-default))]
(unambiguous-pairs-seq-fn opts pairs))))
(dispatcher.common/distinct-by first)
(remove (fn [[dispatch-val]] (contains? standard-dispatch-vals dispatch-val))))
(partially-specialized-default-dispatch-values dispatch-value default-value))))

(defn matching-primary-methods
"Return a lazy sequence of applicable priamry methods for `dispatch-value`, sorted from most-specific to
Expand Down
Loading