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.

Sign up for GitHub

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

Jump to bottom

Replace Clojure functions that contain metadata with custom FnWithMeta #150

Merged
merged 4 commits into from
Aug 14, 2024
Merged

Replace Clojure functions that contain metadata with custom FnWithMeta #150

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
0d04686
Attempt at widening the arities for multimethod calls
bshepherdson Jul 31, 2024
3fc564e
Fix tests after widening arities
alexander-yakushev Aug 7, 2024
6968c26
Introduce custom FnWithMeta to attach metadata to functions
alexander-yakushev Aug 2, 2024
0d75db1
Reimplement threaded combinator with explicit first/last separation
alexander-yakushev Aug 7, 2024
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
3 changes: 2 additions & 1 deletion .clj-kondo/config.edn
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,8 @@

:unresolved-symbol
{:exclude
[(clojure.test/is [macroexpansion-spec-error?])]}
[->FnWithMeta FnWithMeta
(clojure.test/is [macroexpansion-spec-error?])]}

:consistent-alias
{:aliases
Expand Down
43 changes: 29 additions & 14 deletions src/methodical/impl/combo/clos.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
96 changes: 92 additions & 4 deletions src/methodical/impl/combo/common.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,91 @@
(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."
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It would be nice to add a Kondo :discouraged-var rule for clojure.core/partial but I can do that separately

([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`
Expand All @@ -8,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)
Comment on lines -11 to +97
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I wonder if maybe we should also have a with-meta* that does the right thing for functions but otherwise does normal with-meta and then have Kondo :discouraged-var tell everyone to use that. Then we don't need fn-with-meta and it's impossible to forget to use it

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Good idea!

(meta primary-method)))
nil
(reverse primary-methods))))

Expand All @@ -19,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))

Expand All @@ -36,7 +124,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)+)"
Expand Down
127 changes: 60 additions & 67 deletions src/methodical/impl/combo/threaded.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -13,71 +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 & more] (apply threaded-fn a b c d more)))
(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 & more] [a (fn [method a*] (apply method a* b c d 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]
(let [last-val (last more)
butlast* (vec (concat [a b c d] (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
Expand All @@ -95,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))
Expand All @@ -115,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))
20 changes: 12 additions & 8 deletions src/methodical/impl/dispatcher/everything.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -32,26 +33,29 @@
(= 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)
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)
comparatorr (dispatcher.common/domination-comparator (deref hierarchy-var) prefs)]
(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)
Expand Down
Loading
Loading