luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixes

Browse source
This commit is contained in:
Nathan Marz 2016-09-01 10:04:51 -04:00
parent eb5de0bdd5
commit c80a2d3c50
4 changed files with 171 additions and 208 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

147
src/clj/com/rpl/specter.cljc
View file

@ -2,11 +2,12 @@
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter.macros [com.rpl.specter.macros
:refer :refer
[late-bound-richnav [late-bound-nav
late-bound-nav late-bound-richnav
late-bound-collector late-bound-collector
defcollector
defnav defnav
defpathedfn defdynamicnav
richnav richnav
defrichnav]] defrichnav]]
@ -15,11 +16,12 @@
(: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
[fixed-pathed-collector [late-bound-nav
fixed-pathed-nav late-bound-richnav
late-bound-collector
defcollector defcollector
defnav defnav
defpathedfn defdynamicnav
richnav richnav
defrichnav]]) defrichnav]])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
@ -150,6 +152,10 @@
[path transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}] [path transform-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
(compiled-replace-in (i/comp-paths* path) transform-fn structure :merge-fn merge-fn)) (compiled-replace-in (i/comp-paths* path) transform-fn structure :merge-fn merge-fn))
;; Helper for making late-bound navs
(def late-path i/late-path)
;; Built-in pathing and context operations ;; Built-in pathing and context operations
(defnav (defnav
@ -178,8 +184,8 @@
(richnav [afn] (richnav [afn]
(select* [this vals structure next-fn] (select* [this vals structure next-fn]
(i/throw-illegal "'terminal' should only be used in multi-transform")) (i/throw-illegal "'terminal' should only be used in multi-transform"))
(transform* [this params params-idx vals structure next-fn] (transform* [this vals structure next-fn]
(n/terminal* afn vals structure)))) (i/terminal* afn vals structure))))
(defn terminal-val (defn terminal-val
@ -254,14 +260,10 @@
continuous-subseqs continuous-subseqs
[pred] [pred]
(select* [this structure next-fn] (select* [this structure next-fn]
(doseqres NONE [[s e] (n/matching-ranges structure pred)] (doseqres NONE [[s e] (i/matching-ranges structure pred)]
(n/srange-select structure s e next-fn))) (n/srange-select structure s e next-fn)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(reduce (i/continuous-subseqs-transform* pred structure next-fn)))
(fn [structure [s e]]
(n/srange-transform structure s e next-fn))
structure
(reverse (n/matching-ranges structure pred)))))
(defnav (defnav
@ -334,9 +336,9 @@
(select* [this structure next-fn] (select* [this structure next-fn]
(n/walk-select afn next-fn structure)) (n/walk-select afn next-fn structure))
(transform* [this structure next-fn] (transform* [this structure next-fn]
(n/codewalk-until afn next-fn structure))) (i/codewalk-until afn next-fn structure)))
(defpathedfn subselect (defdynamicnav subselect
"Navigates to a sequence that contains the results of (select ...), "Navigates to a sequence that contains the results of (select ...),
but is a view to the original structure that can be transformed. but is a view to the original structure that can be transformed.
@ -344,7 +346,7 @@
children in the same order when executed on \"select\" and then children in the same order when executed on \"select\" and then
\"transform\"." \"transform\"."
[& path] [& path]
(late-bound-nav [late path] (late-bound-nav [late (late-path path)]
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (compiled-select late structure))) (next-fn (compiled-select late structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
@ -414,69 +416,14 @@
(swap! structure next-fn) (swap! structure next-fn)
structure))) structure)))
(defpathedfn selected? (defdynamicnav selected?
"Filters the current value based on whether a path finds anything. "Filters the current value based on whether a path 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."
[& path] [& path]
;;TODO: how to handle this if the path is being auto-compiled by this point?
;; same for if-path...
;; make selected? and if-path macros?
;; expand to: (if-let [(afn (extract-basic-filter-fn path)) (pred afn) (let [p ...] (nav [] ...))]
;; there needs to be a "compile-time" component here.... which is a macro
;; but it's not "compile-time", it's the first run-through by specter
;; maybe if pathed-fn returns a function when run in first run-through, then it's given
;; a compiled/parameterized version of the path
;; pathedfn basically substitutes for either a navigator or a parameterized navigator (parameterized
;; with a compiled path)
;; TODO: no, the function vs. nav thing doesn't work because a path may or may not
;; be needed by the resulting navigator... (and there could be multiple path arguments, some
;; of which may not be needed)
;; maybe there could be a special marker for inline caching to invoke different codepaths
;; if a path is a series of functions or not...
;; but would much rather have it be internalizable in the operation
;; maybe still have fixed-pathed-nav and inline caching turns path into something that
;; has delayed evaluation
;; what about non-path params? they should be dynamic every single time...
;; maybe defnav indicates what's a path and what's not...
;; - no, still need intermediate logic to determine what the nav will be...
;; it needs to happen outside the function...
;; or "transformed" needs to work differently... and return a function that takes in the param
;; could tag with metadata about how to statically analyze that argument
;; and then it takes in the actual paths as input
;; - this would compose with other pathedfns, like how filterer works
;; - but static analysis needs to ALSO switch the implementation depending on what it finds
;; - also needs to work if just call it like a regular function...
;; - maybe fixed-pathed-nav recognizes metadata on the path to see if it's inside inline
;; caching or not... and then decides whether to compile or not
;; - maybe I need a dynamic nav that looks at uncompiled paths and returns function to invoke
;; with the same arguments... uncompiledpath has parts of it escaped
;; - if path and all arguments are static then it will be invoked and cached normally...
;; - no, but still doesn't handle the switching to pred case and making a custom navigator
;; - unless rely on the fact it will be invoked statically when everything is constant...
;; - but filterer still doesn't seem to work so well...
;; - the dynamic nav is told when a ^:notpath argument is dynamic or not
;; - how does this compose for filterer?
;; - not quite right... since extraction only happens at "compile time" and then the
;; pred navigator used like it's static
;; - maybe instead of "fixed-pathed-nav" have "late-nav" that can also take non-path args that were
;; marked as ^:notpath
;; - having fixed-pathed-navs doesn't work because of non-path arguments
;; - returning functions doesn't work because may want to call down to other higher-order navs...
;; - maybe DO have a paramsneeded type that's a function with the uncompiled paths + dynamic local
;; information on it (which is what fixed-pathed-nav can do...)
;; - or can just say "with-args" and then metadata tells specter which are paths and which aren't
;; - (late-bound-nav [late path c an-arg])
;; - if they aren't bound yet, then that returns a function... otherwise it returns a proper navigator
;; - how does this compose with filterer?
;; (subselect ALL (selected? path))
;; - selected? returns a function that takes in params (and is annotated with WHAT params)...
;; - subselect does the same late bound stuff with its path and it sees what IT is composed of
;; - at end have an AST indicating what the final top-level paths / sub-paths are
(if-let [afn (n/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
afn afn
(late-bound-nav [late path] (late-bound-nav [late (late-path path)]
(select* [this structure next-fn] (select* [this structure next-fn]
(i/filter-select (i/filter-select
#(n/selected?* late %) #(n/selected?* late %)
@ -488,10 +435,10 @@
structure structure
next-fn))))) next-fn)))))
(defpathedfn not-selected? [& path] (defdynamicnav not-selected? [& path]
(if-let [afn (n/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
(fn [s] (not (afn s))) (fn [s] (not (afn s)))
(late-bound-nav [late path] (late-bound-nav [late (late-path path)]
(select* [this structure next-fn] (select* [this structure next-fn]
(i/filter-select (i/filter-select
#(n/not-selected?* late %) #(n/not-selected?* late %)
@ -503,7 +450,7 @@
structure structure
next-fn))))) next-fn)))))
(defpathedfn filterer (defdynamicnav filterer
"Navigates to a view of the current sequence that only contains elements that "Navigates to a view of the current sequence that only contains elements that
match the given path. An element matches the selector path if calling select match the given path. An element matches the selector path if calling select
on that element with the path yields anything other than an empty sequence. on that element with the path yields anything other than an empty sequence.
@ -514,15 +461,15 @@
[& path] [& path]
(subselect ALL (selected? path))) (subselect ALL (selected? path)))
(defpathedfn transformed (defdynamicnav 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 path and update-fn. specified path and update-fn.
The input path may be parameterized, in which case the result of transformed The input path may be parameterized, in which case the result of transformed
will be parameterized in the order of which the parameterized navigators will be parameterized in the order of which the parameterized navigators
were declared." were declared."
[path ^:notpath update-fn] [path update-fn]
(late-bound-nav [late path] (late-bound-nav [late (late-path path)]
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn (compiled-transform late update-fn structure))) (next-fn (compiled-transform late update-fn structure)))
(transform* [this structure next-fn] (transform* [this structure next-fn]
@ -587,22 +534,22 @@
(transform* [this structure next-fn] (transform* [this structure next-fn]
(with-meta structure (next-fn (meta structure))))) (with-meta structure (next-fn (meta structure)))))
(defpathedfn (defdynamicnav
^{:doc "Adds the result of running select with the given path on the ^{:doc "Adds the result of running select with the given path on the
current value to the collected vals."} current value to the collected vals."}
collect collect
[& path] [& path]
(late-bound-collector [late path] (late-bound-collector [late (late-path path)]
(collect-val [this structure] (collect-val [this structure]
(compiled-select late structure)))) (compiled-select late structure))))
(defpathedfn (defdynamicnav
^{:doc "Adds the result of running select-one with the given path on the ^{:doc "Adds the result of running select-one with the given path on the
current value to the collected vals."} current value to the collected vals."}
collect-one collect-one
[& path] [& path]
(late-bound-collector [late path] (late-bound-collector [late (late-path path)]
(collect-val [this structure] (collect-val [this structure]
(compiled-select-one late structure)))) (compiled-select-one late structure))))
@ -629,14 +576,14 @@
(transform* [this vals structure next-fn] (transform* [this vals structure next-fn]
(next-fn [] structure))) (next-fn [] structure)))
(defpathedfn if-path (defdynamicnav if-path
"Like cond-path, but with if semantics." "Like cond-path, but with if semantics."
([cond-p then-path] ([cond-p then-path]
(if-path cond-p then-path STOP)) (if-path cond-p then-path STOP))
([cond-p then-path else-path] ([cond-p then-path else-path]
(if-let [afn (n/extract-basic-filter-fn cond-p)] (if-let [afn (n/extract-basic-filter-fn cond-p)]
(late-bound-nav [late-then then-path (late-bound-richnav [late-then (late-path then-path)
late-else else-path] late-else (late-path else-path)]
(select* [this vals structure next-fn] (select* [this vals structure next-fn]
(n/if-select (n/if-select
vals vals
@ -653,9 +600,9 @@
afn afn
late-then late-then
late-else))) late-else)))
(late-bound-nav [late-cond cond-p (late-bound-richnav [late-cond (late-path cond-p)
late-then then-path late-then (late-path then-path)
late-else else-path] late-else (late-path else-path)]
(select* [this vals structure next-fn] (select* [this vals structure next-fn]
(n/if-select (n/if-select
vals vals
@ -674,7 +621,7 @@
late-else)))))) late-else))))))
(defpathedfn cond-path (defdynamicnav cond-path
"Takes in alternating cond-path path cond-path path... "Takes in alternating cond-path path cond-path path...
Tests the structure if selecting with cond-path returns anything. Tests the structure if selecting with cond-path returns anything.
If so, it uses the following path for this portion of the navigation. If so, it uses the following path for this portion of the navigation.
@ -693,34 +640,34 @@
pairs))) pairs)))
(defpathedfn multi-path (defdynamicnav 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."
([] STAY) ([] STAY)
([path] path) ([path] path)
([path1 path2] ([path1 path2]
(late-bound-nav [late1 path1 (late-bound-richnav [late1 (late-path path1)
late2 path2] late2 (late-path path2)]
(select* [this vals structure next-fn] (select* [this vals structure next-fn]
(let [res1 (i/exec-select* nav1 vals structure next-fn) (let [res1 (i/exec-select* late1 vals structure next-fn)
res2 (i/exec-select* nav2 vals structure next-fn)] res2 (i/exec-select* late2 vals structure next-fn)]
(if (identical? NONE res2) (if (identical? NONE res2)
res1 res1
res2))) res2)))
(transform* [this vals structure next-fn] (transform* [this vals structure next-fn]
(let [s1 (i/exec-transform* nav1 vals structure next-fn)] (let [s1 (i/exec-transform* late1 vals structure next-fn)]
(i/exec-transform* nav2 vals s1 next-fn))))) (i/exec-transform* late2 vals s1 next-fn)))))
([path1 path2 & paths] ([path1 path2 & paths]
(reduce multi-path (multi-path path1 path2) paths))) (reduce multi-path (multi-path path1 path2) paths)))
(defpathedfn stay-then-continue (defdynamicnav stay-then-continue
"Navigates to the current element and then navigates via the provided path. "Navigates to the current element and then navigates via the provided path.
This can be used to implement pre-order traversal." This can be used to implement pre-order traversal."
[& path] [& path]
(multi-path STAY path)) (multi-path STAY path))
(defpathedfn continue-then-stay (defdynamicnav continue-then-stay
"Navigates to the provided path and then to the current element. This can be used "Navigates to the provided path and then to the current element. This can be used
to implement post-order traversal." to implement post-order traversal."
[& path] [& path]

122
src/clj/com/rpl/specter/impl.cljc
View file

@ -91,6 +91,14 @@
(defn intern* [ns name val] (defn intern* [ns name val]
(throw-illegal "intern not supported in ClojureScript"))) (throw-illegal "intern not supported in ClojureScript")))
#?(
:clj
(defmacro fast-object-array [i]
`(com.rpl.specter.Util/makeObjectArray ~i))
:cljs
(defn fast-object-array [i]
(object-array i)))
(defn benchmark [iters afn] (defn benchmark [iters afn]
(time (time
@ -240,7 +248,14 @@
;; TODO: this used to be a macro for clj... check if that's still important ;; TODO: this used to be a macro for clj... check if that's still important
(defn compiled-traverse* [path result-fn structure] (defn compiled-traverse* [path result-fn structure]
(exec-select* path [] structure result-fn)) (exec-select*
path
[]
structure
(fn [vals structure]
(if (identical? vals [])
(result-fn structure)
(result-fn (conj vals structure))))))
@ -319,15 +334,17 @@
(defn compiled-selected-any?* [path structure] (defn compiled-selected-any?* [path structure]
(not= NONE (compiled-select-any* path structure))) (not= NONE (compiled-select-any* path structure)))
(defn terminal* [afn vals structure]
(if (identical? vals [])
(afn structure)
(apply afn (conj vals structure))))
;;TODO: could inline cache the transform-fn, or even have a different one ;;TODO: could inline cache the transform-fn, or even have a different one
;;if know there are no vals at the end ;;if know there are no vals at the end
(defn compiled-transform* [nav transform-fn structure] (defn compiled-transform* [nav transform-fn structure]
(exec-transform* nav [] structure (exec-transform* nav [] structure
(fn [vals structure] (fn [vals structure]
(if (identical? vals []) (terminal* transform-fn vals structure))))
(transform-fn vals)
(apply transform-fn (conj vals structure))))))
(defn fn-invocation? [f] (defn fn-invocation? [f]
(or #?(:clj (instance? clojure.lang.Cons f)) (or #?(:clj (instance? clojure.lang.Cons f))
@ -351,21 +368,26 @@
(defrecord DynamicVal (defrecord DynamicVal
[code]) [code])
;; path is a vector with elements of:
;; - DynamicFunction
;; - DynamicVal
;; - constant navigators
(defrecord DynamicPath (defrecord DynamicPath
[path]) [path])
;; params are either dynamicval, dynamicpath, or constants
;;TODO: what about path like: [((make-nav-maker a) :a :b) ALL]
;; should treat it like a special form if it's dynamic
;; if all static args, then resolve it at "compile" time
;; can have op be a dynamicfunction as well... or a dynamicval for that matter
(defrecord DynamicFunction (defrecord DynamicFunction
[op params]) [op params])
(defn dynamic-param? [o]
(contains? #{DynamicPath DynamicVal DynamicFunction} (class o)))
(defn static-path? [path]
(if (sequential? path)
(every? (complement dynamic-param?) path)
(-> path dynamic-param? not)))
(defn late-path [path]
(if (static-path? path)
(comp-paths* path)
(com.rpl.specter.impl/->DynamicPath path)))
(defrecord CachedPathInfo (defrecord CachedPathInfo
[dynamic? precompiled]) [dynamic? precompiled])
@ -437,15 +459,25 @@
(transform* [this vals structure next-fn] (transform* [this vals structure next-fn]
(next-fn vals structure)))) (next-fn vals structure))))
(defn comp-navs (defn gensyms [amt]
(vec (repeatedly amt gensym)))
(defmacro mk-comp-navs []
(let [impls (for [i (range 3 20)]
(let [[fsym & rsyms :as syms] (gensyms i)]
`([~@syms] (~'comp-navs ~fsym (~'comp-navs ~@rsyms)))))
last-syms (gensyms 19)]
`(defn comp-navs
([] STAY*) ([] STAY*)
([nav1] nav1) ([nav1#] nav1#)
([nav1 nav2] (combine-two-navs nav1 nav2)) ([nav1# nav2#] (combine-two-navs nav1# nav2#))
([nav1 nav2 nav3] (comp-navs nav1 (comp-navs nav2 nav3))) ~@impls
([nav1 nav2 nav3 nav4] (comp-navs nav1 (comp-navs nav2 nav3 nav4)))) ([~@last-syms ~'& rest#]
;; ...TODO: make a macro for this (~'comp-navs
(~'comp-navs ~@last-syms)
(reduce comp-navs rest#))))))
(mk-comp-navs)
(defn collected?* [afn] (defn collected?* [afn]
(reify RichNavigator (reify RichNavigator
@ -468,6 +500,33 @@
(vec res) (vec res)
res))) res)))
(defn- matching-indices [aseq p]
(keep-indexed (fn [i e] (if (p e) i)) aseq))
(defn matching-ranges [aseq p]
(first
(reduce
(fn [[ranges curr-start curr-last :as curr] i]
(cond
(nil? curr-start)
[ranges i i]
(= i (inc curr-last))
[ranges curr-start i]
:else
[(conj ranges [curr-start (inc curr-last)]) i i]))
[[] nil nil]
(concat (matching-indices aseq p) [-1]))))
(defn continuous-subseqs-transform* [pred structure next-fn]
(reduce
(fn [structure [s e]]
(srange-transform* structure s e next-fn))
structure
(reverse (matching-ranges structure pred))))
(defn codewalk-until [pred on-match-fn structure] (defn codewalk-until [pred on-match-fn structure]
(if (pred structure) (if (pred structure)
(on-match-fn structure) (on-match-fn structure)
@ -520,7 +579,7 @@
(defn coerce-nav [o] (defn coerce-nav [o]
(if (instance? com.rpl.specter.protocols.RichNavigator o) (if (instance? com.rpl.specter.protocols.RichNavigator o)
o o
(implicit-nav o))) (p/implicit-nav o)))
(defn dynamic-var? [v] (defn dynamic-var? [v]
@ -540,7 +599,7 @@
;; TODO: check metadata on locals to determine if it's definitely a direct-nav or not ;; TODO: check metadata on locals to determine if it's definitely a direct-nav or not
(->DynamicVal (:sym o)) (->DynamicVal (:sym o))
(instance? SpecialForm o) (instance? SpecialFormUse o)
(let [code (:code o) (let [code (:code o)
v (->DynamicVal code)] v (->DynamicVal code)]
(if (= 'fn* (first code)) (if (= 'fn* (first code))
@ -588,15 +647,18 @@
(cond (cond
(instance? DynamicPath o) (instance? DynamicPath o)
(let [path (:path o)] (let [path (:path o)]
(if (sequential? path)
(if (empty? path) (if (empty? path)
STAY* STAY*
(if (sequential? path) (let [resolved (vec (map resolve-magic-code path))
(let [resolved (map #(resolve-magic-code % true) path) combined (continuous-subseqs-transform*
combined (continuous-subseqs-transform path rich-nav? comp-paths)] rich-nav?
resolved
(fn [s] [(comp-paths* s)]))]
(if (and (= 1 (count combined)) (rich-nav? (first combined))) (if (and (= 1 (count combined)) (rich-nav? (first combined)))
(first combined) (first combined)
`(comp-navs ~@combined))) `(comp-navs ~@combined))))
(resolve-magic-code path)))) (resolve-magic-code path)))
(instance? DynamicVal o) (instance? DynamicVal o)
;;TODO: check ^:nav hint to see whether this is necessary ;;TODO: check ^:nav hint to see whether this is necessary
@ -613,7 +675,7 @@
params (map resolve-dynamic-fn-arg (:params o))] params (map resolve-dynamic-fn-arg (:params o))]
(if (all-static? (conj params op)) (if (all-static? (conj params op))
(coerce-nav (apply op params)) (coerce-nav (apply op params))
`(coerce-nav ~(resolve-magic-code op) ~@(map resolve-magic-code params)))) `(coerce-nav (~(resolve-magic-code op) ~@(map resolve-magic-code params)))))
:else :else
(coerce-nav o))) (coerce-nav o)))
@ -621,11 +683,11 @@
(defn magic-precompilation [path ns-str used-locals] (defn magic-precompilation [path ns-str used-locals]
(let [path (magic-precompilation* path) (let [path (magic-precompilation* path)
ns (find-ns ns-str) ns (find-ns (symbol ns-str))
maker (binding [*ns* ns] maker (binding [*ns* ns]
(eval+ (eval+
`(fn [~@used-locals] `(fn [~@used-locals]
~(resolve-magic-code (->DynamicPath path) true))))] ~(resolve-magic-code (->DynamicPath path)))))]
(if (static-path? path) (if (static-path? path)
(->CachedPathInfo false (maker)) (->CachedPathInfo false (maker))
(->CachedPathInfo true maker)))) (->CachedPathInfo true maker))))

64
src/clj/com/rpl/specter/macros.clj
View file

@ -3,10 +3,6 @@
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk])) [clojure.walk :as cljwalk]))
(defn ^:no-doc gensyms [amt]
(vec (repeatedly amt gensym)))
(defn ^:no-doc determine-params-impls [impls] (defn ^:no-doc determine-params-impls [impls]
(let [grouped (->> impls (map (fn [[n & body]] [n body])) (into {}))] (let [grouped (->> impls (map (fn [[n & body]] [n body])) (into {}))]
(if-not (= #{'select* 'transform*} (-> grouped keys set)) (if-not (= #{'select* 'transform*} (-> grouped keys set))
@ -17,7 +13,7 @@
(defmacro richnav [params & impls] (defmacro richnav [params & impls]
(if (empty? params) (if (empty? params)
(reify RichNavigator ~@impls) `(reify RichNavigator ~@impls)
`(fn ~params `(fn ~params
(reify RichNavigator (reify RichNavigator
~@impls)))) ~@impls))))
@ -34,14 +30,12 @@
(let [~t-next-fn-sym (fn [s#] (next-fn# vals# s#))] (let [~t-next-fn-sym (fn [s#] (next-fn# vals# s#))]
~@t-body))))) ~@t-body)))))
(defmacro collector [params [_ [_ structure-sym] & body] impl] (defmacro collector [params [_ [_ structure-sym] & body]]
(let [cfn# (fn [vals# ~structure-sym next-fn#]
(next-fn# (conj vals# (do ~@body)) ~structure-sym))]
`(richnav ~params `(richnav ~params
(~'select* [this# vals# structure# next-fn#] (~'select* [this# vals# ~structure-sym next-fn#]
(cfn# vals# structure# next-fn#)) (next-fn# (conj vals# (do ~@body)) ~structure-sym))
(~'transform* [this# vals# structure# next-fn#] (~'transform* [this# vals# ~structure-sym next-fn#]
(cfn# vals# structure# next-fn#))))) (next-fn# (conj vals# (do ~@body)) ~structure-sym))))
(defn- helper-name [name method-name] (defn- helper-name [name method-name]
(symbol (str name "-" method-name))) (symbol (str name "-" method-name)))
@ -57,37 +51,32 @@
~@helpers ~@helpers
(def ~name (nav ~params ~@impls))))) (def ~name (nav ~params ~@impls)))))
(defrichnav [name params & impls] (defmacro defrichnav [name params & impls]
`(def ~name (richnav ~params ~@impls))) `(def ~name (richnav ~params ~@impls)))
(defmacro defcollector [name & body] (defmacro defcollector [name & body]
`(def ~name (collector ~@body))) `(def ~name (collector ~@body)))
(defn dynamic-param? [o] (defn- late-bound-operation [bindings builder-op impls]
(contains? #{DynamicPath DynamicVal DynamicFunction} (class o)))
(defn static-path? [path]
(if (sequential? path)
(every? (complement dynamic-param?) path)
(-> path dynamic-param? not)))
(defn late-path [path]
(if (static-path? path)
(comp-paths path)
(com.rpl.specter.impl/->DynamicPath path)))
(defmacro late-bound-nav [bindings & impl]
(let [bindings (partition 2 bindings) (let [bindings (partition 2 bindings)
params (map first bindings) params (map first bindings)
curr-params (map second bindings)] curr-params (map second bindings)]
`(let [builder# (nav [~@params] ~@impl) `(let [builder# (~builder-op [~@params] ~@impls)
curr-params# [~@curr-params]] curr-params# [~@curr-params]]
(if (every? (complement dynamic-param?) curr-params#) (if (every? (complement i/dynamic-param?) curr-params#)
(apply builder# curr-params#) (apply builder# curr-params#)
;;TODO: should tag with metadata that the return is a direct navigator ;;TODO: should tag with metadata that the return is a direct navigator
(com.rpl.specter.impl/->DynamicFunction builder# curr-params#))))) (com.rpl.specter.impl/->DynamicFunction builder# curr-params#)))))
(defmacro late-bound-nav [bindings & impls]
(late-bound-operation bindings `nav impls))
(defmacro late-bound-collector [bindings impl]
(late-bound-operation bindings `collector [impl]))
(defmacro late-bound-richnav [bindings & impls]
(late-bound-operation bindings `richnav impls))
(defn- protpath-sym [name] (defn- protpath-sym [name]
(-> name (str "-prot") symbol)) (-> name (str "-prot") symbol))
@ -236,7 +225,7 @@
(let [used-locals-cell (i/mutable-cell [])] (let [used-locals-cell (i/mutable-cell [])]
(cljwalk/postwalk (cljwalk/postwalk
(fn [e] (fn [e]
(if (local-syms e) (if (locals-set e)
(i/update-cell! used-locals-cell #(conj % e)) (i/update-cell! used-locals-cell #(conj % e))
e)) e))
form) form)
@ -333,7 +322,7 @@
(cljs-macroexpand-all &env (vec path))) (cljs-macroexpand-all &env (vec path)))
prepared-path (ic-prepare-path local-syms expanded) prepared-path (ic-prepare-path local-syms expanded)
possible-params (vec (ic-possible-params expanded)) ; possible-params (vec (ic-possible-params expanded))
cache-sym (vary-meta cache-sym (vary-meta
(gensym "pathcache") (gensym "pathcache")
@ -362,11 +351,11 @@
;;TODO: redo clojurescript portions ;;TODO: redo clojurescript portions
handle-params-code handle-params-code
(if (= platform :clj) (if (= platform :clj)
`(~precompiled-sym ~@used-locals) `(~precompiled-sym ~@used-locals))]
`(i/handle-params ; `(i/handle-params
~precompiled-sym ; ~precompiled-sym
~params-maker-sym ; ~params-maker-sym
~(mapv (fn [p] `(fn [] ~p)) possible-params)))] ; ~(mapv (fn [p] `(fn [] ~p)) possible-params)))]
(if (= platform :clj) (if (= platform :clj)
@ -378,8 +367,7 @@
(let [~info-sym (i/magic-precompilation (let [~info-sym (i/magic-precompilation
~prepared-path ~prepared-path
~(str *ns*) ~(str *ns*)
(quote ~used-locals) (quote ~used-locals))]
(quote ~possible-params))]
~add-cache-code ~add-cache-code
~info-sym) ~info-sym)
info#) info#)

38
src/clj/com/rpl/specter/navs.cljc
View file

@ -2,23 +2,14 @@
#?(:cljs (:require-macros #?(:cljs (:require-macros
[com.rpl.specter.macros [com.rpl.specter.macros
:refer :refer
[fixed-pathed-collector [defnav]]
fixed-pathed-nav
defcollector
defnav
defpathedfn
richnav
defnavconstructor]]
[com.rpl.specter.util-macros :refer [com.rpl.specter.util-macros :refer
[doseqres]])) [doseqres]]))
(:use #?(:clj [com.rpl.specter macros]) (:use #?(:clj [com.rpl.specter macros])
#?(:clj [com.rpl.specter.util-macros :only [doseqres]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres]]))
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as walk] [clojure.walk :as walk]
#?(:clj [clojure.core.reducers :as r]) #?(:clj [clojure.core.reducers :as r])))
[com.rpl.specter.defnavhelpers])) ; so that for cljs it's loaded as macros expand to this
@ -250,26 +241,6 @@
(def srange-transform i/srange-transform*) (def srange-transform i/srange-transform*)
(defn- matching-indices [aseq p]
(keep-indexed (fn [i e] (if (p e) i)) aseq))
(defn matching-ranges [aseq p]
(first
(reduce
(fn [[ranges curr-start curr-last :as curr] i]
(cond
(nil? curr-start)
[ranges i i]
(= i (inc curr-last))
[ranges curr-start i]
:else
[(conj ranges [curr-start (inc curr-last)]) i i]))
[[] nil nil]
(concat (matching-indices aseq p) [-1]))))
(defn extract-basic-filter-fn [path] (defn extract-basic-filter-fn [path]
(cond (fn? path) (cond (fn? path)
@ -304,11 +275,6 @@
next-fn)) next-fn))
(defn terminal* [afn vals structure]
(if (identical? vals [])
(afn structure)
(apply afn (conj vals structure))))
(defprotocol AddExtremes (defprotocol AddExtremes