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

reformat code with parinfer

Browse source
This commit is contained in:
Nathan Marz 2016-08-11 10:13:27 -04:00
parent 87137c633d
commit ac3f604211
18 changed files with 1281 additions and 1294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
project.clj
View file

@ -1,9 +1,9 @@
(def VERSION (.trim (slurp "VERSION"))) (def VERSION (.trim (slurp "VERSION")))
(defproject com.rpl/specter VERSION (defproject com.rpl/specter VERSION
:jvm-opts ["-XX:-OmitStackTraceInFastThrow" ; this prevents JVM from doing optimizations which can remove stack traces from NPE and other exceptions :jvm-opts ["-XX:-OmitStackTraceInFastThrow"] ; this prevents JVM from doing optimizations which can remove stack traces from NPE and other exceptions
;"-agentpath:/Applications/YourKit_Java_Profiler_2015_build_15056.app/Contents/Resources/bin/mac/libyjpagent.jnilib" ;"-agentpath:/Applications/YourKit_Java_Profiler_2015_build_15056.app/Contents/Resources/bin/mac/libyjpagent.jnilib"]
]
:source-paths ["src/clj"] :source-paths ["src/clj"]
:java-source-paths ["src/java"] :java-source-paths ["src/java"]
:test-paths ["test", "target/test-classes"] :test-paths ["test", "target/test-classes"]
@ -18,15 +18,14 @@
com.rpl.specter.transients] com.rpl.specter.transients]
:source-uri :source-uri
{#"target/classes" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}x#L{line}" {#"target/classes" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}x#L{line}"
#".*" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}#L{line}" #".*" "https://github.com/nathanmarz/specter/tree/{version}/src/clj/{classpath}#L{line}"}}
}
}
:profiles {:dev {:dependencies :profiles {:dev {:dependencies
[[org.clojure/test.check "0.7.0"] [[org.clojure/test.check "0.7.0"]
[org.clojure/clojure "1.7.0"] [org.clojure/clojure "1.7.0"]
[org.clojure/clojurescript "1.7.10"]] [org.clojure/clojurescript "1.7.10"]]}
}
:test {:dependencies [[org.clojure/clojure "1.7.0"]]} :test {:dependencies [[org.clojure/clojure "1.7.0"]]}}
}
:aliases {"deploy" ["do" "clean," "deploy" "clojars"]} :aliases {"deploy" ["do" "clean," "deploy" "clojars"]})
)

4
repl.clj
View file

@ -10,8 +10,8 @@
(when-let [s (cljs.analyzer/error-message warning-type extra)] (when-let [s (cljs.analyzer/error-message warning-type extra)]
(binding [*out* *err*] (binding [*out* *err*]
(println "WARNING:" (cljs.analyzer/message env s)) (println "WARNING:" (cljs.analyzer/message env s))
(println "Failed to build because of warning!") (println "Failed to build because of warning!"))
)
(System/exit 1))))]}) (System/exit 1))))]})
(cljs.repl/repl (cljs.repl.node/repl-env) (cljs.repl/repl (cljs.repl.node/repl-env)

87
scripts/benchmarks.clj
View file

@ -3,8 +3,8 @@
[com.rpl.specter macros] [com.rpl.specter macros]
[com.rpl.specter.transients] [com.rpl.specter.transients]
[com.rpl.specter.impl :only [benchmark]]) [com.rpl.specter.impl :only [benchmark]])
(:require [clojure.walk :as walk]) (:require [clojure.walk :as walk]))
)
;; run via `lein repl` with `(load-file "scripts/benchmarks.clj")` ;; run via `lein repl` with `(load-file "scripts/benchmarks.clj")`
@ -19,8 +19,8 @@
(let [start (System/nanoTime) (let [start (System/nanoTime)
_ (dotimes [_ amt] (afn)) _ (dotimes [_ amt] (afn))
end (System/nanoTime)] end (System/nanoTime)]
(/ (- end start) 1000000.0) (/ (- end start) 1000000.0)))
))
(defn avg [numbers] (defn avg [numbers]
(/ (reduce + numbers) (/ (reduce + numbers)
@ -41,20 +41,20 @@
(fn [afn] (fn [afn]
(average-time-ms 8 amt-per-iter afn)) (average-time-ms 8 amt-per-iter afn))
afn-map) afn-map)
[[_ best-time] & _ :as sorted] (sort-by last results) [[_ best-time] & _ :as sorted] (sort-by last results)]
]
(println "\nAvg(ms)\t\tvs best\t\tCode") (println "\nAvg(ms)\t\tvs best\t\tCode")
(doseq [[k t] sorted] (doseq [[k t] sorted]
(println (pretty-float5 t) "\t\t" (pretty-float3 (/ t best-time 1.0)) "\t\t" k) (println (pretty-float5 t) "\t\t" (pretty-float3 (/ t best-time 1.0)) "\t\t" k))))
)))
(defmacro run-benchmark [name amt-per-iter & exprs] (defmacro run-benchmark [name amt-per-iter & exprs]
(let [afn-map (->> exprs shuffle (map (fn [e] [`(quote ~e) `(fn [] ~e)])) (into {}))] (let [afn-map (->> exprs shuffle (map (fn [e] [`(quote ~e) `(fn [] ~e)])) (into {}))]
`(do `(do
(println "Benchmark:" ~name (str "(" ~amt-per-iter " iterations)")) (println "Benchmark:" ~name (str "(" ~amt-per-iter " iterations)"))
(compare-benchmark ~amt-per-iter ~afn-map) (compare-benchmark ~amt-per-iter ~afn-map)
(println "\n********************************\n") (println "\n********************************\n"))))
)))
(let [data {:a {:b {:c 1}}} (let [data {:a {:b {:c 1}}}
p (comp-paths :a :b :c)] p (comp-paths :a :b :c)]
@ -66,8 +66,8 @@
(compiled-select-any p data) (compiled-select-any p data)
(get-in data [:a :b :c]) (get-in data [:a :b :c])
(-> data :a :b :c) (-> data :a :b :c)
(select-any [(keypath :a) (keypath :b) (keypath :c)] data) (select-any [(keypath :a) (keypath :b) (keypath :c)] data)))
))
;; because below 1.7 there is no update function ;; because below 1.7 there is no update function
@ -85,8 +85,8 @@
(run-benchmark "update value in nested map" 500000 (run-benchmark "update value in nested map" 500000
(update-in data [:a :b :c] inc) (update-in data [:a :b :c] inc)
(transform [:a :b :c] inc data) (transform [:a :b :c] inc data)
(manual-transform data inc) (manual-transform data inc)))
))
(defn map-vals-map-iterable [^clojure.lang.IMapIterable m afn] (defn map-vals-map-iterable [^clojure.lang.IMapIterable m afn]
(let [k-it (.keyIterator m) (let [k-it (.keyIterator m)
@ -95,10 +95,10 @@
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it)] v (.next v-it)]
(recur (assoc ret k (afn v))) (recur (assoc ret k (afn v))))
)
ret ret))))
))))
(defn map-vals-map-iterable-transient [^clojure.lang.IMapIterable m afn] (defn map-vals-map-iterable-transient [^clojure.lang.IMapIterable m afn]
(persistent! (persistent!
@ -108,10 +108,10 @@
(if (.hasNext k-it) (if (.hasNext k-it)
(let [k (.next k-it) (let [k (.next k-it)
v (.next v-it)] v (.next v-it)]
(recur (assoc! ret k (afn v))) (recur (assoc! ret k (afn v))))
)
ret ret)))))
)))))
(let [data {:a 1 :b 2 :c 3 :d 4}] (let [data {:a 1 :b 2 :c 3 :d 4}]
(run-benchmark "transform values of a small map" 500000 (run-benchmark "transform values of a small map" 500000
@ -124,8 +124,8 @@
(zipmap (keys data) (map inc (vals data))) (zipmap (keys data) (map inc (vals data)))
(into {} (map (fn [e] [(key e) (inc (val e))]) data)) (into {} (map (fn [e] [(key e) (inc (val e))]) data))
(map-vals-map-iterable data inc) (map-vals-map-iterable data inc)
(map-vals-map-iterable-transient data inc) (map-vals-map-iterable-transient data inc)))
))
(let [data (->> (for [i (range 1000)] [i i]) (into {}))] (let [data (->> (for [i (range 1000)] [i i]) (into {}))]
(run-benchmark "transform values of large map" 600 (run-benchmark "transform values of large map" 600
@ -139,23 +139,23 @@
(zipmap (keys data) (map inc (vals data))) (zipmap (keys data) (map inc (vals data)))
(into {} (map (fn [e] [(key e) (inc (val e))]) data)) (into {} (map (fn [e] [(key e) (inc (val e))]) data))
(map-vals-map-iterable data inc) (map-vals-map-iterable data inc)
(map-vals-map-iterable-transient data inc) (map-vals-map-iterable-transient data inc)))
))
(let [data [1 2 3 4 5]] (let [data [1 2 3 4 5]]
(run-benchmark "map a function over a vector" 1000000 (run-benchmark "map a function over a vector" 1000000
(vec (map inc data)) (vec (map inc data))
(mapv inc data) (mapv inc data)
(transform ALL inc data) (transform ALL inc data)))
))
(let [data [1 2 3 4 5 6 7 8 9 10]] (let [data [1 2 3 4 5 6 7 8 9 10]]
(run-benchmark "filter a sequence" 500000 (run-benchmark "filter a sequence" 500000
(doall (filter even? data)) (doall (filter even? data))
(filterv even? data) (filterv even? data)
(select [ALL even?] data) (select [ALL even?] data)
(select-any (filterer even?) data) (select-any (filterer even?) data)))
))
(let [data [{:a 2 :b 2} {:a 1} {:a 4} {:a 6}] (let [data [{:a 2 :b 2} {:a 1} {:a 4} {:a 6}]
xf (comp (map :a) (filter even?))] xf (comp (map :a) (filter even?))]
@ -163,8 +163,8 @@
(select [ALL :a even?] data) (select [ALL :a even?] data)
(->> data (mapv :a) (filter even?) doall) (->> data (mapv :a) (filter even?) doall)
(into [] (comp (map :a) (filter even?)) data) (into [] (comp (map :a) (filter even?)) data)
(into [] xf data) (into [] xf data)))
))
(let [v (vec (range 1000))] (let [v (vec (range 1000))]
(run-benchmark "END on large vector" (run-benchmark "END on large vector"
@ -191,8 +191,8 @@
(defn tree-value-transform [afn atree] (defn tree-value-transform [afn atree]
(if (vector? atree) (if (vector? atree)
(mapv #(tree-value-transform afn %) atree) (mapv #(tree-value-transform afn %) atree)
(afn atree) (afn atree)))
))
(let [data [1 2 [[3]] [4 6 [7 [8]] 10]]] (let [data [1 2 [[3]] [4 6 [7 [8]] 10]]]
(run-benchmark "update every value in a tree (represented with vectors)" (run-benchmark "update every value in a tree (represented with vectors)"
@ -201,8 +201,8 @@
(transform [(walker number?) even?] inc data) (transform [(walker number?) even?] inc data)
(transform [TreeValues even?] inc data) (transform [TreeValues even?] inc data)
(transform [TreeValuesProt even?] inc data) (transform [TreeValuesProt even?] inc data)
(tree-value-transform (fn [e] (if (even? e) (inc e) e)) data) (tree-value-transform (fn [e] (if (even? e) (inc e) e)) data)))
))
(let [toappend (range 1000)] (let [toappend (range 1000)]
(run-benchmark "transient comparison: building up vectors" (run-benchmark "transient comparison: building up vectors"
@ -218,8 +218,8 @@
(reduce (fn [v i] (conj v i)) [] toappend) (reduce (fn [v i] (conj v i)) [] toappend)
(reduce (fn [v i] (conj! v i)) (transient []) toappend) (reduce (fn [v i] (conj! v i)) (transient []) toappend)
(reduce (fn [v i] (setval END [i] v)) [] toappend) (reduce (fn [v i] (setval END [i] v)) [] toappend)
(reduce (fn [v i] (setval END! [i] v)) (transient []) toappend) (reduce (fn [v i] (setval END! [i] v)) (transient []) toappend)))
))
(let [data (vec (range 1000)) (let [data (vec (range 1000))
tdata (transient data) tdata (transient data)
@ -280,19 +280,18 @@
(into #{} (traverse ALL data)) (into #{} (traverse ALL data))
(persistent! (persistent!
(reduce conj! (transient #{}) (traverse ALL data))) (reduce conj! (transient #{}) (traverse ALL data)))
(reduce conj #{} (traverse ALL data)) (reduce conj #{} (traverse ALL data))))
))
(defn mult-10 [v] (* 10 v)) (defn mult-10 [v] (* 10 v))
(let [data [1 2 3 4 5 6 7 8 9]] (let [data [1 2 3 4 5 6 7 8 9]]
(run-benchmark "multi-transform vs. consecutive transforms, one shared nav" 300000 (run-benchmark "multi-transform vs. consecutive transforms, one shared nav" 300000
(->> data (transform [ALL even?] mult-10) (transform [ALL odd?] dec)) (->> data (transform [ALL even?] mult-10) (transform [ALL odd?] dec))
(multi-transform [ALL (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data) (multi-transform [ALL (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data)))
))
(let [data [[1 2 3 4 :a] [5] [6 7 :b 8 9] [10 11 12 13]]] (let [data [[1 2 3 4 :a] [5] [6 7 :b 8 9] [10 11 12 13]]]
(run-benchmark "multi-transform vs. consecutive transforms, three shared navs" 150000 (run-benchmark "multi-transform vs. consecutive transforms, three shared navs" 150000
(->> data (transform [ALL ALL number? even?] mult-10) (transform [ALL ALL number? odd?] dec)) (->> data (transform [ALL ALL number? even?] mult-10) (transform [ALL ALL number? odd?] dec))
(multi-transform [ALL ALL number? (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data) (multi-transform [ALL ALL number? (multi-path [even? (terminal mult-10)] [odd? (terminal dec)])] data)))
))

132
src/clj/com/rpl/specter.cljc
View file

@ -8,11 +8,11 @@
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor defnavconstructor]]
]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]] [doseqres]]))
))
(:use [com.rpl.specter.protocols :only [ImplicitNav]] (:use [com.rpl.specter.protocols :only [ImplicitNav]]
#?(:clj [com.rpl.specter.macros :only #?(:clj [com.rpl.specter.macros :only
[fixed-pathed-collector [fixed-pathed-collector
@ -22,12 +22,12 @@
defpathedfn defpathedfn
richnav richnav
defnavconstructor]]) defnavconstructor]])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]]) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
)
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[com.rpl.specter.navs :as n] [com.rpl.specter.navs :as n]
[clojure.set :as set]) [clojure.set :as set]))
)
(defn comp-paths (defn comp-paths
"Returns a compiled version of the given path for use with "Returns a compiled version of the given path for use with
@ -177,8 +177,8 @@
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn)) (i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn) (i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn)))))
))))
;; Built-in pathing and context operations ;; Built-in pathing and context operations
@ -190,8 +190,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
NONE) NONE)
(transform* [this structure next-fn] (transform* [this structure next-fn]
structure structure))
))
(defnav (defnav
@ -213,8 +213,8 @@
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/throw-illegal "'terminal' should only be used in multi-transform")) (i/throw-illegal "'terminal' should only be used in multi-transform"))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(n/terminal* params params-idx vals structure) (n/terminal* params params-idx vals structure))))
)))
(defnavconstructor terminal-val (defnavconstructor terminal-val
"Like `terminal` but specifies a val to set at the location regardless of "Like `terminal` but specifies a val to set at the location regardless of
@ -240,11 +240,11 @@
[] []
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [v (vals structure)] (doseqres NONE [v (vals structure)]
(next-fn v) (next-fn v)))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/map-vals-transform structure next-fn) (n/map-vals-transform structure next-fn)))
))
(defcollector VAL [] (defcollector VAL []
@ -271,8 +271,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(n/srange-select structure (start-fn structure) (end-fn structure) next-fn)) (n/srange-select structure (start-fn structure) (end-fn structure) next-fn))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/srange-transform structure (start-fn structure) (end-fn structure) next-fn) (n/srange-transform structure (start-fn structure) (end-fn structure) next-fn)))
))
(defnav (defnav
^{:doc "Navigates to the subsequence bound by the indexes start (inclusive) ^{:doc "Navigates to the subsequence bound by the indexes start (inclusive)
@ -282,8 +282,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(n/srange-select structure start end next-fn)) (n/srange-select structure start end next-fn))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/srange-transform structure start end next-fn) (n/srange-transform structure start end next-fn)))
))
(defnav (defnav
^{:doc "Navigates to every continuous subsequence of elements matching `pred`"} ^{:doc "Navigates to every continuous subsequence of elements matching `pred`"}
@ -291,15 +291,15 @@
[pred] [pred]
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [[s e] (n/matching-ranges structure pred)] (doseqres NONE [[s e] (n/matching-ranges structure pred)]
(n/srange-select structure s e next-fn) (n/srange-select structure s e next-fn)))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(reduce (reduce
(fn [structure [s e]] (fn [structure [s e]]
(n/srange-transform structure s e next-fn)) (n/srange-transform structure s e next-fn))
structure structure
(reverse (n/matching-ranges structure pred)) (reverse (n/matching-ranges structure pred)))))
)))
(defnav (defnav
^{:doc "Navigate to the empty subsequence before the first element of the collection."} ^{:doc "Navigate to the empty subsequence before the first element of the collection."}
@ -309,8 +309,8 @@
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-prepend (next-fn [])] (let [to-prepend (next-fn [])]
(n/prepend-all structure to-prepend) (n/prepend-all structure to-prepend))))
)))
(defnav (defnav
^{:doc "Navigate to the empty subsequence after the last element of the collection."} ^{:doc "Navigate to the empty subsequence after the last element of the collection."}
@ -320,8 +320,8 @@
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-append (next-fn [])] (let [to-append (next-fn [])]
(n/append-all structure to-append) (n/append-all structure to-append))))
)))
(defnav (defnav
^{:doc "Navigates to the specified subset (by taking an intersection). ^{:doc "Navigates to the specified subset (by taking an intersection).
@ -336,8 +336,8 @@
newset (next-fn subset)] newset (next-fn subset)]
(-> structure (-> structure
(set/difference subset) (set/difference subset)
(set/union newset)) (set/union newset)))))
)))
(defnav (defnav
^{:doc "Navigates to the specified submap (using select-keys). ^{:doc "Navigates to the specified submap (using select-keys).
@ -401,8 +401,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (get structure key))) (next-fn (get structure key)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(assoc structure key (next-fn (get structure key))) (assoc structure key (next-fn (get structure key)))))
))
(defnav (defnav
^{:doc "Navigates to the key only if it exists in the map."} ^{:doc "Navigates to the key only if it exists in the map."}
@ -415,8 +415,8 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
(if (contains? structure k) (if (contains? structure k)
(assoc structure k (next-fn (get structure k))) (assoc structure k (next-fn (get structure k)))
structure structure)))
)))
(defnav (defnav
^{:doc "Navigates to result of running `afn` on the currently navigated value."} ^{:doc "Navigates to result of running `afn` on the currently navigated value."}
@ -425,8 +425,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (afn structure))) (next-fn (afn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(next-fn (afn structure)) (next-fn (afn structure))))
))
(defnav (defnav
^{:doc "Navigate to the result of running `parse-fn` on the value. For ^{:doc "Navigate to the result of running `parse-fn` on the value. For
@ -437,8 +437,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (parse-fn structure))) (next-fn (parse-fn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(unparse-fn (next-fn (parse-fn structure))) (unparse-fn (next-fn (parse-fn structure)))))
))
(defnav (defnav
^{:doc "Navigates to atom value."} ^{:doc "Navigates to atom value."}
@ -522,8 +522,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(if (afn structure) (next-fn structure) NONE)) (if (afn structure) (next-fn structure) NONE))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(if (afn structure) (next-fn structure) structure)) (if (afn structure) (next-fn structure) structure)))
)
(extend-type nil (extend-type nil
ImplicitNav ImplicitNav
@ -531,8 +531,8 @@
(extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword) (extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)
ImplicitNav ImplicitNav
(implicit-nav [this] (keypath this)) (implicit-nav [this] (keypath this)))
)
(extend-type #?(:clj clojure.lang.AFn :cljs function) (extend-type #?(:clj clojure.lang.AFn :cljs function)
ImplicitNav ImplicitNav
@ -586,8 +586,8 @@
[& path] [& path]
(fixed-pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select late structure) (compiled-select late structure))))
)))
(defpathedfn (defpathedfn
^{:doc "Adds the result of running select-one with the given path on the ^{:doc "Adds the result of running select-one with the given path on the
@ -596,8 +596,8 @@
[& path] [& path]
(fixed-pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select-one late structure) (compiled-select-one late structure))))
)))
(defcollector (defcollector
^{:doc ^{:doc
@ -640,8 +640,8 @@
afn afn
then-nav then-nav
then-needed then-needed
else-nav else-nav))
))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(n/if-transform (n/if-transform
params params
@ -652,8 +652,8 @@
afn afn
then-nav then-nav
then-needed then-needed
else-nav else-nav))))
))))
(let [cond-comp (i/comp-paths-internalized cond-p) (let [cond-comp (i/comp-paths-internalized cond-p)
cond-needed (i/num-needed-params cond-comp)] cond-needed (i/num-needed-params cond-comp)]
(richnav (+ then-needed else-needed cond-needed) (richnav (+ then-needed else-needed cond-needed)
@ -668,8 +668,8 @@
#(n/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav)))
)))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)] (let [late-cond (i/parameterize-path cond-comp params params-idx)]
(n/if-transform (n/if-transform
@ -681,8 +681,8 @@
#(n/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav))))))))
))))))))
(defpathedfn cond-path (defpathedfn cond-path
"Takes in alternating cond-path path cond-path path... "Takes in alternating cond-path path cond-path path...
@ -700,8 +700,8 @@
(fn [p [tester apath]] (fn [p [tester apath]]
(if-path tester apath p)) (if-path tester apath p))
STOP STOP
pairs pairs)))
)))
(defpathedfn multi-path (defpathedfn multi-path
"A path that branches on multiple paths. For updates, "A path that branches on multiple paths. For updates,
@ -713,23 +713,23 @@
comp2 (i/comp-paths-internalized path2) comp2 (i/comp-paths-internalized path2)
comp1-needed (i/num-needed-params comp1) comp1-needed (i/num-needed-params comp1)
nav1 (i/extract-rich-nav comp1) nav1 (i/extract-rich-nav comp1)
nav2 (i/extract-rich-nav comp2) nav2 (i/extract-rich-nav comp2)]
]
(richnav (+ comp1-needed (i/num-needed-params comp2)) (richnav (+ comp1-needed (i/num-needed-params comp2))
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn) (let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn)
res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)] res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)]
(if (identical? NONE res2) (if (identical? NONE res2)
res1 res1
res2 res2)))
)))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(let [s1 (i/exec-rich-transform* nav1 params params-idx vals structure next-fn)] (let [s1 (i/exec-rich-transform* nav1 params params-idx vals structure next-fn)]
(i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn) (i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn))))))
)))))
([path1 path2 & paths] ([path1 path2 & paths]
(reduce multi-path (multi-path path1 path2) paths) (reduce multi-path (multi-path path1 path2) paths)))
))
(defpathedfn stay-then-continue (defpathedfn stay-then-continue
"Navigates to the current element and then navigates via the provided path. "Navigates to the current element and then navigates via the provided path.

7
src/clj/com/rpl/specter/defhelpers.clj
View file

@ -11,10 +11,9 @@
`(~invoke-name [this# ~@args] `(~invoke-name [this# ~@args]
(let [~a (~(if clj? 'com.rpl.specter.impl/fast-object-array 'object-array) ~i)] (let [~a (~(if clj? 'com.rpl.specter.impl/fast-object-array 'object-array) ~i)]
~@setters ~@setters
(com.rpl.specter.impl/bind-params* this# ~a 0) (com.rpl.specter.impl/bind-params* this# ~a 0))))]
)))]
`(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params] `(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params]
~fn-type ~fn-type
~@impls ~@impls
~var-arity-impl ~var-arity-impl)))
)))

7
src/clj/com/rpl/specter/defnavhelpers.cljc
View file

@ -3,12 +3,11 @@
(defn param-delta [i] (defn param-delta [i]
(fn [^objects params params-idx] (fn [^objects params params-idx]
(aget params (+ params-idx i)) (aget params (+ params-idx i))))
))
(defn bound-params [path start-delta] (defn bound-params [path start-delta]
(fn [^objects params params-idx] (fn [^objects params params-idx]
(if (i/params-needed-path? path) (if (i/params-needed-path? path)
(i/bind-params* path params (+ params-idx start-delta)) (i/bind-params* path params (+ params-idx start-delta))
path path)))
)))

407
src/clj/com/rpl/specter/impl.cljc
View file

@ -1,19 +1,19 @@
(ns com.rpl.specter.impl (ns com.rpl.specter.impl
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter.defhelpers :refer [define-ParamsNeededPath]] [com.rpl.specter.defhelpers :refer [define-ParamsNeededPath]]
[com.rpl.specter.util-macros :refer [doseqres]] [com.rpl.specter.util-macros :refer [doseqres]]))
))
(:use [com.rpl.specter.protocols :only (:use [com.rpl.specter.protocols :only
[select* transform* collect-val Navigator]] [select* transform* collect-val Navigator]]
#?(:clj [com.rpl.specter.util-macros :only [doseqres]]) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
)
(:require [com.rpl.specter.protocols :as p] (:require [com.rpl.specter.protocols :as p]
[clojure.string :as s] [clojure.string :as s]
#?(:clj [com.rpl.specter.defhelpers :as dh]) #?(:clj [com.rpl.specter.defhelpers :as dh])
#?(:clj [riddley.walk :as riddley]) #?(:clj [riddley.walk :as riddley]))
)
#?(:clj (:import [com.rpl.specter Util MutableCell])) #?(:clj (:import [com.rpl.specter Util MutableCell])))
)
(def NONE ::NONE) (def NONE ::NONE)
@ -45,8 +45,8 @@
([a1 a2 a3 a4 a5 a6 a7 a8] v) ([a1 a2 a3 a4 a5 a6 a7 a8] v)
([a1 a2 a3 a4 a5 a6 a7 a8 a9] v) ([a1 a2 a3 a4 a5 a6 a7 a8 a9] v)
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] v) ([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] v)
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 & r] v) ([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 & r] v)))
))
#?(:clj #?(:clj
(defmacro throw* [etype & args] (defmacro throw* [etype & args]
@ -60,8 +60,8 @@
:cljs :cljs
(defn throw-illegal [& args] (defn throw-illegal [& args]
(throw (js/Error. (apply str args)))) (throw (js/Error. (apply str args)))))
)
;; need to get the expansion function like this so that ;; need to get the expansion function like this so that
;; this code compiles in a clojure environment where cljs.analyzer ;; this code compiles in a clojure environment where cljs.analyzer
@ -74,8 +74,8 @@
;; this version is for bootstrap cljs ;; this version is for bootstrap cljs
:cljs :cljs
(defn cljs-analyzer-macroexpand-1 [] (defn cljs-analyzer-macroexpand-1 []
^:cljs.analyzer/no-resolve cljs.analyzer/macroexpand-1) ^:cljs.analyzer/no-resolve cljs.analyzer/macroexpand-1))
)
#?( #?(
:clj :clj
@ -84,8 +84,8 @@
:cljs :cljs
(defn clj-macroexpand-all [form] (defn clj-macroexpand-all [form]
(throw-illegal "not implemented")) (throw-illegal "not implemented")))
)
#?( #?(
:clj :clj
@ -93,8 +93,8 @@
:cljs :cljs
(defn intern* [ns name val] (defn intern* [ns name val]
(throw-illegal "intern not supported in ClojureScript")) (throw-illegal "intern not supported in ClojureScript")))
)
(defn benchmark [iters afn] (defn benchmark [iters afn]
(time (time
@ -107,56 +107,56 @@
(defprotocol RichNavigator (defprotocol RichNavigator
(rich-select* [this params params-idx vals structure next-fn]) (rich-select* [this params params-idx vals structure next-fn])
(rich-transform* [this params params-idx vals structure next-fn]) (rich-transform* [this params params-idx vals structure next-fn]))
)
#?( #?(
:clj :clj
(defmacro exec-rich-select* [this & args] (defmacro exec-rich-select* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})]
`(.rich-select* ~hinted ~@args) `(.rich-select* ~hinted ~@args)))
))
:cljs :cljs
(defn exec-rich-select* [this params params-idx vals structure next-fn] (defn exec-rich-select* [this params params-idx vals structure next-fn]
(rich-select* ^not-native this params params-idx vals structure next-fn)) (rich-select* ^not-native this params params-idx vals structure next-fn)))
)
#?( #?(
:clj :clj
(defmacro exec-rich-transform* [this & args] (defmacro exec-rich-transform* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})]
`(.rich-transform* ~hinted ~@args) `(.rich-transform* ~hinted ~@args)))
))
:cljs :cljs
(defn exec-rich-transform* [this params params-idx vals structure next-fn] (defn exec-rich-transform* [this params params-idx vals structure next-fn]
(rich-transform* ^not-native this params params-idx vals structure next-fn)) (rich-transform* ^not-native this params params-idx vals structure next-fn)))
)
#?( #?(
:clj :clj
(defmacro exec-select* [this & args] (defmacro exec-select* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})]
`(.select* ~hinted ~@args) `(.select* ~hinted ~@args)))
))
:cljs :cljs
(defn exec-select* [this structure next-fn] (defn exec-select* [this structure next-fn]
(p/select* ^not-native this structure next-fn)) (p/select* ^not-native this structure next-fn)))
)
#?( #?(
:clj :clj
(defmacro exec-transform* [this & args] (defmacro exec-transform* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})]
`(.transform* ~hinted ~@args) `(.transform* ~hinted ~@args)))
))
:cljs :cljs
(defn exec-transform* [this structure next-fn] (defn exec-transform* [this structure next-fn]
(p/transform* ^not-native this structure next-fn)) (p/transform* ^not-native this structure next-fn)))
)
(def RichPathExecutor (def RichPathExecutor
(->ExecutorFunctions (->ExecutorFunctions
@ -176,16 +176,16 @@
(fn [_ _ vals structure] (fn [_ _ vals structure]
(if (identical? [] vals) (if (identical? [] vals)
(transform-fn structure) (transform-fn structure)
(apply transform-fn (conj vals structure)))))) (apply transform-fn (conj vals structure))))))))
))
(def LeanPathExecutor (def LeanPathExecutor
(->ExecutorFunctions (->ExecutorFunctions
(fn [nav result-fn structure] (fn [nav result-fn structure]
(exec-select* nav structure result-fn)) (exec-select* nav structure result-fn))
(fn [nav transform-fn structure] (fn [nav transform-fn structure]
(exec-transform* nav structure transform-fn)) (exec-transform* nav structure transform-fn))))
))
(defrecord CompiledPath [executors nav]) (defrecord CompiledPath [executors nav])
@ -198,8 +198,8 @@
(->ParameterizedRichNav (->ParameterizedRichNav
rich-nav rich-nav
nil nil
0 0)))
)))
(defn lean-compiled-path [nav] (defn lean-compiled-path [nav]
(->CompiledPath LeanPathExecutor nav)) (->CompiledPath LeanPathExecutor nav))
@ -214,8 +214,8 @@
:cljs :cljs
(defn fast-object-array [i] (defn fast-object-array [i]
(object-array i)) (object-array i)))
)
#?( #?(
:clj :clj
@ -240,9 +240,9 @@
[p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 [p01 p02 p03 p04 p05 p06 p07 p08 p09 p10
p11 p12 p13 p14 p15 p16 p17 p18 p19 p20] p11 p12 p13 p14 p15 p16 p17 p18 p19 p20]
rest))] rest))]
(com.rpl.specter.impl/bind-params* this a 0)) (com.rpl.specter.impl/bind-params* this a 0)))))
))
)
(defn params-needed-path? [o] (defn params-needed-path? [o]
(instance? ParamsNeededPath o)) (instance? ParamsNeededPath o))
@ -253,8 +253,8 @@
(let [n (.-nav ^CompiledPath p)] (let [n (.-nav ^CompiledPath p)]
(if (instance? ParameterizedRichNav n) (if (instance? ParameterizedRichNav n)
(.-rich-nav ^ParameterizedRichNav n) (.-rich-nav ^ParameterizedRichNav n)
n n))))
))))
(defn bind-params* [^ParamsNeededPath params-needed-path params idx] (defn bind-params* [^ParamsNeededPath params-needed-path params idx]
@ -263,15 +263,15 @@
(->ParameterizedRichNav (->ParameterizedRichNav
(.-rich-nav params-needed-path) (.-rich-nav params-needed-path)
params params
idx idx)))
)))
(defprotocol PathComposer (defprotocol PathComposer
(do-comp-paths [paths])) (do-comp-paths [paths]))
(defn comp-paths* [p] (defn comp-paths* [p]
(if (compiled-path? p) p (do-comp-paths p)) (if (compiled-path? p) p (do-comp-paths p)))
)
(defn- seq-contains? [aseq val] (defn- seq-contains? [aseq val]
(->> aseq (->> aseq
@ -285,8 +285,8 @@
(defn- coerce-object [this] (defn- coerce-object [this]
(cond (root-params-nav? this) (-> this meta :highernav :params-needed-path) (cond (root-params-nav? this) (-> this meta :highernav :params-needed-path)
(satisfies? p/ImplicitNav this) (p/implicit-nav this) (satisfies? p/ImplicitNav this) (p/implicit-nav this)
:else (throw-illegal "Not a navigator: " this) :else (throw-illegal "Not a navigator: " this)))
))
(defprotocol CoercePath (defprotocol CoercePath
(coerce-path [this])) (coerce-path [this]))
@ -335,14 +335,14 @@
(exec-rich-select* curr params params-idx vals structure (exec-rich-select* curr params params-idx vals structure
(fn [params-next params-idx-next vals-next structure-next] (fn [params-next params-idx-next vals-next structure-next]
(exec-rich-select* next params-next params-idx-next (exec-rich-select* next params-next params-idx-next
vals-next structure-next next-fn) vals-next structure-next next-fn))))
)))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(exec-rich-transform* curr params params-idx vals structure (exec-rich-transform* curr params params-idx vals structure
(fn [params-next params-idx-next vals-next structure-next] (fn [params-next params-idx-next vals-next structure-next]
(exec-rich-transform* next params-next params-idx-next (exec-rich-transform* next params-next params-idx-next
vals-next structure-next next-fn) vals-next structure-next next-fn))))))
)))))
(fn [curr next] (fn [curr next]
(reify Navigator (reify Navigator
(select* [this structure next-fn] (select* [this structure next-fn]
@ -360,11 +360,11 @@
nav nav
(reify RichNavigator (reify RichNavigator
(rich-select* [this params params-idx vals structure next-fn] (rich-select* [this params params-idx vals structure next-fn]
(exec-select* nav structure (fn [structure] (next-fn params params-idx vals structure))) (exec-select* nav structure (fn [structure] (next-fn params params-idx vals structure))))
)
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(exec-transform* nav structure (fn [structure] (next-fn params params-idx vals structure))) (exec-transform* nav structure (fn [structure] (next-fn params params-idx vals structure)))))))
))))
(defn extract-rich-nav [p] (defn extract-rich-nav [p]
(coerce-rich-navigator (extract-nav p))) (coerce-rich-navigator (extract-nav p)))
@ -389,13 +389,13 @@
(rich-select* [this params2 params-idx2 vals structure next-fn] (rich-select* [this params2 params-idx2 vals structure next-fn]
(exec-rich-select* rich-nav params params-idx vals structure (exec-rich-select* rich-nav params params-idx vals structure
(fn [_ _ vals-next structure-next] (fn [_ _ vals-next structure-next]
(next-fn params2 params-idx2 vals-next structure-next) (next-fn params2 params-idx2 vals-next structure-next))))
)))
(rich-transform* [this params2 params-idx2 vals structure next-fn] (rich-transform* [this params2 params-idx2 vals structure next-fn]
(exec-rich-transform* rich-nav params params-idx vals structure (exec-rich-transform* rich-nav params params-idx vals structure
(fn [_ _ vals-next structure-next] (fn [_ _ vals-next structure-next]
(next-fn params2 params-idx2 vals-next structure-next) (next-fn params2 params-idx2 vals-next structure-next))))))))))
)))))))))
(defn comp-paths-internalized [path] (defn comp-paths-internalized [path]
(capture-params-internally (comp-paths* path))) (capture-params-internally (comp-paths* path)))
@ -417,14 +417,14 @@
combined (->> coerced combined (->> coerced
(map extract-nav) (map extract-nav)
(partition-by type) (partition-by type)
(map combine-same-types) (map combine-same-types))
)
result-nav (if (= 1 (count combined)) result-nav (if (= 1 (count combined))
(first combined) (first combined)
(->> combined (->> combined
(map coerce-rich-navigator) (map coerce-rich-navigator)
combine-same-types) combine-same-types))
)
needs-params-paths (filter #(instance? ParamsNeededPath %) coerced)] needs-params-paths (filter #(instance? ParamsNeededPath %) coerced)]
(if (empty? needs-params-paths) (if (empty? needs-params-paths)
(if (satisfies? Navigator result-nav) (if (satisfies? Navigator result-nav)
@ -434,9 +434,9 @@
(coerce-rich-navigator result-nav) (coerce-rich-navigator result-nav)
(->> needs-params-paths (->> needs-params-paths
(map :num-needed-params) (map :num-needed-params)
(reduce +)) (reduce +))))))))
))
))))
(defn num-needed-params [path] (defn num-needed-params [path]
@ -448,14 +448,14 @@
;; cell implementation idea taken from prismatic schema library ;; cell implementation idea taken from prismatic schema library
#?(:cljs #?(:cljs
(defprotocol PMutableCell (defprotocol PMutableCell
(set_cell [cell x])) (set_cell [cell x])))
)
#?(:cljs #?(:cljs
(deftype MutableCell [^:volatile-mutable q] (deftype MutableCell [^:volatile-mutable q]
PMutableCell PMutableCell
(set_cell [this x] (set! q x))) (set_cell [this x] (set! q x))))
)
#?( #?(
:clj :clj
@ -466,8 +466,8 @@
:cljs :cljs
(defn mutable-cell (defn mutable-cell
([] (mutable-cell nil)) ([] (mutable-cell nil))
([init] (MutableCell. init))) ([init] (MutableCell. init))))
)
#?( #?(
:clj :clj
@ -476,8 +476,8 @@
:cljs :cljs
(defn set-cell! [cell val] (defn set-cell! [cell val]
(set_cell cell val)) (set_cell cell val)))
)
#?( #?(
:clj :clj
@ -487,8 +487,8 @@
:cljs :cljs
(defn get-cell [cell] (defn get-cell [cell]
(.-q cell)) (.-q cell)))
)
@ -520,8 +520,8 @@
((traverse-executor-field ex#) ((traverse-executor-field ex#)
nav# nav#
~result-fn ~result-fn
~structure) ~structure)))
))
:cljs :cljs
(defn compiled-traverse* [path result-fn structure] (defn compiled-traverse* [path result-fn structure]
@ -530,9 +530,9 @@
((traverse-executor-field ex) ((traverse-executor-field ex)
nav nav
result-fn result-fn
structure) structure))))
))
)
(defn do-compiled-traverse [apath structure] (defn do-compiled-traverse [apath structure]
(reify #?(:clj clojure.lang.IReduce :cljs cljs.core/IReduce) (reify #?(:clj clojure.lang.IReduce :cljs cljs.core/IReduce)
@ -546,22 +546,22 @@
apath apath
(fn [elem] (fn [elem]
(let [curr (get-cell cell)] (let [curr (get-cell cell)]
(set-cell! cell (afn curr elem)) (set-cell! cell (afn curr elem))))
))
structure structure)
)
(get-cell cell) (get-cell cell)))))
))))
(defn compiled-select* [path structure] (defn compiled-select* [path structure]
(let [res (mutable-cell (transient [])) (let [res (mutable-cell (transient []))
result-fn (fn [structure] result-fn (fn [structure]
(let [curr (get-cell res)] (let [curr (get-cell res)]
(set-cell! res (conj! curr structure)) (set-cell! res (conj! curr structure))))]
))]
(compiled-traverse* path result-fn structure) (compiled-traverse* path result-fn structure)
(persistent! (get-cell res)) (persistent! (get-cell res))))
))
(defn compiled-select-one* [path structure] (defn compiled-select-one* [path structure]
(let [res (mutable-cell NONE) (let [res (mutable-cell NONE)
@ -569,14 +569,14 @@
(let [curr (get-cell res)] (let [curr (get-cell res)]
(if (identical? curr NONE) (if (identical? curr NONE)
(set-cell! res structure) (set-cell! res structure)
(throw-illegal "More than one element found in structure: " structure) (throw-illegal "More than one element found in structure: " structure))))]
)))]
(compiled-traverse* path result-fn structure) (compiled-traverse* path result-fn structure)
(let [ret (get-cell res)] (let [ret (get-cell res)]
(if (identical? ret NONE) (if (identical? ret NONE)
nil nil
ret ret))))
))))
(defn compiled-select-one!* [path structure] (defn compiled-select-one!* [path structure]
(let [res (mutable-cell NONE) (let [res (mutable-cell NONE)
@ -584,14 +584,14 @@
(let [curr (get-cell res)] (let [curr (get-cell res)]
(if (identical? curr NONE) (if (identical? curr NONE)
(set-cell! res structure) (set-cell! res structure)
(throw-illegal "More than one element found in structure: " structure) (throw-illegal "More than one element found in structure: " structure))))]
)))]
(compiled-traverse* path result-fn structure) (compiled-traverse* path result-fn structure)
(let [ret (get-cell res)] (let [ret (get-cell res)]
(if (identical? NONE ret) (if (identical? NONE ret)
(throw-illegal "Found no elements for select-one! on " structure)) (throw-illegal "Found no elements for select-one! on " structure))
ret ret)))
)))
(defn compiled-select-first* [path structure] (defn compiled-select-first* [path structure]
(let [res (mutable-cell NONE) (let [res (mutable-cell NONE)
@ -603,8 +603,8 @@
(let [ret (get-cell res)] (let [ret (get-cell res)]
(if (identical? ret NONE) (if (identical? ret NONE)
nil nil
ret ret))))
))))
(defn compiled-select-any* [path structure] (defn compiled-select-any* [path structure]
(compiled-traverse* path identity structure)) (compiled-traverse* path identity structure))
@ -616,8 +616,8 @@
[^com.rpl.specter.impl.CompiledPath path transform-fn structure] [^com.rpl.specter.impl.CompiledPath path transform-fn structure]
(let [nav (.-nav path) (let [nav (.-nav path)
^com.rpl.specter.impl.ExecutorFunctions ex (.-executors path)] ^com.rpl.specter.impl.ExecutorFunctions ex (.-executors path)]
((.-transform-executor ex) nav transform-fn structure) ((.-transform-executor ex) nav transform-fn structure)))
))
(defn params-needed-nav (defn params-needed-nav
@ -629,8 +629,8 @@
^com.rpl.specter.impl.RichNavigator ^com.rpl.specter.impl.RichNavigator
[^com.rpl.specter.impl.CompiledPath path] [^com.rpl.specter.impl.CompiledPath path]
(let [^com.rpl.specter.impl.ParameterizedRichNav pr (.-nav path)] (let [^com.rpl.specter.impl.ParameterizedRichNav pr (.-nav path)]
(.-rich-nav pr) (.-rich-nav pr)))
))
(defn coerce-compiled->rich-nav [path] (defn coerce-compiled->rich-nav [path]
(if (instance? ParamsNeededPath path) (if (instance? ParamsNeededPath path)
@ -638,8 +638,8 @@
(let [nav (.-nav ^CompiledPath path)] (let [nav (.-nav ^CompiledPath path)]
(if (satisfies? Navigator nav) (if (satisfies? Navigator nav)
(no-params-rich-compiled-path (coerce-rich-navigator nav)) (no-params-rich-compiled-path (coerce-rich-navigator nav))
path path))))
))))
(defn fn-invocation? [f] (defn fn-invocation? [f]
(or #?(:clj (instance? clojure.lang.Cons f)) (or #?(:clj (instance? clojure.lang.Cons f))
@ -660,8 +660,8 @@
(and (instance? ParamsNeededPath anav) (and (instance? ParamsNeededPath anav)
(> (:num-needed-params anav) 0))) (> (:num-needed-params anav) 0)))
(throw-illegal "defnavconstructor must be used on a navigator defined with (throw-illegal "defnavconstructor must be used on a navigator defined with
defnav with at least one parameter") defnav with at least one parameter")))
))
(defn layered-wrapper [anav] (defn layered-wrapper [anav]
(verify-layerable! anav) (verify-layerable! anav)
@ -676,8 +676,8 @@
([a1 a2 a3 a4 a5 a6 a7 a8 a9] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9))) ([a1 a2 a3 a4 a5 a6 a7 a8 a9] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9)))
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))) ([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)))
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 & args] ([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 & args]
(->LayeredNav (apply anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 args))) (->LayeredNav (apply anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 args)))))
))
(defrecord LocalSym (defrecord LocalSym
[val sym]) [val sym])
@ -694,8 +694,8 @@
(defrecord CachedPathInfo (defrecord CachedPathInfo
[precompiled ; can be null [precompiled ; can be null
params-maker ; can be null params-maker]) ; can be null
])
(def MUST-CACHE-PATHS (mutable-cell false)) (def MUST-CACHE-PATHS (mutable-cell false))
@ -712,8 +712,8 @@
(set? node) (every? constant-node? node) (set? node) (every? constant-node? node)
(map? node) (and (every? constant-node? (vals node)) (map? node) (and (every? constant-node? (vals node))
(every? constant-node? (keys node))) (every? constant-node? (keys node)))
:else false :else false))
))
(defn- extract-original-code [p] (defn- extract-original-code [p]
(cond (cond
@ -721,8 +721,8 @@
(instance? VarUse p) (:sym p) (instance? VarUse p) (:sym p)
(instance? SpecialFormUse p) (:code p) (instance? SpecialFormUse p) (:code p)
(instance? FnInvocation p) (:code p) (instance? FnInvocation p) (:code p)
:else p :else p))
))
(defn- valid-navigator? [v] (defn- valid-navigator? [v]
(or (satisfies? p/ImplicitNav v) (or (satisfies? p/ImplicitNav v)
@ -733,8 +733,8 @@
(let [params (fast-object-array (count params-maker))] (let [params (fast-object-array (count params-maker))]
(dotimes [i (count params-maker)] (dotimes [i (count params-maker)]
(aset params i ((get possible-params (get params-maker i))))) (aset params i ((get possible-params (get params-maker i)))))
(bind-params* precompiled params 0) (bind-params* precompiled params 0))))
)))
(defn filter-select [afn structure next-fn] (defn filter-select [afn structure next-fn]
(if (afn structure) (if (afn structure)
@ -753,16 +753,16 @@
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (afn structure) (if (afn structure)
(next-fn params (inc params-idx) vals structure) (next-fn params (inc params-idx) vals structure)
NONE NONE)))
)))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (afn structure) (if (afn structure)
(next-fn params (inc params-idx) vals structure) (next-fn params (inc params-idx) vals structure)
structure structure))))
))))
1 1))
))
(def collected?* (def collected?*
(->ParamsNeededPath (->ParamsNeededPath
@ -771,16 +771,16 @@
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (afn vals) (if (afn vals)
(next-fn params (inc params-idx) vals structure) (next-fn params (inc params-idx) vals structure)
NONE NONE)))
)))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (afn vals) (if (afn vals)
(next-fn params (inc params-idx) vals structure) (next-fn params (inc params-idx) vals structure)
structure structure))))
))))
1 1))
))
(def rich-compiled-path-proxy (def rich-compiled-path-proxy
(->ParamsNeededPath (->ParamsNeededPath
@ -796,8 +796,8 @@
vals vals
structure structure
(fn [_ _ vals-next structure-next] (fn [_ _ vals-next structure-next]
(next-fn params params-idx vals-next structure-next)) (next-fn params params-idx vals-next structure-next)))))
)))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(let [apath ^CompiledPath (aget ^objects params params-idx) (let [apath ^CompiledPath (aget ^objects params params-idx)
pnav ^ParameterizedRichNav (.-nav apath) pnav ^ParameterizedRichNav (.-nav apath)
@ -809,10 +809,10 @@
vals vals
structure structure
(fn [_ _ vals-next structure-next] (fn [_ _ vals-next structure-next]
(next-fn params params-idx vals-next structure-next)) (next-fn params params-idx vals-next structure-next))))))
))))
1 1))
))
(def lean-compiled-path-proxy (def lean-compiled-path-proxy
(->ParamsNeededPath (->ParamsNeededPath
@ -824,8 +824,8 @@
nav nav
structure structure
(fn [structure-next] (fn [structure-next]
(next-fn params params-idx vals structure-next)) (next-fn params params-idx vals structure-next)))))
)))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(let [^CompiledPath apath (aget ^objects params params-idx) (let [^CompiledPath apath (aget ^objects params params-idx)
^Navigator nav (.-nav apath)] ^Navigator nav (.-nav apath)]
@ -833,10 +833,10 @@
nav nav
structure structure
(fn [structure-next] (fn [structure-next]
(next-fn params params-idx vals structure-next)) (next-fn params params-idx vals structure-next))))))
))))
1 1))
))
(defn srange-transform* [structure start end next-fn] (defn srange-transform* [structure start end next-fn]
(let [structurev (vec structure) (let [structurev (vec structure)
@ -846,8 +846,8 @@
(subvec structurev end (count structure)))] (subvec structurev end (count structure)))]
(if (vector? structure) (if (vector? structure)
(vec res) (vec res)
res res)))
)))
(defn- variadic-arglist? [al] (defn- variadic-arglist? [al]
(contains? (set al) '&)) (contains? (set al) '&))
@ -857,8 +857,8 @@
(filter (filter
(fn [al] (fn [al]
(or (= (count al) c) (or (= (count al) c)
(variadic-arglist? al)) (variadic-arglist? al))))
))
first) first)
len (count ret)] len (count ret)]
(when-not ret (when-not ret
@ -866,8 +866,8 @@
(if (variadic-arglist? ret) (if (variadic-arglist? ret)
(srange-transform* ret (- len 2) len (srange-transform* ret (- len 2) len
(fn [_] (repeatedly (- c (- len 2)) gensym))) (fn [_] (repeatedly (- c (- len 2)) gensym)))
ret ret)))
)))
(defn- magic-precompilation* [p params-atom failed-atom] (defn- magic-precompilation* [p params-atom failed-atom]
(let [magic-fail! (fn [& reason] (let [magic-fail! (fn [& reason]
@ -897,17 +897,17 @@
vv vv
:else :else
(magic-fail! "Var " (:sym p) " is not a navigator") (magic-fail! "Var " (:sym p) " is not a navigator")))
))
(instance? SpecialFormUse p) (instance? SpecialFormUse p)
(if (->> p :code first (contains? #{'fn* 'fn})) (if (->> p :code first (contains? #{'fn* 'fn}))
(do (do
(swap! params-atom conj (:code p)) (swap! params-atom conj (:code p))
pred* pred*)
)
(magic-fail! "Special form " (:code p) " where navigator expected") (magic-fail! "Special form " (:code p) " where navigator expected"))
)
(instance? FnInvocation p) (instance? FnInvocation p)
(let [op (:op p) (let [op (:op p)
@ -923,8 +923,8 @@
(apply vv ps) (apply vv ps)
(do (do
(swap! params-atom #(vec (concat % ps))) (swap! params-atom #(vec (concat % ps)))
(coerce-path vv) (coerce-path vv)))
))
(and (fn? vv) (-> v meta :pathedfn)) (and (fn? vv) (-> v meta :pathedfn))
;;TODO: update this to ignore args that aren't symbols or have :nopath ;;TODO: update this to ignore args that aren't symbols or have :nopath
@ -953,14 +953,14 @@
(magic-fail! "Could not factor static param " (magic-fail! "Could not factor static param "
"of pathedfn because it's not a static var " "of pathedfn because it's not a static var "
" or non-collection value: " " or non-collection value: "
(extract-original-code p)) (extract-original-code p)))))
)))
al al
ps))] ps))]
(if @failed-atom (if @failed-atom
nil nil
(apply vv subpath) (apply vv subpath)))
))
(and (fn? vv) (-> vv meta :layerednav)) (and (fn? vv) (-> vv meta :layerednav))
(if (every? constant-node? ps) (if (every? constant-node? ps)
@ -969,20 +969,20 @@
(swap! params-atom conj (:code p)) (swap! params-atom conj (:code p))
(if (= (-> vv meta :layerednav) :lean) (if (= (-> vv meta :layerednav) :lean)
lean-compiled-path-proxy lean-compiled-path-proxy
rich-compiled-path-proxy rich-compiled-path-proxy)))
)))
:else :else
(magic-fail! "Var " (:sym op) " must be either a parameterized " (magic-fail! "Var " (:sym op) " must be either a parameterized "
"navigator, a higher order pathed constructor function, " "navigator, a higher order pathed constructor function, "
"or a nav constructor") "or a nav constructor"))))
)))
(magic-fail! "Code at " (extract-original-code p) " is in " (magic-fail! "Code at " (extract-original-code p) " is in "
"function invocation position and must be either a parameterized " "function invocation position and must be either a parameterized "
"navigator, a higher order pathed constructor function, or a " "navigator, a higher order pathed constructor function, or a "
"nav constructor." "nav constructor.")))
)
))
:else :else
(cond (set? p) (cond (set? p)
@ -999,9 +999,9 @@
p p
:else :else
(magic-fail! "Code " p " is not a valid navigator or can't be factored") (magic-fail! "Code " p " is not a valid navigator or can't be factored")))))
)
)))
;; This is needed when aset is used on primitive values in mk-params-maker ;; This is needed when aset is used on primitive values in mk-params-maker
@ -1022,10 +1022,10 @@
~@(map-indexed ~@(map-indexed
(fn [i c] (fn [i c]
`(aset-object ~array-sym ~i ~c)) `(aset-object ~array-sym ~i ~c))
params-code params-code)
)
~array-sym ~array-sym))))))
))))))
:cljs :cljs
(defn mk-params-maker [ns-str params-code possible-params-code used-locals] (defn mk-params-maker [ns-str params-code possible-params-code used-locals]
@ -1033,15 +1033,15 @@
(map-indexed (comp vec reverse vector)) (map-indexed (comp vec reverse vector))
(into {}))] (into {}))]
;;TODO: may be more efficient as an array ;;TODO: may be more efficient as an array
(mapv (fn [c] (get indexed c)) params-code))) (mapv (fn [c] (get indexed c)) params-code))))
)
;; possible-params-code is for cljs impl that can't use eval ;; possible-params-code is for cljs impl that can't use eval
(defn magic-precompilation [prepared-path ns-str used-locals possible-params-code] (defn magic-precompilation [prepared-path ns-str used-locals possible-params-code]
(let [params-atom (atom []) (let [params-atom (atom [])
failed-atom (atom false) failed-atom (atom false)
path (magic-precompilation* prepared-path params-atom failed-atom) path (magic-precompilation* prepared-path params-atom failed-atom)]
]
(if @failed-atom (if @failed-atom
(if (get-cell MUST-CACHE-PATHS) (if (get-cell MUST-CACHE-PATHS)
(throw-illegal "Failed to cache path") (throw-illegal "Failed to cache path")
@ -1049,13 +1049,13 @@
(let [precompiled (comp-paths* path) (let [precompiled (comp-paths* path)
params-code (mapv extract-original-code @params-atom) params-code (mapv extract-original-code @params-atom)
params-maker (if-not (empty? params-code) params-maker (if-not (empty? params-code)
(mk-params-maker ns-str params-code possible-params-code used-locals)) (mk-params-maker ns-str params-code possible-params-code used-locals))]
]
;; TODO: error if precompiled is compiledpath and there are params or ;; TODO: error if precompiled is compiledpath and there are params or
;; precompiled is paramsneededpath and there are no params... ;; precompiled is paramsneededpath and there are no params...
(->CachedPathInfo precompiled params-maker) (->CachedPathInfo precompiled params-maker)))))
))
))
@ -1074,11 +1074,11 @@
(merge-fn (get-cell state)) (merge-fn (get-cell state))
(set-cell! state)) (set-cell! state))
ret) ret)
(last args) (last args))))
)))
structure) structure)
(get-cell state)] (get-cell state)]))
))
(defn- multi-transform-error-fn [& nav] (defn- multi-transform-error-fn [& nav]
(throw-illegal (throw-illegal
@ -1096,22 +1096,21 @@
(doseq [[atype apath] extensions] (doseq [[atype apath] extensions]
(let [p (comp-paths-internalized apath) (let [p (comp-paths-internalized apath)
needed-params (num-needed-params p) needed-params (num-needed-params p)
rich-nav (extract-rich-nav p) rich-nav (extract-rich-nav p)]
]
(if-not (= needed-params expected-params) (if-not (= needed-params expected-params)
(throw-illegal "Invalid number of params in extended protocol path, expected " (throw-illegal "Invalid number of params in extended protocol path, expected "
expected-params " but got " needed-params)) expected-params " but got " needed-params))
(extend atype protpath-prot {m (fn [_] rich-nav)}) (extend atype protpath-prot {m (fn [_] rich-nav)}))))))
)))))
(defn parameterize-path [apath params params-idx] (defn parameterize-path [apath params params-idx]
(if (instance? CompiledPath apath) (if (instance? CompiledPath apath)
apath apath
(bind-params* apath params params-idx) (bind-params* apath params params-idx)))
))
(defn mk-jump-next-fn [next-fn init-idx total-params] (defn mk-jump-next-fn [next-fn init-idx total-params]
(let [jumped (+ init-idx total-params)] (let [jumped (+ init-idx total-params)]
(fn [params params-idx vals structure] (fn [params params-idx vals structure]
(next-fn params jumped vals structure) (next-fn params jumped vals structure))))
)))

220
src/clj/com/rpl/specter/macros.clj
View file

@ -3,8 +3,8 @@
[com.rpl.specter.impl :only [RichNavigator]]) [com.rpl.specter.impl :only [RichNavigator]])
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk] [clojure.walk :as cljwalk]
[com.rpl.specter.defnavhelpers :as dnh]) [com.rpl.specter.defnavhelpers :as dnh]))
)
(defn ^:no-doc gensyms [amt] (defn ^:no-doc gensyms [amt]
(vec (repeatedly amt gensym))) (vec (repeatedly amt gensym)))
@ -14,8 +14,8 @@
(if-not (= #{'select* 'transform*} (-> grouped keys set)) (if-not (= #{'select* 'transform*} (-> grouped keys set))
(i/throw-illegal "defnav must implement select* and transform*, instead got " (i/throw-illegal "defnav must implement select* and transform*, instead got "
(keys grouped))) (keys grouped)))
grouped grouped))
))
(defmacro richnav (defmacro richnav
"Defines a navigator with full access to collected vals, the parameters array, "Defines a navigator with full access to collected vals, the parameters array,
@ -30,8 +30,8 @@
s-next-fn-sym (last s-params) s-next-fn-sym (last s-params)
s-pidx-sym (nth s-params 2) s-pidx-sym (nth s-params 2)
t-next-fn-sym (last t-params) t-next-fn-sym (last t-params)
t-pidx-sym (nth t-params 2) t-pidx-sym (nth t-params 2)]
]
`(let [num-params# ~num-params `(let [num-params# ~num-params
nav# (reify RichNavigator nav# (reify RichNavigator
(~'rich-select* ~s-params (~'rich-select* ~s-params
@ -39,12 +39,12 @@
~@s-body)) ~@s-body))
(~'rich-transform* ~t-params (~'rich-transform* ~t-params
(let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)]
~@t-body)) ~@t-body)))]
)]
(if (zero? num-params#) (if (zero? num-params#)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# num-params#) (i/->ParamsNeededPath nav# num-params#)))))
))))
(defmacro ^:no-doc lean-nav* [& impls] (defmacro ^:no-doc lean-nav* [& impls]
`(reify Navigator ~@impls)) `(reify Navigator ~@impls))
@ -60,16 +60,15 @@
binding-fn-syms)) binding-fn-syms))
body (op-maker binding-declarations)] body (op-maker binding-declarations)]
`(let [~@binding-fn-declarations] `(let [~@binding-fn-declarations]
~body ~body)))
)))
(defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls] (defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls]
(let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select* (let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select*
[[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*} [[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*}
(determine-params-impls impls) (determine-params-impls impls)
params-sym (gensym "params") params-sym (gensym "params")
params-idx-sym (gensym "params-idx") params-idx-sym (gensym "params-idx")]
]
(operation-with-bindings (operation-with-bindings
bindings bindings
params-sym params-sym
@ -84,8 +83,8 @@
next-params-idx# next-params-idx#
vals# vals#
structure#))] structure#))]
~@s-body ~@s-body))
))
(~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#] (~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#]
(let [~@binding-declarations (let [~@binding-declarations
next-params-idx# (+ ~params-idx-sym ~num-params-code) next-params-idx# (+ ~params-idx-sym ~num-params-code)
@ -94,9 +93,9 @@
next-params-idx# next-params-idx#
vals# vals#
structure#))] structure#))]
~@t-body ~@t-body)))))))
))
)))))
(defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl] (defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl]
(let [[_ [_ structure-sym] & body] impl (let [[_ [_ structure-sym] & body] impl
@ -110,21 +109,21 @@
`(let [num-params# ~num-params-code `(let [num-params# ~num-params-code
cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#] cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#]
(let [~@binding-declarations] (let [~@binding-declarations]
(next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym) (next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym)))]
))]
(reify RichNavigator (reify RichNavigator
(~'rich-select* [this# params# params-idx# vals# structure# next-fn#] (~'rich-select* [this# params# params-idx# vals# structure# next-fn#]
(cfn# params# params-idx# vals# structure# next-fn#)) (cfn# params# params-idx# vals# structure# next-fn#))
(~'rich-transform* [this# params# params-idx# vals# structure# next-fn#] (~'rich-transform* [this# params# params-idx# vals# structure# next-fn#]
(cfn# params# params-idx# vals# structure# next-fn#)) (cfn# params# params-idx# vals# structure# next-fn#))))))))
))))))
(defn- delta-param-bindings [params] (defn- delta-param-bindings [params]
(->> params (->> params
(map-indexed (fn [i p] [p `(dnh/param-delta ~i)])) (map-indexed (fn [i p] [p `(dnh/param-delta ~i)]))
(apply concat) (apply concat)
vec vec))
))
(defmacro nav (defmacro nav
"Defines a navigator with late bound parameters. This navigator can be precompiled "Defines a navigator with late bound parameters. This navigator can be precompiled
@ -143,10 +142,10 @@
(i/->ParamsNeededPath (i/->ParamsNeededPath
(rich-nav-with-bindings ~(count params) (rich-nav-with-bindings ~(count params)
~(delta-param-bindings params) ~(delta-param-bindings params)
~@impls ~@impls)
)
~(count params))} ~(count params))})))
)))
(defmacro collector (defmacro collector
"Defines a Collector with late bound parameters. This collector can be precompiled "Defines a Collector with late bound parameters. This collector can be precompiled
@ -157,8 +156,8 @@
[params body] [params body]
`(let [rich-nav# (collector-with-bindings ~(count params) `(let [rich-nav# (collector-with-bindings ~(count params)
~(delta-param-bindings params) ~(delta-param-bindings params)
~body ~body)]
)]
(if ~(empty? params) (if ~(empty? params)
(i/no-params-rich-compiled-path rich-nav#) (i/no-params-rich-compiled-path rich-nav#)
(vary-meta (vary-meta
@ -172,9 +171,9 @@
:params-needed-path :params-needed-path
(i/->ParamsNeededPath (i/->ParamsNeededPath
rich-nav# rich-nav#
~(count params) ~(count params))}))))
)}
))))
(defn ^:no-doc fixed-pathed-operation [bindings op-maker] (defn ^:no-doc fixed-pathed-operation [bindings op-maker]
(let [bindings (partition 2 bindings) (let [bindings (partition 2 bindings)
@ -184,8 +183,8 @@
compiled-syms (vec (gensyms (count bindings))) compiled-syms (vec (gensyms (count bindings)))
runtime-bindings (vec (mapcat runtime-bindings (vec (mapcat
(fn [l c d] (fn [l c d]
`[~l (dnh/bound-params ~c ~d)] `[~l (dnh/bound-params ~c ~d)])
)
late-path-syms late-path-syms
compiled-syms compiled-syms
delta-syms)) delta-syms))
@ -195,10 +194,10 @@
~compiled-syms compiled# ~compiled-syms compiled#
deltas# (cons 0 (reductions + (map i/num-needed-params compiled#))) deltas# (cons 0 (reductions + (map i/num-needed-params compiled#)))
~delta-syms deltas# ~delta-syms deltas#
~total-params-sym (last deltas#) ~total-params-sym (last deltas#)]
]
~body ~body)))
)))
(defmacro fixed-pathed-nav (defmacro fixed-pathed-nav
"This helper is used to define navigators that take in a fixed number of other "This helper is used to define navigators that take in a fixed number of other
@ -212,16 +211,16 @@
lean-bindings (mapcat vector late-syms compiled-syms)] lean-bindings (mapcat vector late-syms compiled-syms)]
`(if (zero? ~total-params-sym) `(if (zero? ~total-params-sym)
(let [~@lean-bindings] (let [~@lean-bindings]
(i/lean-compiled-path (lean-nav* ~@impls)) (i/lean-compiled-path (lean-nav* ~@impls)))
)
(i/->ParamsNeededPath (i/->ParamsNeededPath
(rich-nav-with-bindings ~total-params-sym (rich-nav-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@impls ~@impls)
)
~total-params-sym ~total-params-sym))))))
)))
)))
(defmacro fixed-pathed-collector (defmacro fixed-pathed-collector
@ -241,21 +240,21 @@
(i/->ParamsNeededPath (i/->ParamsNeededPath
(collector-with-bindings ~total-params-sym (collector-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@body ~@body)
)
~total-params-sym ~total-params-sym))))))
))))))
(defmacro paramsfn [params [structure-sym] & impl] (defmacro paramsfn [params [structure-sym] & impl]
`(nav ~params `(nav ~params
(~'select* [this# structure# next-fn#] (~'select* [this# structure# next-fn#]
(let [afn# (fn [~structure-sym] ~@impl)] (let [afn# (fn [~structure-sym] ~@impl)]
(i/filter-select afn# structure# next-fn#) (i/filter-select afn# structure# next-fn#)))
))
(~'transform* [this# structure# next-fn#] (~'transform* [this# structure# next-fn#]
(let [afn# (fn [~structure-sym] ~@impl)] (let [afn# (fn [~structure-sym] ~@impl)]
(i/filter-transform afn# structure# next-fn#) (i/filter-transform afn# structure# next-fn#)))))
))))
(defmacro defnav [name & body] (defmacro defnav [name & body]
`(def ~name (nav ~@body))) `(def ~name (nav ~@body)))
@ -293,24 +292,24 @@
num-params (count params) num-params (count params)
ssym (gensym "structure") ssym (gensym "structure")
rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")] rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")]
retrieve `(~m ~ssym) retrieve `(~m ~ssym)]
]
`(do `(do
(defprotocol ~prot-name (~m [structure#])) (defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)))
))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-transform* inav# ~@rargs) (i/exec-rich-transform* inav# ~@rargs))))]
)))]
(def ~name (def ~name
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params))))))))
)))))))
@ -342,12 +341,12 @@
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(~select-exec ~declared ~@rargs)) (~select-exec ~declared ~@rargs))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(~transform-exec ~declared ~@rargs) (~transform-exec ~declared ~@rargs)))]
))]
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params))))))))
)))))))
(defmacro providepath [name apath] (defmacro providepath [name apath]
`(let [comped# (i/comp-paths-internalized ~apath) `(let [comped# (i/comp-paths-internalized ~apath)
@ -357,8 +356,8 @@
(i/throw-illegal "Invalid number of params in provided path, expected " (i/throw-illegal "Invalid number of params in provided path, expected "
expected-params# " but got " needed-params#)) expected-params# " but got " needed-params#))
(def ~(declared-name name) (def ~(declared-name name)
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)) (i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)))))
)))
(defmacro extend-protocolpath (defmacro extend-protocolpath
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
@ -420,15 +419,15 @@
(i/throw-illegal "Expected result navigator '" (quote ~anav) (i/throw-illegal "Expected result navigator '" (quote ~anav)
"' from nav constructor '" (quote ~name) "'" "' from nav constructor '" (quote ~name) "'"
" constructed with the provided constructor '" (quote ~csym) " constructed with the provided constructor '" (quote ~csym)
"'")) "'"))))))]
))))]
`(def ~name `(def ~name
(vary-meta (vary-meta
(let [~csym (i/layered-wrapper ~anav)] (let [~csym (i/layered-wrapper ~anav)]
(fn ~@checked-code)) (fn ~@checked-code))
assoc :layerednav (or (-> ~anav meta :highernav :type) :rich) assoc :layerednav (or (-> ~anav meta :highernav :type) :rich)))))
))
))
(defn ^:no-doc ic-prepare-path [locals-set path] (defn ^:no-doc ic-prepare-path [locals-set path]
@ -440,8 +439,8 @@
(if (contains? locals-set path) (if (contains? locals-set path)
`(com.rpl.specter.impl/->LocalSym ~path (quote ~path)) `(com.rpl.specter.impl/->LocalSym ~path (quote ~path))
;; var-get doesn't work in cljs, so capture the val in the macro instead ;; var-get doesn't work in cljs, so capture the val in the macro instead
`(com.rpl.specter.impl/->VarUse ~path (var ~path) (quote ~path)) `(com.rpl.specter.impl/->VarUse ~path (var ~path) (quote ~path)))
)
(i/fn-invocation? path) (i/fn-invocation? path)
(let [[op & params] path] (let [[op & params] path]
@ -452,12 +451,12 @@
`(com.rpl.specter.impl/->FnInvocation `(com.rpl.specter.impl/->FnInvocation
~(ic-prepare-path locals-set op) ~(ic-prepare-path locals-set op)
~(mapv #(ic-prepare-path locals-set %) params) ~(mapv #(ic-prepare-path locals-set %) params)
(quote ~path))) (quote ~path))))
)
:else :else
`(quote ~path) `(quote ~path)))
))
(defn ^:no-doc ic-possible-params [path] (defn ^:no-doc ic-possible-params [path]
(do (do
@ -473,10 +472,10 @@
(concat [e] (rest e) (ic-possible-params e)) (concat [e] (rest e) (ic-possible-params e))
(vector? e) (vector? e)
(ic-possible-params e) (ic-possible-params e)))
))
path path)))
)))
(defn cljs-macroexpand [env form] (defn cljs-macroexpand [env form]
(let [expand-fn (i/cljs-analyzer-macroexpand-1) (let [expand-fn (i/cljs-analyzer-macroexpand-1)
@ -490,13 +489,13 @@
(#{'fn 'fn* 'cljs.core/fn} (first form))) (#{'fn 'fn* 'cljs.core/fn} (first form)))
form form
(let [expanded (if (seq? form) (cljs-macroexpand env form) form)] (let [expanded (if (seq? form) (cljs-macroexpand env form) form)]
(cljwalk/walk #(cljs-macroexpand-all* env %) identity expanded) (cljwalk/walk #(cljs-macroexpand-all* env %) identity expanded))))
)))
(defn cljs-macroexpand-all [env form] (defn cljs-macroexpand-all [env form]
(let [ret (cljs-macroexpand-all* env form)] (let [ret (cljs-macroexpand-all* env form)]
ret ret))
))
;; still possible to mess this up with alter-var-root ;; still possible to mess this up with alter-var-root
(defmacro path (defmacro path
@ -509,15 +508,15 @@
platform (if (contains? &env :locals) :cljs :clj) platform (if (contains? &env :locals) :cljs :clj)
local-syms (if (= platform :cljs) local-syms (if (= platform :cljs)
(-> &env :locals keys set) ;cljs (-> &env :locals keys set) ;cljs
(-> &env keys set) ;clj (-> &env keys set)) ;clj
)
used-locals-cell (i/mutable-cell []) used-locals-cell (i/mutable-cell [])
_ (cljwalk/postwalk _ (cljwalk/postwalk
(fn [e] (fn [e]
(if (local-syms e) (if (local-syms e)
(i/update-cell! used-locals-cell #(conj % e)) (i/update-cell! used-locals-cell #(conj % e))
e e))
))
path) path)
used-locals (i/get-cell used-locals-cell) used-locals (i/get-cell used-locals-cell)
@ -549,10 +548,10 @@
(alter-var-root (alter-var-root
(var ~cache-sym) (var ~cache-sym)
(fn [_#] (i/mutable-cell))) (fn [_#] (i/mutable-cell)))
nil nil))))
))))
cache-sym cache-sym)
)
add-cache-code (if (= platform :clj) add-cache-code (if (= platform :clj)
`(i/set-cell! ~cache-sym ~info-sym) `(i/set-cell! ~cache-sym ~info-sym)
`(def ~cache-sym ~info-sym)) `(def ~cache-sym ~info-sym))
@ -567,9 +566,9 @@
`(i/handle-params `(i/handle-params
~precompiled-sym ~precompiled-sym
~params-maker-sym ~params-maker-sym
~(mapv (fn [p] `(fn [] ~p)) possible-params) ~(mapv (fn [p] `(fn [] ~p)) possible-params)))]
))
]
(if (= platform :clj) (if (= platform :clj)
(i/intern* *ns* cache-sym (i/mutable-cell))) (i/intern* *ns* cache-sym (i/mutable-cell)))
`(let [info# ~get-cache-code `(let [info# ~get-cache-code
@ -580,13 +579,13 @@
~prepared-path ~prepared-path
~(str *ns*) ~(str *ns*)
(quote ~used-locals) (quote ~used-locals)
(quote ~possible-params) (quote ~possible-params))]
)]
~add-cache-code ~add-cache-code
~info-sym ~info-sym)
)
info# info#)
)
~precompiled-sym (.-precompiled info#) ~precompiled-sym (.-precompiled info#)
~params-maker-sym (.-params-maker info#)] ~params-maker-sym (.-params-maker info#)]
@ -594,10 +593,10 @@
(i/comp-paths* ~(if (= (count path) 1) (first path) (vec path))) (i/comp-paths* ~(if (= (count path) 1) (first path) (vec path)))
(if (nil? ~params-maker-sym) (if (nil? ~params-maker-sym)
~precompiled-sym ~precompiled-sym
~handle-params-code ~handle-params-code)))))
)
))
))
(defmacro select (defmacro select
"Navigates to and returns a sequence of all the elements specified by the path. "Navigates to and returns a sequence of all the elements specified by the path.
@ -705,5 +704,4 @@
to capture all the collected values as a single vector." to capture all the collected values as a single vector."
[params & body] [params & body]
(let [platform (if (contains? &env :locals) :cljs :clj)] (let [platform (if (contains? &env :locals) :cljs :clj)]
`(i/collected?* (~'fn [~params] ~@body)) `(i/collected?* (~'fn [~params] ~@body))))
))

192
src/clj/com/rpl/specter/navs.cljc
View file

@ -8,19 +8,19 @@
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor defnavconstructor]]
]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]] [doseqres]]))
))
(:use #?(:clj [com.rpl.specter macros]) (:use #?(:clj [com.rpl.specter macros])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as walk] [clojure.walk :as walk]
#?(:clj [clojure.core.reducers :as r]) #?(:clj [clojure.core.reducers :as r])
[com.rpl.specter.defnavhelpers] ; so that for cljs it's loaded as macros expand to this [com.rpl.specter.defnavhelpers])) ; so that for cljs it's loaded as macros expand to this
)
)
(defn- append [coll elem] (defn- append [coll elem]
(-> coll vec (conj elem))) (-> coll vec (conj elem)))
@ -42,20 +42,20 @@
(let [r (continue-fn structure)] (let [r (continue-fn structure)]
(if-not (identical? r i/NONE) (if-not (identical? r i/NONE)
(i/set-cell! ret r)) (i/set-cell! ret r))
r r)
)
(walk/walk this identity structure) (walk/walk this identity structure)))]
))]
(walker structure) (walker structure)
(i/get-cell ret) (i/get-cell ret)))
))
(defn key-select [akey structure next-fn] (defn key-select [akey structure next-fn]
(next-fn (get structure akey))) (next-fn (get structure akey)))
(defn key-transform [akey structure next-fn] (defn key-transform [akey structure next-fn]
(assoc structure akey (next-fn (get structure akey)) (assoc structure akey (next-fn (get structure akey))))
))
(defn all-select [structure next-fn] (defn all-select [structure next-fn]
(doseqres i/NONE [e structure] (doseqres i/NONE [e structure]
@ -68,8 +68,8 @@
:cljs :cljs
(defn queue? [coll] (defn queue? [coll]
(= (type coll) (type #queue []))) (= (type coll) (type #queue []))))
)
(defprotocol AllTransformProtocol (defprotocol AllTransformProtocol
(all-transform [structure next-fn])) (all-transform [structure next-fn]))
@ -78,17 +78,17 @@
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc m newk newv) (assoc m newk newv)))
))
empty-map empty-map
structure structure))
))
(extend-protocol AllTransformProtocol (extend-protocol AllTransformProtocol
nil nil
(all-transform [structure next-fn] (all-transform [structure next-fn]
nil nil)
)
;; in cljs they're PersistentVector so don't need a special case ;; in cljs they're PersistentVector so don't need a special case
#?(:clj clojure.lang.MapEntry) #?(:clj clojure.lang.MapEntry)
@ -96,8 +96,8 @@
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [newk (next-fn (key structure)) (let [newk (next-fn (key structure))
newv (next-fn (val structure))] newv (next-fn (val structure))]
(clojure.lang.MapEntry. newk newv) (clojure.lang.MapEntry. newk newv))))
)))
#?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
(all-transform [structure next-fn] (all-transform [structure next-fn]
@ -117,19 +117,19 @@
(aset array i newk) (aset array i newk)
(aset array (inc i) newv) (aset array (inc i) newv)
(recur (+ i 2))))) (recur (+ i 2)))))
(clojure.lang.PersistentArrayMap. array) (clojure.lang.PersistentArrayMap. array))))
)))
#?(:cljs cljs.core/PersistentArrayMap) #?(:cljs cljs.core/PersistentArrayMap)
#?(:cljs #?(:cljs
(all-transform [structure next-fn] (all-transform [structure next-fn]
(non-transient-map-all-transform structure next-fn {}) (non-transient-map-all-transform structure next-fn {})))
))
#?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap) #?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap)
(all-transform [structure next-fn] (all-transform [structure next-fn]
(non-transient-map-all-transform structure next-fn (empty structure)) (non-transient-map-all-transform structure next-fn (empty structure)))
)
#?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap) #?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap)
(all-transform [structure next-fn] (all-transform [structure next-fn]
@ -137,13 +137,13 @@
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc! m newk newv) (assoc! m newk newv)))
))
(transient (transient
#?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY) #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))
)
structure structure)))
)))
#?(:clj Object) #?(:clj Object)
@ -159,15 +159,15 @@
(reduce-kv (reduce-kv
(fn [m k v] (fn [m k v]
(let [[newk newv] (next-fn [k v])] (let [[newk newv] (next-fn [k v])]
(assoc m newk newv) (assoc m newk newv)))
))
empty-structure empty-structure
structure structure)
)
:else :else
(->> structure (r/map next-fn) (into empty-structure)) (->> structure (r/map next-fn) (into empty-structure))))))
))))
#?(:cljs default) #?(:cljs default)
#?(:cljs #?(:cljs
@ -176,9 +176,9 @@
(if (and (list? empty-structure) (not (queue? empty-structure))) (if (and (list? empty-structure) (not (queue? empty-structure)))
;; this is done to maintain order, otherwise lists get reversed ;; this is done to maintain order, otherwise lists get reversed
(doall (map next-fn structure)) (doall (map next-fn structure))
(into empty-structure (map #(next-fn %)) structure) (into empty-structure (map #(next-fn %)) structure))))))
))))
)
(defprotocol MapValsTransformProtocol (defprotocol MapValsTransformProtocol
(map-vals-transform [structure next-fn])) (map-vals-transform [structure next-fn]))
@ -193,8 +193,8 @@
(extend-protocol MapValsTransformProtocol (extend-protocol MapValsTransformProtocol
nil nil
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
nil nil)
)
#?(:clj clojure.lang.PersistentArrayMap) #?(:clj clojure.lang.PersistentArrayMap)
#?(:clj #?(:clj
@ -210,19 +210,19 @@
(aset array i k) (aset array i k)
(aset array (inc i) newv) (aset array (inc i) newv)
(recur (+ i 2))))) (recur (+ i 2)))))
(clojure.lang.PersistentArrayMap. array) (clojure.lang.PersistentArrayMap. array))))
)))
#?(:cljs cljs.core/PersistentArrayMap) #?(:cljs cljs.core/PersistentArrayMap)
#?(:cljs #?(:cljs
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
(map-vals-non-transient-transform structure {} next-fn) (map-vals-non-transient-transform structure {} next-fn)))
))
#?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap) #?(:clj clojure.lang.PersistentTreeMap :cljs cljs.core/PersistentTreeMap)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
(map-vals-non-transient-transform structure (empty structure) next-fn) (map-vals-non-transient-transform structure (empty structure) next-fn))
)
#?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap) #?(:clj clojure.lang.PersistentHashMap :cljs cljs.core/PersistentHashMap)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
@ -231,10 +231,10 @@
(fn [m k v] (fn [m k v]
(assoc! m k (next-fn v))) (assoc! m k (next-fn v)))
(transient (transient
#?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY) #?(:clj clojure.lang.PersistentHashMap/EMPTY :cljs cljs.core.PersistentHashMap.EMPTY))
)
structure structure)))
)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(map-vals-transform [structure next-fn] (map-vals-transform [structure next-fn]
@ -242,8 +242,8 @@
(fn [m k v] (fn [m k v]
(assoc m k (next-fn v))) (assoc m k (next-fn v)))
(empty structure) (empty structure)
structure)) structure)))
)
(defn srange-select [structure start end next-fn] (defn srange-select [structure start end next-fn]
(next-fn (-> structure vec (subvec start end)))) (next-fn (-> structure vec (subvec start end))))
@ -265,11 +265,11 @@
[ranges curr-start i] [ranges curr-start i]
:else :else
[(conj ranges [curr-start (inc curr-last)]) i i] [(conj ranges [curr-start (inc curr-last)]) i i]))
))
[[] nil nil] [[] nil nil]
(concat (matching-indices aseq p) [-1]) (concat (matching-indices aseq p) [-1]))))
)))
(defn extract-basic-filter-fn [path] (defn extract-basic-filter-fn [path]
(cond (fn? path) (cond (fn? path)
@ -280,10 +280,10 @@
(reduce (reduce
(fn [combined afn] (fn [combined afn]
(fn [structure] (fn [structure]
(and (combined structure) (afn structure)) (and (combined structure) (afn structure))))
))
path path)))
)))
@ -299,8 +299,8 @@
idx idx
vals vals
structure structure
next-fn next-fn)))
)))
(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] (defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
@ -315,15 +315,15 @@
idx idx
vals vals
structure structure
next-fn next-fn)))
)))
(defn terminal* [params params-idx vals structure] (defn terminal* [params params-idx vals structure]
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (identical? vals []) (if (identical? vals [])
(afn structure) (afn structure)
(apply afn (conj vals structure))) (apply afn (conj vals structure)))))
))
(defprotocol AddExtremes (defprotocol AddExtremes
@ -345,15 +345,15 @@
(as-> ret <> (as-> ret <>
(reduce conj! <> elements) (reduce conj! <> elements)
(reduce conj! <> structure) (reduce conj! <> structure)
(persistent! <>) (persistent! <>))))
)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(append-all [structure elements] (append-all [structure elements]
(concat structure elements)) (concat structure elements))
(prepend-all [structure elements] (prepend-all [structure elements]
(concat elements structure)) (concat elements structure)))
)
(defprotocol UpdateExtremes (defprotocol UpdateExtremes
@ -390,8 +390,8 @@
:cljs :cljs
(defn vec-count [v] (defn vec-count [v]
(count v)) (count v)))
)
#?( #?(
:clj :clj
@ -400,15 +400,15 @@
:cljs :cljs
(defn transient-vec-count [v] (defn transient-vec-count [v]
(count v)) (count v)))
)
(extend-protocol UpdateExtremes (extend-protocol UpdateExtremes
#?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector)
(update-first [v afn] (update-first [v afn]
(let [val (nth v 0)] (let [val (nth v 0)]
(assoc v 0 (afn val)) (assoc v 0 (afn val))))
))
(update-last [v afn] (update-last [v afn]
;; type-hinting vec-count to ^int caused weird errors with case ;; type-hinting vec-count to ^int caused weird errors with case
(let [c (int (vec-count v))] (let [c (int (vec-count v))]
@ -416,14 +416,14 @@
1 (let [[e] v] [(afn e)]) 1 (let [[e] v] [(afn e)])
2 (let [[e1 e2] v] [e1 (afn e2)]) 2 (let [[e1 e2] v] [e1 (afn e2)])
(let [i (dec c)] (let [i (dec c)]
(assoc v i (afn (nth v i))) (assoc v i (afn (nth v i)))))))
))))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(update-first [l val] (update-first [l val]
(update-first-list l val)) (update-first-list l val))
(update-last [l val] (update-last [l val]
(update-last-list l val) (update-last-list l val)))
))
(extend-protocol GetExtremes (extend-protocol GetExtremes
#?(:clj clojure.lang.IPersistentVector :cljs cljs.core/PersistentVector) #?(:clj clojure.lang.IPersistentVector :cljs cljs.core/PersistentVector)
@ -435,8 +435,8 @@
(get-first [s] (get-first [s]
(first s)) (first s))
(get-last [s] (get-last [s]
(last s) (last s)))
))
(extend-protocol FastEmpty (extend-protocol FastEmpty
@ -451,14 +451,14 @@
(= 0 (transient-vec-count v))) (= 0 (transient-vec-count v)))
#?(:clj Object :cljs default) #?(:clj Object :cljs default)
(fast-empty? [s] (fast-empty? [s]
(empty? s)) (empty? s)))
)
(defn walk-until [pred on-match-fn structure] (defn walk-until [pred on-match-fn structure]
(if (pred structure) (if (pred structure)
(on-match-fn structure) (on-match-fn structure)
(walk/walk (partial walk-until pred on-match-fn) identity structure) (walk/walk (partial walk-until pred on-match-fn) identity structure)))
))
(defn codewalk-until [pred on-match-fn structure] (defn codewalk-until [pred on-match-fn structure]
(if (pred structure) (if (pred structure)
@ -466,8 +466,8 @@
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)] (let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
(if (and (i/fn-invocation? structure) (i/fn-invocation? ret)) (if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure)) (with-meta ret (meta structure))
ret ret))))
))))
(def DISPENSE* (def DISPENSE*
(i/no-params-rich-compiled-path (i/no-params-rich-compiled-path

4
src/clj/com/rpl/specter/protocols.cljc
View file

@ -15,8 +15,8 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
"An implementation of `transform*` must use `next-fn` to transform "An implementation of `transform*` must use `next-fn` to transform
any subvalues of `structure` and then merge those transformed values any subvalues of `structure` and then merge those transformed values
back into `structure`. Everything else in `structure` must be unchanged." back into `structure`. Everything else in `structure` must be unchanged."))
))
(defprotocol Collector (defprotocol Collector
"Do not use this protocol directly. All navigators must be created using "Do not use this protocol directly. All navigators must be created using

4
src/clj/com/rpl/specter/transients.cljc
View file

@ -81,8 +81,8 @@
(defn- select-keys-from-transient-map (defn- select-keys-from-transient-map
"Uses select-keys on a transient map." "Uses select-keys on a transient map."
[m m-keys] [m m-keys]
(select-keys m m-keys)) (select-keys m m-keys)))
)
(defnav (defnav
^{:doc "Navigates to the specified persistent submap of a transient map."} ^{:doc "Navigates to the specified persistent submap of a transient map."}

7
src/clj/com/rpl/specter/util_macros.clj
View file

@ -6,8 +6,7 @@
(let [ret# (do ~@body)] (let [ret# (do ~@body)]
(if (identical? ret# ~backup-res) (if (identical? ret# ~backup-res)
curr# curr#
ret# ret#)))
)))
~backup-res ~backup-res
~aseq ~aseq))
))

51
src/clj/com/rpl/specter/zipper.cljc
View file

@ -12,8 +12,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (constructor structure))) (next-fn (constructor structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(zip/root (next-fn (constructor structure))) (zip/root (next-fn (constructor structure)))))
))
(def VECTOR-ZIP (zipper zip/vector-zip)) (def VECTOR-ZIP (zipper zip/vector-zip))
(def SEQ-ZIP (zipper zip/seq-zip)) (def SEQ-ZIP (zipper zip/seq-zip))
@ -34,12 +34,12 @@
(nav [] (nav []
(select* [this structure next-fn] (select* [this structure next-fn]
(let [ret (znav structure)] (let [ret (znav structure)]
(if ret (next-fn ret)) (if ret (next-fn ret))))
))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [ret (znav structure)] (let [ret (znav structure)]
(if ret (next-fn ret) structure) (if ret (next-fn ret) structure)))))
))))
;; (multi-path RIGHT LEFT) will not navigate to the right and left ;; (multi-path RIGHT LEFT) will not navigate to the right and left
;; of the currently navigated element because locations aren't stable ;; of the currently navigated element because locations aren't stable
@ -69,12 +69,12 @@
inserts (reduce inserts (reduce
(fn [z e] (-> z (inserter e) mover)) (fn [z e] (-> z (inserter e) mover))
structure structure
to-insert to-insert)]
)]
(if backer (if backer
(reduce (fn [z _] (backer z)) inserts to-insert) (reduce (fn [z _] (backer z)) inserts to-insert)
inserts) inserts)))
))
(defnav ^{:doc "Navigate to the empty subsequence directly to the (defnav ^{:doc "Navigate to the empty subsequence directly to the
right of this element."} right of this element."}
@ -82,8 +82,8 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(inner-insert structure next-fn zip/insert-right zip/right zip/left) (inner-insert structure next-fn zip/insert-right zip/right zip/left)))
))
(defnav ^{:doc "Navigate to the empty subsequence directly to the (defnav ^{:doc "Navigate to the empty subsequence directly to the
left of this element."} left of this element."}
@ -91,16 +91,16 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [])) (next-fn []))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(inner-insert structure next-fn zip/insert-left identity nil) (inner-insert structure next-fn zip/insert-left identity nil)))
))
(defnav NODE [] (defnav NODE []
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (zip/node structure)) (next-fn (zip/node structure)))
)
(transform* [this structure next-fn] (transform* [this structure next-fn]
(zip/edit structure next-fn) (zip/edit structure next-fn)))
))
(defnav ^{:doc "Navigate to the subsequence containing only (defnav ^{:doc "Navigate to the subsequence containing only
the node currently pointed to. This works just the node currently pointed to. This works just
@ -108,13 +108,13 @@
from the structure"} from the structure"}
NODE-SEQ [] NODE-SEQ []
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn [(zip/node structure)]) (next-fn [(zip/node structure)]))
)
(transform* [this structure next-fn] (transform* [this structure next-fn]
(let [to-insert (next-fn [(zip/node structure)]) (let [to-insert (next-fn [(zip/node structure)])
inserted (reduce zip/insert-left structure to-insert)] inserted (reduce zip/insert-left structure to-insert)]
(zip/remove inserted) (zip/remove inserted))))
)))
(declarepath ^{:doc "Navigate the zipper to the first element (declarepath ^{:doc "Navigate the zipper to the first element
in the structure matching predfn. A linear scan in the structure matching predfn. A linear scan
@ -124,8 +124,8 @@
(providepath find-first (providepath find-first
(s/if-path [NODE s/pred] (s/if-path [NODE s/pred]
s/STAY s/STAY
[NEXT (s/params-reset find-first)] [NEXT (s/params-reset find-first)]))
))
(declarepath ^{:doc "Navigate to every element reachable using calls (declarepath ^{:doc "Navigate to every element reachable using calls
to NEXT"} to NEXT"}
@ -134,5 +134,4 @@
(providepath NEXT-WALK (providepath NEXT-WALK
(s/stay-then-continue (s/stay-then-continue
NEXT NEXT
NEXT-WALK NEXT-WALK))
))

4
test/com/rpl/specter/cljs_test_runner.cljs
View file

@ -1,8 +1,8 @@
(ns com.rpl.specter.cljs-test-runner (ns com.rpl.specter.cljs-test-runner
(:require [cljs.test :as test :refer-macros [run-tests]] (:require [cljs.test :as test :refer-macros [run-tests]]
[com.rpl.specter.core-test] [com.rpl.specter.core-test]
[com.rpl.specter.zipper-test] [com.rpl.specter.zipper-test]))
))
(run-tests 'com.rpl.specter.core-test) (run-tests 'com.rpl.specter.core-test)
(run-tests 'com.rpl.specter.zipper-test) (run-tests 'com.rpl.specter.zipper-test)

529
test/com/rpl/specter/core_test.cljc
View file

File diff suppressed because it is too large Load diff

15
test/com/rpl/specter/test_helpers.clj
View file

@ -2,8 +2,8 @@
(:require [clojure.test.check (:require [clojure.test.check
[generators :as gen] [generators :as gen]
[properties :as prop]] [properties :as prop]]
[clojure.test] [clojure.test])
)
(:use [com.rpl.specter.macros :only [select transform]] (:use [com.rpl.specter.macros :only [select transform]]
[com.rpl.specter :only [select* transform* must-cache-paths!]])) [com.rpl.specter :only [select* transform* must-cache-paths!]]))
@ -29,13 +29,12 @@
icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data)) icfntran# (fn [~@params-decl] (transform ~apath ~transform-fn ~data))
regfnsel# (fn [~@params-decl] (select* ~apath ~data)) regfnsel# (fn [~@params-decl] (select* ~apath ~data))
regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data)) regfntran# (fn [~@params-decl] (transform* ~apath ~transform-fn ~data))
params# (if (empty? ~params) [[]] ~params) params# (if (empty? ~params) [[]] ~params)]
]
(must-cache-paths! ~must-cache?) (must-cache-paths! ~must-cache?)
(dotimes [_# 3] (dotimes [_# 3]
(doseq [ps# params#] (doseq [ps# params#]
(~is-sym (= (apply icfnsel# ps#) (apply regfnsel# ps#))) (~is-sym (= (apply icfnsel# ps#) (apply regfnsel# ps#)))
(~is-sym (= (apply icfntran# ps#) (apply regfntran# ps#))) (~is-sym (= (apply icfntran# ps#) (apply regfntran# ps#)))))
))
(must-cache-paths! false) (must-cache-paths! false))))
)))

64
test/com/rpl/specter/zipper_test.cljc
View file

@ -5,16 +5,16 @@
[com.rpl.specter.cljs-test-helpers :refer [for-all+]] [com.rpl.specter.cljs-test-helpers :refer [for-all+]]
[com.rpl.specter.macros [com.rpl.specter.macros
:refer [declarepath providepath select select-one select-one! :refer [declarepath providepath select select-one select-one!
select-first transform setval replace-in]] select-first transform setval replace-in]]))
))
(:use (:use
#?(:clj [clojure.test :only [deftest is]]) #?(:clj [clojure.test :only [deftest is]])
#?(:clj [clojure.test.check.clojure-test :only [defspec]]) #?(:clj [clojure.test.check.clojure-test :only [defspec]])
#?(:clj [com.rpl.specter.test-helpers :only [for-all+]]) #?(:clj [com.rpl.specter.test-helpers :only [for-all+]])
#?(:clj [com.rpl.specter.macros #?(:clj [com.rpl.specter.macros
:only [declarepath providepath select select-one select-one! :only [declarepath providepath select select-one select-one!
select-first transform setval replace-in]]) select-first transform setval replace-in]]))
)
(:require #?(:clj [clojure.test.check.generators :as gen]) (:require #?(:clj [clojure.test.check.generators :as gen])
#?(:clj [clojure.test.check.properties :as prop]) #?(:clj [clojure.test.check.properties :as prop])
#?(:cljs [cljs.test.check :as tc]) #?(:cljs [cljs.test.check :as tc])
@ -28,8 +28,8 @@
[v (gen/not-empty (gen/vector gen/int)) [v (gen/not-empty (gen/vector gen/int))
i (gen/vector gen/int)] i (gen/vector gen/int)]
(= (setval s/END i v) (= (setval s/END i v)
(setval [z/VECTOR-ZIP z/DOWN z/RIGHTMOST z/INNER-RIGHT] i v)) (setval [z/VECTOR-ZIP z/DOWN z/RIGHTMOST z/INNER-RIGHT] i v))))
))
(deftest zipper-multi-insert-test (deftest zipper-multi-insert-test
(is (= [1 2 :a :b 3 :a :b 4] (is (= [1 2 :a :b 3 :a :b 4]
@ -37,22 +37,22 @@
z/DOWN z/DOWN
z/RIGHT z/RIGHT
z/RIGHT z/RIGHT
(s/multi-path z/INNER-RIGHT z/INNER-LEFT) (s/multi-path z/INNER-RIGHT z/INNER-LEFT)]
]
[:a :b] [:a :b]
[1 2 3 4] [1 2 3 4])
)
(setval [z/VECTOR-ZIP (setval [z/VECTOR-ZIP
z/DOWN z/DOWN
z/RIGHT z/RIGHT
z/RIGHT z/RIGHT
(s/multi-path z/INNER-LEFT z/INNER-RIGHT) (s/multi-path z/INNER-LEFT z/INNER-RIGHT)]
]
[:a :b] [:a :b]
[1 2 3 4] [1 2 3 4]))))
)
))
)
(deftest zipper-down-up-test (deftest zipper-down-up-test
(is (= [1 [2 3 5] 6] (is (= [1 [2 3 5] 6]
@ -67,9 +67,9 @@
[z/UP z/RIGHT]) [z/UP z/RIGHT])
z/NODE] z/NODE]
inc inc
[1 [2 3 4] 5] [1 [2 3 4] 5]))))
)))
)
(deftest next-terminate-test (deftest next-terminate-test
@ -83,10 +83,10 @@
(s/selected? z/NODE number? even?) (s/selected? z/NODE number? even?)
z/NODE-SEQ] z/NODE-SEQ]
[] []
[1 2 [3 [[4]] 5] 6] [1 2 [3 [[4]] 5] 6]))))
)
))
)
(deftest zipper-nav-stop-test (deftest zipper-nav-stop-test
(is (= [1] (is (= [1]
@ -96,19 +96,19 @@
(is (= [1] (is (= [1]
(transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1]))) (transform [z/VECTOR-ZIP z/DOWN z/RIGHT z/NODE] inc [1])))
(is (= [] (is (= []
(transform [z/VECTOR-ZIP z/DOWN z/NODE] inc []))) (transform [z/VECTOR-ZIP z/DOWN z/NODE] inc []))))
)
(deftest find-first-test (deftest find-first-test
(is (= [1 [3 [[4]] 5] 6] (is (= [1 [3 [[4]] 5] 6]
(setval [z/VECTOR-ZIP (setval [z/VECTOR-ZIP
(z/find-first #(and (number? %) (even? %))) (z/find-first #(and (number? %) (even? %)))
z/NODE-SEQ z/NODE-SEQ]
]
[] []
[1 2 [3 [[4]] 5] 6]) [1 2 [3 [[4]] 5] 6]))))
))
)
(deftest nodeseq-expand-test (deftest nodeseq-expand-test
(is (= [2 [2] [[4 4 4]] 4 4 4 6] (is (= [2 [2] [[4 4 4]] 4 4 4 6]
@ -119,6 +119,4 @@
z/NODE-SEQ] z/NODE-SEQ]
(fn [v _] (fn [v _]
(repeat v (inc v))) (repeat v (inc v)))
[1 [2] [[3]] 3 6] [1 [2] [[3]] 3 6]))))
)))
)