completely re-implement nav, collector, fixed-pathed-nav, and pathed-collector in cleaner and more flexible way

This commit is contained in:
Nathan Marz 2016-08-05 14:10:38 -04:00
parent 33d19ebd1d
commit e7dc940cd0

View file

@ -2,7 +2,8 @@
(:use [com.rpl.specter.protocols :only [Navigator]] (:use [com.rpl.specter.protocols :only [Navigator]]
[com.rpl.specter.impl :only [RichNavigator]]) [com.rpl.specter.impl :only [RichNavigator]])
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk]) [clojure.walk :as cljwalk]
[com.rpl.specter.defnavhelpers :as dnh])
) )
(defn ^:no-doc gensyms [amt] (defn ^:no-doc gensyms [amt]
@ -11,134 +12,18 @@
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]] (defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
(if-not (= #{name1 name2} #{'select* 'transform*}) (if-not (= #{name1 name2} #{'select* 'transform*})
(i/throw-illegal "defnav must implement select* and transform*, instead got " (i/throw-illegal "defnav must implement select* and transform*, instead got "
name1 " and " name2)) name1 " and " name2))
(if (= name1 'select*) (if (= name1 'select*)
[impl1 impl2] [impl1 impl2]
[impl2 impl1])) [impl2 impl1]))
(def ^:no-doc PARAMS-SYM (gensym "params"))
(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/lean-compiled-path
(reify Navigator
(~'select* [this# ~s-structure-sym ~s-next-fn-sym]
~@select-body)
(~'transform* [this# ~t-structure-sym ~t-next-fn-sym]
~@transform-body)
))
`(i/->ParamsNeededPath
(reify RichNavigator
(~'rich-select* [this# ~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
))
(~'rich-transform* [this# ~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
))))
(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)
))
nav# (reify RichNavigator
(~'rich-select* [this# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#]
(collector# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#))
(~'rich-transform* [this# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#]
(collector# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~structure-sym next-fn#))
)]
(if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath
nav#
~num-params
))))
(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?#)
(if (i/params-needed-path? ret#)
(i/bind-params* ret# nil 0)
ret#)
ret#
))))
(defn ^:no-doc make-param-retrievers [params]
(->> params
(map-indexed
(fn [i p]
[p `(i/object-aget ~PARAMS-SYM
(+ ~PARAMS-IDX-SYM ~i))]
))
(apply concat)))
(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])
))
(defmacro richnav (defmacro richnav
"Defines a navigator with full access to collected vals, the parameters array, "Defines a navigator with full access to collected vals, the parameters array,
and the parameters array index. `next-fn` expects to receive the params 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. 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 `next-fn` will automatically skip ahead in params array by `num-params`, so the
index passed to it is ignored. index passed to it is ignored.
This is the lowest level way of making navigators." This is the lowest level way of making navigators."
[num-params impl1 impl2] [num-params impl1 impl2]
(let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2) (let [[[s-params & s-body] [t-params & t-body]] (determine-params-impls impl1 impl2)
s-next-fn-sym (last s-params) s-next-fn-sym (last s-params)
@ -155,93 +40,208 @@
(let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)]
~@t-body)) ~@t-body))
)] )]
(if (zero? num-params#) (if (zero? num-params#)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# num-params#) (i/->ParamsNeededPath nav# num-params#)
))))
(defmacro 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 lean-nav* [& impls]
`(reify Navigator ~@impls))
(defn 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 (map vector binding-fn-syms fn-exprs)
binding-declarations (map (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 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]]
(determine-params-impls impl1 impl2)
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 collector-with-bindings [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 [cfn# (fn [params# params-idx# vals# ~structure-sym next-fn#]
(next-fn# params# params-idx# (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 (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)
`(i/lean-compiled-path (lean-nav* ~@impls))
`(i/->ParamsNeededPath
;(fn ~params (lean-nav* ~@body))
(rich-nav-with-bindings ~(count params)
~(delta-param-bindings params)
~@impls
)
~(count params)
)))
(defmacro collector
"Defines a Collector with late bound parameters. This collector can be precompiled "Defines a Collector with late bound parameters. This collector can be precompiled
with other selectors without knowing the parameters. When precompiled with other with other selectors without knowing the parameters. When precompiled with other
selectors, the resulting selector takes in parameters for all selectors in the path selectors, the resulting selector takes in parameters for all selectors in the path
that needed parameters (in the order in which they were declared). that needed parameters (in the order in which they were declared).
" "
[params impl] [params body]
(let [num-params (count params) `(let [rich-nav (collector-with-bindings ~(count params)
retrieve-params (make-param-retrievers params)] ~(delta-param-bindings params)
(paramscollector* retrieve-params num-params impl) ~impl-body
)) )]
(if ~(empty? params)
(i/no-params-rich-compiled-path rich-nav)
(i/->ParamsNeededPath
; (fn ~params
; (collector-with-bindings 0
; ~impl-body))
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 (dfn/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* ~@body))
)
(->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 _ total-params-sym]
`(->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] (defmacro defnav [name & body]
`(def ~name (nav ~@body))) `(def ~name (nav ~@body)))
(defmacro defcollector [name & 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] (defn- protpath-sym [name]
(-> name (str "-prot") symbol)) (-> name (str "-prot") symbol))
@ -249,47 +249,47 @@
(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
specify that all extensions must require that number of parameters. specify that all extensions must require that number of parameters.
Currently not available for ClojureScript. Currently not available for ClojureScript.
Example of usage: Example of usage:
(defrecord SingleAccount [funds]) (defrecord SingleAccount [funds])
(defrecord FamilyAccount [single-accounts]) (defrecord FamilyAccount [single-accounts])
(defprotocolpath FundsPath) (defprotocolpath FundsPath)
(extend-protocolpath FundsPath (extend-protocolpath FundsPath
SingleAccount :funds SingleAccount :funds
FamilyAccount [ALL FundsPath] FamilyAccount [ALL FundsPath]
) )
" "
([name] ([name]
`(defprotocolpath ~name [])) `(defprotocolpath ~name []))
([name params] ([name params]
(let [prot-name (protpath-sym name) (let [prot-name (protpath-sym name)
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 "params") (gensym "pidx") (gensym "vals") ssym (gensym "next-fn")]
retrieve `(~m ~ssym) retrieve `(~m ~ssym)
] ]
`(do `(do
(defprotocol ~prot-name (~m [structure#])) (defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)
)) ))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-transform* inav# ~@rargs) (i/exec-rich-transform* inav# ~@rargs)
)))] )))]
(def ~name (def ~name
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params)
))))))) )))))))
@ -301,32 +301,32 @@
(defmacro declarepath (defmacro declarepath
([name] ([name]
`(declarepath ~name [])) `(declarepath ~name []))
([name params] ([name params]
(let [platform (if (contains? &env :locals) :cljs :clj) (let [platform (if (contains? &env :locals) :cljs :clj)
select-exec (if (= platform :clj) select-exec (if (= platform :clj)
`i/exec-rich-select* `i/exec-rich-select*
`i/rich-select*) `i/rich-select*)
transform-exec (if (= platform :clj) transform-exec (if (= platform :clj)
`i/exec-rich-transform* `i/exec-rich-transform*
`i/rich-transform*) `i/rich-transform*)
num-params (count params) num-params (count params)
declared (declared-name name) declared (declared-name name)
rargs [(gensym "params") (gensym "pidx") (gensym "vals") rargs [(gensym "params") (gensym "pidx") (gensym "vals")
(gensym "structure") (gensym "next-fn")]] (gensym "structure") (gensym "next-fn")]]
`(do `(do
(declare ~declared) (declare ~declared)
(def ~name (def ~name
(let [nav# (reify RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(~select-exec ~declared ~@rargs)) (~select-exec ~declared ~@rargs))
(~'rich-transform* [this# ~@rargs] (~'rich-transform* [this# ~@rargs]
(~transform-exec ~declared ~@rargs) (~transform-exec ~declared ~@rargs)
))] ))]
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path nav#) (i/no-params-rich-compiled-path nav#)
(i/->ParamsNeededPath nav# ~num-params) (i/->ParamsNeededPath nav# ~num-params)
))))))) )))))))
(defmacro providepath [name apath] (defmacro providepath [name apath]
`(let [comped# (i/comp-paths-internalized ~apath) `(let [comped# (i/comp-paths-internalized ~apath)
@ -334,10 +334,10 @@
needed-params# (i/num-needed-params comped#)] needed-params# (i/num-needed-params comped#)]
(if-not (= needed-params# expected-params#) (if-not (= needed-params# expected-params#)
(i/throw-illegal "Invalid number of params in provided path, expected " (i/throw-illegal "Invalid number of params in provided path, expected "
expected-params# " but got " needed-params#)) expected-params# " but got " needed-params#))
(def ~(declared-name name) (def ~(declared-name name)
(i/extract-rich-nav (i/coerce-compiled->rich-nav comped#)) (i/extract-rich-nav (i/coerce-compiled->rich-nav comped#))
))) )))
(defmacro extend-protocolpath (defmacro extend-protocolpath
"Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]."
@ -347,14 +347,14 @@
;; copied from tools.macro to avoid the dependency ;; copied from tools.macro to avoid the dependency
(defn ^:no-doc name-with-attributes (defn ^:no-doc name-with-attributes
"To be used in macro definitions. "To be used in macro definitions.
Handles optional docstrings and attribute maps for a name to be defined 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, 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 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 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 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 macro argument list. The return value is a vector containing the name
with its extended metadata map and the list of unprocessed macro with its extended metadata map and the list of unprocessed macro
arguments." arguments."
[name macro-args] [name macro-args]
(let [[docstring macro-args] (if (string? (first macro-args)) (let [[docstring macro-args] (if (string? (first macro-args))
[(first macro-args) (next macro-args)] [(first macro-args) (next macro-args)]
@ -372,14 +372,14 @@
(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. This macro is generally used in conjunction with [[fixed-pathed-nav]]
or [[variable-pathed-nav]]. When inline factoring 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 automatically interepret all one of these higher order navigators, it will automatically interepret all
arguments as paths, factor them accordingly, and set up the callsite to arguments as paths, factor them accordingly, and set up the callsite to
provide the parameters dynamically. Use ^:notpath metadata on arguments provide the parameters dynamically. Use ^:notpath metadata on arguments
to indicate non-path arguments that should not be factored  note that in order 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 to be inline factorable, these arguments must be statically resolvable (e.g. a
top level var). See `transformed` for an example." 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)]
@ -391,22 +391,22 @@
checked-code checked-code
(doall (doall
(for [[args & body] bodies] (for [[args & body] bodies]
`(~args `(~args
(let [ret# (do ~@body)] (let [ret# (do ~@body)]
(if (i/layered-nav? ret#) (if (i/layered-nav? ret#)
(i/layered-nav-underlying ret#) (i/layered-nav-underlying ret#)
(i/throw-illegal "Expected result navigator '" (quote ~anav) (i/throw-illegal "Expected result navigator '" (quote ~anav)
"' from nav constructor '" (quote ~name) "'" "' from nav constructor '" (quote ~name) "'"
" constructed with the provided constructor '" (quote ~csym) " constructed with the provided constructor '" (quote ~csym)
"'")) "'"))
))))] ))))]
`(def ~name `(def ~name
(vary-meta (vary-meta
(let [~csym (i/layered-wrapper ~anav)] (let [~csym (i/layered-wrapper ~anav)]
(fn ~@checked-code)) (fn ~@checked-code))
assoc :layerednav true)) assoc :layerednav true))
)) ))
(defn ^:no-doc ic-prepare-path [locals-set path] (defn ^:no-doc ic-prepare-path [locals-set path]
@ -428,9 +428,9 @@
(if (or (= 'fn op) (special-symbol? op)) (if (or (= 'fn op) (special-symbol? op))
`(com.rpl.specter.impl/->SpecialFormUse ~path (quote ~path)) `(com.rpl.specter.impl/->SpecialFormUse ~path (quote ~path))
`(com.rpl.specter.impl/->FnInvocation `(com.rpl.specter.impl/->FnInvocation
~(ic-prepare-path locals-set op) ~(ic-prepare-path locals-set op)
~(mapv #(ic-prepare-path locals-set %) params) ~(mapv #(ic-prepare-path locals-set %) params)
(quote ~path))) (quote ~path)))
) )
:else :else
@ -440,21 +440,21 @@
(defn ^:no-doc ic-possible-params [path] (defn ^:no-doc ic-possible-params [path]
(do (do
(mapcat (mapcat
(fn [e] (fn [e]
(cond (or (set? e) (cond (or (set? e)
(map? e) ; in case inline maps are ever extended (map? e) ; in case inline maps are ever extended
(and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e))))
[e] [e]
(i/fn-invocation? e) (i/fn-invocation? e)
;; the [e] here handles nav constructors ;; the [e] here handles nav constructors
(concat [e] (rest e) (ic-possible-params e)) (concat [e] (rest e) (ic-possible-params e))
(vector? e) (vector? e)
(ic-possible-params e) (ic-possible-params e)
)) ))
path path
))) )))
(defn cljs-macroexpand [env form] (defn cljs-macroexpand [env form]
(let [expand-fn (i/cljs-analyzer-macroexpand-1) (let [expand-fn (i/cljs-analyzer-macroexpand-1)
@ -479,32 +479,32 @@
;; still possible to mess this up with alter-var-root ;; still possible to mess this up with alter-var-root
(defmacro path (defmacro path
"Same as calling comp-paths, except it caches the composition of the static part "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 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 of Specter provides huge speedup. This macro is automatically used by the
select/transform/setval/replace-in/etc. macros." select/transform/setval/replace-in/etc. macros."
[& path] [& path]
(let [;;this is a hack, but the composition of &env is considered stable for cljs (let [;;this is a hack, but the composition of &env is considered stable for cljs
platform (if (contains? &env :locals) :cljs :clj) platform (if (contains? &env :locals) :cljs :clj)
local-syms (if (= platform :cljs) local-syms (if (= platform :cljs)
(-> &env :locals keys set) ;cljs (-> &env :locals keys set) ;cljs
(-> &env keys set) ;clj (-> &env keys set) ;clj
) )
used-locals-cell (i/mutable-cell []) used-locals-cell (i/mutable-cell [])
_ (cljwalk/postwalk _ (cljwalk/postwalk
(fn [e] (fn [e]
(if (local-syms e) (if (local-syms e)
(i/update-cell! used-locals-cell #(conj % e)) (i/update-cell! used-locals-cell #(conj % e))
e e
)) ))
path) path)
used-locals (i/get-cell used-locals-cell) used-locals (i/get-cell used-locals-cell)
;; note: very important to use riddley's macroexpand-all here, so that ;; note: very important to use riddley's macroexpand-all here, so that
;; &env is preserved in any potential nested calls to select (like via ;; &env is preserved in any potential nested calls to select (like via
;; a view function) ;; a view function)
expanded (if (= platform :clj) expanded (if (= platform :clj)
(i/clj-macroexpand-all (vec path)) (i/clj-macroexpand-all (vec path))
(cljs-macroexpand-all &env (vec path))) (cljs-macroexpand-all &env (vec path)))
prepared-path (ic-prepare-path local-syms expanded) prepared-path (ic-prepare-path local-syms expanded)
possible-params (vec (ic-possible-params expanded)) possible-params (vec (ic-possible-params expanded))
@ -513,22 +513,22 @@
;; to invoke and/or parameterize the precompiled path without ;; to invoke and/or parameterize the precompiled path without
;; a bunch of checks beforehand ;; a bunch of checks beforehand
cache-sym (vary-meta cache-sym (vary-meta
(gensym "pathcache") (gensym "pathcache")
assoc :cljs.analyzer/no-resolve true) assoc :cljs.analyzer/no-resolve true)
info-sym (gensym "info") info-sym (gensym "info")
get-cache-code (if (= platform :clj) get-cache-code (if (= platform :clj)
`(try (i/get-cell ~cache-sym) `(try (i/get-cell ~cache-sym)
(catch ClassCastException e# (catch ClassCastException e#
(if (bound? (var ~cache-sym)) (if (bound? (var ~cache-sym))
(throw e#) (throw e#)
(do (do
(alter-var-root (alter-var-root
(var ~cache-sym) (var ~cache-sym)
(fn [_#] (i/mutable-cell))) (fn [_#] (i/mutable-cell)))
nil nil
)))) ))))
cache-sym cache-sym
) )
add-cache-code (if (= platform :clj) add-cache-code (if (= platform :clj)
@ -543,28 +543,28 @@
(if (= platform :clj) (if (= platform :clj)
`(i/bind-params* ~precompiled-sym (~params-maker-sym ~@used-locals) 0) `(i/bind-params* ~precompiled-sym (~params-maker-sym ~@used-locals) 0)
`(i/handle-params `(i/handle-params
~precompiled-sym ~precompiled-sym
~params-maker-sym ~params-maker-sym
~(mapv (fn [p] `(fn [] ~p)) possible-params) ~(mapv (fn [p] `(fn [] ~p)) possible-params)
)) ))
] ]
(if (= platform :clj) (if (= platform :clj)
(i/intern* *ns* cache-sym (i/mutable-cell))) (i/intern* *ns* cache-sym (i/mutable-cell)))
`(let [info# ~get-cache-code `(let [info# ~get-cache-code
^com.rpl.specter.impl.CachedPathInfo info# ^com.rpl.specter.impl.CachedPathInfo info#
(if (nil? info#) (if (nil? info#)
(let [~info-sym (i/magic-precompilation (let [~info-sym (i/magic-precompilation
~prepared-path ~prepared-path
~(str *ns*) ~(str *ns*)
(quote ~used-locals) (quote ~used-locals)
(quote ~possible-params) (quote ~possible-params)
)] )]
~add-cache-code ~add-cache-code
~info-sym ~info-sym
) )
info# info#
) )
~precompiled-sym (.-precompiled info#) ~precompiled-sym (.-precompiled info#)
~params-maker-sym (.-params-maker info#)] ~params-maker-sym (.-params-maker info#)]
@ -575,112 +575,112 @@
~handle-params-code ~handle-params-code
) )
)) ))
)) ))
(defmacro select (defmacro select
"Navigates to and returns a sequence of all the elements specified by the path. "Navigates to and returns a sequence of all the elements specified by the path.
This macro will attempt to do inline factoring and caching of the path, falling 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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))
(defmacro multi-transform (defmacro multi-transform
"Just like `transform` but expects transform functions to be specified "Just like `transform` but expects transform functions to be specified
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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." factor/cache the path."
[apath structure] [apath structure]
`(i/do-compiled-traverse (path ~apath) ~structure)) `(i/do-compiled-traverse (path ~apath) ~structure))
(defmacro replace-in (defmacro replace-in
"Similar to transform, except returns a pair of [transformed-structure sequence-of-user-ret]. "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 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 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 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 back to compiling the path on every invocation if it's not possible to
factor/cache the path." 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))
(defmacro collected? (defmacro collected?
"Creates a filter function navigator that takes in all the collected values "Creates a filter function navigator that takes in all the collected values
as input. For arguments, can use `(collected? [a b] ...)` syntax to look as input. For arguments, can use `(collected? [a b] ...)` syntax to look
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)] (let [platform (if (contains? &env :locals) :cljs :clj)]
`(i/collected?* (~'fn [~params] ~@body)) `(i/collected?* (~'fn [~params] ~@body))