complete no protocol execution, speed is generally now just as good or far better than equivalent clojure code
This commit is contained in:
Nathan Marz
parent
e052ee06a8
commit
4e268629c3
3 changed files with 196 additions and 146 deletions
|
|
@ -11,84 +11,89 @@
|
|||
|
||||
;; Selector functions
|
||||
|
||||
(defn select
|
||||
"Navigates to and returns a sequence of all the elements specified by the selector."
|
||||
[selector structure]
|
||||
(let [sp (comp-paths* selector)]
|
||||
(select-full* sp
|
||||
[]
|
||||
structure
|
||||
(fn [vals structure]
|
||||
(if-not (empty? vals) [(conj vals structure)] [structure])))
|
||||
))
|
||||
|
||||
(defn select-fast
|
||||
(defn compiled-select
|
||||
"Version of select that takes in a selector pre-compiled with comp-paths"
|
||||
[^com.rpl.specter.impl.StructureValsPathFunctions selfns structure]
|
||||
((.selector selfns) [] structure
|
||||
(fn [vals structure]
|
||||
(if-not (empty? vals) [(conj vals structure)] [structure])))
|
||||
)
|
||||
(if-not (empty? vals) [(conj vals structure)] [structure]))))
|
||||
|
||||
(defn select-one
|
||||
"Like select, but returns either one element or nil. Throws exception if multiple elements found"
|
||||
(defn select
|
||||
"Navigates to and returns a sequence of all the elements specified by the selector."
|
||||
[selector structure]
|
||||
(let [res (select selector structure)]
|
||||
(compiled-select (comp-paths* selector)
|
||||
structure))
|
||||
|
||||
(defn compiled-select-one
|
||||
"Version of select-one that takes in a selector pre-compiled with comp-paths"
|
||||
[selector structure]
|
||||
(let [res (compiled-select selector structure)]
|
||||
(when (> (count res) 1)
|
||||
(throw-illegal "More than one element found for params: " selector structure))
|
||||
(first res)
|
||||
))
|
||||
|
||||
(defn select-one!
|
||||
"Returns exactly one element, throws exception if zero or multiple elements found"
|
||||
(defn select-one
|
||||
"Like select, but returns either one element or nil. Throws exception if multiple elements found"
|
||||
[selector structure]
|
||||
(let [res (select-one selector structure)]
|
||||
(compiled-select-one (comp-paths* selector) structure))
|
||||
|
||||
(defn compiled-select-one!
|
||||
"Version of select-one! that takes in a selector pre-compiled with comp-paths"
|
||||
[selector structure]
|
||||
(let [res (compiled-select-one selector structure)]
|
||||
(when (nil? res) (throw-illegal "No elements found for params: " selector structure))
|
||||
res
|
||||
))
|
||||
|
||||
(defn select-one!
|
||||
"Returns exactly one element, throws exception if zero or multiple elements found"
|
||||
[selector structure]
|
||||
(compiled-select-one! (comp-paths* selector) structure))
|
||||
|
||||
(defn compiled-select-first
|
||||
"Version of select-first that takes in a selector pre-compiled with comp-paths"
|
||||
[selector structure]
|
||||
(first (compiled-select selector structure)))
|
||||
|
||||
(defn select-first
|
||||
"Returns first element found. Not any more efficient than select, just a convenience"
|
||||
[selector structure]
|
||||
(first (select selector structure)))
|
||||
(compiled-select-first (comp-paths* selector) structure))
|
||||
|
||||
;; Update functions
|
||||
|
||||
(defn update
|
||||
"Navigates to each value specified by the selector and replaces it by the result of running
|
||||
the update-fn on it"
|
||||
[selector update-fn structure]
|
||||
(let [selector (comp-paths* selector)]
|
||||
(update-full* selector
|
||||
[]
|
||||
structure
|
||||
(fn [vals structure]
|
||||
(if (empty? vals)
|
||||
(update-fn structure)
|
||||
(apply update-fn (conj vals structure)))
|
||||
))))
|
||||
|
||||
(defn update-fast [^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure]
|
||||
(defn compiled-update
|
||||
"Version of update that takes in a selector pre-compiled with comp-paths"
|
||||
[^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure]
|
||||
((.updater selfns) [] structure
|
||||
(fn [vals structure]
|
||||
(if (empty? vals)
|
||||
(update-fn structure)
|
||||
(apply update-fn (conj vals structure)))
|
||||
))
|
||||
)
|
||||
)))
|
||||
|
||||
(defn update
|
||||
"Navigates to each value specified by the selector and replaces it by the result of running
|
||||
the update-fn on it"
|
||||
[selector update-fn structure]
|
||||
(compiled-update (comp-paths* selector) update-fn structure))
|
||||
|
||||
(defn compiled-setval
|
||||
"Version of setval that takes in a selector pre-compiled with comp-paths"
|
||||
[selector val structure]
|
||||
(compiled-update selector (fn [_] val) structure))
|
||||
|
||||
(defn setval
|
||||
"Navigates to each value specified by the selector and replaces it by val"
|
||||
[selector val structure]
|
||||
(update selector (fn [_] val) structure))
|
||||
(compiled-setval (comp-paths* selector) val structure))
|
||||
|
||||
(defn replace-in [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
|
||||
"Similar to update, except returns a pair of [updated-structure sequence-of-user-ret].
|
||||
The update-fn in this case is expected to return [ret user-ret]. ret is
|
||||
what's used to update the data structure, while user-ret will be added to the user-ret sequence
|
||||
in the final return. replace-in is useful for situations where you need to know the specific values
|
||||
of what was updated in the data structure."
|
||||
(defn compiled-replace-in
|
||||
"Version of replace-in that takes in a selector pre-compiled with comp-paths"
|
||||
[selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
|
||||
(let [state (mutable-cell nil)]
|
||||
[(update selector
|
||||
[(compiled-update selector
|
||||
(fn [e]
|
||||
(let [res (update-fn e)]
|
||||
(if res
|
||||
|
|
@ -103,6 +108,15 @@
|
|||
(get-cell state)]
|
||||
))
|
||||
|
||||
(defn replace-in
|
||||
"Similar to update, except returns a pair of [updated-structure sequence-of-user-ret].
|
||||
The update-fn in this case is expected to return [ret user-ret]. ret is
|
||||
what's used to update the data structure, while user-ret will be added to the user-ret sequence
|
||||
in the final return. replace-in is useful for situations where you need to know the specific values
|
||||
of what was updated in the data structure."
|
||||
[selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
|
||||
(compiled-replace-in (comp-paths* selector) update-fn structure :merge-fn merge-fn))
|
||||
|
||||
;; Built-in pathing and context operations
|
||||
|
||||
(def ALL (->AllStructurePath))
|
||||
|
|
|
|||
|
|
@ -4,27 +4,38 @@
|
|||
[clojure.core.reducers :as r])
|
||||
)
|
||||
|
||||
(defmacro throw* [etype & args]
|
||||
`(throw (new ~etype (pr-str ~@args))))
|
||||
|
||||
(defmacro throw-illegal [& args]
|
||||
`(throw* IllegalArgumentException ~@args))
|
||||
|
||||
(defn benchmark [iters afn]
|
||||
(time
|
||||
(dotimes [_ iters]
|
||||
(afn))))
|
||||
|
||||
(deftype StructureValsPathFunctions [selector updater]
|
||||
StructureValsPath
|
||||
(select-full* [this vals structure next-fn]
|
||||
(selector vals structure next-fn))
|
||||
(update-full* [this vals structure next-fn]
|
||||
(updater vals structure next-fn)))
|
||||
(deftype StructureValsPathFunctions [selector updater])
|
||||
|
||||
(defprotocol CoerceStructureValsPathFunctions
|
||||
(coerce-path [this]))
|
||||
|
||||
(extend-protocol CoerceStructureValsPathFunctions
|
||||
(defn no-prot-error-str [obj]
|
||||
(str "Protocol implementation cannot be found for object.
|
||||
Extending Specter protocols should not be done inline in a deftype definition
|
||||
because that prevents Specter from finding the protocol implementations for
|
||||
optimized performance. Instead, you should extend the protocols via an
|
||||
explicit extend-protocol call. \n" obj))
|
||||
|
||||
com.rpl.specter.protocols.StructureValsPath
|
||||
(coerce-path [this]
|
||||
(let [pimpl (->> this
|
||||
(find-protocol-impl StructureValsPath))
|
||||
(defn find-protocol-impl! [prot obj]
|
||||
(let [ret (find-protocol-impl prot obj)]
|
||||
(if (= ret obj)
|
||||
(throw-illegal (no-prot-error-str obj))
|
||||
ret
|
||||
)))
|
||||
|
||||
(defn coerce-structure-vals-path [this]
|
||||
(let [pimpl (find-protocol-impl! StructureValsPath this)
|
||||
selector (:select-full* pimpl)
|
||||
updater (:update-full* pimpl)]
|
||||
(->StructureValsPathFunctions
|
||||
|
|
@ -34,22 +45,18 @@
|
|||
(updater this vals structure next-fn)))
|
||||
))
|
||||
|
||||
com.rpl.specter.protocols.Collector
|
||||
(coerce-path [collector]
|
||||
(let [pimpl (->> collector
|
||||
(find-protocol-impl Collector)
|
||||
(defn coerce-collector [this]
|
||||
(let [cfn (->> this
|
||||
(find-protocol-impl! Collector)
|
||||
:collect-val
|
||||
)
|
||||
afn (fn [vals structure next-fn]
|
||||
(next-fn (conj vals (pimpl collector structure)) structure)
|
||||
(next-fn (conj vals (cfn this structure)) structure)
|
||||
)]
|
||||
(->StructureValsPathFunctions afn afn)))
|
||||
|
||||
;; need to say Object instead of StructurePath so that things like Keyword are properly coerced
|
||||
Object
|
||||
(coerce-path [this]
|
||||
(let [pimpl (->> this
|
||||
(find-protocol-impl StructurePath))
|
||||
(defn coerce-structure-path [this]
|
||||
(let [pimpl (find-protocol-impl! StructurePath this)
|
||||
selector (:select* pimpl)
|
||||
updater (:update* pimpl)]
|
||||
(->StructureValsPathFunctions
|
||||
|
|
@ -58,7 +65,23 @@
|
|||
(fn [vals structure next-fn]
|
||||
(updater this structure (fn [structure] (next-fn vals structure))))
|
||||
)))
|
||||
)
|
||||
|
||||
(defn obj-extends? [prot obj]
|
||||
(->> obj (find-protocol-impl prot) nil? not))
|
||||
|
||||
(extend-protocol CoerceStructureValsPathFunctions
|
||||
|
||||
StructureValsPathFunctions
|
||||
(coerce-path [this]
|
||||
this)
|
||||
|
||||
Object
|
||||
(coerce-path [this]
|
||||
(cond (obj-extends? StructurePath this) (coerce-structure-path this)
|
||||
(obj-extends? Collector this) (coerce-collector this)
|
||||
(obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
|
||||
:else (throw-illegal (no-prot-error-str this))
|
||||
)))
|
||||
|
||||
|
||||
(extend-protocol StructureValsPathComposer
|
||||
|
|
@ -67,9 +90,6 @@
|
|||
(coerce-path sp))
|
||||
java.util.List
|
||||
(comp-paths* [structure-paths]
|
||||
;;TODO: don't reify any protocols... instead coerce to a "StructureValsPathFunctions" record
|
||||
;; and compose functions directly
|
||||
|
||||
(reduce (fn [^StructureValsPathFunctions sp-curr ^StructureValsPathFunctions sp]
|
||||
(let [curr-selector (.selector sp-curr)
|
||||
selector (.selector sp)
|
||||
|
|
@ -110,12 +130,6 @@
|
|||
(defn get-cell [^PMutableCell cell]
|
||||
(.get_cell cell))
|
||||
|
||||
(defmacro throw* [etype & args]
|
||||
`(throw (new ~etype (pr-str ~@args))))
|
||||
|
||||
(defmacro throw-illegal [& args]
|
||||
`(throw* IllegalArgumentException ~@args))
|
||||
|
||||
(defn update-cell! [cell afn]
|
||||
(let [ret (afn (get-cell cell))]
|
||||
(set-cell! cell ret)
|
||||
|
|
@ -202,8 +216,10 @@
|
|||
(assoc structure akey (next-fn (get structure akey))
|
||||
))
|
||||
|
||||
(deftype AllStructurePath []
|
||||
StructurePath
|
||||
(deftype AllStructurePath [])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
AllStructurePath
|
||||
(select* [this structure next-fn]
|
||||
(into [] (r/mapcat next-fn structure)))
|
||||
(update* [this structure next-fn]
|
||||
|
|
@ -214,45 +230,58 @@
|
|||
(->> structure (r/map next-fn) (into empty-structure))
|
||||
))))
|
||||
|
||||
(deftype ValCollect []
|
||||
Collector
|
||||
(deftype ValCollect [])
|
||||
|
||||
(extend-protocol Collector
|
||||
ValCollect
|
||||
(collect-val [this structure]
|
||||
structure))
|
||||
|
||||
(deftype LastStructurePath []
|
||||
StructurePath
|
||||
(deftype LastStructurePath [])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
LastStructurePath
|
||||
(select* [this structure next-fn]
|
||||
(next-fn (last structure)))
|
||||
(update* [this structure next-fn]
|
||||
(set-last structure (next-fn (last structure)))))
|
||||
|
||||
(deftype FirstStructurePath []
|
||||
StructurePath
|
||||
(deftype FirstStructurePath [])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
FirstStructurePath
|
||||
(select* [this structure next-fn]
|
||||
(next-fn (first structure)))
|
||||
(update* [this structure next-fn]
|
||||
(set-first structure (next-fn (first structure)))))
|
||||
|
||||
(deftype WalkerStructurePath [afn]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(walk-select afn next-fn structure))
|
||||
(update* [this structure next-fn]
|
||||
(walk-until afn next-fn structure)))
|
||||
(deftype WalkerStructurePath [afn])
|
||||
|
||||
(deftype CodeWalkerStructurePath [afn]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(walk-select afn next-fn structure))
|
||||
(update* [this structure next-fn]
|
||||
(codewalk-until afn next-fn structure)))
|
||||
(extend-protocol StructurePath
|
||||
WalkerStructurePath
|
||||
(select* [^WalkerStructurePath this structure next-fn]
|
||||
(walk-select (.afn this) next-fn structure))
|
||||
(update* [^WalkerStructurePath this structure next-fn]
|
||||
(walk-until (.afn this) next-fn structure)))
|
||||
|
||||
(deftype FilterStructurePath [afn]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(->> structure (filter afn) doall next-fn))
|
||||
(update* [this structure next-fn]
|
||||
(let [[filtered ancestry] (filter+ancestry afn structure)
|
||||
(deftype CodeWalkerStructurePath [afn])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
CodeWalkerStructurePath
|
||||
(select* [^CodeWalkerStructurePath this structure next-fn]
|
||||
(walk-select (.afn this) next-fn structure))
|
||||
(update* [^CodeWalkerStructurePath this structure next-fn]
|
||||
(codewalk-until (.afn this) next-fn structure)))
|
||||
|
||||
|
||||
(deftype FilterStructurePath [afn])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
FilterStructurePath
|
||||
(select* [^FilterStructurePath this structure next-fn]
|
||||
(->> structure (filter (.afn this)) doall next-fn))
|
||||
(update* [^FilterStructurePath this structure next-fn]
|
||||
(let [[filtered ancestry] (filter+ancestry (.afn this) structure)
|
||||
;; the vec is necessary so that we can get by index later
|
||||
;; (can't get by index for cons'd lists)
|
||||
next (vec (next-fn filtered))]
|
||||
|
|
@ -261,29 +290,36 @@
|
|||
(vec structure)
|
||||
ancestry))))
|
||||
|
||||
(deftype KeyPath [akey]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(key-select akey structure next-fn))
|
||||
(update* [this structure next-fn]
|
||||
(key-update akey structure next-fn)
|
||||
(deftype KeyPath [akey])
|
||||
|
||||
|
||||
(extend-protocol StructurePath
|
||||
KeyPath
|
||||
(select* [^KeyPath this structure next-fn]
|
||||
(key-select (.akey this) structure next-fn))
|
||||
(update* [^KeyPath this structure next-fn]
|
||||
(key-update (.akey this) structure next-fn)
|
||||
))
|
||||
|
||||
(deftype SelectCollector [sel-fn selector]
|
||||
Collector
|
||||
(collect-val [this structure]
|
||||
(sel-fn selector structure)))
|
||||
(deftype SelectCollector [sel-fn selector])
|
||||
|
||||
(deftype SRangePath [start-fn end-fn]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(let [start (start-fn structure)
|
||||
end (end-fn structure)]
|
||||
(extend-protocol Collector
|
||||
SelectCollector
|
||||
(collect-val [^SelectCollector this structure]
|
||||
((.sel-fn this) (.selector this) structure)))
|
||||
|
||||
(deftype SRangePath [start-fn end-fn])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
SRangePath
|
||||
(select* [^SRangePath this structure next-fn]
|
||||
(let [start ((.start-fn this) structure)
|
||||
end ((.end-fn this) structure)]
|
||||
(next-fn (-> structure vec (subvec start end)))
|
||||
))
|
||||
(update* [this structure next-fn]
|
||||
(let [start (start-fn structure)
|
||||
end (end-fn structure)
|
||||
(update* [^SRangePath this structure next-fn]
|
||||
(let [start ((.start-fn this) structure)
|
||||
end ((.end-fn this) structure)
|
||||
structurev (vec structure)
|
||||
newpart (next-fn (-> structurev (subvec start end)))
|
||||
res (concat (subvec structurev 0 start)
|
||||
|
|
@ -294,12 +330,14 @@
|
|||
res
|
||||
))))
|
||||
|
||||
(deftype ViewPath [view-fn]
|
||||
StructurePath
|
||||
(select* [this structure next-fn]
|
||||
(-> structure view-fn next-fn))
|
||||
(update* [this structure next-fn]
|
||||
(-> structure view-fn next-fn)
|
||||
(deftype ViewPath [view-fn])
|
||||
|
||||
(extend-protocol StructurePath
|
||||
ViewPath
|
||||
(select* [^ViewPath this structure next-fn]
|
||||
(->> structure ((.view-fn this)) next-fn))
|
||||
(update* [^ViewPath this structure next-fn]
|
||||
(->> structure ((.view-fn this)) next-fn)
|
||||
))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
(ns com.rpl.specter.protocols)
|
||||
|
||||
|
||||
;;TODO: can use find-protocol-impl function to avoid all the protocol calls
|
||||
(defprotocol StructureValsPath
|
||||
(select-full* [this vals structure next-fn])
|
||||
(update-full* [this vals structure next-fn]))
|
||||
|
|
|
|||
Loading…
Reference in a new issue