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

initial rewriting

Browse source
This commit is contained in:
Nathan Marz 2016-08-29 22:01:17 -04:00
parent a7b743c75d
commit f511cd4fca
7 changed files with 330 additions and 1034 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -2,13 +2,13 @@
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter.macros [com.rpl.specter.macros
:refer :refer
[fixed-pathed-collector [late-bound-richnav
fixed-pathed-nav late-bound-nav
defcollector late-bound-collector
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor]] defrichnav]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]])) [doseqres]]))
@ -21,7 +21,7 @@
defnav defnav
defpathedfn defpathedfn
richnav richnav
defnavconstructor]]) defrichnav]])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
@ -38,18 +38,6 @@
[& apath] [& apath]
(i/comp-paths* (vec apath))) (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
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)`
can be used to turn this feature off.
Reasons why it may not be able to factor a path include using
a local symbol, special form, or regular function invocation
where a navigator is expected."}
must-cache-paths! i/must-cache-paths!)
;; Selection functions ;; Selection functions
(def ^{:doc "Version of select that takes in a path precompiled with comp-paths"} (def ^{:doc "Version of select that takes in a path precompiled with comp-paths"}
@ -162,24 +150,6 @@
[path transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] [path transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
(compiled-replace-in (i/comp-paths* path) transform-fn structure :merge-fn merge-fn)) (compiled-replace-in (i/comp-paths* path) transform-fn structure :merge-fn merge-fn))
;; Helpers for defining selectors and collectors with late-bound params
(def ^{:doc "Takes a compiled path that needs late-bound params and supplies it with
an array of params and a position in the array from which to begin reading
params. The return value is an executable selector."}
bind-params* i/bind-params*)
(defn params-reset [params-path]
;; TODO: error if not paramsneededpath
(let [nav (i/params-needed-nav params-path)
needed (i/num-needed-params params-path)]
(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 ;; Built-in pathing and context operations
(defnav (defnav
@ -209,19 +179,18 @@
function works just like it does in `transform`, with collected values function works just like it does in `transform`, with collected values
given as the first arguments"} given as the first arguments"}
terminal terminal
(richnav 1 (richnav [afn]
(select* [this params params-idx vals structure next-fn] (select* [this vals structure next-fn]
(i/throw-illegal "'terminal' should only be used in multi-transform")) (i/throw-illegal "'terminal' should only be used in multi-transform"))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(n/terminal* params params-idx vals structure)))) (n/terminal* afn vals structure))))
(defnavconstructor terminal-val (defn terminal-val
"Like `terminal` but specifies a val to set at the location regardless of "Like `terminal` but specifies a val to set at the location regardless of
the collected values or the value at the location." the collected values or the value at the location."
[p terminal]
[v] [v]
(p (i/fast-constantly v))) (terminal (i/fast-constantly v)))
(defnav (defnav
^{:doc "Navigate to every element of the collection. For maps navigates to ^{:doc "Navigate to every element of the collection. For maps navigates to
@ -241,7 +210,6 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [v (vals structure)] (doseqres NONE [v (vals structure)]
(next-fn v))) (next-fn v)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/map-vals-transform structure next-fn))) (n/map-vals-transform structure next-fn)))
@ -292,7 +260,6 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [[s e] (n/matching-ranges structure pred)] (doseqres NONE [[s e] (n/matching-ranges structure pred)]
(n/srange-select structure s e next-fn))) (n/srange-select structure s e next-fn)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(reduce (reduce
(fn [structure [s e]] (fn [structure [s e]]
@ -381,7 +348,7 @@
children in the same order when executed on \"select\" and then children in the same order when executed on \"select\" and then
\"transform\"." \"transform\"."
[& path] [& path]
(fixed-pathed-nav [late path] (late-bound-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (compiled-select late structure))) (next-fn (compiled-select late structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
@ -454,15 +421,66 @@
(defpathedfn selected? (defpathedfn selected?
"Filters the current value based on whether a path finds anything. "Filters the current value based on whether a path finds anything.
e.g. (selected? :vals ALL even?) keeps the current element only if an e.g. (selected? :vals ALL even?) keeps the current element only if an
even number exists for the :vals key. even number exists for the :vals key."
The input path may be parameterized, in which case the result of selected?
will be parameterized in the order of which the parameterized navigators
were declared."
[& path] [& path]
;;TODO: how to handle this if the path is being auto-compiled by this point?
;; same for if-path...
;; make selected? and if-path macros?
;; expand to: (if-let [(afn (extract-basic-filter-fn path)) (pred afn) (let [p ...] (nav [] ...))]
;; there needs to be a "compile-time" component here.... which is a macro
;; but it's not "compile-time", it's the first run-through by specter
;; maybe if pathed-fn returns a function when run in first run-through, then it's given
;; a compiled/parameterized version of the path
;; pathedfn basically substitutes for either a navigator or a parameterized navigator (parameterized
;; with a compiled path)
;; TODO: no, the function vs. nav thing doesn't work because a path may or may not
;; be needed by the resulting navigator... (and there could be multiple path arguments, some
;; of which may not be needed)
;; maybe there could be a special marker for inline caching to invoke different codepaths
;; if a path is a series of functions or not...
;; but would much rather have it be internalizable in the operation
;; maybe still have fixed-pathed-nav and inline caching turns path into something that
;; has delayed evaluation
;; what about non-path params? they should be dynamic every single time...
;; maybe defnav indicates what's a path and what's not...
;; - no, still need intermediate logic to determine what the nav will be...
;; it needs to happen outside the function...
;; or "transformed" needs to work differently... and return a function that takes in the param
;; could tag with metadata about how to statically analyze that argument
;; and then it takes in the actual paths as input
;; - this would compose with other pathedfns, like how filterer works
;; - but static analysis needs to ALSO switch the implementation depending on what it finds
;; - also needs to work if just call it like a regular function...
;; - maybe fixed-pathed-nav recognizes metadata on the path to see if it's inside inline
;; caching or not... and then decides whether to compile or not
;; - maybe I need a dynamic nav that looks at uncompiled paths and returns function to invoke
;; with the same arguments... uncompiledpath has parts of it escaped
;; - if path and all arguments are static then it will be invoked and cached normally...
;; - no, but still doesn't handle the switching to pred case and making a custom navigator
;; - unless rely on the fact it will be invoked statically when everything is constant...
;; - but filterer still doesn't seem to work so well...
;; - the dynamic nav is told when a ^:notpath argument is dynamic or not
;; - how does this compose for filterer?
;; - not quite right... since extraction only happens at "compile time" and then the
;; pred navigator used like it's static
;; - maybe instead of "fixed-pathed-nav" have "late-nav" that can also take non-path args that were
;; marked as ^:notpath
;; - having fixed-pathed-navs doesn't work because of non-path arguments
;; - returning functions doesn't work because may want to call down to other higher-order navs...
;; - maybe DO have a paramsneeded type that's a function with the uncompiled paths + dynamic local
;; information on it (which is what fixed-pathed-nav can do...)
;; - or can just say "with-args" and then metadata tells specter which are paths and which aren't
;; - (late-bound-nav [late path c an-arg])
;; - if they aren't bound yet, then that returns a function... otherwise it returns a proper navigator
;; - how does this compose with filterer?
;; (subselect ALL (selected? path))
;; - selected? returns a function that takes in params (and is annotated with WHAT params)...
;; - subselect does the same late bound stuff with its path and it sees what IT is composed of
;; - at end have an AST indicating what the final top-level paths / sub-paths are
(if-let [afn (n/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
afn afn
(fixed-pathed-nav [late path] (late-bound-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
(i/filter-select (i/filter-select
#(n/selected?* late %) #(n/selected?* late %)
@ -477,7 +495,7 @@
(defpathedfn not-selected? [& path] (defpathedfn not-selected? [& path]
(if-let [afn (n/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
(fn [s] (not (afn s))) (fn [s] (not (afn s)))
(fixed-pathed-nav [late path] (late-bound-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
(i/filter-select (i/filter-select
#(n/not-selected?* late %) #(n/not-selected?* late %)
@ -508,22 +526,17 @@
will be parameterized in the order of which the parameterized navigators will be parameterized in the order of which the parameterized navigators
were declared." were declared."
[path ^:notpath update-fn] [path ^:notpath update-fn]
(fixed-pathed-nav [late path] (late-bound-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (compiled-transform late update-fn structure))) (next-fn (compiled-transform late update-fn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(next-fn (compiled-transform late update-fn structure))))) (next-fn (compiled-transform late update-fn structure)))))
(defnav (def
^{:doc "Keeps the element only if it matches the supplied predicate. This is the ^{: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."} late-bound parameterized version of using a function directly in a path."}
pred pred
[afn] i/pred*)
(select* [this structure next-fn]
(if (afn structure) (next-fn structure) NONE))
(transform* [this structure next-fn]
(if (afn structure) (next-fn structure) structure)))
(extend-type nil (extend-type nil
ImplicitNav ImplicitNav
@ -533,7 +546,6 @@
ImplicitNav ImplicitNav
(implicit-nav [this] (keypath this))) (implicit-nav [this] (keypath this)))
(extend-type #?(:clj clojure.lang.AFn :cljs function) (extend-type #?(:clj clojure.lang.AFn :cljs function)
ImplicitNav ImplicitNav
(implicit-nav [this] (pred this))) (implicit-nav [this] (pred this)))
@ -584,7 +596,7 @@
current value to the collected vals."} current value to the collected vals."}
collect collect
[& path] [& path]
(fixed-pathed-collector [late path] (late-bound-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select late structure)))) (compiled-select late structure))))
@ -594,7 +606,7 @@
current value to the collected vals."} current value to the collected vals."}
collect-one collect-one
[& path] [& path]
(fixed-pathed-collector [late path] (late-bound-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select-one late structure)))) (compiled-select-one late structure))))
@ -612,76 +624,58 @@
(collect-val [this structure] (collect-val [this structure]
val)) val))
(def (defrichnav
^{:doc "Drops all collected values for subsequent navigation."} ^{:doc "Drops all collected values for subsequent navigation."}
DISPENSE n/DISPENSE*) DISPENSE
[]
(select* [this vals structure next-fn]
(next-fn [] structure))
(transform* [this vals structure next-fn]
(next-fn [] structure)))
(defpathedfn if-path (defpathedfn if-path
"Like cond-path, but with if semantics." "Like cond-path, but with if semantics."
([cond-p then-path] ([cond-p then-path]
(if-path cond-p then-path STOP)) (if-path cond-p then-path STOP))
([cond-p then-path else-path] ([cond-p then-path else-path]
(let [then-comp (i/comp-paths-internalized then-path) (if-let [afn (n/extract-basic-filter-fn cond-p)]
else-comp (i/comp-paths-internalized else-path) (late-bound-nav [late-then then-path
then-needed (i/num-needed-params then-comp) late-else else-path]
else-needed (i/num-needed-params else-comp) (select* [this vals structure next-fn]
then-nav (i/extract-rich-nav then-comp) (n/if-select
else-nav (i/extract-rich-nav else-comp)] vals
(if-let [afn (n/extract-basic-filter-fn cond-p)] structure
(richnav (+ then-needed else-needed) next-fn
(select* [this params params-idx vals structure next-fn] afn
(n/if-select late-then
params late-else))
params-idx (transform* [this vals structure next-fn]
vals (n/if-transform
structure vals
next-fn structure
afn next-fn
then-nav afn
then-needed late-then
else-nav)) late-else)))
(late-bound-nav [late-cond cond-p
(transform* [this params params-idx vals structure next-fn] late-then then-path
(n/if-transform late-else else-path]
params (select* [this vals structure next-fn]
params-idx (n/if-select
vals vals
structure structure
next-fn next-fn
afn #(n/selected?* late-cond %)
then-nav late-then
then-needed late-else))
else-nav)))) (transform* [this vals structure next-fn]
(n/if-transform
(let [cond-comp (i/comp-paths-internalized cond-p) vals
cond-needed (i/num-needed-params cond-comp)] structure
(richnav (+ then-needed else-needed cond-needed) next-fn
(select* [this params params-idx vals structure next-fn] #(n/selected?* late-cond %)
(let [late-cond (i/parameterize-path cond-comp params params-idx)] late-then
(n/if-select late-else))))))
params
(+ params-idx cond-needed)
vals
structure
next-fn
#(n/selected?* late-cond %)
then-nav
then-needed
else-nav)))
(transform* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)]
(n/if-transform
params
(+ params-idx cond-needed)
vals
structure
next-fn
#(n/selected?* late-cond %)
then-nav
then-needed
else-nav))))))))
(defpathedfn cond-path (defpathedfn cond-path
@ -707,26 +701,19 @@
"A path that branches on multiple paths. For updates, "A path that branches on multiple paths. For updates,
applies updates to the paths in order." applies updates to the paths in order."
([] STAY) ([] STAY)
([path] (i/comp-paths* path)) ([path] path)
([path1 path2] ([path1 path2]
(let [comp1 (i/comp-paths-internalized path1) (late-bound-nav [late1 path1
comp2 (i/comp-paths-internalized path2) late2 path2]
comp1-needed (i/num-needed-params comp1) (select* [this vals structure next-fn]
nav1 (i/extract-rich-nav comp1) (let [res1 (i/exec-select* nav1 vals structure next-fn)
nav2 (i/extract-rich-nav comp2)] res2 (i/exec-select* nav2 vals structure next-fn)]
(if (identical? NONE res2)
(richnav (+ comp1-needed (i/num-needed-params comp2)) res1
(select* [this params params-idx vals structure next-fn] res2)))
(let [res1 (i/exec-rich-select* nav1 params params-idx vals structure next-fn) (transform* [this vals structure next-fn]
res2 (i/exec-rich-select* nav2 params (+ params-idx comp1-needed) vals structure next-fn)] (let [s1 (i/exec-transform* nav1 vals structure next-fn)]
(if (identical? NONE res2) (i/exec-transform* nav2 vals s1 next-fn)))))
res1
res2)))
(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] ([path1 path2 & paths]
(reduce multi-path (multi-path path1 path2) paths))) (reduce multi-path (multi-path path1 path2) paths)))

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

@ -1,19 +0,0 @@
(ns com.rpl.specter.defhelpers)
(defn gensyms [amt]
(vec (repeatedly amt gensym)))
(defmacro define-ParamsNeededPath [clj? fn-type invoke-name var-arity-impl]
(let [a (with-meta (gensym "array") {:tag 'objects})
impls (for [i (range 21)
:let [args (vec (gensyms i))
setters (for [j (range i)] `(aset ~a ~j ~(get args j)))]]
`(~invoke-name [this# ~@args]
(let [~a (~(if clj? 'com.rpl.specter.impl/fast-object-array 'object-array) ~i)]
~@setters
(com.rpl.specter.impl/bind-params* this# ~a 0))))]
`(defrecord ~'ParamsNeededPath [~'rich-nav ~'num-needed-params]
~fn-type
~@impls
~var-arity-impl)))

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

@ -1,13 +0,0 @@
(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)))

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

@ -1,15 +1,13 @@
(ns com.rpl.specter.impl (ns com.rpl.specter.impl
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter.defhelpers :refer [define-ParamsNeededPath]]
[com.rpl.specter.util-macros :refer [doseqres]])) [com.rpl.specter.util-macros :refer [doseqres]]))
(:use [com.rpl.specter.protocols :only (:use [com.rpl.specter.protocols :only
[select* transform* collect-val Navigator]] [select* transform* collect-val Rich Navigator]]
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.protocols :as p] (:require [com.rpl.specter.protocols :as p]
[clojure.string :as s] [clojure.string :as s]
#?(:clj [com.rpl.specter.defhelpers :as dh])
#?(:clj [riddley.walk :as riddley])) #?(:clj [riddley.walk :as riddley]))
#?(:clj (:import [com.rpl.specter Util MutableCell]))) #?(:clj (:import [com.rpl.specter Util MutableCell])))
@ -30,9 +28,6 @@
(defn smart-str [& elems] (defn smart-str [& elems]
(apply str (map smart-str* elems))) (apply str (map smart-str* elems)))
(defn object-aget [^objects a i]
(aget a i))
(defn fast-constantly [v] (defn fast-constantly [v]
(fn ([] v) (fn ([] v)
([a1] v) ([a1] v)
@ -101,39 +96,6 @@
(dotimes [_ iters] (dotimes [_ iters]
(afn)))) (afn))))
(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 :clj
(defmacro exec-select* [this & args] (defmacro exec-select* [this & args]
@ -142,8 +104,8 @@
:cljs :cljs
(defn exec-select* [this structure next-fn] (defn exec-select* [this vals structure next-fn]
(p/select* ^not-native this structure next-fn))) (p/select* ^not-native this vals structure next-fn)))
#?( #?(
@ -154,123 +116,17 @@
:cljs :cljs
(defn exec-transform* [this structure next-fn] (defn exec-transform* [this vals structure next-fn]
(p/transform* ^not-native this structure next-fn))) (p/transform* ^not-native this vals structure next-fn)))
(def RichPathExecutor
(->ExecutorFunctions
(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 [^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)
(apply transform-fn (conj vals structure))))))))
(def LeanPathExecutor
(->ExecutorFunctions
(fn [nav result-fn structure]
(exec-select* nav structure result-fn))
(fn [nav transform-fn structure]
(exec-transform* nav structure transform-fn))))
(defrecord CompiledPath [executors nav])
(defn compiled-path? [o]
(instance? CompiledPath o))
(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*)
#?(
:clj
(defmacro fast-object-array [i]
`(com.rpl.specter.Util/makeObjectArray ~i))
:cljs
(defn fast-object-array [i]
(object-array i)))
#?(
:clj
(dh/define-ParamsNeededPath
true
clojure.lang.IFn
invoke
(applyTo [this args]
(let [a (object-array args)]
(com.rpl.specter.impl/bind-params* this a 0))))
:cljs
(define-ParamsNeededPath
false
cljs.core/IFn
-invoke
(-invoke [this p01 p02 p03 p04 p05 p06 p07 p08 p09 p10
p11 p12 p13 p14 p15 p16 p17 p18 p19 p20
rest]
(let [a (object-array
(concat
[p01 p02 p03 p04 p05 p06 p07 p08 p09 p10
p11 p12 p13 p14 p15 p16 p17 p18 p19 p20]
rest))]
(com.rpl.specter.impl/bind-params* this a 0)))))
(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
RichPathExecutor
(->ParameterizedRichNav
(.-rich-nav params-needed-path)
params
idx)))
(defprotocol PathComposer (defprotocol PathComposer
(do-comp-paths [paths])) (do-comp-paths [paths]))
(defn rich-nav? [n]
(instance? com.rpl.specter.protocols.RichNavigator n))
(defn comp-paths* [p] (defn comp-paths* [p]
(if (compiled-path? p) p (do-comp-paths p))) (if (rich-nav? p) p (do-comp-paths p)))
(defn- seq-contains? [aseq val] (defn- seq-contains? [aseq val]
@ -279,12 +135,8 @@
empty? empty?
not)) not))
(defn root-params-nav? [o]
(and (fn? o) (-> o meta :highernav)))
(defn- coerce-object [this] (defn- coerce-object [this]
(cond (root-params-nav? this) (-> this meta :highernav :params-needed-path) (cond (satisfies? p/ImplicitNav this) (p/implicit-nav this)
(satisfies? p/ImplicitNav this) (p/implicit-nav this)
:else (throw-illegal "Not a navigator: " this))) :else (throw-illegal "Not a navigator: " this)))
@ -296,14 +148,6 @@
(coerce-path [this] (coerce-path [this]
(coerce-object this)) (coerce-object this))
CompiledPath
(coerce-path [this]
this)
ParamsNeededPath
(coerce-path [this]
this)
#?(:clj java.util.List :cljs cljs.core/PersistentVector) #?(:clj java.util.List :cljs cljs.core/PersistentVector)
(coerce-path [this] (coerce-path [this]
(do-comp-paths this)) (do-comp-paths this))
@ -326,84 +170,16 @@
(coerce-object this))) (coerce-object this)))
(defn- combine-same-types [[n & _ :as all]] (defn combine-two-navs [nav1 nav2]
(let [combiner (reify RichNavigator
(if (satisfies? RichNavigator n) (select* [this vals structure next-fn]
(fn [curr next] (exec-select* curr vals structure
(reify RichNavigator (fn [vals-next structure-next]
(rich-select* [this params params-idx vals structure next-fn] (exec-select* next vals-next structure-next next-fn))))
(exec-rich-select* curr params params-idx vals structure (transform* [this vals structure next-fn]
(fn [params-next params-idx-next vals-next structure-next] (exec-transform* curr vals structure
(exec-rich-select* next params-next params-idx-next (fn [vals-next structure-next]
vals-next structure-next next-fn)))) (exec-rich-transform* 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]
(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)))
(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]
(cond
(not (instance? CompiledPath path))
path
(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-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 params2 params-idx2 vals-next structure-next))))
(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 params2 params-idx2 vals-next structure-next))))))))))
(defn comp-paths-internalized [path]
(capture-params-internally (comp-paths* path)))
(defn nav-type [n]
(if (satisfies? RichNavigator n)
:rich
:lean))
(extend-protocol PathComposer (extend-protocol PathComposer
nil nil
@ -414,40 +190,7 @@
(coerce-path o)) (coerce-path o))
#?(:clj java.util.List :cljs cljs.core/PersistentVector) #?(:clj java.util.List :cljs cljs.core/PersistentVector)
(do-comp-paths [navigators] (do-comp-paths [navigators]
(if (empty? navigators) (reduce combine-two-navs navigators)))
(coerce-path nil)
(let [coerced (->> navigators
(map coerce-path)
(map capture-params-internally))
combined (->> coerced
(map extract-nav)
(partition-by nav-type)
(map combine-same-types))
result-nav (if (= 1 (count combined))
(first combined)
(->> combined
(map coerce-rich-navigator)
combine-same-types))
needs-params-paths (filter #(instance? ParamsNeededPath %) coerced)]
(if (empty? needs-params-paths)
(if (satisfies? Navigator result-nav)
(lean-compiled-path result-nav)
(no-params-rich-compiled-path result-nav))
(->ParamsNeededPath
(coerce-rich-navigator result-nav)
(->> needs-params-paths
(map :num-needed-params)
(reduce +))))))))
(defn num-needed-params [path]
(if (instance? CompiledPath path)
0
(.-num-needed-params ^ParamsNeededPath path)))
;; cell implementation idea taken from prismatic schema library ;; cell implementation idea taken from prismatic schema library
@ -502,41 +245,11 @@
(set-cell! cell ret) (set-cell! cell ret)
ret)) ret))
;; TODO: this used to be a macro for clj... check if that's still important
(defn compiled-traverse* [path result-fn structure]
(exec-select* path [] structure result-fn))
(defn compiled-nav-field [^CompiledPath p]
(.-nav p))
(defn compiled-executors-field [^CompiledPath p]
(.-executors p))
(defn traverse-executor-field [^ExecutorFunctions ex]
(.-traverse-executor ex))
;; 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 [nav# (compiled-nav-field ~path)
ex# (compiled-executors-field ~path)]
((traverse-executor-field ex#)
nav#
~result-fn
~structure)))
:cljs
(defn compiled-traverse* [path result-fn structure]
(let [nav (compiled-nav-field path)
ex (compiled-executors-field path)]
((traverse-executor-field ex)
nav
result-fn
structure))))
(defn do-compiled-traverse [apath structure] (defn do-compiled-traverse [apath structure]
@ -552,9 +265,7 @@
(fn [elem] (fn [elem]
(let [curr (get-cell cell)] (let [curr (get-cell cell)]
(set-cell! cell (afn curr elem)))) (set-cell! cell (afn curr elem))))
structure) structure)
(get-cell cell))))) (get-cell cell)))))
@ -563,7 +274,6 @@
result-fn (fn [structure] result-fn (fn [structure]
(let [curr (get-cell res)] (let [curr (get-cell res)]
(set-cell! res (conj! curr structure))))] (set-cell! res (conj! curr structure))))]
(compiled-traverse* path result-fn structure) (compiled-traverse* path result-fn structure)
(persistent! (get-cell res)))) (persistent! (get-cell res))))
@ -590,7 +300,6 @@
(if (identical? curr NONE) (if (identical? curr NONE)
(set-cell! res structure) (set-cell! res structure)
(throw-illegal "More than one element found in structure: " structure))))] (throw-illegal "More than one element found in structure: " structure))))]
(compiled-traverse* path result-fn structure) (compiled-traverse* path result-fn structure)
(let [ret (get-cell res)] (let [ret (get-cell res)]
(if (identical? NONE ret) (if (identical? NONE ret)
@ -617,34 +326,15 @@
(defn compiled-selected-any?* [path structure] (defn compiled-selected-any?* [path structure]
(not= NONE (compiled-select-any* path structure))) (not= NONE (compiled-select-any* path structure)))
(defn compiled-transform*
[^com.rpl.specter.impl.CompiledPath path transform-fn structure]
(let [nav (.-nav path)
^com.rpl.specter.impl.ExecutorFunctions ex (.-executors path)]
((.-transform-executor ex) nav transform-fn structure)))
(defn params-needed-nav
^com.rpl.specter.impl.RichNavigator
[^com.rpl.specter.impl.ParamsNeededPath path]
(.-rich-nav path))
(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 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))))
;;TODO: could inline cache the transform-fn, or even have a different one
;;if know there are no vals at the end
(defn compiled-transform* [path transform-fn structure]
(exec-transform* nav [] structure
(fn [vals structure]
(if (identical? vals [])
(transform-fn vals)
(apply transform-fn (conj vals structure))))))
(defn fn-invocation? [f] (defn fn-invocation? [f]
(or #?(:clj (instance? clojure.lang.Cons f)) (or #?(:clj (instance? clojure.lang.Cons f))
@ -652,38 +342,6 @@
#?(:cljs (instance? cljs.core.LazySeq f)) #?(:cljs (instance? cljs.core.LazySeq f))
(list? f))) (list? f)))
(defrecord LayeredNav [underlying])
(defn layered-nav? [o] (instance? LayeredNav o))
(defn layered-nav-underlying [^LayeredNav ln]
(.-underlying ln))
(defn verify-layerable! [anav]
(if-not
(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")))
(defn layered-wrapper [anav]
(verify-layerable! anav)
(fn ([a1] (->LayeredNav (anav a1)))
([a1 a2] (->LayeredNav (anav a1 a2)))
([a1 a2 a3] (->LayeredNav (anav a1 a2 a3)))
([a1 a2 a3 a4] (->LayeredNav (anav a1 a2 a3 a4)))
([a1 a2 a3 a4 a5] (->LayeredNav (anav a1 a2 a3 a4 a5)))
([a1 a2 a3 a4 a5 a6] (->LayeredNav (anav a1 a2 a3 a4 a5 a6)))
([a1 a2 a3 a4 a5 a6 a7] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7)))
([a1 a2 a3 a4 a5 a6 a7 a8] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8)))
([a1 a2 a3 a4 a5 a6 a7 a8 a9] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9)))
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10] (->LayeredNav (anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)))
([a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 & args]
(->LayeredNav (apply anav a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 args)))))
(defrecord LocalSym (defrecord LocalSym
[val sym]) [val sym])
@ -698,16 +356,9 @@
[op params code]) [op params code])
(defrecord CachedPathInfo (defrecord CachedPathInfo
[precompiled ; can be null [path-fn])
params-maker]) ; can be null
(def MUST-CACHE-PATHS (mutable-cell false))
(defn must-cache-paths!
([] (must-cache-paths! true))
([v] (set-cell! MUST-CACHE-PATHS v)))
(defn constant-node? [node] (defn constant-node? [node]
(cond (and (instance? VarUse node) (cond (and (instance? VarUse node)
(-> node :var meta :dynamic not)) true (-> node :var meta :dynamic not)) true
@ -743,14 +394,7 @@
(defn- valid-navigator? [v] (defn- valid-navigator? [v]
(or (satisfies? p/ImplicitNav v) (or (satisfies? p/ImplicitNav v)
(instance? CompiledPath v))) (rich-nav? v)))
#?(:cljs
(defn handle-params [precompiled params-maker possible-params]
(let [params (fast-object-array (count params-maker))]
(dotimes [i (count params-maker)]
(aset params i ((get possible-params (get params-maker i)))))
(bind-params* precompiled params 0))))
(defn filter-select [afn structure next-fn] (defn filter-select [afn structure next-fn]
@ -763,97 +407,28 @@
(next-fn structure) (next-fn structure)
structure)) structure))
(def pred* (defn pred* [afn]
(->ParamsNeededPath (reify RichNavigator
(reify RichNavigator (select* [this vals structure next-fn]
(rich-select* [this params params-idx vals structure next-fn] (if (afn structure)
(let [afn (aget ^objects params params-idx)] (next-fn vals structure)
(if (afn structure) NONE))
(next-fn params (inc params-idx) vals structure) (transform* [this vals structure next-fn]
NONE))) (if (afn structure)
(next-fn vals structure)
(rich-transform* [this params params-idx vals structure next-fn] structure))))
(let [afn (aget ^objects params params-idx)]
(if (afn structure)
(next-fn params (inc params-idx) vals structure)
structure))))
1))
(def collected?* (defn collected?* [afn]
(->ParamsNeededPath (reify RichNavigator
(reify RichNavigator (select* [this vals structure next-fn]
(rich-select* [this params params-idx vals structure next-fn] (if (afn vals)
(let [afn (aget ^objects params params-idx)] (next-fn vals structure)
(if (afn vals) NONE))
(next-fn params (inc params-idx) vals structure) (transform* [this vals structure next-fn]
NONE))) (if (afn vals)
(next-fn vals structure)
(rich-transform* [this params params-idx vals structure next-fn] structure))))
(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
(reify RichNavigator
(rich-select* [this params params-idx vals structure next-fn]
(let [apath ^CompiledPath (aget ^objects params params-idx)
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)))))
(rich-transform* [this params params-idx vals structure next-fn]
(let [apath ^CompiledPath (aget ^objects params params-idx)
pnav ^ParameterizedRichNav (.-nav apath)
nav (.-rich-nav pnav)]
(exec-rich-transform*
nav
(.-params pnav)
(.-params-idx pnav)
vals
structure
(fn [_ _ vals-next structure-next]
(next-fn params params-idx vals-next structure-next))))))
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] (defn srange-transform* [structure start end next-fn]
(let [structurev (vec structure) (let [structurev (vec structure)
@ -885,7 +460,7 @@
(fn [_] (repeatedly (- c (- len 2)) gensym))) (fn [_] (repeatedly (- c (- len 2)) gensym)))
ret))) ret)))
;;TODO: all needs to change
(defn- magic-precompilation* [p params-atom failed-atom] (defn- magic-precompilation* [p params-atom failed-atom]
(let [magic-fail! (fn [& reason] (let [magic-fail! (fn [& reason]
(if (get-cell MUST-CACHE-PATHS) (if (get-cell MUST-CACHE-PATHS)
@ -1105,29 +680,20 @@
(defn compiled-multi-transform* [path structure] (defn compiled-multi-transform* [path structure]
(compiled-transform* path multi-transform-error-fn structure)) (compiled-transform* path multi-transform-error-fn structure))
#?(:clj ;;TODO: need a way to deal with protocol paths...
(defn extend-protocolpath* [protpath protpath-prot extensions] ;;maybe they get extended with a function and produce a `path`
(let [extensions (partition 2 extensions) ;;but could be recursive
m (-> protpath-prot :sigs keys first) ; #?(:clj
expected-params (num-needed-params protpath)] ; (defn extend-protocolpath* [protpath protpath-prot extensions]
(doseq [[atype apath] extensions] ; (let [extensions (partition 2 extensions)
(let [p (comp-paths-internalized apath) ; m (-> protpath-prot :sigs keys first)
needed-params (num-needed-params p) ; expected-params (num-needed-params protpath)]
rich-nav (extract-rich-nav p)] ; (doseq [[atype apath] extensions]
; (let [p (comp-paths-internalized apath)
(if-not (= needed-params expected-params) ; needed-params (num-needed-params p)
(throw-illegal "Invalid number of params in extended protocol path, expected " ; rich-nav (extract-rich-nav p)]
expected-params " but got " needed-params)) ;
(extend atype protpath-prot {m (fn [_] rich-nav)})))))) ; (if-not (= needed-params expected-params)
; (throw-illegal "Invalid number of params in extended protocol path, expected "
; expected-params " but got " needed-params))
(defn parameterize-path [apath params params-idx] ; (extend atype protpath-prot {m (fn [_] rich-nav)}))))))
(if (instance? CompiledPath apath)
apath
(bind-params* apath params params-idx)))
(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))))

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

@ -1,9 +1,7 @@
(ns com.rpl.specter.macros (ns com.rpl.specter.macros
(:use [com.rpl.specter.protocols :only [Navigator]] (:use [com.rpl.specter.protocols :only [RichNavigator]])
[com.rpl.specter.impl :only [RichNavigator]])
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk] [clojure.walk :as cljwalk]))
[com.rpl.specter.defnavhelpers :as dnh]))
(defn ^:no-doc gensyms [amt] (defn ^:no-doc gensyms [amt]
@ -17,243 +15,33 @@
grouped)) grouped))
(defmacro richnav (defmacro richnav [params & impls]
"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 & impls]
(let [{[s-params & s-body] 'select*
[t-params & t-body] 'transform*} (determine-params-impls impls)
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#)))))
(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)))
(defmacro ^:no-doc rich-nav-with-bindings [num-params-code bindings & impls]
(let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select*
[[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*}
(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)))))))
(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 `(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 & impls]
(if (empty? params) (if (empty? params)
`(i/lean-compiled-path (lean-nav* ~@impls)) (reify RichNavigator ~@impls)
`(vary-meta `(fn ~params
(fn ~params (i/lean-compiled-path (lean-nav* ~@impls))) (reify RichNavigator
assoc ~@impls))))
:highernav
{:type :lean
:params-needed-path
(i/->ParamsNeededPath
(rich-nav-with-bindings ~(count params)
~(delta-param-bindings params)
~@impls)
~(count params))})))
(defmacro collector (defmacro nav [params & impls]
"Defines a Collector with late bound parameters. This collector can be precompiled (let [{[[_ s-structure-sym s-next-fn-sym] & s-body] 'select*
with other selectors without knowing the parameters. When precompiled with other [[_ t-structure-sym t-next-fn-sym] & t-body] 'transform*} (determine-params-impls impls)]
selectors, the resulting selector takes in parameters for all selectors in the path `(richnav ~params
that needed parameters (in the order in which they were declared). (~'select* [this# vals# ~s-structure-sym next-fn#]
" (let [~s-next-fn-sym (fn [s#] (next-fn# vals# s#))]
[params body] ~@s-body))
`(let [rich-nav# (collector-with-bindings ~(count params) (~'transform* [this# vals# ~t-structure-sym next-fn#]
~(delta-param-bindings params) (let [~t-next-fn-sym (fn [s#] (next-fn# vals# s#))]
~body)] ~@t-body)))))
(if ~(empty? params) (defmacro collector [params [_ [_ structure-sym] & body] impl]
(i/no-params-rich-compiled-path rich-nav#) (let [cfn# (fn [vals# ~structure-sym next-fn#]
(vary-meta (next-fn# (conj vals# (do ~@body)) ~structure-sym))]
(fn ~params `(richnav ~params
(i/no-params-rich-compiled-path (~'select* [this# vals# structure# next-fn#]
(collector-with-bindings 0 [] (cfn# vals# structure# next-fn#))
~body))) (~'transform* [this# vals# structure# next-fn#]
assoc (cfn# vals# structure# next-fn#)))))
: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#)))))
(defn- helper-name [name method-name] (defn- helper-name [name method-name]
(symbol (str name "-" method-name))) (symbol (str name "-" method-name)))
@ -269,14 +57,76 @@
~@helpers ~@helpers
(def ~name (nav ~params ~@impls))))) (def ~name (nav ~params ~@impls)))))
(defrichnav [name params & impls]
`(def ~name (richnav ~params ~@impls)))
(defmacro defcollector [name & body] (defmacro defcollector [name & body]
`(def ~name (collector ~@body))) `(def ~name (collector ~@body)))
(defmacro late-bound-nav [bindings & impl])
;;TODO
;; if bindings are static, then immediately return a navigator
;; otherwise, return a function from params -> navigator (using nav)
;; function has metadata about what each arg should correspond to
;;TODO:
;; during inline caching analysis, defpathedfn can return:
;; - a path (in a sequence - vector or list from &), which can contain both static and dynamic params
;; - a navigator implementation
;; - a late-bound-nav or late-bound-collector
;; - which can have within the late paths other late-bound paths
;; - a record containing a function that takes in params, and then a vector of
;; what those params are (exactly what was put into bindings)
;; - should explicitly say in late-bound-nav which ones are paths and which aren't
;; - can use ^:path metadata? or wrap in: (late-path path)
;; - a non-vector constant (which will have indirect-nav run on it)
;;
;; when `path` passes args to a pathedfn:
;; - needs to wrap all dynamic portions in "dynamicparam"
;; (VarUse, LocalSym, etc.)
;; - it should descend into vectors as well
;; inline caching should do the following:
;; - escape path as it's doing now (recursing into vectors)
;; - go through path and for each navigator position:
;; - if a localsym: then it's a dynamic call to (if (navigator? ...) ... (indirect-nav))
;; - if a varuse: if dynamic, then it's a dynamic call as above
;; - if static, then get the value. if a navigator then done, otherwise call indirect-nav
;; - if specialform: it's a dynamic call to if (navigator? ...) as above
;; - if fninvocation:
;; - if not pathedfn:
;; - if params are constant, then invoke. if return is not navigator, then call indirect-nav
;; - otherwise, label that point as "dynamic invocation" with the args
;; - if pathedfn:
;; - take all arguments that have anything dynamic in them and wrap in dynamicparam
;; - including inside vectors (just one level
;; - call the function:
;; - if return is constant, then do indirect-nav or use the nav
;; - if return is a sequence, then treat it as path for that point to be merged in
;; , strip "dynamicparam", and recurse inside the vector
;; - should also flatten the vector
;; - if return is a late-bound record, then:
;; - label point as dynamic invocation with the args
;; - args marked as "latepath" TODO
;; - if sequence: then flatten and recurse
;; - if constant, then call indirect-nav
;; for all (if (navigator ...)... (indirect-nav)) calls, use metadata to determine whether
;; return is definitely a navigator in which case that dynamic code can be omitted
;; annotation could be :tag or :direct-nav
;; defnav needs to annotate return appropriately
(defn- protpath-sym [name] (defn- protpath-sym [name]
(-> name (str "-prot") symbol)) (-> name (str "-prot") symbol))
;;TODO: redesign so can still have parameterized protpaths...
;;TODO: mainly need recursion
(defmacro defprotocolpath (defmacro defprotocolpath
"Defines a navigator that chooses the path to take based on the type "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 of the value at the current point. May be specified with parameters to
@ -301,19 +151,19 @@
m (-> name (str "-retrieve") symbol) m (-> name (str "-retrieve") symbol)
num-params (count params) num-params (count params)
ssym (gensym "structure") ssym (gensym "structure")
rargs [(gensym "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")] rargs [(gensym "vals") ssym (gensym "next-fn")]
retrieve `(~m ~ssym)] retrieve `(~m ~ssym)]
`(do `(do
(defprotocol ~prot-name (~m [structure#])) (defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'select* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs))) (i/exec-select* inav# ~@rargs)))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-transform* inav# ~@rargs))))] (i/exec-transform* inav# ~@rargs))))]
(def ~name (def ~name
(if (= ~num-params 0) (if (= ~num-params 0)
@ -328,7 +178,7 @@
(vary-meta (symbol (str name "-declared")) (vary-meta (symbol (str name "-declared"))
assoc :no-doc true)) assoc :no-doc true))
;;TODO: redesign so can be recursive
(defmacro declarepath (defmacro declarepath
([name] ([name]
`(declarepath ~name [])) `(declarepath ~name []))
@ -402,43 +252,15 @@
(defmacro defpathedfn (defmacro defpathedfn
"Defines a higher order navigator that itself takes in one or more paths "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]] as input. When inline caching is applied to a path containing
or [[variable-pathed-nav]]. When inline factoring is applied to a path containing one of these higher order navigators, it will apply inline caching and
one of these higher order navigators, it will automatically interepret all compilation to the subpaths as well. Use ^:notpath metadata on arguments
arguments as paths, factor them accordingly, and set up the callsite to to indicate non-path arguments that should not be compiled"
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] [name & args]
(let [[name args] (name-with-attributes name args) (let [[name args] (name-with-attributes name args)
name (vary-meta name assoc :pathedfn true)] name (vary-meta name assoc :pathedfn true)]
`(defn ~name ~@args))) `(defn ~name ~@args)))
(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)
"'"))))))]
`(def ~name
(vary-meta
(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] (defn ^:no-doc ic-prepare-path [locals-set path]
(cond (cond
@ -610,59 +432,45 @@
(defmacro select (defmacro select
"Navigates to and returns a sequence of all the elements specified by the path. "Navigates to and returns a sequence of all the elements specified by the path.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-select* (path ~apath) ~structure)) `(i/compiled-select* (path ~apath) ~structure))
(defmacro select-one! (defmacro select-one!
"Returns exactly one element, throws exception if zero or multiple elements found. "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 This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-select-one!* (path ~apath) ~structure)) `(i/compiled-select-one!* (path ~apath) ~structure))
(defmacro select-one (defmacro select-one
"Like select, but returns either one element or nil. Throws exception if multiple elements found. "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 This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-select-one* (path ~apath) ~structure)) `(i/compiled-select-one* (path ~apath) ~structure))
(defmacro select-first (defmacro select-first
"Returns first element found. "Returns first element found.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-select-first* (path ~apath) ~structure)) `(i/compiled-select-first* (path ~apath) ~structure))
(defmacro select-any (defmacro select-any
"Returns any element found or [[NONE]] if nothing selected. This is the most "Returns any element found or [[NONE]] if nothing selected. This is the most
efficient of the various selection operations. efficient of the various selection operations.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-select-any* (path ~apath) ~structure)) `(i/compiled-select-any* (path ~apath) ~structure))
(defmacro selected-any? (defmacro selected-any?
"Returns true if any element was selected, false otherwise. "Returns true if any element was selected, false otherwise.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-selected-any?* (path ~apath) ~structure)) `(i/compiled-selected-any?* (path ~apath) ~structure))
(defmacro transform (defmacro transform
"Navigates to each value specified by the path and replaces it by the result of running "Navigates to each value specified by the path and replaces it by the result of running
the transform-fn on it. the transform-fn on it.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath transform-fn structure] [apath transform-fn structure]
`(i/compiled-transform* (path ~apath) ~transform-fn ~structure)) `(i/compiled-transform* (path ~apath) ~transform-fn ~structure))
@ -671,27 +479,21 @@
inline in the path using `terminal`. Error is thrown if navigation finishes 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`. the `multi-transform` equivalent of `setval`.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/compiled-multi-transform* (path ~apath) ~structure)) `(i/compiled-multi-transform* (path ~apath) ~structure))
(defmacro setval (defmacro setval
"Navigates to each value specified by the path and replaces it by `aval`. "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 This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath aval structure] [apath aval structure]
`(i/compiled-setval* (path ~apath) ~aval ~structure)) `(i/compiled-setval* (path ~apath) ~aval ~structure))
(defmacro traverse (defmacro traverse
"Return a reducible object that traverses over `structure` to every element "Return a reducible object that traverses over `structure` to every element
specified by the path. specified by the path.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath structure] [apath structure]
`(i/do-compiled-traverse (path ~apath) ~structure)) `(i/do-compiled-traverse (path ~apath) ~structure))
@ -701,9 +503,7 @@
what's used to transform the data structure, while user-ret will be added to the user-ret sequence 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 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. of what was transformed in the data structure.
This macro will attempt to do inline factoring and caching of the path, falling This macro will do inline caching of the path."
back to compiling the path on every invocation if it's not possible to
factor/cache the path."
[apath transform-fn structure & args] [apath transform-fn structure & args]
`(i/compiled-replace-in* (path ~apath) ~transform-fn ~structure ~@args)) `(i/compiled-replace-in* (path ~apath) ~transform-fn ~structure ~@args))
@ -713,5 +513,4 @@
at each collected value as individual arguments, or `(collected? v ...)` syntax at each collected value as individual arguments, or `(collected? v ...)` syntax
to capture all the collected values as a single vector." to capture all the collected values as a single vector."
[params & body] [params & body]
(let [platform (if (contains? &env :locals) :cljs :clj)] `(i/collected?* (~'fn [~params] ~@body)))
`(i/collected?* (~'fn [~params] ~@body))))

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

@ -287,42 +287,27 @@
(defn if-select [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] (defn if-select [vals structure next-fn then-tester then-nav else-nav]
(let [test? (then-tester structure) (i/exec-select*
sel (if test? (if (then-tester structure) then-nav else-nav)
then-nav vals
else-nav) structure
idx (if test? params-idx (+ params-idx then-params))] next-fn))
(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] (defn if-transform [vals structure next-fn then-tester then-nav else-nav]
(let [test? (then-tester structure) (i/exec-transform*
tran (if test? (if (then-tester structure) then-nav else-nav)
then-nav vals
else-nav) structure
idx (if test? params-idx (+ params-idx then-params))] next-fn))
(i/exec-rich-transform*
tran
params
idx
vals
structure
next-fn)))
(defn terminal* [params params-idx vals structure] (defn terminal* [afn vals structure]
(let [afn (aget ^objects params params-idx)] (if (identical? vals [])
(if (identical? vals []) (afn structure)
(afn structure) (apply afn (conj vals structure))))
(apply afn (conj vals structure)))))
@ -467,12 +452,3 @@
(if (and (i/fn-invocation? structure) (i/fn-invocation? ret)) (if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure)) (with-meta ret (meta structure))
ret)))) ret))))
(def DISPENSE*
(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)))))

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

@ -1,9 +1,9 @@
(ns com.rpl.specter.protocols) (ns com.rpl.specter.protocols)
(defprotocol Navigator (defprotocol RichNavigator
"Do not use this protocol directly. All navigators must be created using "Do not use this protocol directly. All navigators must be created using
com.rpl.specter.macros namespace." com.rpl.specter.macros namespace."
(select* [this structure next-fn] (select* [this vals structure next-fn]
"An implementation of `select*` must call `next-fn` on each "An implementation of `select*` must call `next-fn` on each
subvalue of `structure`. The result of `select*` is specified subvalue of `structure`. The result of `select*` is specified
as follows: as follows:
@ -12,7 +12,7 @@
2. `NONE` if all calls to `next-fn` return `NONE` 2. `NONE` if all calls to `next-fn` return `NONE`
3. Otherwise, any non-`NONE` return value from calling `next-fn` 3. Otherwise, any non-`NONE` return value from calling `next-fn`
") ")
(transform* [this structure next-fn] (transform* [this vals structure next-fn]
"An implementation of `transform*` must use `next-fn` to transform "An implementation of `transform*` must use `next-fn` to transform
any subvalues of `structure` and then merge those transformed values any subvalues of `structure` and then merge those transformed values
back into `structure`. Everything else in `structure` must be unchanged.")) back into `structure`. Everything else in `structure` must be unchanged."))