completely re-implement nav, collector, fixed-pathed-nav, and pathed-collector in cleaner and more flexible way
This commit is contained in:
parent
33d19ebd1d
commit
e7dc940cd0
1 changed files with 399 additions and 399 deletions
|
|
@ -2,7 +2,8 @@
|
|||
(:use [com.rpl.specter.protocols :only [Navigator]]
|
||||
[com.rpl.specter.impl :only [RichNavigator]])
|
||||
(:require [com.rpl.specter.impl :as i]
|
||||
[clojure.walk :as cljwalk])
|
||||
[clojure.walk :as cljwalk]
|
||||
[com.rpl.specter.defnavhelpers :as dnh])
|
||||
)
|
||||
|
||||
(defn ^:no-doc gensyms [amt]
|
||||
|
|
@ -16,122 +17,6 @@
|
|||
[impl1 impl2]
|
||||
[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
|
||||
"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,
|
||||
|
|
@ -160,6 +45,186 @@
|
|||
(i/->ParamsNeededPath nav# num-params#)
|
||||
))))
|
||||
|
||||
(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
|
||||
with other selectors without knowing the parameters. When precompiled with other
|
||||
selectors, the resulting selector takes in parameters for all selectors in the path
|
||||
that needed parameters (in the order in which they were declared).
|
||||
"
|
||||
[params body]
|
||||
`(let [rich-nav (collector-with-bindings ~(count params)
|
||||
~(delta-param-bindings params)
|
||||
~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#]
|
||||
|
|
@ -171,77 +236,12 @@
|
|||
(i/filter-transform afn# structure# next-fn#)
|
||||
))))
|
||||
|
||||
(defmacro paramscollector
|
||||
"Defines a Collector with late bound parameters. This collector can be precompiled
|
||||
with other selectors without knowing the parameters. When precompiled with other
|
||||
selectors, the resulting selector takes in parameters for all selectors in the path
|
||||
that needed parameters (in the order in which they were declared).
|
||||
"
|
||||
[params impl]
|
||||
(let [num-params (count params)
|
||||
retrieve-params (make-param-retrievers params)]
|
||||
(paramscollector* retrieve-params num-params impl)
|
||||
))
|
||||
|
||||
(defmacro defnav [name & body]
|
||||
`(def ~name (nav ~@body)))
|
||||
|
||||
(defmacro defcollector [name & body]
|
||||
`(def ~name (paramscollector ~@body)))
|
||||
`(def ~name (collector ~@body)))
|
||||
|
||||
(defmacro fixed-pathed-nav
|
||||
"This helper is used to define navigators that take in a fixed number of other
|
||||
paths as input. Those paths may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[bindings impl1 impl2]
|
||||
(let [bindings (partition 2 bindings)
|
||||
paths (mapv second bindings)
|
||||
names (mapv first bindings)
|
||||
latefns-sym (gensym "latefns")
|
||||
latefn-syms (vec (gensyms (count paths)))]
|
||||
(pathed-nav*
|
||||
paramsnav*
|
||||
paths
|
||||
latefns-sym
|
||||
[latefn-syms latefns-sym]
|
||||
(mapcat (fn [n l] [n `(~l ~PARAMS-SYM ~PARAMS-IDX-SYM)]) names latefn-syms)
|
||||
[impl1 impl2])))
|
||||
|
||||
(defmacro variable-pathed-nav
|
||||
"This helper is used to define navigators that take in a variable number of other
|
||||
paths as input. Those paths may require late-bound params, so this helper
|
||||
will create a parameterized navigator if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[[latepaths-seq-sym paths-seq] impl1 impl2]
|
||||
(let [latefns-sym (gensym "latefns")]
|
||||
(pathed-nav*
|
||||
paramsnav*
|
||||
paths-seq
|
||||
latefns-sym
|
||||
[]
|
||||
[latepaths-seq-sym `(map (fn [l#] (l# ~PARAMS-SYM ~PARAMS-IDX-SYM))
|
||||
~latefns-sym)]
|
||||
[impl1 impl2]
|
||||
)))
|
||||
|
||||
(defmacro pathed-collector
|
||||
"This helper is used to define collectors that take in a single selector
|
||||
paths as input. That path may require late-bound params, so this helper
|
||||
will create a parameterized selector if that is the case. If no late-bound params
|
||||
are required, then the result is executable."
|
||||
[[name path] impl]
|
||||
(let [latefns-sym (gensym "latefns")
|
||||
latefn (gensym "latefn")]
|
||||
(pathed-nav*
|
||||
paramscollector*
|
||||
[path]
|
||||
latefns-sym
|
||||
[[latefn] latefns-sym]
|
||||
[name `(~latefn ~PARAMS-SYM ~PARAMS-IDX-SYM)]
|
||||
impl
|
||||
)
|
||||
))
|
||||
|
||||
(defn- protpath-sym [name]
|
||||
(-> name (str "-prot") symbol))
|
||||
|
|
@ -263,7 +263,7 @@
|
|||
SingleAccount :funds
|
||||
FamilyAccount [ALL FundsPath]
|
||||
)
|
||||
"
|
||||
"
|
||||
([name]
|
||||
`(defprotocolpath ~name []))
|
||||
([name params]
|
||||
|
|
|
|||
Loading…
Reference in a new issue