luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

complete no protocol execution, speed is generally now just as good or far better than equivalent clojure code

Browse source
This commit is contained in:
Nathan Marz 2015-05-10 18:47:57 -04:00
parent e052ee06a8
commit 4e268629c3
3 changed files with 196 additions and 146 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

106
src/clj/com/rpl/specter.clj
View file

@ -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))

234
src/clj/com/rpl/specter/impl.clj
View file

@ -4,61 +4,84 @@
[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]))
(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))
(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
(fn [vals structure next-fn]
(selector this vals structure next-fn))
(fn [vals structure next-fn]
(updater this vals structure next-fn)))
))
(defn coerce-collector [this]
(let [cfn (->> this
(find-protocol-impl! Collector)
:collect-val
)
afn (fn [vals structure next-fn]
(next-fn (conj vals (cfn this structure)) structure)
)]
(->StructureValsPathFunctions afn afn)))
(defn coerce-structure-path [this]
(let [pimpl (find-protocol-impl! StructurePath this)
selector (:select* pimpl)
updater (:update* pimpl)]
(->StructureValsPathFunctions
(fn [vals structure next-fn]
(selector this structure (fn [structure] (next-fn vals structure))))
(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
com.rpl.specter.protocols.StructureValsPath
StructureValsPathFunctions
(coerce-path [this]
(let [pimpl (->> this
(find-protocol-impl StructureValsPath))
selector (:select-full* pimpl)
updater (:update-full* pimpl)]
(->StructureValsPathFunctions
(fn [vals structure next-fn]
(selector this vals structure next-fn))
(fn [vals structure next-fn]
(updater this vals structure next-fn)))
))
this)
com.rpl.specter.protocols.Collector
(coerce-path [collector]
(let [pimpl (->> collector
(find-protocol-impl Collector)
:collect-val
)
afn (fn [vals structure next-fn]
(next-fn (conj vals (pimpl collector 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))
selector (:select* pimpl)
updater (:update* pimpl)]
(->StructureValsPathFunctions
(fn [vals structure next-fn]
(selector this structure (fn [structure] (next-fn vals structure))))
(fn [vals structure next-fn]
(updater this structure (fn [structure] (next-fn vals structure))))
(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])
(extend-protocol Collector
SelectCollector
(collect-val [^SelectCollector this structure]
((.sel-fn this) (.selector this) structure)))
(deftype SRangePath [start-fn end-fn]
StructurePath
(select* [this structure next-fn]
(let [start (start-fn structure)
end (end-fn 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)
))

2
src/clj/com/rpl/specter/protocols.clj
View file

@ -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]))