diff --git a/src/clj/com/rpl/specter.cljx b/src/clj/com/rpl/specter.cljx index f143824..e5332ed 100644 --- a/src/clj/com/rpl/specter.cljx +++ b/src/clj/com/rpl/specter.cljx @@ -2,8 +2,7 @@ #+cljs (:require-macros [com.rpl.specter.macros :refer - [pathed-collector - variable-pathed-nav + [fixed-pathed-collector fixed-pathed-nav defcollector defnav @@ -14,10 +13,9 @@ [com.rpl.specter.util-macros :refer [doseqres]] ) - (:use [com.rpl.specter.protocols :only [Navigator]] + (:use [com.rpl.specter.protocols :only [ImplicitNav]] #+clj [com.rpl.specter.macros :only - [pathed-collector - variable-pathed-nav + [fixed-pathed-collector fixed-pathed-nav defcollector defnav @@ -27,6 +25,7 @@ #+clj [com.rpl.specter.util-macros :only [doseqres]] ) (:require [com.rpl.specter.impl :as i] + [com.rpl.specter.navs :as n] [clojure.set :as set]) ) @@ -40,7 +39,7 @@ (i/comp-paths* (vec apath))) (def ^{:doc "Mandate that operations that do inline path factoring and compilation - (select/transform/setval/replace-in/path/etc.) must succeed in + (select/transform/setval/replace-in/path/etc.) must succeed in factoring the path into static and dynamic portions. If not, an error will be thrown and the reasons for not being able to factor will be printed. Defaults to false, and `(must-cache-paths! false)` @@ -137,7 +136,7 @@ (defn multi-transform* "Just like `transform` but expects transform functions to be specified inline in the path using `terminal`. Error is thrown if navigation finishes - at a non-`terminal` navigator. `terminal-val` is a wrapper around `terminal` and is + at a non-`terminal` navigator. `terminal-val` is a wrapper around `terminal` and is the `multi-transform` equivalent of `setval`." [path structure] (compiled-multi-transform (i/comp-paths* path) structure)) @@ -172,24 +171,19 @@ (defn params-reset [params-path] ;; TODO: error if not paramsneededpath - (let [s (i/params-needed-selector params-path) - t (i/params-needed-transformer params-path) + (let [nav (i/params-needed-nav params-path) needed (i/num-needed-params params-path)] - (i/->ParamsNeededPath - (i/->TransformFunctions - i/RichPathExecutor - (fn [params params-idx vals structure next-fn] - (s params (- params-idx needed) vals structure next-fn) - ) - (fn [params params-idx vals structure next-fn] - (t params (- params-idx needed) vals structure next-fn) - )) - 0))) + (richnav 0 + (select* [this params params-idx 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] + (i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn) + )))) ;; Built-in pathing and context operations (defnav - ^{:doc "Stops navigation at this point. For selection returns nothing and for + ^{:doc "Stops navigation at this point. For selection returns nothing and for transformation returns the structure unchanged"} STOP [] @@ -199,6 +193,7 @@ structure )) + (defnav ^{:doc "Stays navigated at the current point. Essentially a no-op navigator."} STAY @@ -208,7 +203,6 @@ (transform* [this structure next-fn] (next-fn structure))) - (def ^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation that will have the parameterized transform function run. The transform @@ -216,10 +210,10 @@ given as the first arguments"} terminal (richnav 1 - (select* [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")) - (transform* [params params-idx vals structure next-fn] - (i/terminal* params params-idx vals structure) + (transform* [this params params-idx vals structure next-fn] + (n/terminal* params params-idx vals structure) ))) (defnavconstructor terminal-val @@ -229,14 +223,18 @@ [v] (p (i/fast-constantly v))) -(def +(defnav ^{:doc "Navigate to every element of the collection. For maps navigates to a vector of `[key value]`."} ALL - (comp-paths (i/->AllNavigator))) + [] + (select* [this structure next-fn] + (n/all-select structure next-fn)) + (transform* [this structure next-fn] + (n/all-transform structure next-fn))) (defnav - ^{:doc "Navigate to each value of the map. This is more efficient than + ^{:doc "Navigate to each value of the map. This is more efficient than navigating via [ALL LAST]"} MAP-VALS [] @@ -245,23 +243,25 @@ (next-fn v) )) (transform* [this structure next-fn] - (i/map-vals-transform structure next-fn) + (n/map-vals-transform structure next-fn) )) -(def VAL (i/->ValCollect)) +(defcollector VAL [] + (collect-val [this structure] + structure)) (def ^{:doc "Navigate to the last element of the collection. If the collection is empty navigation is stopped at this point."} LAST - (comp-paths (i/->PosNavigator i/get-last i/update-last))) + (n/PosNavigator n/get-last n/update-last)) (def ^{:doc "Navigate to the first element of the collection. If the collection is empty navigation is stopped at this point."} FIRST - (comp-paths (i/->PosNavigator i/get-first i/update-first))) + (n/PosNavigator n/get-first n/update-first)) (defnav ^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence @@ -269,9 +269,9 @@ srange-dynamic [start-fn end-fn] (select* [this structure next-fn] - (i/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] - (i/srange-transform structure (start-fn structure) (end-fn structure) next-fn) + (n/srange-transform structure (start-fn structure) (end-fn structure) next-fn) )) (defnav @@ -280,9 +280,9 @@ srange [start end] (select* [this structure next-fn] - (i/srange-select structure start end next-fn)) + (n/srange-select structure start end next-fn)) (transform* [this structure next-fn] - (i/srange-transform structure start end next-fn) + (n/srange-transform structure start end next-fn) )) (defnav @@ -290,15 +290,15 @@ continuous-subseqs [pred] (select* [this structure next-fn] - (doseqres NONE [[s e] (i/matching-ranges structure pred)] - (i/srange-select structure s e next-fn) + (doseqres NONE [[s e] (n/matching-ranges structure pred)] + (n/srange-select structure s e next-fn) )) (transform* [this structure next-fn] (reduce (fn [structure [s e]] - (i/srange-transform structure s e next-fn)) + (n/srange-transform structure s e next-fn)) structure - (reverse (i/matching-ranges structure pred)) + (reverse (n/matching-ranges structure pred)) ))) (defnav @@ -309,7 +309,7 @@ (next-fn [])) (transform* [this structure next-fn] (let [to-prepend (next-fn [])] - (i/prepend-all structure to-prepend) + (n/prepend-all structure to-prepend) ))) (defnav @@ -320,9 +320,9 @@ (next-fn [])) (transform* [this structure next-fn] (let [to-append (next-fn [])] - (i/append-all structure to-append) + (n/append-all structure to-append) ))) - + (defnav ^{:doc "Navigates to the specified subset (by taking an intersection). In a transform, that subset in the original set is changed to the @@ -360,18 +360,18 @@ walker [afn] (select* [this structure next-fn] - (i/walk-select afn next-fn structure)) + (n/walk-select afn next-fn structure)) (transform* [this structure next-fn] - (i/walk-until afn next-fn structure))) + (n/walk-until afn next-fn structure))) (defnav ^{:doc "Like `walker` but maintains metadata of any forms traversed."} codewalker [afn] (select* [this structure next-fn] - (i/walk-select afn next-fn structure)) + (n/walk-select afn next-fn structure)) (transform* [this structure next-fn] - (i/codewalk-until afn next-fn structure))) + (n/codewalk-until afn next-fn structure))) (defpathedfn subselect "Navigates to a sequence that contains the results of (select ...), @@ -429,8 +429,8 @@ )) (defnav - ^{:doc "Navigate to the result of running `parse-fn` on the value. For - transforms, the transformed value then has `unparse-fn` run on + ^{:doc "Navigate to the result of running `parse-fn` on the value. For + transforms, the transformed value then has `unparse-fn` run on it to get the final value at this point."} parser [parse-fn unparse-fn] @@ -460,32 +460,32 @@ will be parameterized in the order of which the parameterized navigators were declared." [& path] - (if-let [afn (i/extract-basic-filter-fn path)] + (if-let [afn (n/extract-basic-filter-fn path)] afn (fixed-pathed-nav [late path] (select* [this structure next-fn] (i/filter-select - #(i/selected?* late %) + #(n/selected?* late %) structure next-fn)) (transform* [this structure next-fn] (i/filter-transform - #(i/selected?* late %) + #(n/selected?* late %) structure next-fn))))) (defpathedfn not-selected? [& path] - (if-let [afn (i/extract-basic-filter-fn path)] + (if-let [afn (n/extract-basic-filter-fn path)] (fn [s] (not (afn s))) (fixed-pathed-nav [late path] (select* [this structure next-fn] (i/filter-select - #(i/not-selected?* late %) + #(n/not-selected?* late %) structure next-fn)) (transform* [this structure next-fn] (i/filter-transform - #(i/not-selected?* late %) + #(n/not-selected?* late %) structure next-fn))))) @@ -514,28 +514,6 @@ (transform* [this structure next-fn] (next-fn (compiled-transform late update-fn structure))))) -(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core/Keyword - Navigator - (select* [kw structure next-fn] - (next-fn (get structure kw))) - (transform* [kw structure next-fn] - (assoc structure kw (next-fn (get structure kw))) - )) - -(extend-type #+clj clojure.lang.AFn #+cljs function - Navigator - (select* [afn structure next-fn] - (i/filter-select afn structure next-fn)) - (transform* [afn structure next-fn] - (i/filter-transform afn structure next-fn))) - -(extend-type #+clj clojure.lang.PersistentHashSet #+cljs cljs.core/PersistentHashSet - Navigator - (select* [aset structure next-fn] - (i/filter-select aset structure next-fn)) - (transform* [aset structure next-fn] - (i/filter-transform aset structure next-fn))) - (def ^{:doc "Keeps the element only if it matches the supplied predicate. This is the late-bound parameterized version of using a function directly in a path."} @@ -543,6 +521,23 @@ i/pred* ) +(extend-type nil + ImplicitNav + (implicit-nav [this] STAY)) + +(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core/Keyword + ImplicitNav + (implicit-nav [this] (keypath this)) + ) + +(extend-type #+clj clojure.lang.AFn #+cljs function + ImplicitNav + (implicit-nav [this] (pred this))) + +(extend-type #+clj clojure.lang.PersistentHashSet #+cljs cljs.core/PersistentHashSet + ImplicitNav + (implicit-nav [this] (pred this))) + (defnav ^{:doc "Navigates to the provided val if the structure is nil. Otherwise it stays navigated at the structure."} @@ -585,7 +580,7 @@ current value to the collected vals."} collect [& path] - (pathed-collector [late path] + (fixed-pathed-collector [late path] (collect-val [this structure] (compiled-select late structure) ))) @@ -595,7 +590,7 @@ current value to the collected vals."} collect-one [& path] - (pathed-collector [late path] + (fixed-pathed-collector [late path] (collect-val [this structure] (compiled-select-one late structure) ))) @@ -615,7 +610,7 @@ (def ^{:doc "Drops all collected values for subsequent navigation."} - DISPENSE i/DISPENSE*) + DISPENSE n/DISPENSE*) (defpathedfn if-path @@ -623,66 +618,66 @@ ([cond-p then-path] (if-path cond-p then-path STOP)) ([cond-p then-path else-path] - (let [then-comp (i/comp-paths* then-path) - else-comp (i/comp-paths* else-path) + (let [then-comp (i/comp-paths-internalized then-path) + else-comp (i/comp-paths-internalized else-path) then-needed (i/num-needed-params then-comp) else-needed (i/num-needed-params else-comp) - [then-s then-t] (i/extract-rich-tfns then-comp) - [else-s else-t] (i/extract-rich-tfns else-comp)] - (if-let [afn (i/extract-basic-filter-fn cond-p)] + then-nav (i/extract-rich-nav then-comp) + else-nav (i/extract-rich-nav else-comp)] + (if-let [afn (n/extract-basic-filter-fn cond-p)] (richnav (+ then-needed else-needed) - (select* [params params-idx vals structure next-fn] - (i/if-select + (select* [this params params-idx vals structure next-fn] + (n/if-select params params-idx vals structure next-fn afn - then-s + then-nav then-needed - else-s + else-nav )) - (transform* [params params-idx vals structure next-fn] - (i/if-transform + (transform* [this params params-idx vals structure next-fn] + (n/if-transform params params-idx vals structure next-fn afn - then-t + then-nav then-needed - else-t + else-nav )))) - (let [cond-comp (i/comp-paths* cond-p) + (let [cond-comp (i/comp-paths-internalized cond-p) cond-needed (i/num-needed-params cond-comp)] (richnav (+ then-needed else-needed cond-needed) - (select* [params params-idx vals structure next-fn] + (select* [this params params-idx vals structure next-fn] (let [late-cond (i/parameterize-path cond-comp params params-idx)] - (i/if-select + (n/if-select params (+ params-idx cond-needed) vals structure next-fn - #(i/selected?* late-cond %) - then-s + #(n/selected?* late-cond %) + then-nav then-needed - else-s + else-nav ))) - (transform* [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)] - (i/if-transform + (n/if-transform params (+ params-idx cond-needed) vals structure next-fn - #(i/selected?* late-cond %) - then-t + #(n/selected?* late-cond %) + then-nav then-needed - else-t + else-nav )))))))) (defpathedfn cond-path @@ -710,23 +705,23 @@ ([] STAY) ([path] (i/comp-paths* path)) ([path1 path2] - (let [comp1 (i/comp-paths* path1) - comp2 (i/comp-paths* path2) + (let [comp1 (i/comp-paths-internalized path1) + comp2 (i/comp-paths-internalized path2) comp1-needed (i/num-needed-params comp1) - [s1 t1] (i/extract-rich-tfns comp1) - [s2 t2] (i/extract-rich-tfns comp2) + nav1 (i/extract-rich-nav comp1) + nav2 (i/extract-rich-nav comp2) ] (richnav (+ comp1-needed (i/num-needed-params comp2)) - (select* [params params-idx vals structure next-fn] - (let [res1 (s1 params params-idx vals structure next-fn) - res2 (s2 params (+ params-idx comp1-needed) 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) + res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)] (if (identical? NONE res2) res1 res2 ))) - (transform* [params params-idx vals structure next-fn] - (let [s1 (t1 params params-idx vals structure next-fn)] - (t2 params (+ params-idx comp1-needed) vals s1 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)] + (i/exec-rich-transform* nav2 params (+ params-idx comp1-needed) vals s1 next-fn) ))))) ([path1 path2 & paths] (reduce multi-path (multi-path path1 path2) paths) diff --git a/src/clj/com/rpl/specter/defhelpers.clj b/src/clj/com/rpl/specter/defhelpers.clj index 31a4a39..e45eed7 100644 --- a/src/clj/com/rpl/specter/defhelpers.clj +++ b/src/clj/com/rpl/specter/defhelpers.clj @@ -13,7 +13,7 @@ ~@setters (com.rpl.specter.impl/bind-params* this# ~a 0) )))] - `(defrecord ~'ParamsNeededPath [~'transform-fns ~'num-needed-params] + `(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params] ~fn-type ~@impls ~var-arity-impl diff --git a/src/clj/com/rpl/specter/defnavhelpers.cljx b/src/clj/com/rpl/specter/defnavhelpers.cljx new file mode 100644 index 0000000..ac14b22 --- /dev/null +++ b/src/clj/com/rpl/specter/defnavhelpers.cljx @@ -0,0 +1,14 @@ +(ns com.rpl.specter.defnavhelpers + (:require [com.rpl.specter.impl :as i])) + +(defn param-delta [i] + (fn [^objects params params-idx] + (aget params (+ params-idx i)) + )) + +(defn bound-params [path start-delta] + (fn [^objects params params-idx] + (if (i/params-needed-path? path) + (i/bind-params* path params (+ params-idx start-delta)) + path + ))) diff --git a/src/clj/com/rpl/specter/impl.cljx b/src/clj/com/rpl/specter/impl.cljx index 44b3ce9..1a9bd3a 100644 --- a/src/clj/com/rpl/specter/impl.cljx +++ b/src/clj/com/rpl/specter/impl.cljx @@ -6,12 +6,10 @@ [com.rpl.specter.util-macros :refer [doseqres]] ) (:use [com.rpl.specter.protocols :only - [select* transform* collect-val]] + [select* transform* collect-val Navigator]] #+clj [com.rpl.specter.util-macros :only [doseqres]] ) (:require [com.rpl.specter.protocols :as p] - [clojure.walk :as walk] - #+clj [clojure.core.reducers :as r] [clojure.string :as s] #+clj [com.rpl.specter.defhelpers :as dh] #+clj [riddley.walk :as riddley] @@ -35,6 +33,9 @@ (defn smart-str [& elems] (apply str (map smart-str* elems))) +(defn object-aget [^objects a i] + (aget a i)) + (defn fast-constantly [v] (fn ([] v) ([a1] v) @@ -63,7 +64,7 @@ (defn throw-illegal [& 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 ;; namespace does not exist #+clj @@ -90,35 +91,75 @@ (defn intern* [ns name val] (throw-illegal "intern not supported in ClojureScript")) -;; so that macros.clj compiles appropriately when -;; run in cljs (this code isn't called in that case) -#+cljs -(defn gen-uuid-str [] - (throw-illegal "Cannot get UUID in Javascript")) - -#+clj -(defn gen-uuid-str [] - (str (java.util.UUID/randomUUID))) - (defn benchmark [iters afn] (time (dotimes [_ iters] (afn)))) -(deftype ExecutorFunctions [type traverse-executor transform-executor]) +(deftype ExecutorFunctions [traverse-executor transform-executor]) + +(deftype ParameterizedRichNav [rich-nav params params-idx]) + +(defprotocol RichNavigator + (rich-select* [this params params-idx vals structure next-fn]) + (rich-transform* [this params params-idx vals structure next-fn]) + ) + +#+clj +(defmacro exec-rich-select* [this & args] + (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})] + `(.rich-select* ~hinted ~@args) + )) + +#+cljs +(defn exec-rich-select* [this params params-idx vals structure next-fn] + (rich-select* ^not-native this params params-idx vals structure next-fn)) + +#+clj +(defmacro exec-rich-transform* [this & args] + (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})] + `(.rich-transform* ~hinted ~@args) + )) + +#+cljs +(defn exec-rich-transform* [this params params-idx vals structure next-fn] + (rich-transform* ^not-native this params params-idx vals structure next-fn)) + +#+clj +(defmacro exec-select* [this & args] + (let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})] + `(.select* ~hinted ~@args) + )) + +#+cljs +(defn exec-select* [this structure next-fn] + (p/select* ^not-native this structure next-fn)) + +#+clj +(defmacro exec-transform* [this & args] + (let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})] + `(.transform* ~hinted ~@args) + )) + +#+cljs +(defn exec-transform* [this structure next-fn] + (p/transform* ^not-native this structure next-fn)) (def RichPathExecutor (->ExecutorFunctions - :richpath - (fn [params params-idx selector result-fn structure] - (selector params params-idx [] structure + (fn [^ParameterizedRichNav richnavp result-fn structure] + (exec-rich-select* (.-rich-nav richnavp) + (.-params richnavp) (.-params-idx richnavp) + [] structure (fn [_ _ vals structure] (result-fn (if (identical? vals []) structure (conj vals structure)))))) - (fn [params params-idx transformer transform-fn structure] - (transformer params params-idx [] structure + (fn [^ParameterizedRichNav richnavp transform-fn structure] + (exec-rich-transform* (.-rich-nav richnavp) + (.-params richnavp) (.-params-idx richnavp) + [] structure (fn [_ _ vals structure] (if (identical? [] vals) (transform-fn structure) @@ -127,22 +168,28 @@ (def LeanPathExecutor (->ExecutorFunctions - :leanpath - (fn [params params-idx selector result-fn structure] - (selector structure result-fn)) - (fn [params params-idx transformer transform-fn structure] - (transformer structure transform-fn)) + (fn [nav result-fn structure] + (exec-select* nav structure result-fn)) + (fn [nav transform-fn structure] + (exec-transform* nav structure transform-fn)) )) -(defrecord TransformFunctions [executors selector transformer]) - -(defrecord CompiledPath [transform-fns params params-idx]) +(defrecord CompiledPath [executors nav]) (defn compiled-path? [o] (instance? CompiledPath o)) -(defn no-params-compiled-path [transform-fns] - (->CompiledPath transform-fns nil 0)) +(defn no-params-rich-compiled-path [rich-nav] + (->CompiledPath + RichPathExecutor + (->ParameterizedRichNav + rich-nav + nil + 0 + ))) + +(defn lean-compiled-path [nav] + (->CompiledPath LeanPathExecutor nav)) (declare bind-params*) @@ -174,7 +221,7 @@ p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 rest] (let [a (object-array - (concat + (concat [p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20] rest))] @@ -184,11 +231,24 @@ (defn params-needed-path? [o] (instance? ParamsNeededPath o)) +(defn extract-nav [p] + (if (params-needed-path? p) + (.-rich-nav ^ParamsNeededPath p) + (let [n (.-nav ^CompiledPath p)] + (if (instance? ParameterizedRichNav n) + (.-rich-nav ^ParameterizedRichNav n) + n + )))) + + (defn bind-params* [^ParamsNeededPath params-needed-path params idx] (->CompiledPath - (.-transform-fns params-needed-path) - params - idx)) + RichPathExecutor + (->ParameterizedRichNav + (.-rich-nav params-needed-path) + params + idx + ))) (defprotocol PathComposer (do-comp-paths [paths])) @@ -203,93 +263,22 @@ empty? not)) -(defn no-prot-error-str [obj] - (str "Protocol implementation cannot be found for object. - Extending Specter protocols should not be done inline in a deftype definition - because that prevents Specter from finding the protocol implementations for - optimized performance. Instead, you should extend the protocols via an - explicit extend-protocol call. \n" obj)) +(defn root-params-nav? [o] + (and (fn? o) (-> o meta :highernav))) -#+clj -(defn find-protocol-impl! [prot obj] - (let [ret (find-protocol-impl prot obj)] - (if (= ret obj) - (throw-illegal (no-prot-error-str obj)) - ret - ))) - -#+clj -(defn structure-path-impl [this] - (if (fn? this) - ;;TODO: this isn't kosher, it uses knowledge of internals of protocols - (-> p/Navigator :impls (get clojure.lang.AFn)) - (find-protocol-impl! p/Navigator this))) - -#+clj -(defn collector-impl [this] - (find-protocol-impl! p/Collector this)) - - -#+cljs -(defn structure-path-impl [obj] - {:select* (mk-optimized-invocation p/Navigator obj select* 2) - :transform* (mk-optimized-invocation p/Navigator obj transform* 2) - }) - -#+cljs -(defn collector-impl [obj] - {:collect-val (mk-optimized-invocation p/Collector obj collect-val 1) - }) - -(defn coerce-collector [this] - (let [cfn (->> this - collector-impl - :collect-val - ) - afn (fn [params params-idx vals structure next-fn] - (next-fn params params-idx (conj vals (cfn this structure)) structure) - )] - (no-params-compiled-path - (->TransformFunctions RichPathExecutor afn afn) - ))) - - -(defn coerce-structure-path [this] - (let [pimpl (structure-path-impl this) - selector (:select* pimpl) - transformer (:transform* pimpl)] - (no-params-compiled-path - (->TransformFunctions - LeanPathExecutor - (fn [structure next-fn] - (selector this structure next-fn)) - (fn [structure next-fn] - (transformer this structure next-fn))) - ))) - -(defn coerce-structure-path-rich [this] - (let [pimpl (structure-path-impl this) - selector (:select* pimpl) - transformer (:transform* pimpl)] - (no-params-compiled-path - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] - (selector this structure (fn [structure] (next-fn params params-idx vals structure)))) - (fn [params params-idx vals structure next-fn] - (transformer this structure (fn [structure] (next-fn params params-idx vals structure))))) - ))) - -(defn structure-path? [obj] - (or (fn? obj) (satisfies? p/Navigator obj))) +(defn- coerce-object [this] + (cond (root-params-nav? this) (-> this meta :highernav :params-needed-path) + (satisfies? p/ImplicitNav this) (p/implicit-nav this) + :else (throw-illegal "Not a navigator: " this) + )) (defprotocol CoercePath (coerce-path [this])) (extend-protocol CoercePath - nil ; needs its own path because it doesn't count as an Object + nil ; needs its own coercer because it doesn't count as an Object (coerce-path [this] - (coerce-structure-path nil)) + (coerce-object this)) CompiledPath (coerce-path [this] @@ -298,7 +287,7 @@ ParamsNeededPath (coerce-path [this] this) - + #+clj java.util.List #+cljs cljs.core/PersistentVector (coerce-path [this] (do-comp-paths this)) @@ -315,113 +304,118 @@ #+cljs cljs.core/LazySeq #+cljs (coerce-path [this] (coerce-path (vec this))) - + #+clj Object #+cljs default (coerce-path [this] - (cond (structure-path? this) (coerce-structure-path this) - (satisfies? p/Collector this) (coerce-collector this) - :else (throw-illegal (no-prot-error-str this)) - ))) + (coerce-object this))) -(defn extype [^TransformFunctions f] - (let [^ExecutorFunctions exs (.-executors f)] - (.-type exs) - )) - -(defn- combine-same-types [[^TransformFunctions f & _ :as all]] - (let [^ExecutorFunctions exs (.-executors f) - - t (.-type exs) - - combiner - (if (= t :richpath) +(defn- combine-same-types [[n & _ :as all]] + (let [combiner + (if (satisfies? RichNavigator n) (fn [curr next] - (fn [params params-idx vals structure next-fn] - (curr params params-idx vals structure - (fn [params-next params-idx-next vals-next structure-next] - (next params-next params-idx-next vals-next structure-next next-fn) - )))) + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] + (exec-rich-select* curr params params-idx vals structure + (fn [params-next params-idx-next vals-next structure-next] + (exec-rich-select* next params-next params-idx-next + vals-next structure-next next-fn) + ))) + (rich-transform* [this params params-idx vals structure next-fn] + (exec-rich-transform* curr params params-idx vals structure + (fn [params-next params-idx-next vals-next structure-next] + (exec-rich-transform* next params-next params-idx-next + vals-next structure-next next-fn) + ))))) (fn [curr next] - (fn [structure next-fn] - (curr structure (fn [structure] (next structure next-fn))))) - )] + (reify Navigator + (select* [this structure next-fn] + (exec-select* curr structure + (fn [structure-next] + (exec-select* next structure-next next-fn)))) + (transform* [this structure next-fn] + (exec-transform* curr structure + (fn [structure-next] + (exec-transform* next structure-next next-fn)))))))] + (reduce combiner all))) - (reduce (fn [^TransformFunctions curr ^TransformFunctions next] - (->TransformFunctions - exs - (combiner (.-selector curr) (.-selector next)) - (combiner (.-transformer curr) (.-transformer next)) - )) - all))) - -(defn coerce-tfns-rich [^TransformFunctions tfns] - (if (= (extype tfns) :richpath) - tfns - (let [selector (.-selector tfns) - transformer (.-transformer tfns)] - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] - (selector structure (fn [structure] (next-fn params params-idx vals structure)))) - (fn [params params-idx vals structure next-fn] - (transformer structure (fn [structure] (next-fn params params-idx vals structure)))) +(defn coerce-rich-navigator [nav] + (if (satisfies? RichNavigator nav) + nav + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] + (exec-select* nav structure (fn [structure] (next-fn params params-idx vals structure))) + ) + (rich-transform* [this params params-idx vals structure next-fn] + (exec-transform* nav structure (fn [structure] (next-fn params params-idx vals structure))) )))) +(defn extract-rich-nav [p] + (coerce-rich-navigator (extract-nav p))) + (defn capture-params-internally [path] - (if-not (instance? CompiledPath path) + (cond + (not (instance? CompiledPath path)) path - (let [params (:params path) - params-idx (:params-idx path) - selector (-> path :transform-fns :selector) - transformer (-> path :transform-fns :transformer)] + + (satisfies? Navigator (:nav path)) + path + + :else + (let [^ParameterizedRichNav prich-nav (:nav path) + rich-nav (.-rich-nav prich-nav) + params (.-params prich-nav) + params-idx (.-params-idx prich-nav)] (if (empty? params) path - (no-params-compiled-path - (->TransformFunctions - RichPathExecutor - (fn [x-params x-params-idx vals structure next-fn] - (selector params params-idx vals structure + (no-params-rich-compiled-path + (reify RichNavigator + (rich-select* [this params2 params-idx2 vals structure next-fn] + (exec-rich-select* rich-nav params params-idx vals structure (fn [_ _ vals-next structure-next] - (next-fn x-params x-params-idx vals-next structure-next) + (next-fn params2 params-idx2 vals-next structure-next) ))) - (fn [x-params x-params-idx vals structure next-fn] - (transformer params params-idx vals structure + (rich-transform* [this params2 params-idx2 vals structure next-fn] + (exec-rich-transform* rich-nav params params-idx vals structure (fn [_ _ vals-next structure-next] - (next-fn x-params x-params-idx vals-next structure-next) - )))) - ))))) + (next-fn params2 params-idx2 vals-next structure-next) + ))))))))) + +(defn comp-paths-internalized [path] + (capture-params-internally (comp-paths* path))) (extend-protocol PathComposer nil - (do-comp-paths [sp] - (coerce-path sp)) + (do-comp-paths [o] + (coerce-path o)) #+clj Object #+cljs default - (do-comp-paths [sp] - (coerce-path sp)) + (do-comp-paths [o] + (coerce-path o)) #+clj java.util.List #+cljs cljs.core/PersistentVector - (do-comp-paths [structure-paths] - (if (empty? structure-paths) + (do-comp-paths [navigators] + (if (empty? navigators) (coerce-path nil) - (let [coerced (->> structure-paths + (let [coerced (->> navigators (map coerce-path) (map capture-params-internally)) combined (->> coerced - (map :transform-fns) - (partition-by extype) + (map extract-nav) + (partition-by type) (map combine-same-types) ) - result-tfn (if (= 1 (count combined)) + result-nav (if (= 1 (count combined)) (first combined) (->> combined - (map coerce-tfns-rich) + (map coerce-rich-navigator) combine-same-types) ) needs-params-paths (filter #(instance? ParamsNeededPath %) coerced)] (if (empty? needs-params-paths) - (no-params-compiled-path result-tfn) + (if (satisfies? Navigator result-nav) + (lean-compiled-path result-nav) + (no-params-rich-compiled-path result-nav)) (->ParamsNeededPath - (coerce-tfns-rich result-tfn) + (coerce-rich-navigator result-nav) (->> needs-params-paths (map :num-needed-params) (reduce +)) @@ -479,214 +473,37 @@ (set-cell! cell ret) ret)) -(defn- append [coll elem] - (-> coll vec (conj elem))) - -(defprotocol AddExtremes - (append-all [structure elements]) - (prepend-all [structure elements])) - -(extend-protocol AddExtremes - nil - (append-all [_ elements] - elements) - (prepend-all [_ elements] - elements) - - #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector - (append-all [structure elements] - (reduce conj structure elements)) - (prepend-all [structure elements] - (let [ret (transient [])] - (as-> ret <> - (reduce conj! <> elements) - (reduce conj! <> structure) - (persistent! <>) - ))) - - #+clj Object #+cljs default - (append-all [structure elements] - (concat structure elements)) - (prepend-all [structure elements] - (concat elements structure)) - ) -(defprotocol UpdateExtremes - (update-first [s afn]) - (update-last [s afn])) +(defn compiled-nav-field [^CompiledPath p] + (.-nav p)) -(defprotocol GetExtremes - (get-first [s]) - (get-last [s])) +(defn compiled-executors-field [^CompiledPath p] + (.-executors p)) -(defprotocol FastEmpty - (fast-empty? [s])) - -(defn- update-first-list [l afn] - (cons (afn (first l)) (rest l))) - -(defn- update-last-list [l afn] - (append (butlast l) (afn (last l)))) - -#+clj -(defn vec-count [^clojure.lang.IPersistentVector v] - (.length v)) - -#+cljs -(defn vec-count [v] - (count v)) - -#+clj -(defn transient-vec-count [^clojure.lang.ITransientVector v] - (.count v)) - -#+cljs -(defn transient-vec-count [v] - (count v)) - -(extend-protocol UpdateExtremes - #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector - (update-first [v afn] - (let [val (nth v 0)] - (assoc v 0 (afn val)) - )) - (update-last [v afn] - ;; type-hinting vec-count to ^int caused weird errors with case - (let [c (int (vec-count v))] - (case c - 1 (let [[e] v] [(afn e)]) - 2 (let [[e1 e2] v] [e1 (afn e2)]) - (let [i (dec c)] - (assoc v i (afn (nth v i))) - )))) - #+clj Object #+cljs default - (update-first [l val] - (update-first-list l val)) - (update-last [l val] - (update-last-list l val) - )) - -(extend-protocol GetExtremes - #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector - (get-first [v] - (nth v 0)) - (get-last [v] - (peek v)) - #+clj Object #+cljs default - (get-first [s] - (first s)) - (get-last [s] - (last s) - )) - - -(extend-protocol FastEmpty - nil - (fast-empty? [_] true) - - #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector - (fast-empty? [v] - (= 0 (vec-count v))) - #+clj clojure.lang.ITransientVector #+cljs cljs.core/TransientVector - (fast-empty? [v] - (= 0 (transient-vec-count v))) - #+clj Object #+cljs default - (fast-empty? [s] - (empty? s)) - ) - -(defn walk-until [pred on-match-fn structure] - (if (pred structure) - (on-match-fn structure) - (walk/walk (partial walk-until pred on-match-fn) identity structure) - )) - -(defn fn-invocation? [f] - (or #+clj (instance? clojure.lang.Cons f) - #+clj (instance? clojure.lang.LazySeq f) - #+cljs (instance? cljs.core.LazySeq f) - (list? f))) - -(defn codewalk-until [pred on-match-fn structure] - (if (pred structure) - (on-match-fn structure) - (let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)] - (if (and (fn-invocation? structure) (fn-invocation? ret)) - (with-meta ret (meta structure)) - ret - )))) - - -(def collected?* - (->ParamsNeededPath - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] - (let [afn (aget ^objects params params-idx)] - (if (afn vals) - (next-fn params (inc params-idx) vals structure) - NONE - ))) - (fn [params params-idx vals structure next-fn] - (let [afn (aget ^objects params params-idx)] - (if (afn vals) - (next-fn params (inc params-idx) vals structure) - structure - )))) - 1 - )) - -(def DISPENSE* - (no-params-compiled-path - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] - (next-fn params params-idx [] structure)) - (fn [params params-idx vals structure next-fn] - (next-fn params params-idx [] structure)) - ))) - -(defn transform-fns-field [^CompiledPath path] - (.-transform-fns path)) - -(defn executors-field [^TransformFunctions tfns] - (.-executors tfns)) (defn traverse-executor-field [^ExecutorFunctions ex] (.-traverse-executor ex)) -(defn params-field [^CompiledPath path] - (.-params path)) -(defn params-idx-field [^CompiledPath path] - (.-params-idx path)) - -(defn selector-field [^TransformFunctions tfns] - (.-selector tfns)) - -;; amazingly doing this as a macro shows a big effect in the +;; amazingly doing this as a macro shows a big effect in the ;; benchmark for getting a value out of a nested map #+clj (defmacro compiled-traverse* [path result-fn structure] - `(let [tfns# (transform-fns-field ~path) - ex# (executors-field tfns#)] + `(let [nav# (compiled-nav-field ~path) + ex# (compiled-executors-field ~path)] ((traverse-executor-field ex#) - (params-field ~path) - (params-idx-field ~path) - (selector-field tfns#) + nav# ~result-fn ~structure) )) #+cljs (defn compiled-traverse* [path result-fn structure] - (let [tfns (transform-fns-field path) - ex (executors-field tfns)] + (let [nav (compiled-nav-field path) + ex (compiled-executors-field path)] ((traverse-executor-field ex) - (params-field path) - (params-idx-field path) - (selector-field tfns) + nav result-fn structure) )) @@ -771,385 +588,38 @@ (defn compiled-transform* [^com.rpl.specter.impl.CompiledPath path transform-fn structure] - (let [^com.rpl.specter.impl.TransformFunctions tfns (.-transform-fns path) - ^com.rpl.specter.impl.ExecutorFunctions ex (.-executors tfns)] - ((.-transform-executor ex) (.-params path) (.-params-idx path) (.-transformer tfns) transform-fn structure) + (let [nav (.-nav path) + ^com.rpl.specter.impl.ExecutorFunctions ex (.-executors path)] + ((.-transform-executor ex) nav transform-fn structure) )) -(defn not-selected?* - [compiled-path structure] - (->> structure - (compiled-select-any* compiled-path) - (identical? NONE))) -(defn selected?* - [compiled-path structure] - (not (not-selected?* compiled-path structure))) +(defn params-needed-nav + ^com.rpl.specter.impl.RichNavigator + [^com.rpl.specter.impl.ParamsNeededPath path] + (.-rich-nav path)) -(defn walk-select [pred continue-fn structure] - (let [ret (mutable-cell NONE) - walker (fn this [structure] - (if (pred structure) - (let [r (continue-fn structure)] - (if-not (identical? r NONE) - (set-cell! ret r)) - r - ) - (walk/walk this identity structure) - ))] - (walker structure) - (get-cell ret) +(defn compiled-path-rich-nav + ^com.rpl.specter.impl.RichNavigator + [^com.rpl.specter.impl.CompiledPath path] + (let [^com.rpl.specter.impl.ParameterizedRichNav pr (.-nav path)] + (.-rich-nav pr) )) -(defn key-select [akey structure next-fn] - (next-fn (get structure akey))) - -(defn key-transform [akey structure next-fn] - (assoc structure akey (next-fn (get structure akey)) - )) - -(defn all-select [structure next-fn] - (doseqres NONE [e structure] - (next-fn e))) - -#+cljs -(defn queue? [coll] - (= (type coll) (type #queue []))) - -#+clj -(defn queue? [coll] - (instance? clojure.lang.PersistentQueue coll)) - -(defprotocol AllTransformProtocol - (all-transform [structure next-fn])) - -(defn- non-transient-map-all-transform [structure next-fn empty-map] - (reduce-kv - (fn [m k v] - (let [[newk newv] (next-fn [k v])] - (assoc m newk newv) - )) - empty-map - structure - )) - -(extend-protocol AllTransformProtocol - nil - (all-transform [structure next-fn] - nil - ) - - ;; in cljs they're PersistentVector so don't need a special case - #+clj clojure.lang.MapEntry - #+clj - (all-transform [structure next-fn] - (let [newk (next-fn (key structure)) - newv (next-fn (val structure))] - (clojure.lang.MapEntry. newk newv) - )) - - #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector - (all-transform [structure next-fn] - (mapv next-fn structure)) - - #+clj - clojure.lang.PersistentArrayMap - #+clj - (all-transform [structure next-fn] - (let [k-it (.keyIterator structure) - v-it (.valIterator structure)] - (loop [ret {}] - (if (.hasNext k-it) - (let [k (.next k-it) - v (.next v-it) - [newk newv] (next-fn [k v])] - (recur (assoc ret newk newv))) - ret - )))) - - #+cljs - cljs.core/PersistentArrayMap - #+cljs - (all-transform [structure next-fn] - (non-transient-map-all-transform structure next-fn {}) - ) - - #+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap - (all-transform [structure next-fn] - (non-transient-map-all-transform structure next-fn (empty structure)) - ) - - #+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap - (all-transform [structure next-fn] - (persistent! - (reduce-kv - (fn [m k v] - (let [[newk newv] (next-fn [k v])] - (assoc! m newk newv) - )) - (transient - #+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY - ) - structure - ))) - - - #+clj - Object - #+clj - (all-transform [structure next-fn] - (let [empty-structure (empty structure)] - (cond (and (list? empty-structure) (not (queue? empty-structure))) - ;; this is done to maintain order, otherwise lists get reversed - (doall (map next-fn structure)) - - (map? structure) - ;; reduce-kv is much faster than doing r/map through call to (into ...) - (reduce-kv - (fn [m k v] - (let [[newk newv] (next-fn [k v])] - (assoc m newk newv) - )) - empty-structure - structure - ) - - :else - (->> structure (r/map next-fn) (into empty-structure)) - ))) - - #+cljs - default - #+cljs - (all-transform [structure next-fn] - (let [empty-structure (empty structure)] - (if (and (list? empty-structure) (not (queue? empty-structure))) - ;; this is done to maintain order, otherwise lists get reversed - (doall (map next-fn structure)) - (into empty-structure (map #(next-fn %)) structure) - ))) - ) - -(deftype AllNavigator []) - -(extend-protocol p/Navigator - AllNavigator - (select* [this structure next-fn] - (all-select structure next-fn)) - (transform* [this structure next-fn] - (all-transform structure next-fn))) - -(defprotocol MapValsTransformProtocol - (map-vals-transform [structure next-fn])) - -(defn map-vals-non-transient-transform [structure empty-map next-fn] - (reduce-kv - (fn [m k v] - (assoc m k (next-fn v))) - empty-map - structure)) - -(extend-protocol MapValsTransformProtocol - nil - (map-vals-transform [structure next-fn] - nil - ) - - #+clj - clojure.lang.PersistentArrayMap - #+clj - (map-vals-transform [structure next-fn] - (let [k-it (.keyIterator structure) - v-it (.valIterator structure)] - (loop [ret {}] - (if (.hasNext k-it) - (let [k (.next k-it) - v (.next v-it)] - (recur (assoc ret k (next-fn v)))) - ret - )))) - - #+cljs - cljs.core/PersistentArrayMap - #+cljs - (map-vals-transform [structure next-fn] - (map-vals-non-transient-transform structure {} next-fn) - ) - - #+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap - (map-vals-transform [structure next-fn] - (map-vals-non-transient-transform structure (empty structure) next-fn) - ) - - #+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap - (map-vals-transform [structure next-fn] - (persistent! - (reduce-kv - (fn [m k v] - (assoc! m k (next-fn v))) - (transient - #+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY - ) - structure - ))) - - #+clj Object #+cljs default - (map-vals-transform [structure next-fn] - (reduce-kv - (fn [m k v] - (assoc m k (next-fn v))) - (empty structure) - structure)) - ) - - -(deftype ValCollect []) - -(extend-protocol p/Collector - ValCollect - (collect-val [this structure] - structure)) - -(deftype PosNavigator [getter updater]) - -(extend-protocol p/Navigator - PosNavigator - (select* [this structure next-fn] - (if-not (fast-empty? structure) - (next-fn ((.-getter this) structure)) - NONE)) - (transform* [this structure next-fn] - (if (fast-empty? structure) - structure - ((.-updater this) structure next-fn)))) - -(defn srange-select [structure start end next-fn] - (next-fn (-> structure vec (subvec start end)))) - -(defn srange-transform [structure start end next-fn] - (let [structurev (vec structure) - newpart (next-fn (-> structurev (subvec start end))) - res (concat (subvec structurev 0 start) - newpart - (subvec structurev end (count structure)))] - (if (vector? structure) - (vec res) - res - ))) - -(defn- matching-indices [aseq p] - (keep-indexed (fn [i e] (if (p e) i)) aseq)) - -(defn matching-ranges [aseq p] - (first - (reduce - (fn [[ranges curr-start curr-last :as curr] i] - (cond - (nil? curr-start) - [ranges i i] - - (= i (inc curr-last)) - [ranges curr-start i] - - :else - [(conj ranges [curr-start (inc curr-last)]) i i] - )) - [[] nil nil] - (concat (matching-indices aseq p) [-1]) - ))) - -(extend-protocol p/Navigator - nil - (select* [this structure next-fn] - (next-fn structure)) - (transform* [this structure next-fn] - (next-fn structure) - )) - -(deftype TransientEndNavigator []) - -(extend-protocol p/Navigator - TransientEndNavigator - (select* [this structure next-fn] - (next-fn [])) - (transform* [this structure next-fn] - (let [res (next-fn [])] - (reduce conj! structure res)))) - -(defn extract-basic-filter-fn [path] - (cond (fn? path) +(defn coerce-compiled->rich-nav [path] + (if (instance? ParamsNeededPath path) + path + (let [nav (.-nav ^CompiledPath path)] + (if (satisfies? Navigator nav) + (no-params-rich-compiled-path (coerce-rich-navigator nav)) path + )))) - (and (coll? path) - (every? fn? path)) - (reduce - (fn [combined afn] - (fn [structure] - (and (combined structure) (afn structure)) - )) - path - ))) - - - -(defn if-select [params params-idx vals structure next-fn then-tester then-s then-params else-s] - (let [test? (then-tester structure) - sel (if test? - then-s - else-s) - idx (if test? params-idx (+ params-idx then-params))] - (sel params - idx - vals - structure - next-fn - ))) - -(defn if-transform [params params-idx vals structure next-fn then-tester then-t then-params else-t] - (let [test? (then-tester structure) - tran (if test? - then-t - else-t) - idx (if test? params-idx (+ params-idx then-params))] - (tran params - idx - vals - structure - next-fn - ))) - -(defn terminal* [params params-idx vals structure] - (let [afn (aget ^objects params params-idx)] - (if (identical? vals []) - (afn structure) - (apply afn (conj vals structure))) - )) - -(defn filter-select [afn structure next-fn] - (if (afn structure) - (next-fn structure) - NONE)) - -(defn filter-transform [afn structure next-fn] - (if (afn structure) - (next-fn structure) - structure)) - -(defn compiled-selector [^com.rpl.specter.impl.CompiledPath path] - (let [^com.rpl.specter.impl.TransformFunctions tfns (.-transform-fns path)] - (.-selector tfns))) - -(defn compiled-transformer [^com.rpl.specter.impl.CompiledPath path] - (let [^com.rpl.specter.impl.TransformFunctions tfns (.-transform-fns path)] - (.-transformer tfns))) - -(defn params-needed-selector [^com.rpl.specter.impl.ParamsNeededPath path] - (let [^com.rpl.specter.impl.TransformFunctions tfns (.-transform-fns path)] - (.-selector tfns))) - -(defn params-needed-transformer [^com.rpl.specter.impl.ParamsNeededPath path] - (let [^com.rpl.specter.impl.TransformFunctions tfns (.-transform-fns path)] - (.-transformer tfns))) +(defn fn-invocation? [f] + (or #+clj (instance? clojure.lang.Cons f) + #+clj (instance? clojure.lang.LazySeq f) + #+cljs (instance? cljs.core.LazySeq f) + (list? f))) (defrecord LayeredNav [underlying]) @@ -1160,8 +630,9 @@ (defn verify-layerable! [anav] (if-not - (and (instance? ParamsNeededPath anav) - (> (:num-needed-params anav) 0)) + (or (root-params-nav? anav) + (and (instance? ParamsNeededPath anav) + (> (:num-needed-params anav) 0))) (throw-illegal "defnavconstructor must be used on a navigator defined with defnav with at least one parameter") )) @@ -1206,6 +677,18 @@ ([] (must-cache-paths! true)) ([v] (set-cell! MUST-CACHE-PATHS v))) +(defn constant-node? [node] + (cond (record? node) false + (number? node) true + (keyword? node) true + (string? node) true + (vector? node) (every? constant-node? node) + (set? node) (every? constant-node? node) + (map? node) (and (every? constant-node? (vals node)) + (every? constant-node? (keys node))) + :else false + )) + (defn- extract-original-code [p] (cond (instance? LocalSym p) (:sym p) @@ -1216,8 +699,7 @@ )) (defn- valid-navigator? [v] - (or (structure-path? v) - (satisfies? p/Collector v) + (or (satisfies? p/ImplicitNav v) (instance? CompiledPath v))) #+cljs @@ -1228,17 +710,26 @@ (bind-params* precompiled params 0) )) +(defn filter-select [afn structure next-fn] + (if (afn structure) + (next-fn structure) + NONE)) + +(defn filter-transform [afn structure next-fn] + (if (afn structure) + (next-fn structure) + structure)) + (def pred* (->ParamsNeededPath - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] (let [afn (aget ^objects params params-idx)] (if (afn structure) (next-fn params (inc params-idx) vals structure) NONE ))) - (fn [params params-idx vals structure next-fn] + (rich-transform* [this params params-idx vals structure next-fn] (let [afn (aget ^objects params params-idx)] (if (afn structure) (next-fn params (inc params-idx) vals structure) @@ -1247,29 +738,48 @@ 1 )) +(def collected?* + (->ParamsNeededPath + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] + (let [afn (aget ^objects params params-idx)] + (if (afn vals) + (next-fn params (inc params-idx) vals structure) + NONE + ))) + (rich-transform* [this params params-idx vals structure next-fn] + (let [afn (aget ^objects params params-idx)] + (if (afn vals) + (next-fn params (inc params-idx) vals structure) + structure + )))) + 1 + )) + (def rich-compiled-path-proxy (->ParamsNeededPath - (->TransformFunctions - RichPathExecutor - (fn [params params-idx vals structure next-fn] + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] (let [apath ^CompiledPath (aget ^objects params params-idx) - transform-fns ^TransformFunctions (.-transform-fns apath) - selector (.-selector transform-fns)] - (selector - (.-params apath) - (.-params-idx apath) + pnav ^ParameterizedRichNav (.-nav apath) + nav (.-rich-nav pnav)] + (exec-rich-select* + nav + (.-params pnav) + (.-params-idx pnav) vals structure (fn [_ _ vals-next structure-next] (next-fn params params-idx vals-next structure-next)) ))) - (fn [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) - transform-fns ^TransformFunctions (.-transform-fns apath) - transformer (.-transformer transform-fns)] - (transformer - (.-params apath) - (.-params-idx apath) + pnav ^ParameterizedRichNav (.-nav apath) + nav (.-rich-nav pnav)] + (exec-rich-transform* + nav + (.-params pnav) + (.-params-idx pnav) vals structure (fn [_ _ vals-next structure-next] @@ -1278,6 +788,41 @@ 1 )) +(def lean-compiled-path-proxy + (->ParamsNeededPath + (reify RichNavigator + (rich-select* [this params params-idx vals structure next-fn] + (let [^CompiledPath apath (aget ^objects params params-idx) + ^Navigator nav (.-nav apath)] + (exec-select* + nav + structure + (fn [structure-next] + (next-fn params params-idx vals structure-next)) + ))) + (rich-transform* [this params params-idx vals structure next-fn] + (let [^CompiledPath apath (aget ^objects params params-idx) + ^Navigator nav (.-nav apath)] + (exec-transform* + nav + structure + (fn [structure-next] + (next-fn params params-idx vals structure-next)) + )))) + 1 + )) + +(defn srange-transform* [structure start end next-fn] + (let [structurev (vec structure) + newpart (next-fn (-> structurev (subvec start end))) + res (concat (subvec structurev 0 start) + newpart + (subvec structurev end (count structure)))] + (if (vector? structure) + (vec res) + res + ))) + (defn- variadic-arglist? [al] (contains? (set al) '&)) @@ -1293,7 +838,7 @@ (when-not ret (throw-illegal "Invalid # arguments at " code)) (if (variadic-arglist? ret) - (srange-transform ret (- len 2) len + (srange-transform* ret (- len 2) len (fn [_] (repeatedly (- c (- len 2)) gensym))) ret ))) @@ -1347,15 +892,13 @@ (if (-> v meta :dynamic) (magic-fail! "Var " (:sym op) " is dynamic") (cond - (instance? ParamsNeededPath vv) - ;;TODO: if all params are constants, then just bind the path right here - ;;otherwise, add the params - ;; - could extend this to see if it contains nested function calls which - ;; are only on constants - (do - (swap! params-atom #(vec (concat % ps))) - vv - ) + (or (root-params-nav? vv) (instance? ParamsNeededPath vv)) + (if (every? constant-node? ps) + (apply vv ps) + (do + (swap! params-atom #(vec (concat % ps))) + (coerce-path vv) + )) (and (fn? vv) (-> v meta :pathedfn)) ;;TODO: update this to ignore args that aren't symbols or have :nopath @@ -1394,10 +937,14 @@ )) (and (fn? vv) (-> vv meta :layerednav)) - (do - (swap! params-atom conj (:code p)) - rich-compiled-path-proxy - ) + (if (every? constant-node? ps) + (apply vv ps) + (do + (swap! params-atom conj (:code p)) + (if (= (-> vv meta :layerednav) :lean) + lean-compiled-path-proxy + rich-compiled-path-proxy + ))) :else (magic-fail! "Var " (:sym op) " must be either a parameterized " @@ -1517,13 +1064,14 @@ m (-> protpath-prot :sigs keys first) expected-params (num-needed-params protpath)] (doseq [[atype apath] extensions] - (let [p (comp-paths* apath) - rp (assoc p :transform-fns (coerce-tfns-rich (:transform-fns p))) - needed-params (num-needed-params rp)] + (let [p (comp-paths-internalized apath) + needed-params (num-needed-params p) + rich-nav (extract-rich-nav p) + ] (if-not (= needed-params expected-params) (throw-illegal "Invalid number of params in extended protocol path, expected " expected-params " but got " needed-params)) - (extend atype protpath-prot {m (fn [_] rp)}) + (extend atype protpath-prot {m (fn [_] rich-nav)}) )))) (defn parameterize-path [apath params params-idx] @@ -1532,13 +1080,8 @@ (bind-params* apath params params-idx) )) -(defn extract-rich-tfns [apath] - (let [tfns (coerce-tfns-rich (:transform-fns apath))] - [(:selector tfns) (:transformer tfns)] - )) - (defn mk-jump-next-fn [next-fn init-idx total-params] (let [jumped (+ init-idx total-params)] (fn [params params-idx vals structure] (next-fn params jumped vals structure) - ))) \ No newline at end of file + ))) diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index 7fb4f46..4efe10e 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -1,6 +1,9 @@ (ns com.rpl.specter.macros + (:use [com.rpl.specter.protocols :only [Navigator]] + [com.rpl.specter.impl :only [RichNavigator]]) (:require [com.rpl.specter.impl :as i] - [clojure.walk :as cljwalk]) + [clojure.walk :as cljwalk] + [com.rpl.specter.defnavhelpers :as dnh]) ) (defn ^:no-doc gensyms [amt] @@ -8,352 +11,352 @@ (defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]] (if-not (= #{name1 name2} #{'select* 'transform*}) - (i/throw-illegal "defpath must implement select* and transform*, instead got " - name1 " and " name2)) + (i/throw-illegal "defnav must implement select* and transform*, instead got " + name1 " and " name2)) (if (= name1 'select*) [impl1 impl2] [impl2 impl1])) - -(def ^:no-doc PARAMS-SYM (vary-meta (gensym "params") assoc :tag 'objects)) -(def ^:no-doc PARAMS-IDX-SYM (gensym "params-idx")) - -(defn ^:no-doc paramsnav* [bindings num-params [impl1 impl2]] - (let [[[[_ s-structure-sym s-next-fn-sym] & select-body] - [[_ t-structure-sym t-next-fn-sym] & transform-body]] - (determine-params-impls impl1 impl2)] - (if (= 0 num-params) - `(i/no-params-compiled-path - (i/->TransformFunctions - i/LeanPathExecutor - (fn [~s-structure-sym ~s-next-fn-sym] - ~@select-body) - (fn [~t-structure-sym ~t-next-fn-sym] - ~@transform-body) - )) - `(i/->ParamsNeededPath - (i/->TransformFunctions - i/RichPathExecutor - (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#] - (let [~s-next-fn-sym (fn [structure#] - (next-fn# - ~PARAMS-SYM - (+ ~PARAMS-IDX-SYM ~num-params) - vals# - structure#)) - ~@bindings] - ~@select-body - )) - (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~t-structure-sym next-fn#] - (let [~t-next-fn-sym (fn [structure#] - (next-fn# - ~PARAMS-SYM - (+ ~PARAMS-IDX-SYM ~num-params) - vals# - structure#)) - ~@bindings] - ~@transform-body - ))) - ~num-params +(defmacro richnav + "Defines a navigator with full access to collected vals, the parameters array, + and the parameters array index. `next-fn` expects to receive the params array, + a params index, the collected vals, and finally the next structure. + `next-fn` will automatically skip ahead in params array by `num-params`, so the + index passed to it is ignored. + This is the lowest level way of making navigators." + [num-params impl1 impl2] + (let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2) + s-next-fn-sym (last s-params) + s-pidx-sym (nth s-params 2) + t-next-fn-sym (last t-params) + t-pidx-sym (nth t-params 2) + ] + `(let [num-params# ~num-params + nav# (reify RichNavigator + (~'rich-select* ~s-params + (let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)] + ~@s-body)) + (~'rich-transform* ~t-params + (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] + ~@t-body)) + )] + (if (zero? num-params#) + (i/no-params-rich-compiled-path nav#) + (i/->ParamsNeededPath nav# num-params#) )))) -(defn ^:no-doc paramscollector* [post-bindings num-params [_ [_ structure-sym] & body]] - `(let [collector# (fn [~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#] - (let [~@post-bindings ~@[] ; to avoid syntax highlighting issues - c# (do ~@body)] - (next-fn# - ~PARAMS-SYM - (+ ~PARAMS-IDX-SYM ~num-params) - (conj vals# c#) - ~structure-sym) - ))] - (i/->ParamsNeededPath - (i/->TransformFunctions - i/RichPathExecutor - collector# - collector# ) - ~num-params +(defmacro ^:no-doc lean-nav* [& impls] + `(reify Navigator ~@impls)) + +(defn ^:no-doc operation-with-bindings [bindings params-sym params-idx-sym op-maker] + (let [bindings (partition 2 bindings) + binding-fn-syms (gensyms (count bindings)) + binding-syms (map first bindings) + fn-exprs (map second bindings) + binding-fn-declarations (vec (mapcat vector binding-fn-syms fn-exprs)) + binding-declarations (vec (mapcat (fn [s f] [s `(~f ~params-sym ~params-idx-sym)]) + binding-syms + binding-fn-syms)) + body (op-maker binding-declarations)] + `(let [~@binding-fn-declarations] + ~body ))) -(defn ^:no-doc pathed-nav* [builder paths-seq latefns-sym pre-bindings post-bindings impls] - (let [num-params-sym (gensym "num-params")] - `(let [paths# (map i/comp-paths* ~paths-seq) - needed-params# (map i/num-needed-params paths#) - offsets# (cons 0 (reductions + needed-params#)) - any-params-needed?# (->> paths# - (filter i/params-needed-path?) - empty? - not) - ~num-params-sym (last offsets#) - ~latefns-sym (map - (fn [o# p#] - (if (i/compiled-path? p#) - (fn [params# params-idx#] - p# ) - (fn [params# params-idx#] - (i/bind-params* p# params# (+ params-idx# o#)) - ))) - offsets# - paths#) - ~@pre-bindings - ret# ~(builder post-bindings num-params-sym impls) - ] - (if (not any-params-needed?#) - (i/bind-params* ret# nil 0) - ret# - )))) +(defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls] + (let [[[[_ s-structure-sym s-next-fn-sym] & s-body] + [[_ t-structure-sym t-next-fn-sym] & t-body]] + (apply determine-params-impls impls) + params-sym (gensym "params") + params-idx-sym (gensym "params-idx") + ] + (operation-with-bindings + bindings + params-sym + params-idx-sym + (fn [binding-declarations] + `(reify RichNavigator + (~'rich-select* [this# ~params-sym ~params-idx-sym vals# ~s-structure-sym next-fn#] + (let [~@binding-declarations + next-params-idx# (+ ~params-idx-sym ~num-params-code) + ~s-next-fn-sym (fn [structure#] + (next-fn# ~params-sym + next-params-idx# + vals# + structure#))] + ~@s-body + )) + (~'rich-transform* [this# ~params-sym ~params-idx-sym vals# ~t-structure-sym next-fn#] + (let [~@binding-declarations + next-params-idx# (+ ~params-idx-sym ~num-params-code) + ~t-next-fn-sym (fn [structure#] + (next-fn# ~params-sym + next-params-idx# + vals# + structure#))] + ~@t-body + )) + ))))) -(defn ^:no-doc make-param-retrievers [params] +(defmacro ^:no-doc collector-with-bindings [num-params-code bindings impl] + (let [[_ [_ structure-sym] & body] impl + params-sym (gensym "params") + params-idx-sym (gensym "params")] + (operation-with-bindings + bindings + params-sym + params-idx-sym + (fn [binding-declarations] + `(let [num-params# ~num-params-code + cfn# (fn [~params-sym ~params-idx-sym vals# ~structure-sym next-fn#] + (let [~@binding-declarations] + (next-fn# ~params-sym (+ ~params-idx-sym num-params#) (conj vals# (do ~@body)) ~structure-sym) + ))] + (reify RichNavigator + (~'rich-select* [this# 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#] + (cfn# params# params-idx# vals# structure# next-fn#)) + )))))) + +(defn- delta-param-bindings [params] (->> params - (map-indexed - (fn [i p] - [p `(aget ~PARAMS-SYM - (+ ~PARAMS-IDX-SYM ~i))] - )) - (apply concat))) - + (map-indexed (fn [i p] [p `(dnh/param-delta ~i)])) + (apply concat) + vec + )) (defmacro nav "Defines a navigator with late bound parameters. This navigator can be precompiled with other navigators without knowing the parameters. When precompiled with other navigators, the resulting path takes in parameters for all navigators in the path that needed parameters (in the order in which they were declared)." - [params impl1 impl2] - (let [num-params (count params) - retrieve-params (make-param-retrievers params)] - (paramsnav* retrieve-params num-params [impl1 impl2]) - )) + [params & impls] + (if (empty? params) + `(i/lean-compiled-path (lean-nav* ~@impls)) + `(vary-meta + (fn ~params (i/lean-compiled-path (lean-nav* ~@impls))) + assoc + :highernav + {:type :lean + :params-needed-path + (i/->ParamsNeededPath + (rich-nav-with-bindings ~(count params) + ~(delta-param-bindings params) + ~@impls + ) + ~(count params))} + ))) -(defmacro richnav - "Defines a navigator with full access to collected vals, the parameters array, - and the parameters array index. `next-fn` expects to receive the params array, - a params index, the collected vals, and finally the next structure. - `next-fn` will automatically skip ahead in params array by `num-params`, so the - index passed to it is ignored. - This is the lowest level way of making navigators." - [num-params impl1 impl2] - (let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2) - s-next-fn-sym (last s-params) - s-pidx-sym (second s-params) - t-next-fn-sym (last t-params) - t-pidx-sym (second t-params) - ] - `(let [num-params# ~num-params - tfns# (i/->TransformFunctions - i/RichPathExecutor - (fn ~s-params - (let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)] - ~@s-body)) - (fn ~t-params - (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] - ~@t-body)) - )] - (if (zero? num-params#) - (i/no-params-compiled-path tfns#) - (i/->ParamsNeededPath tfns# num-params#) - )))) - -(defmacro paramsfn [params [structure-sym] & impl] - `(nav ~params - (~'select* [this# structure# next-fn#] - (let [afn# (fn [~structure-sym] ~@impl)] - (i/filter-select afn# structure# next-fn#) - )) - (~'transform* [this# structure# next-fn#] - (let [afn# (fn [~structure-sym] ~@impl)] - (i/filter-transform afn# structure# next-fn#) - )))) - -(defmacro paramscollector +(defmacro collector "Defines a Collector with late bound parameters. This collector can be precompiled with other selectors without knowing the parameters. When precompiled with other selectors, the resulting selector takes in parameters for all selectors in the path that needed parameters (in the order in which they were declared). - " - [params impl] - (let [num-params (count params) - retrieve-params (make-param-retrievers params)] - (paramscollector* retrieve-params num-params impl) - )) + " + [params body] + `(let [rich-nav# (collector-with-bindings ~(count params) + ~(delta-param-bindings params) + ~body + )] + (if ~(empty? params) + (i/no-params-rich-compiled-path rich-nav#) + (vary-meta + (fn ~params + (i/no-params-rich-compiled-path + (collector-with-bindings 0 [] + ~body))) + assoc + :highernav + {:type :rich + :params-needed-path + (i/->ParamsNeededPath + rich-nav# + ~(count params) + )} + )))) + +(defn ^:no-doc fixed-pathed-operation [bindings op-maker] + (let [bindings (partition 2 bindings) + late-path-syms (map first bindings) + paths-code (vec (map second bindings)) + delta-syms (vec (gensyms (count bindings))) + compiled-syms (vec (gensyms (count bindings))) + runtime-bindings (vec (mapcat + (fn [l c d] + `[~l (dnh/bound-params ~c ~d)] + ) + late-path-syms + compiled-syms + delta-syms)) + total-params-sym (gensym "total-params") + body (op-maker runtime-bindings compiled-syms total-params-sym)] + `(let [compiled# (doall (map i/comp-paths* ~paths-code)) + ~compiled-syms compiled# + deltas# (cons 0 (reductions + (map i/num-needed-params compiled#))) + ~delta-syms deltas# + ~total-params-sym (last deltas#) + ] + ~body + ))) + +(defmacro fixed-pathed-nav + "This helper is used to define navigators that take in a fixed number of other + paths as input. Those paths may require late-bound params, so this helper + will create a parameterized navigator if that is the case. If no late-bound params + are required, then the result is executable." + [bindings & impls] + (fixed-pathed-operation bindings + (fn [runtime-bindings compiled-syms total-params-sym] + (let [late-syms (map first (partition 2 bindings)) + lean-bindings (mapcat vector late-syms compiled-syms)] + `(if (zero? ~total-params-sym) + (let [~@lean-bindings] + (i/lean-compiled-path (lean-nav* ~@impls)) + ) + (i/->ParamsNeededPath + (rich-nav-with-bindings ~total-params-sym + ~runtime-bindings + ~@impls + ) + ~total-params-sym + ))) + ))) + + +(defmacro fixed-pathed-collector + "This helper is used to define collectors that take in a fixed number of + paths as input. That path may require late-bound params, so this helper + will create a parameterized navigator if that is the case. If no late-bound params + are required, then the result is executable." + [bindings & body] + (fixed-pathed-operation bindings + (fn [runtime-bindings compiled-syms total-params-sym] + (let [late-syms (map first (partition 2 bindings)) + lean-bindings (mapcat vector late-syms compiled-syms)] + `(if (zero? ~total-params-sym) + (let [~@lean-bindings] + (i/no-params-rich-compiled-path + (collector-with-bindings 0 [] ~@body))) + (i/->ParamsNeededPath + (collector-with-bindings ~total-params-sym + ~runtime-bindings + ~@body + ) + ~total-params-sym + )))))) + +(defmacro paramsfn [params [structure-sym] & impl] + `(nav ~params + (~'select* [this# structure# next-fn#] + (let [afn# (fn [~structure-sym] ~@impl)] + (i/filter-select afn# structure# next-fn#) + )) + (~'transform* [this# structure# next-fn#] + (let [afn# (fn [~structure-sym] ~@impl)] + (i/filter-transform afn# structure# next-fn#) + )))) (defmacro defnav [name & body] `(def ~name (nav ~@body))) (defmacro defcollector [name & body] - `(def ~name (paramscollector ~@body))) + `(def ~name (collector ~@body))) -(defmacro fixed-pathed-nav - "This helper is used to define navigators that take in a fixed number of other - paths as input. Those paths may require late-bound params, so this helper - will create a parameterized navigator if that is the case. If no late-bound params - are required, then the result is executable." - [bindings impl1 impl2] - (let [bindings (partition 2 bindings) - paths (mapv second bindings) - names (mapv first bindings) - latefns-sym (gensym "latefns") - latefn-syms (vec (gensyms (count paths)))] - (pathed-nav* - paramsnav* - paths - latefns-sym - [latefn-syms latefns-sym] - (mapcat (fn [n l] [n `(~l ~PARAMS-SYM ~PARAMS-IDX-SYM)]) names latefn-syms) - [impl1 impl2]))) - -(defmacro variable-pathed-nav - "This helper is used to define navigators that take in a variable number of other - paths as input. Those paths may require late-bound params, so this helper - will create a parameterized navigator if that is the case. If no late-bound params - are required, then the result is executable." - [[latepaths-seq-sym paths-seq] impl1 impl2] - (let [latefns-sym (gensym "latefns")] - (pathed-nav* - paramsnav* - paths-seq - latefns-sym - [] - [latepaths-seq-sym `(map (fn [l#] (l# ~PARAMS-SYM ~PARAMS-IDX-SYM)) - ~latefns-sym)] - [impl1 impl2] - ))) - -(defmacro pathed-collector - "This helper is used to define collectors that take in a single selector - paths as input. That path may require late-bound params, so this helper - will create a parameterized selector if that is the case. If no late-bound params - are required, then the result is executable." - [[name path] impl] - (let [latefns-sym (gensym "latefns") - latefn (gensym "latefn")] - (pathed-nav* - paramscollector* - [path] - latefns-sym - [[latefn] latefns-sym] - [name `(~latefn ~PARAMS-SYM ~PARAMS-IDX-SYM)] - impl - ) - )) (defn- protpath-sym [name] (-> name (str "-prot") symbol)) + (defmacro defprotocolpath "Defines a navigator that chooses the path to take based on the type - of the value at the current point. May be specified with parameters to - specify that all extensions must require that number of parameters. + of the value at the current point. May be specified with parameters to + specify that all extensions must require that number of parameters. - Currently not available for ClojureScript. + Currently not available for ClojureScript. - Example of usage: - (defrecord SingleAccount [funds]) - (defrecord FamilyAccount [single-accounts]) + Example of usage: + (defrecord SingleAccount [funds]) + (defrecord FamilyAccount [single-accounts]) - (defprotocolpath FundsPath) - (extend-protocolpath FundsPath + (defprotocolpath FundsPath) + (extend-protocolpath FundsPath SingleAccount :funds FamilyAccount [ALL FundsPath] ) - " +" ([name] - `(defprotocolpath ~name [])) + `(defprotocolpath ~name [])) ([name params] - (let [prot-name (protpath-sym name) - m (-> name (str "-retrieve") symbol) - num-params (count params) - ssym (gensym "structure") - rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")] - retrieve `(~m ~ssym) - ] - `(do - (defprotocol ~prot-name (~m [structure#])) + (let [prot-name (protpath-sym name) + m (-> name (str "-retrieve") symbol) + num-params (count params) + ssym (gensym "structure") + rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")] + retrieve `(~m ~ssym) + ] + `(do + (defprotocol ~prot-name (~m [structure#])) + (let [nav# (reify RichNavigator + (~'rich-select* [this# ~@rargs] + (let [inav# ~retrieve] + (i/exec-rich-select* inav# ~@rargs) + )) + (~'rich-transform* [this# ~@rargs] + (let [inav# ~retrieve] + (i/exec-rich-transform* inav# ~@rargs) + )))] (def ~name (if (= ~num-params 0) - (i/no-params-compiled-path - (i/->TransformFunctions - i/RichPathExecutor - (fn ~rargs - (let [path# ~retrieve - selector# (i/compiled-selector path#)] - (selector# ~@rargs) - )) - (fn ~rargs - (let [path# ~retrieve - transformer# (i/compiled-transformer path#)] - (transformer# ~@rargs) - )))) - (i/->ParamsNeededPath - (i/->TransformFunctions - i/RichPathExecutor - (fn ~rargs - (let [path# ~retrieve - selector# (i/params-needed-selector path#)] - (selector# ~@rargs) - )) - (fn ~rargs - (let [path# ~retrieve - transformer# (i/params-needed-transformer path#)] - (transformer# ~@rargs) - ))) - ~num-params - ) - )))))) + (i/no-params-rich-compiled-path nav#) + (i/->ParamsNeededPath nav# ~num-params) + ))))))) + + (defn ^:no-doc declared-name [name] (vary-meta (symbol (str name "-declared")) assoc :no-doc true)) + (defmacro declarepath ([name] - `(declarepath ~name [])) + `(declarepath ~name [])) ([name params] - (let [num-params (count params) - declared (declared-name name) - rargs [(gensym "params") (gensym "pidx") (gensym "vals") - (gensym "structure") (gensym "next-fn")]] - `(do - (declare ~declared) - (def ~name - (if (= ~num-params 0) - (i/no-params-compiled-path - (i/->TransformFunctions - i/RichPathExecutor - (fn ~rargs - (let [selector# (i/compiled-selector ~declared)] - (selector# ~@rargs) - )) - (fn ~rargs - (let [transformer# (i/compiled-transformer ~declared)] - (transformer# ~@rargs) - )))) - (i/->ParamsNeededPath - (i/->TransformFunctions - i/RichPathExecutor - (fn ~rargs - (let [selector# (i/params-needed-selector ~declared)] - (selector# ~@rargs) - )) - (fn ~rargs - (let [transformer# (i/params-needed-transformer ~declared)] - (transformer# ~@rargs) - ))) - ~num-params - ) - )))))) + (let [platform (if (contains? &env :locals) :cljs :clj) + select-exec (if (= platform :clj) + `i/exec-rich-select* + `i/rich-select*) + transform-exec (if (= platform :clj) + `i/exec-rich-transform* + `i/rich-transform*) + num-params (count params) + declared (declared-name name) + rargs [(gensym "params") (gensym "pidx") (gensym "vals") + (gensym "structure") (gensym "next-fn")]] + `(do + (declare ~declared) + (def ~name + (let [nav# (reify RichNavigator + (~'rich-select* [this# ~@rargs] + (~select-exec ~declared ~@rargs)) + (~'rich-transform* [this# ~@rargs] + (~transform-exec ~declared ~@rargs) + ))] + (if (= ~num-params 0) + (i/no-params-rich-compiled-path nav#) + (i/->ParamsNeededPath nav# ~num-params) + ))))))) (defmacro providepath [name apath] - `(let [comped# (i/comp-paths* ~apath) + `(let [comped# (i/comp-paths-internalized ~apath) expected-params# (i/num-needed-params ~name) needed-params# (i/num-needed-params comped#)] (if-not (= needed-params# expected-params#) (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) - (update-in comped# - [:transform-fns] - i/coerce-tfns-rich) + (i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)) ))) (defmacro extend-protocolpath @@ -364,14 +367,14 @@ ;; copied from tools.macro to avoid the dependency (defn ^:no-doc name-with-attributes "To be used in macro definitions. - Handles optional docstrings and attribute maps for a name to be defined - in a list of macro arguments. If the first macro argument is a string, - it is added as a docstring to name and removed from the macro argument - list. If afterwards the first macro argument is a map, its entries are - added to the name's metadata map and the map is removed from the - macro argument list. The return value is a vector containing the name - with its extended metadata map and the list of unprocessed macro - arguments." + Handles optional docstrings and attribute maps for a name to be defined + in a list of macro arguments. If the first macro argument is a string, + it is added as a docstring to name and removed from the macro argument + list. If afterwards the first macro argument is a map, its entries are + added to the name's metadata map and the map is removed from the + macro argument list. The return value is a vector containing the name + with its extended metadata map and the list of unprocessed macro + arguments." [name macro-args] (let [[docstring macro-args] (if (string? (first macro-args)) [(first macro-args) (next macro-args)] @@ -389,14 +392,14 @@ (defmacro defpathedfn "Defines a higher order navigator that itself takes in one or more paths - as input. This macro is generally used in conjunction with [[fixed-pathed-nav]] - or [[variable-pathed-nav]]. When inline factoring is applied to a path containing - one of these higher order navigators, it will automatically interepret all - arguments as paths, factor them accordingly, and set up the callsite to - provide the parameters dynamically. Use ^:notpath metadata on arguments - to indicate non-path arguments that should not be factored – note that in order - to be inline factorable, these arguments must be statically resolvable (e.g. a - top level var). See `transformed` for an example." + as input. This macro is generally used in conjunction with [[fixed-pathed-nav]] + or [[variable-pathed-nav]]. When inline factoring is applied to a path containing + one of these higher order navigators, it will automatically interepret all + arguments as paths, factor them accordingly, and set up the callsite to + provide the parameters dynamically. Use ^:notpath metadata on arguments + to indicate non-path arguments that should not be factored – note that in order + to be inline factorable, these arguments must be statically resolvable (e.g. a + top level var). See `transformed` for an example." [name & args] (let [[name args] (name-with-attributes name args) name (vary-meta name assoc :pathedfn true)] @@ -405,26 +408,27 @@ (defmacro defnavconstructor [name & args] (let [[name [[csym anav] & body-or-bodies]] (name-with-attributes name args) bodies (if (-> body-or-bodies first vector?) [body-or-bodies] body-or-bodies) - + checked-code (doall - (for [[args & body] bodies] - `(~args - (let [ret# (do ~@body)] - (if (i/layered-nav? ret#) - (i/layered-nav-underlying ret#) - (i/throw-illegal "Expected result navigator '" (quote ~anav) - "' from nav constructor '" (quote ~name) "'" - " constructed with the provided constructor '" (quote ~csym) - "'")) - ))))] + (for [[args & body] bodies] + `(~args + (let [ret# (do ~@body)] + (if (i/layered-nav? ret#) + (i/layered-nav-underlying ret#) + (i/throw-illegal "Expected result navigator '" (quote ~anav) + "' from nav constructor '" (quote ~name) "'" + " constructed with the provided constructor '" (quote ~csym) + "'")) + ))))] `(def ~name (vary-meta - (let [~csym (i/layered-wrapper ~anav)] - (fn ~@checked-code)) - assoc :layerednav true)) - )) - + (let [~csym (i/layered-wrapper ~anav)] + (fn ~@checked-code)) + assoc :layerednav (or (-> ~anav meta :highernav :type) :rich) + )) + )) + (defn ^:no-doc ic-prepare-path [locals-set path] (cond @@ -440,14 +444,14 @@ (i/fn-invocation? path) (let [[op & params] path] - ;; need special case for 'fn since macroexpand does NOT + ;; need special case for 'fn since macroexpand does NOT ;; expand fn when run on cljs code, but it's also not considered a special symbol (if (or (= 'fn op) (special-symbol? op)) `(com.rpl.specter.impl/->SpecialFormUse ~path (quote ~path)) `(com.rpl.specter.impl/->FnInvocation - ~(ic-prepare-path locals-set op) - ~(mapv #(ic-prepare-path locals-set %) params) - (quote ~path))) + ~(ic-prepare-path locals-set op) + ~(mapv #(ic-prepare-path locals-set %) params) + (quote ~path))) ) :else @@ -457,21 +461,21 @@ (defn ^:no-doc ic-possible-params [path] (do (mapcat - (fn [e] - (cond (or (set? e) - (map? e) ; in case inline maps are ever extended - (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) - [e] + (fn [e] + (cond (or (set? e) + (map? e) ; in case inline maps are ever extended + (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) + [e] - (i/fn-invocation? e) - ;; the [e] here handles nav constructors - (concat [e] (rest e) (ic-possible-params e)) + (i/fn-invocation? e) + ;; the [e] here handles nav constructors + (concat [e] (rest e) (ic-possible-params e)) - (vector? e) - (ic-possible-params e) - )) - path - ))) + (vector? e) + (ic-possible-params e) + )) + path + ))) (defn cljs-macroexpand [env form] (let [expand-fn (i/cljs-analyzer-macroexpand-1) @@ -496,32 +500,32 @@ ;; still possible to mess this up with alter-var-root (defmacro path "Same as calling comp-paths, except it caches the composition of the static part - of the path for later re-use (when possible). For almost all idiomatic uses - of Specter provides huge speedup. This macro is automatically used by the - select/transform/setval/replace-in/etc. macros." + of the path for later re-use (when possible). For almost all idiomatic uses + of Specter provides huge speedup. This macro is automatically used by the + select/transform/setval/replace-in/etc. macros." [& path] (let [;;this is a hack, but the composition of &env is considered stable for cljs platform (if (contains? &env :locals) :cljs :clj) local-syms (if (= platform :cljs) - (-> &env :locals keys set) ;cljs - (-> &env keys set) ;clj - ) + (-> &env :locals keys set) ;cljs + (-> &env keys set) ;clj + ) used-locals-cell (i/mutable-cell []) _ (cljwalk/postwalk - (fn [e] - (if (local-syms e) - (i/update-cell! used-locals-cell #(conj % e)) - e - )) - path) + (fn [e] + (if (local-syms e) + (i/update-cell! used-locals-cell #(conj % e)) + e + )) + path) used-locals (i/get-cell used-locals-cell) ;; note: very important to use riddley's macroexpand-all here, so that ;; &env is preserved in any potential nested calls to select (like via ;; a view function) expanded (if (= platform :clj) - (i/clj-macroexpand-all (vec path)) - (cljs-macroexpand-all &env (vec path))) + (i/clj-macroexpand-all (vec path)) + (cljs-macroexpand-all &env (vec path))) prepared-path (ic-prepare-path local-syms expanded) possible-params (vec (ic-possible-params expanded)) @@ -530,22 +534,22 @@ ;; to invoke and/or parameterize the precompiled path without ;; a bunch of checks beforehand cache-sym (vary-meta - (gensym "pathcache") - assoc :cljs.analyzer/no-resolve true) + (gensym "pathcache") + assoc :cljs.analyzer/no-resolve true) info-sym (gensym "info") get-cache-code (if (= platform :clj) `(try (i/get-cell ~cache-sym) - (catch ClassCastException e# - (if (bound? (var ~cache-sym)) - (throw e#) - (do - (alter-var-root - (var ~cache-sym) - (fn [_#] (i/mutable-cell))) - nil - )))) + (catch ClassCastException e# + (if (bound? (var ~cache-sym)) + (throw e#) + (do + (alter-var-root + (var ~cache-sym) + (fn [_#] (i/mutable-cell))) + nil + )))) cache-sym ) add-cache-code (if (= platform :clj) @@ -560,28 +564,28 @@ (if (= platform :clj) `(i/bind-params* ~precompiled-sym (~params-maker-sym ~@used-locals) 0) `(i/handle-params - ~precompiled-sym - ~params-maker-sym - ~(mapv (fn [p] `(fn [] ~p)) possible-params) - )) + ~precompiled-sym + ~params-maker-sym + ~(mapv (fn [p] `(fn [] ~p)) possible-params) + )) ] (if (= platform :clj) (i/intern* *ns* cache-sym (i/mutable-cell))) `(let [info# ~get-cache-code - + ^com.rpl.specter.impl.CachedPathInfo info# - (if (nil? info#) - (let [~info-sym (i/magic-precompilation - ~prepared-path - ~(str *ns*) - (quote ~used-locals) - (quote ~possible-params) - )] - ~add-cache-code - ~info-sym - ) - info# - ) + (if (nil? info#) + (let [~info-sym (i/magic-precompilation + ~prepared-path + ~(str *ns*) + (quote ~used-locals) + (quote ~possible-params) + )] + ~add-cache-code + ~info-sym + ) + info# + ) ~precompiled-sym (.-precompiled info#) ~params-maker-sym (.-params-maker info#)] @@ -592,112 +596,112 @@ ~handle-params-code ) )) - )) + )) (defmacro select "Navigates to and returns a sequence of all the elements specified by the path. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-select* (path ~apath) ~structure)) (defmacro select-one! "Returns exactly one element, throws exception if zero or multiple elements found. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-select-one!* (path ~apath) ~structure)) (defmacro select-one "Like select, but returns either one element or nil. Throws exception if multiple elements found. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-select-one* (path ~apath) ~structure)) (defmacro select-first "Returns first element found. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-select-first* (path ~apath) ~structure)) (defmacro select-any "Returns any element found or [[NONE]] if nothing selected. This is the most - efficient of the various selection operations. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + efficient of the various selection operations. + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-select-any* (path ~apath) ~structure)) (defmacro selected-any? "Returns true if any element was selected, false otherwise. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-selected-any?* (path ~apath) ~structure)) (defmacro transform "Navigates to each value specified by the path and replaces it by the result of running - the transform-fn on it. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + the transform-fn on it. + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath transform-fn structure] `(i/compiled-transform* (path ~apath) ~transform-fn ~structure)) (defmacro multi-transform "Just like `transform` but expects transform functions to be specified - inline in the path using `terminal`. Error is thrown if navigation finishes - at a non-`terminal` navigator. `terminal-val` is a wrapper around `terminal` and is - the `multi-transform` equivalent of `setval`. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + inline in the path using `terminal`. Error is thrown if navigation finishes + at a non-`terminal` navigator. `terminal-val` is a wrapper around `terminal` and is + the `multi-transform` equivalent of `setval`. + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/compiled-multi-transform* (path ~apath) ~structure)) (defmacro setval "Navigates to each value specified by the path and replaces it by `aval`. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath aval structure] `(i/compiled-setval* (path ~apath) ~aval ~structure)) (defmacro traverse "Return a reducible object that traverses over `structure` to every element - specified by the path. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + specified by the path. + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath structure] `(i/do-compiled-traverse (path ~apath) ~structure)) (defmacro replace-in "Similar to transform, except returns a pair of [transformed-structure sequence-of-user-ret]. - The transform-fn in this case is expected to return [ret user-ret]. ret is - what's used to transform the data structure, while user-ret will be added to the user-ret sequence - in the final return. replace-in is useful for situations where you need to know the specific values - of what was transformed in the data structure. - This macro will attempt to do inline factoring and caching of the path, falling - back to compiling the path on every invocation if it's not possible to - factor/cache the path." + The transform-fn in this case is expected to return [ret user-ret]. ret is + what's used to transform the data structure, while user-ret will be added to the user-ret sequence + in the final return. replace-in is useful for situations where you need to know the specific values + of what was transformed in the data structure. + This macro will attempt to do inline factoring and caching of the path, falling + back to compiling the path on every invocation if it's not possible to + factor/cache the path." [apath transform-fn structure & args] `(i/compiled-replace-in* (path ~apath) ~transform-fn ~structure ~@args)) (defmacro collected? "Creates a filter function navigator that takes in all the collected values - as input. For arguments, can use `(collected? [a b] ...)` syntax to look - at each collected value as individual arguments, or `(collected? v ...)` syntax - to capture all the collected values as a single vector." + as input. For arguments, can use `(collected? [a b] ...)` syntax to look + at each collected value as individual arguments, or `(collected? v ...)` syntax + to capture all the collected values as a single vector." [params & body] (let [platform (if (contains? &env :locals) :cljs :clj)] `(i/collected?* (~'fn [~params] ~@body)) diff --git a/src/clj/com/rpl/specter/navs.cljx b/src/clj/com/rpl/specter/navs.cljx new file mode 100644 index 0000000..cb78b3c --- /dev/null +++ b/src/clj/com/rpl/specter/navs.cljx @@ -0,0 +1,471 @@ +(ns com.rpl.specter.navs + #+cljs (:require-macros + [com.rpl.specter.macros + :refer + [fixed-pathed-collector + fixed-pathed-nav + defcollector + defnav + defpathedfn + richnav + defnavconstructor + ]] + [com.rpl.specter.util-macros :refer + [doseqres]] + ) + (:use #+clj [com.rpl.specter macros] + #+clj [com.rpl.specter.util-macros :only [doseqres]]) + (:require [com.rpl.specter.impl :as i] + [clojure.walk :as walk] + #+clj [clojure.core.reducers :as r] + [com.rpl.specter.defnavhelpers] ; so that for cljs it's loaded as macros expand to this + ) + ) + +(defn- append [coll elem] + (-> coll vec (conj elem))) + +(defn not-selected?* + [compiled-path structure] + (->> structure + (i/compiled-select-any* compiled-path) + (identical? i/NONE))) + +(defn selected?* + [compiled-path structure] + (not (not-selected?* compiled-path structure))) + +(defn walk-select [pred continue-fn structure] + (let [ret (i/mutable-cell i/NONE) + walker (fn this [structure] + (if (pred structure) + (let [r (continue-fn structure)] + (if-not (identical? r i/NONE) + (i/set-cell! ret r)) + r + ) + (walk/walk this identity structure) + ))] + (walker structure) + (i/get-cell ret) + )) + +(defn key-select [akey structure next-fn] + (next-fn (get structure akey))) + +(defn key-transform [akey structure next-fn] + (assoc structure akey (next-fn (get structure akey)) + )) + +(defn all-select [structure next-fn] + (doseqres i/NONE [e structure] + (next-fn e))) + +#+cljs +(defn queue? [coll] + (= (type coll) (type #queue []))) + +#+clj +(defn queue? [coll] + (instance? clojure.lang.PersistentQueue coll)) + +(defprotocol AllTransformProtocol + (all-transform [structure next-fn])) + +(defn- non-transient-map-all-transform [structure next-fn empty-map] + (reduce-kv + (fn [m k v] + (let [[newk newv] (next-fn [k v])] + (assoc m newk newv) + )) + empty-map + structure + )) + +(extend-protocol AllTransformProtocol + nil + (all-transform [structure next-fn] + nil + ) + + ;; in cljs they're PersistentVector so don't need a special case + #+clj clojure.lang.MapEntry + #+clj + (all-transform [structure next-fn] + (let [newk (next-fn (key structure)) + newv (next-fn (val structure))] + (clojure.lang.MapEntry. newk newv) + )) + + #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector + (all-transform [structure next-fn] + (mapv next-fn structure)) + + #+clj + clojure.lang.PersistentArrayMap + #+clj + (all-transform [structure next-fn] + (let [k-it (.keyIterator structure) + v-it (.valIterator structure)] + (loop [ret {}] + (if (.hasNext k-it) + (let [k (.next k-it) + v (.next v-it) + [newk newv] (next-fn [k v])] + (recur (assoc ret newk newv))) + ret + )))) + + #+cljs + cljs.core/PersistentArrayMap + #+cljs + (all-transform [structure next-fn] + (non-transient-map-all-transform structure next-fn {}) + ) + + #+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap + (all-transform [structure next-fn] + (non-transient-map-all-transform structure next-fn (empty structure)) + ) + + #+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap + (all-transform [structure next-fn] + (persistent! + (reduce-kv + (fn [m k v] + (let [[newk newv] (next-fn [k v])] + (assoc! m newk newv) + )) + (transient + #+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY + ) + structure + ))) + + + #+clj + Object + #+clj + (all-transform [structure next-fn] + (let [empty-structure (empty structure)] + (cond (and (list? empty-structure) (not (queue? empty-structure))) + ;; this is done to maintain order, otherwise lists get reversed + (doall (map next-fn structure)) + + (map? structure) + ;; reduce-kv is much faster than doing r/map through call to (into ...) + (reduce-kv + (fn [m k v] + (let [[newk newv] (next-fn [k v])] + (assoc m newk newv) + )) + empty-structure + structure + ) + + :else + (->> structure (r/map next-fn) (into empty-structure)) + ))) + + #+cljs + default + #+cljs + (all-transform [structure next-fn] + (let [empty-structure (empty structure)] + (if (and (list? empty-structure) (not (queue? empty-structure))) + ;; this is done to maintain order, otherwise lists get reversed + (doall (map next-fn structure)) + (into empty-structure (map #(next-fn %)) structure) + ))) + ) + +(defprotocol MapValsTransformProtocol + (map-vals-transform [structure next-fn])) + +(defn map-vals-non-transient-transform [structure empty-map next-fn] + (reduce-kv + (fn [m k v] + (assoc m k (next-fn v))) + empty-map + structure)) + +(extend-protocol MapValsTransformProtocol + nil + (map-vals-transform [structure next-fn] + nil + ) + + #+clj + clojure.lang.PersistentArrayMap + #+clj + (map-vals-transform [structure next-fn] + (let [k-it (.keyIterator structure) + v-it (.valIterator structure)] + (loop [ret {}] + (if (.hasNext k-it) + (let [k (.next k-it) + v (.next v-it)] + (recur (assoc ret k (next-fn v)))) + ret + )))) + + #+cljs + cljs.core/PersistentArrayMap + #+cljs + (map-vals-transform [structure next-fn] + (map-vals-non-transient-transform structure {} next-fn) + ) + + #+clj clojure.lang.PersistentTreeMap #+cljs cljs.core/PersistentTreeMap + (map-vals-transform [structure next-fn] + (map-vals-non-transient-transform structure (empty structure) next-fn) + ) + + #+clj clojure.lang.PersistentHashMap #+cljs cljs.core/PersistentHashMap + (map-vals-transform [structure next-fn] + (persistent! + (reduce-kv + (fn [m k v] + (assoc! m k (next-fn v))) + (transient + #+clj clojure.lang.PersistentHashMap/EMPTY #+cljs cljs.core.PersistentHashMap.EMPTY + ) + structure + ))) + + #+clj Object #+cljs default + (map-vals-transform [structure next-fn] + (reduce-kv + (fn [m k v] + (assoc m k (next-fn v))) + (empty structure) + structure)) + ) + +(defn srange-select [structure start end next-fn] + (next-fn (-> structure vec (subvec start end)))) + +(def srange-transform i/srange-transform*) + +(defn- matching-indices [aseq p] + (keep-indexed (fn [i e] (if (p e) i)) aseq)) + +(defn matching-ranges [aseq p] + (first + (reduce + (fn [[ranges curr-start curr-last :as curr] i] + (cond + (nil? curr-start) + [ranges i i] + + (= i (inc curr-last)) + [ranges curr-start i] + + :else + [(conj ranges [curr-start (inc curr-last)]) i i] + )) + [[] nil nil] + (concat (matching-indices aseq p) [-1]) + ))) + +(defn extract-basic-filter-fn [path] + (cond (fn? path) + path + + (and (coll? path) + (every? fn? path)) + (reduce + (fn [combined afn] + (fn [structure] + (and (combined structure) (afn structure)) + )) + path + ))) + + + +(defn if-select [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] + (let [test? (then-tester structure) + sel (if test? + then-nav + else-nav) + idx (if test? params-idx (+ params-idx then-params))] + (i/exec-rich-select* + sel + params + idx + vals + structure + next-fn + ))) + + +(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] + (let [test? (then-tester structure) + tran (if test? + then-nav + else-nav) + idx (if test? params-idx (+ params-idx then-params))] + (i/exec-rich-transform* + tran + params + idx + vals + structure + next-fn + ))) + +(defn terminal* [params params-idx vals structure] + (let [afn (aget ^objects params params-idx)] + (if (identical? vals []) + (afn structure) + (apply afn (conj vals structure))) + )) + + +(defprotocol AddExtremes + (append-all [structure elements]) + (prepend-all [structure elements])) + +(extend-protocol AddExtremes + nil + (append-all [_ elements] + elements) + (prepend-all [_ elements] + elements) + + #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector + (append-all [structure elements] + (reduce conj structure elements)) + (prepend-all [structure elements] + (let [ret (transient [])] + (as-> ret <> + (reduce conj! <> elements) + (reduce conj! <> structure) + (persistent! <>) + ))) + + #+clj Object #+cljs default + (append-all [structure elements] + (concat structure elements)) + (prepend-all [structure elements] + (concat elements structure)) + ) + + +(defprotocol UpdateExtremes + (update-first [s afn]) + (update-last [s afn])) + +(defprotocol GetExtremes + (get-first [s]) + (get-last [s])) + +(defprotocol FastEmpty + (fast-empty? [s])) + +(defnav PosNavigator [getter updater] + (select* [this structure next-fn] + (if-not (fast-empty? structure) + (next-fn (getter structure)) + i/NONE)) + (transform* [this structure next-fn] + (if (fast-empty? structure) + structure + (updater structure next-fn)))) + +(defn- update-first-list [l afn] + (cons (afn (first l)) (rest l))) + +(defn- update-last-list [l afn] + (append (butlast l) (afn (last l)))) + +#+clj +(defn vec-count [^clojure.lang.IPersistentVector v] + (.length v)) + +#+cljs +(defn vec-count [v] + (count v)) + +#+clj +(defn transient-vec-count [^clojure.lang.ITransientVector v] + (.count v)) + +#+cljs +(defn transient-vec-count [v] + (count v)) + +(extend-protocol UpdateExtremes + #+clj clojure.lang.PersistentVector #+cljs cljs.core/PersistentVector + (update-first [v afn] + (let [val (nth v 0)] + (assoc v 0 (afn val)) + )) + (update-last [v afn] + ;; type-hinting vec-count to ^int caused weird errors with case + (let [c (int (vec-count v))] + (case c + 1 (let [[e] v] [(afn e)]) + 2 (let [[e1 e2] v] [e1 (afn e2)]) + (let [i (dec c)] + (assoc v i (afn (nth v i))) + )))) + #+clj Object #+cljs default + (update-first [l val] + (update-first-list l val)) + (update-last [l val] + (update-last-list l val) + )) + +(extend-protocol GetExtremes + #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector + (get-first [v] + (nth v 0)) + (get-last [v] + (peek v)) + #+clj Object #+cljs default + (get-first [s] + (first s)) + (get-last [s] + (last s) + )) + + +(extend-protocol FastEmpty + nil + (fast-empty? [_] true) + + #+clj clojure.lang.IPersistentVector #+cljs cljs.core/PersistentVector + (fast-empty? [v] + (= 0 (vec-count v))) + #+clj clojure.lang.ITransientVector #+cljs cljs.core/TransientVector + (fast-empty? [v] + (= 0 (transient-vec-count v))) + #+clj Object #+cljs default + (fast-empty? [s] + (empty? s)) + ) + +(defn walk-until [pred on-match-fn structure] + (if (pred structure) + (on-match-fn structure) + (walk/walk (partial walk-until pred on-match-fn) identity structure) + )) + +(defn codewalk-until [pred on-match-fn structure] + (if (pred structure) + (on-match-fn structure) + (let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)] + (if (and (i/fn-invocation? structure) (i/fn-invocation? ret)) + (with-meta ret (meta structure)) + ret + )))) + +(def DISPENSE* + (i/no-params-rich-compiled-path + (reify i/RichNavigator + (rich-select* [this params params-idx vals structure next-fn] + (next-fn params params-idx [] structure)) + (rich-transform* [this params params-idx vals structure next-fn] + (next-fn params params-idx [] structure))))) diff --git a/src/clj/com/rpl/specter/protocols.cljx b/src/clj/com/rpl/specter/protocols.cljx index 8ccbfc8..f734e3a 100644 --- a/src/clj/com/rpl/specter/protocols.cljx +++ b/src/clj/com/rpl/specter/protocols.cljx @@ -1,6 +1,8 @@ (ns com.rpl.specter.protocols) (defprotocol Navigator + "Do not use this protocol directly. All navigators must be created using + com.rpl.specter.macros namespace." (select* [this structure next-fn] "An implementation of `select*` must call `next-fn` on each subvalue of `structure`. The result of `select*` is specified @@ -17,4 +19,9 @@ )) (defprotocol Collector + "Do not use this protocol directly. All navigators must be created using + com.rpl.specter.macros namespace." (collect-val [this structure])) + +(defprotocol ImplicitNav + (implicit-nav [obj])) diff --git a/src/clj/com/rpl/specter/transients.cljx b/src/clj/com/rpl/specter/transients.cljx index 7bd1e55..5b08991 100644 --- a/src/clj/com/rpl/specter/transients.cljx +++ b/src/clj/com/rpl/specter/transients.cljx @@ -8,7 +8,7 @@ [com.rpl.specter.macros :only [defnav defpathedfn]]) - (:require [com.rpl.specter.impl :as i] + (:require [com.rpl.specter.navs :as n] [com.rpl.specter :refer [subselect selected?]])) (defnav @@ -21,9 +21,17 @@ (transform* [this structure next-fn] (assoc! structure key (next-fn (get structure key))))) -(def END! - "Navigates to an empty (persistent) vector at the end of a transient vector." - (i/comp-paths* (i/->TransientEndNavigator))) + + +(defnav + ^{:doc "Navigates to an empty (persistent) vector at the end of a transient vector."} + END! + [] + (select* [this structure next-fn] + (next-fn [])) + (transform* [this structure next-fn] + (let [res (next-fn [])] + (reduce conj! structure res)))) (defn- t-get-first [tv] @@ -31,7 +39,7 @@ (defn- t-get-last [tv] - (nth tv (dec (i/transient-vec-count tv)))) + (nth tv (dec (n/transient-vec-count tv)))) (defn- t-update-first [tv next-fn] @@ -39,16 +47,17 @@ (defn- t-update-last [tv next-fn] - (let [i (dec (i/transient-vec-count tv))] + (let [i (dec (n/transient-vec-count tv))] (assoc! tv i (next-fn (nth tv i))))) + (def FIRST! "Navigates to the first element of a transient vector." - (i/->PosNavigator t-get-first t-update-first)) + (n/PosNavigator t-get-first t-update-first)) (def LAST! "Navigates to the last element of a transient vector." - (i/->PosNavigator t-get-last t-update-last)) + (n/PosNavigator t-get-last t-update-last)) #+clj (defn- select-keys-from-transient-map diff --git a/test/com/rpl/specter/core_test.cljx b/test/com/rpl/specter/core_test.cljx index b81cd81..480baee 100644 --- a/test/com/rpl/specter/core_test.cljx +++ b/test/com/rpl/specter/core_test.cljx @@ -1291,7 +1291,7 @@ (deftest multi-path-vals-test (is (= {:a 1 :b 6 :c 3} (transform [(s/multi-path (s/collect-one :a) (s/collect-one :c)) :b] - + + + {:a 1 :b 2 :c 3}))) (is (= [[1 2] [3 2]] (select [(s/multi-path (s/collect-one :a) (s/collect-one :c)) :b]