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
@ -41,7 +39,7 @@
(i/comp-paths* (vec apath))) (i/comp-paths* (vec apath)))
(def ^{:doc "Mandate that operations that do inline path factoring and compilation (def ^{:doc "Mandate that operations that do inline path factoring and compilation
(select/transform/setval/replace-in/path/etc.) must succeed in (select/transform/setval/replace-in/path/etc.) must succeed in
factoring the path into static and dynamic portions. If not, an factoring the path into static and dynamic portions. If not, an
error will be thrown and the reasons for not being able to factor error will be thrown and the reasons for not being able to factor
will be printed. Defaults to false, and `(must-cache-paths! false)` will be printed. Defaults to false, and `(must-cache-paths! false)`
@ -138,7 +136,7 @@
(defn multi-transform* (defn 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`."
[path structure] [path structure]
(compiled-multi-transform (i/comp-paths* path) structure)) (compiled-multi-transform (i/comp-paths* path) structure))
@ -185,7 +183,7 @@
;; Built-in pathing and context operations ;; Built-in pathing and context operations
(defnav (defnav
^{:doc "Stops navigation at this point. For selection returns nothing and for ^{:doc "Stops navigation at this point. For selection returns nothing and for
transformation returns the structure unchanged"} transformation returns the structure unchanged"}
STOP STOP
[] []
@ -236,7 +234,7 @@
(n/all-transform structure next-fn))) (n/all-transform structure next-fn)))
(defnav (defnav
^{:doc "Navigate to each value of the map. This is more efficient than ^{:doc "Navigate to each value of the map. This is more efficient than
navigating via [ALL LAST]"} navigating via [ALL LAST]"}
MAP-VALS MAP-VALS
[] []
@ -324,7 +322,7 @@
(let [to-append (next-fn [])] (let [to-append (next-fn [])]
(n/append-all structure to-append) (n/append-all structure to-append)
))) )))
(defnav (defnav
^{:doc "Navigates to the specified subset (by taking an intersection). ^{:doc "Navigates to the specified subset (by taking an intersection).
In a transform, that subset in the original set is changed to the In a transform, that subset in the original set is changed to the
@ -431,8 +429,8 @@
)) ))
(defnav (defnav
^{:doc "Navigate to the result of running `parse-fn` on the value. For ^{:doc "Navigate to the result of running `parse-fn` on the value. For
transforms, the transformed value then has `unparse-fn` run on transforms, the transformed value then has `unparse-fn` run on
it to get the final value at this point."} it to get the final value at this point."}
parser parser
[parse-fn unparse-fn] [parse-fn unparse-fn]
@ -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)
))) )))
@ -652,7 +650,7 @@
then-needed then-needed
else-nav else-nav
)))) ))))
(let [cond-comp (i/comp-paths-internalized cond-p) (let [cond-comp (i/comp-paths-internalized cond-p)
cond-needed (i/num-needed-params cond-comp)] cond-needed (i/num-needed-params cond-comp)]
(richnav (+ then-needed else-needed cond-needed) (richnav (+ then-needed else-needed cond-needed)
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]

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
@ -169,7 +168,7 @@
#+cljs #+cljs
default default
#+cljs #+cljs
(all-transform [structure next-fn] (all-transform [structure next-fn]
(let [empty-structure (empty structure)] (let [empty-structure (empty structure)]
(if (and (list? empty-structure) (not (queue? empty-structure))) (if (and (list? empty-structure) (not (queue? empty-structure)))
@ -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)))))