all higher order selectors now converted to be parameterizable, helpers for making higher order selectors with fixed paths or variable paths complete

This commit is contained in:
Nathan Marz 2015-09-10 20:47:46 -04:00
parent 3187cdad34
commit a983e6e028
2 changed files with 115 additions and 123 deletions

View file

@ -128,14 +128,28 @@
`(def ~name (paramspath ~@body))) `(def ~name (paramspath ~@body)))
(defmacro params-paramspath [bindings & impls] (defmacro params-paramspath [bindings & impls]
(i/params-paramspath* (partition 2 bindings) impls)) (let [bindings (partition 2 bindings)
paths (mapv second bindings)
names (mapv first bindings)
latefns-sym (gensym "latefns")
latefn-syms (vec (i/gensyms (count paths)))]
(i/params-paramspath*
paths
latefns-sym
[latefn-syms latefns-sym]
(mapcat (fn [n l] [n `(~l ~i/PARAMS-SYM ~i/PARAMS-IDX-SYM)]) names latefn-syms)
impls)))
;;TODO: needs to parameterize if necessary according to its path (defmacro params-varparamspath [[latepaths-seq-sym paths-seq] & impls]
;; same for selected?, not-selected?, transformed, collect, collect-one, (let [latefns-sym (gensym "latefns")]
;; cond-path, multi-path (i/params-paramspath*
;;TODO: figure out how to express srange in terms of srange-dynamic paths-seq
;; - will need selector and transformer to call into shared functions latefns-sym
;;TODO: get rid of KeyPath []
[latepaths-seq-sym `(map (fn [l#] (l# ~i/PARAMS-SYM ~i/PARAMS-IDX-SYM))
~latefns-sym)]
impls
)))
;; Built-in pathing and context operations ;; Built-in pathing and context operations
@ -190,26 +204,41 @@
"Filters the current value based on whether a selector finds anything. "Filters the current value based on whether a selector finds anything.
e.g. (selected? :vals ALL even?) keeps the current element only if an e.g. (selected? :vals ALL even?) keeps the current element only if an
even number exists for the :vals key" even number exists for the :vals key"
[& selectors] [& path]
(let [s (i/comp-paths* selectors)] (params-paramspath [late path]
(fn [structure] (select* [this structure next-fn]
(->> structure (i/filter-select
(select s) #(i/selected?* late %)
empty? structure
not)))) next-fn))
(transform* [this structure next-fn]
(i/filter-transform
#(i/selected?* late %)
structure
next-fn))))
(defn not-selected? [& path] (defn not-selected? [& path]
(complement (selected? (i/comp-paths* path)))) (params-paramspath [late path]
(select* [this structure next-fn]
(i/filter-select
#(i/not-selected?* late %)
structure
next-fn))
(transform* [this structure next-fn]
(i/filter-transform
#(i/not-selected?* late %)
structure
next-fn))))
(defn transformed (defn transformed
"Navigates to a view of the current value by transforming it with the "Navigates to a view of the current value by transforming it with the
specified selector and update-fn." specified selector and update-fn."
[selector update-fn] [path update-fn]
(let [compiled (i/comp-paths* selector)] (params-paramspath [late path]
(view (select* [this structure next-fn]
(fn [elem] (next-fn (compiled-transform late update-fn structure)))
(compiled-transform compiled update-fn elem) (transform* [this structure next-fn]
)))) (next-fn (compiled-transform late update-fn structure)))))
(extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword) (extend-type #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword)
StructurePath StructurePath
@ -249,6 +278,8 @@
[val] [val]
(i/->PutValCollector val)) (i/->PutValCollector val))
;;TODO: test nothing matches case
(defn cond-path (defn cond-path
"Takes in alternating cond-path selector cond-path selector... "Takes in alternating cond-path selector cond-path selector...
Tests the structure if selecting with cond-path returns anything. Tests the structure if selecting with cond-path returns anything.
@ -256,21 +287,39 @@
Otherwise, it tries the next cond-path. If nothing matches, then the structure Otherwise, it tries the next cond-path. If nothing matches, then the structure
is not selected." is not selected."
[& conds] [& conds]
(->> conds (params-varparamspath [compiled-paths conds]
(partition 2) (select* [this structure next-fn]
(map (fn [[c p]] [(i/comp-paths* c) (i/comp-paths* p)])) (if-let [selector (i/retrieve-cond-selector compiled-paths structure)]
doall (->> (compiled-select selector structure)
i/->ConditionalPath (mapcat next-fn)
)) doall)))
(transform* [this structure next-fn]
(if-let [selector (i/retrieve-cond-selector compiled-paths structure)]
(compiled-transform selector next-fn structure)
structure
))))
(defn if-path (defn if-path
"Like cond-path, but with if semantics." "Like cond-path, but with if semantics."
([cond-fn if-path] (cond-path cond-fn if-path)) ([cond-p if-path] (cond-path cond-p if-path))
([cond-fn if-path else-path] ([cond-p if-path else-path]
(cond-path cond-fn if-path nil else-path))) (cond-path cond-p if-path nil else-path)))
(defn multi-path (defn multi-path
"A path that branches on multiple paths. For updates, "A path that branches on multiple paths. For updates,
applies updates to the paths in order." applies updates to the paths in order."
[& paths] [& paths]
(i/->MultiPath (->> paths (map i/comp-paths*) doall))) (params-varparamspath [compiled-paths paths]
(select* [this structure next-fn]
(->> compiled-paths
(mapcat #(compiled-select % structure))
(mapcat next-fn)
doall
))
(transform* [this structure next-fn]
(reduce
(fn [structure selector]
(compiled-transform selector next-fn structure))
structure
compiled-paths
))))

View file

@ -9,6 +9,9 @@
[clojure.string :as s]) [clojure.string :as s])
) )
(defn gensyms [amt]
(vec (repeatedly amt gensym)))
(defprotocol PathComposer (defprotocol PathComposer
(comp-paths* [paths])) (comp-paths* [paths]))
@ -360,54 +363,25 @@
0 0
(:num-needed-params path))) (:num-needed-params path)))
(defn params-paramspath* [bindings impls] (defn params-paramspath* [paths-seq latefns-sym pre-bindings post-bindings impls]
(let [bindings (->> bindings (let [num-params-sym (gensym "num-params")]
(map (fn [[late-sym path]] `(let [paths# (map comp-paths* ~paths-seq)
{:late-sym late-sym needed-params# (map num-needed-params paths#)
:path path offsets# (cons 0 (reductions + needed-params#))
:path-sym (gensym "path") ~num-params-sym (last offsets#)
:offset-sym (gensym "offset") ~latefns-sym (map
:latebind-sym (gensym "latebind")})) (fn [o# p#]
(reduce (if (instance? CompiledPath p#)
(fn [bindings binding]
(if (empty? bindings)
[(assoc binding :offset 0)]
(let [last-binding (last bindings)]
(conj bindings
(assoc binding
:offset
`(+ ~(:offset-sym last-binding)
(num-needed-params ~(:path-sym last-binding)))
))
)))
[]))
binding-decls (mapcat (fn [b] [(:path-sym b) `(comp-paths* ~(:path b))]) bindings)
offset-decls (mapcat (fn [b] [(:offset-sym b) (:offset b)]) bindings)
needed-params (map (fn [b] `(num-needed-params ~(:path-sym b))) bindings)
latefn-decls (mapcat
(fn [b]
[(:latebind-sym b)
`(if (instance? CompiledPath ~(:path-sym b))
(fn [params# params-idx#] ~(:path-sym b))
(fn [params# params-idx#] (fn [params# params-idx#]
(bind-params ~(:path-sym b) p# )
params# (fn [params# params-idx#]
(+ params-idx# (bind-params p# params# (+ params-idx# o#))
~(:offset-sym b))) )))
)) offsets#
]) paths#)
bindings) ~@pre-bindings
ret# ~(paramspath* post-bindings num-params-sym impls)
num-params-sym (gensym "num-params") ]
latebindings (mapcat
(fn [b]
[(:late-sym b) `(~(:latebind-sym b) ~PARAMS-SYM ~PARAMS-IDX-SYM)])
bindings)]
`(let [~@binding-decls
~@offset-decls
~num-params-sym (+ ~@needed-params)
~@latefn-decls
ret# ~(paramspath* latebindings num-params-sym impls)]
(if (= 0 ~num-params-sym) (if (= 0 ~num-params-sym)
(bind-params ret# nil 0) (bind-params ret# nil 0)
ret# ret#
@ -502,12 +476,15 @@
((.-transform-executor ex) (.-params path) (.-params-idx path) (.-transformer tfns) transform-fn structure) ((.-transform-executor ex) (.-params path) (.-params-idx path) (.-transformer tfns) transform-fn structure)
)) ))
(defn selected?* (defn not-selected?*
[compiled-path structure] [compiled-path structure]
(->> structure (->> structure
(compiled-select* compiled-path) (compiled-select* compiled-path)
empty? empty?))
not))
(defn selected?*
[compiled-path structure]
(not (not-selected?* compiled-path structure)))
;; returns vector of all results ;; returns vector of all results
(defn- walk-select [pred continue-fn structure] (defn- walk-select [pred continue-fn structure]
@ -648,11 +625,9 @@
(next-fn structure) (next-fn structure)
)) ))
(defn retrieve-cond-selector [cond-paths structure]
(deftype ConditionalPath [cond-pairs]) (->> cond-paths
(partition 2)
(defn- retrieve-selector [cond-pairs structure]
(->> cond-pairs
(drop-while (fn [[c-selector _]] (drop-while (fn [[c-selector _]]
(->> structure (->> structure
(compiled-select* c-selector) (compiled-select* c-selector)
@ -661,38 +636,6 @@
second second
)) ))
;;TODO: test nothing matches case
(extend-protocol p/StructurePath
ConditionalPath
(select* [this structure next-fn]
(if-let [selector (retrieve-selector (.-cond-pairs this) structure)]
(->> (compiled-select* selector structure)
(mapcat next-fn)
doall)))
(transform* [this structure next-fn]
(if-let [selector (retrieve-selector (.-cond-pairs this) structure)]
(compiled-transform* selector next-fn structure)
structure
)))
(deftype MultiPath [paths])
(extend-protocol p/StructurePath
MultiPath
(select* [this structure next-fn]
(->> (.-paths this)
(mapcat #(compiled-select* % structure))
(mapcat next-fn)
doall
))
(transform* [this structure next-fn]
(reduce
(fn [structure selector]
(compiled-transform* selector next-fn structure))
structure
(.-paths this))
))
(defn filter-select [afn structure next-fn] (defn filter-select [afn structure next-fn]
(if (afn structure) (if (afn structure)
(next-fn structure))) (next-fn structure)))