This commit is contained in:
Nathan Marz 2016-08-05 15:48:55 -04:00
parent e7dc940cd0
commit e7db1803b1
3 changed files with 34 additions and 37 deletions

View file

@ -2,8 +2,7 @@
#+cljs (:require-macros #+cljs (:require-macros
[com.rpl.specter.macros [com.rpl.specter.macros
:refer :refer
[pathed-collector [fixed-pathed-collector
variable-pathed-nav
fixed-pathed-nav fixed-pathed-nav
defcollector defcollector
defnav defnav
@ -16,8 +15,7 @@
) )
(:use [com.rpl.specter.protocols :only [ImplicitNav]] (:use [com.rpl.specter.protocols :only [ImplicitNav]]
#+clj [com.rpl.specter.macros :only #+clj [com.rpl.specter.macros :only
[pathed-collector [fixed-pathed-collector
variable-pathed-nav
fixed-pathed-nav fixed-pathed-nav
defcollector defcollector
defnav defnav
@ -582,7 +580,7 @@
current value to the collected vals."} current value to the collected vals."}
collect collect
[& path] [& path]
(pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select late structure) (compiled-select late structure)
))) )))
@ -592,7 +590,7 @@
current value to the collected vals."} current value to the collected vals."}
collect-one collect-one
[& path] [& path]
(pathed-collector [late path] (fixed-pathed-collector [late path]
(collect-val [this structure] (collect-val [this structure]
(compiled-select-one late structure) (compiled-select-one late structure)
))) )))

View file

@ -53,10 +53,10 @@
binding-fn-syms (gensyms (count bindings)) binding-fn-syms (gensyms (count bindings))
binding-syms (map first bindings) binding-syms (map first bindings)
fn-exprs (map second bindings) fn-exprs (map second bindings)
binding-fn-declarations (map vector binding-fn-syms fn-exprs) binding-fn-declarations (vec (mapcat vector binding-fn-syms fn-exprs))
binding-declarations (map (fn [s f] `[s (f ~params-sym ~params-idx-sym)]) binding-declarations (vec (mapcat (fn [s f] [s `(~f ~params-sym ~params-idx-sym)])
binding-syms binding-syms
binding-fn-syms) binding-fn-syms))
body (op-maker binding-declarations)] body (op-maker binding-declarations)]
`(let [~@binding-fn-declarations] `(let [~@binding-fn-declarations]
~body ~body
@ -65,7 +65,7 @@
(defmacro rich-nav-with-bindings [num-params-code bindings & impls] (defmacro rich-nav-with-bindings [num-params-code bindings & impls]
(let [[[[_ s-structure-sym s-next-fn-sym] & s-body] (let [[[[_ s-structure-sym s-next-fn-sym] & s-body]
[[_ t-structure-sym t-next-fn-sym] & t-body]] [[_ t-structure-sym t-next-fn-sym] & t-body]]
(determine-params-impls impl1 impl2) (apply determine-params-impls impls)
params-sym (gensym "params") params-sym (gensym "params")
params-idx-sym (gensym "params-idx") params-idx-sym (gensym "params-idx")
] ]
@ -97,7 +97,7 @@
)) ))
))))) )))))
(defmacro collector-with-bindings [bindings impl] (defmacro collector-with-bindings [num-params-code bindings impl]
(let [[_ [_ structure-sym] & body] impl (let [[_ [_ structure-sym] & body] impl
params-sym (gensym "params") params-sym (gensym "params")
params-idx-sym (gensym "params")] params-idx-sym (gensym "params")]
@ -106,9 +106,11 @@
params-sym params-sym
params-idx-sym params-idx-sym
(fn [binding-declarations] (fn [binding-declarations]
`(let [cfn# (fn [params# params-idx# vals# ~structure-sym next-fn#] `(let [num-params# ~num-params-code
(next-fn# params# params-idx# (conj vals# (do ~@body) ~structure-sym)) 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 (reify RichNavigator
(~'rich-select* [this# params# params-idx# vals# structure# next-fn#] (~'rich-select* [this# params# params-idx# vals# structure# next-fn#]
(cfn# params# params-idx# vals# structure# next-fn#)) (cfn# params# params-idx# vals# structure# next-fn#))
@ -118,7 +120,7 @@
(defn- delta-param-bindings [params] (defn- delta-param-bindings [params]
(->> params (->> params
(map (fn [i p] [p `(dnh/param-delta ~i)])) (map-indexed (fn [i p] [p `(dnh/param-delta ~i)]))
(apply concat) (apply concat)
vec vec
)) ))
@ -147,17 +149,17 @@
that needed parameters (in the order in which they were declared). that needed parameters (in the order in which they were declared).
" "
[params body] [params body]
`(let [rich-nav (collector-with-bindings ~(count params) `(let [rich-nav# (collector-with-bindings ~(count params)
~(delta-param-bindings params) ~(delta-param-bindings params)
~impl-body ~body
)] )]
(if ~(empty? params) (if ~(empty? params)
(i/no-params-rich-compiled-path rich-nav) (i/no-params-rich-compiled-path rich-nav#)
(i/->ParamsNeededPath (i/->ParamsNeededPath
; (fn ~params ; (fn ~params
; (collector-with-bindings 0 ; (collector-with-bindings 0
; ~impl-body)) ; ~impl-body))
rich-nav rich-nav#
~(count params)) ~(count params))
))) )))
@ -169,7 +171,7 @@
compiled-syms (vec (gensyms (count bindings))) compiled-syms (vec (gensyms (count bindings)))
runtime-bindings (vec (mapcat runtime-bindings (vec (mapcat
(fn [l c d] (fn [l c d]
`[~l (dfn/bound-params ~c ~d)] `[~l (dnh/bound-params ~c ~d)]
) )
late-path-syms late-path-syms
compiled-syms compiled-syms
@ -197,9 +199,9 @@
lean-bindings (mapcat vector late-syms compiled-syms)] lean-bindings (mapcat vector late-syms compiled-syms)]
`(if (zero? ~total-params-sym) `(if (zero? ~total-params-sym)
(let [~@lean-bindings] (let [~@lean-bindings]
(i/lean-compiled-path (lean-nav* ~@body)) (i/lean-compiled-path (lean-nav* ~@impls))
) )
(->ParamsNeededPath (i/->ParamsNeededPath
(rich-nav-with-bindings ~total-params-sym (rich-nav-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@impls ~@impls
@ -217,7 +219,7 @@
[bindings & body] [bindings & body]
(fixed-pathed-operation bindings (fixed-pathed-operation bindings
(fn [runtime-bindings _ total-params-sym] (fn [runtime-bindings _ total-params-sym]
`(->ParamsNeededPath `(i/->ParamsNeededPath
(collector-with-bindings ~total-params-sym (collector-with-bindings ~total-params-sym
~runtime-bindings ~runtime-bindings
~@body ~@body

View file

@ -2,8 +2,7 @@
#+cljs (:require-macros #+cljs (:require-macros
[com.rpl.specter.macros [com.rpl.specter.macros
:refer :refer
[pathed-collector [fixed-pathed-collector
variable-pathed-nav
fixed-pathed-nav fixed-pathed-nav
defcollector defcollector
defnav defnav
@ -469,5 +468,3 @@
(next-fn params params-idx [] structure)) (next-fn params params-idx [] structure))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(next-fn params params-idx [] structure))))) (next-fn params params-idx [] structure)))))