completely re-implement nav, collector, fixed-pathed-nav, and pathed-collector in cleaner and more flexible way
This commit is contained in:
Nathan Marz
parent
33d19ebd1d
commit
e7dc940cd0
1 changed files with 399 additions and 399 deletions
|
|
@ -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]
|
||||||
|
|
@ -16,122 +17,6 @@
|
||||||
[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,
|
||||||
|
|
@ -160,6 +45,186 @@
|
||||||
(i/->ParamsNeededPath nav# num-params#)
|
(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]
|
(defmacro paramsfn [params [structure-sym] & impl]
|
||||||
`(nav ~params
|
`(nav ~params
|
||||||
(~'select* [this# structure# next-fn#]
|
(~'select* [this# structure# next-fn#]
|
||||||
|
|
@ -171,77 +236,12 @@
|
||||||
(i/filter-transform afn# structure# next-fn#)
|
(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]
|
(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))
|
||||||
|
|
@ -263,7 +263,7 @@
|
||||||
SingleAccount :funds
|
SingleAccount :funds
|
||||||
FamilyAccount [ALL FundsPath]
|
FamilyAccount [ALL FundsPath]
|
||||||
)
|
)
|
||||||
"
|
"
|
||||||
([name]
|
([name]
|
||||||
`(defprotocolpath ~name []))
|
`(defprotocolpath ~name []))
|
||||||
([name params]
|
([name params]
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue