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

lots of progress

Browse source
This commit is contained in:
Nathan Marz 2016-08-31 22:30:28 -04:00
parent f511cd4fca
commit eb5de0bdd5
4 changed files with 238 additions and 302 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -164,14 +164,10 @@
(defnav
(def
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
STAY
[]
(select* [this structure next-fn]
(next-fn structure))
(transform* [this structure next-fn]
(next-fn structure)))
i/STAY*)
(def
^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation

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

@ -8,6 +8,7 @@
(:require [com.rpl.specter.protocols :as p]
[clojure.string :as s]
[clojure.walk :as walk]
#?(:clj [riddley.walk :as riddley]))
#?(:clj (:import [com.rpl.specter Util MutableCell])))
@ -99,7 +100,7 @@
#?(
:clj
(defmacro exec-select* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.RichNavigator})]
`(.select* ~hinted ~@args)))
@ -111,7 +112,7 @@
#?(
:clj
(defmacro exec-transform* [this & args]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.Navigator})]
(let [hinted (with-meta this {:tag 'com.rpl.specter.protocols.RichNavigator})]
`(.transform* ~hinted ~@args)))
@ -128,13 +129,6 @@
(defn comp-paths* [p]
(if (rich-nav? p) p (do-comp-paths p)))
(defn- seq-contains? [aseq val]
(->> aseq
(filter (partial = val))
empty?
not))
(defn- coerce-object [this]
(cond (satisfies? p/ImplicitNav this) (p/implicit-nav this)
:else (throw-illegal "Not a navigator: " this)))
@ -173,13 +167,13 @@
(defn combine-two-navs [nav1 nav2]
(reify RichNavigator
(select* [this vals structure next-fn]
(exec-select* curr vals structure
(exec-select* nav1 vals structure
(fn [vals-next structure-next]
(exec-select* next vals-next structure-next next-fn))))
(exec-select* nav2 vals-next structure-next next-fn))))
(transform* [this vals structure next-fn]
(exec-transform* curr vals structure
(exec-transform* nav1 vals structure
(fn [vals-next structure-next]
(exec-rich-transform* next vals-next structure-next next-fn))))))
(exec-transform* nav2 vals-next structure-next next-fn))))))
(extend-protocol PathComposer
nil
@ -192,7 +186,6 @@
(do-comp-paths [navigators]
(reduce combine-two-navs navigators)))
;; cell implementation idea taken from prismatic schema library
#?(:cljs
(defprotocol PMutableCell
@ -329,7 +322,7 @@
;;TODO: could inline cache the transform-fn, or even have a different one
;;if know there are no vals at the end
(defn compiled-transform* [path transform-fn structure]
(defn compiled-transform* [nav transform-fn structure]
(exec-transform* nav [] structure
(fn [vals structure]
(if (identical? vals [])
@ -355,8 +348,27 @@
;; op and params elems can be any of the above
[op params code])
(defrecord DynamicVal
[code])
;; path is a vector with elements of:
;; - DynamicFunction
;; - DynamicVal
;; - constant navigators
(defrecord DynamicPath
[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
[op params])
(defrecord CachedPathInfo
[path-fn])
[dynamic? precompiled])
(defn constant-node? [node]
@ -418,6 +430,22 @@
(next-fn vals structure)
structure))))
(def STAY*
(reify RichNavigator
(select* [this vals structure next-fn]
(next-fn vals structure))
(transform* [this vals structure next-fn]
(next-fn vals structure))))
(defn comp-navs
([] STAY*)
([nav1] nav1)
([nav1 nav2] (combine-two-navs nav1 nav2))
([nav1 nav2 nav3] (comp-navs nav1 (comp-navs nav2 nav3)))
([nav1 nav2 nav3 nav4] (comp-navs nav1 (comp-navs nav2 nav3 nav4))))
;; ...TODO: make a macro for this
(defn collected?* [afn]
(reify RichNavigator
@ -440,215 +468,172 @@
(vec res)
res)))
(defn codewalk-until [pred on-match-fn structure]
(if (pred structure)
(on-match-fn structure)
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
(if (and (fn-invocation? structure) (fn-invocation? ret))
(with-meta ret (meta structure))
ret))))
(defn- variadic-arglist? [al]
(contains? (set al) '&))
(defn- arglist-for-params-count [arglists c code]
(let [ret (->> arglists
(filter
(fn [al]
(or (= (count al) c)
(variadic-arglist? al))))
(def ^:dynamic *tmp-closure*)
(defn closed-code [closure body]
(let [lv (mapcat #(vector % `(*tmp-closure* '~%))
(keys closure))]
(binding [*tmp-closure* closure]
(eval `(let [~@lv] ~body)))))
first)
len (count ret)]
(when-not ret
(throw-illegal "Invalid # arguments at " code))
(if (variadic-arglist? ret)
(srange-transform* ret (- len 2) len
(fn [_] (repeatedly (- c (- len 2)) gensym)))
ret)))
(defn any?
"Accepts any number of predicates that take in one input and returns a new predicate that returns true if any of them are true"
[& preds]
(fn [obj]
(some #(% obj) preds)))
;;TODO: all needs to change
(defn- magic-precompilation* [p params-atom failed-atom]
(let [magic-fail! (fn [& reason]
(if (get-cell MUST-CACHE-PATHS)
(println "Failed to cache path:" (apply str reason)))
(reset! failed-atom true)
nil)]
(let [embeddable? (any? number?
symbol?
keyword?
string?
char?
list?
vector?
set?
#(and (map? %) (not (record? %)))
nil?
#(instance? clojure.lang.Cons %)
#(instance? clojure.lang.LazySeq %))]
(defn eval+
"Automatically extracts non-evalable stuff into a closure and then evals"
[form]
(let [replacements (mutable-cell {})
new-form (codewalk-until
#(-> % embeddable? not)
(fn [o]
(let [s (gensym)]
(update-cell! replacements #(assoc % s o))
s))
form)
closure (get-cell replacements)]
(closed-code closure new-form))))
(defn coerce-nav [o]
(if (instance? com.rpl.specter.protocols.RichNavigator o)
o
(implicit-nav o)))
(defn dynamic-var? [v]
(-> v meta :dynamic not))
;; don't do coerce-nav here... save that for resolve-magic-code
(defn- magic-precompilation* [o]
(cond (sequential? o)
(flatten (map magic-precompilation* o))
(instance? VarUse o)
(if (dynamic-var? (:var o))
(->DynamicVal (:sym o))
(:val o))
(instance? LocalSym o)
;; TODO: check metadata on locals to determine if it's definitely a direct-nav or not
(->DynamicVal (:sym o))
(instance? SpecialForm o)
(let [code (:code o)
v (->DynamicVal code)]
(if (= 'fn* (first code))
(->DynamicFunction pred* [v])))
(instance? FnInvocation o)
(let [op (magic-precompilation* (:op o))
params (map magic-precompilation* (:params o))]
(if (-> op meta :dynamicnav)
(apply op params)
(->DynamicFunction op params)))
:else
;; this handles dynamicval as well
o))
(declare resolve-magic-code)
(defn all-static? [params]
(every? (complement dynamic-param?) params))
(defn resolve-dynamic-fn-arg [o]
(cond (instance? DynamicFunction o)
(let [op (resolve-dynamic-fn-arg (:op o))
params (map resolve-dynamic-fn-arg (:params o))]
(if (all-static? (conj params op))
(apply op params)
(->DynamicFunction op params)))
(instance? DynamicVal o)
o
(instance? DynamicPath o)
(let [res (resolve-magic-code o)]
(if (rich-nav? res)
res
(->DynamicVal res)))
:else
o))
(defn resolve-magic-code [o]
(cond
(vector? p)
(mapv
#(magic-precompilation* % params-atom failed-atom)
p)
(instance? DynamicPath o)
(let [path (:path o)]
(if (empty? path)
STAY*
(if (sequential? path)
(let [resolved (map #(resolve-magic-code % true) path)
combined (continuous-subseqs-transform path rich-nav? comp-paths)]
(if (and (= 1 (count combined)) (rich-nav? (first combined)))
(first combined)
`(comp-navs ~@combined)))
(resolve-magic-code path))))
(instance? LocalSym p)
(magic-fail! "Local symbol " (:sym p) " where navigator expected")
(instance? DynamicVal o)
;;TODO: check ^:nav hint to see whether this is necessary
;;this is relevant for localsyms and dynamicvars
;;for localsyms can check metadata in the env as well as metadata on the symbol itself
;;for dynamic vars check the var metadata
`(coerce-nav ~(:code o))
(instance? VarUse p)
(let [v (:var p)
vv (:val p)]
(cond (-> v meta :dynamic)
(magic-fail! "Var " (:sym p) " is dynamic")
(and (fn? vv) (-> v meta :pathedfn))
(throw-illegal "Cannot use pathed fn '" (:sym p) "' where navigator expected")
(valid-navigator? vv)
vv
(instance? DynamicFunction o)
;;TODO: check ^:nav hint on op to see whether coerce-nav is necessary
;; checked when resolving varuse on the function to know if it returns a direct-nav or not
;; ":direct-nav-fn" metadata as opposed to :direct-nav metadata which is used for symbols/values
(let [op (resolve-dynamic-fn-arg (:op o))
params (map resolve-dynamic-fn-arg (:params o))]
(if (all-static? (conj params op))
(coerce-nav (apply op params))
`(coerce-nav ~(resolve-magic-code op) ~@(map resolve-magic-code params))))
:else
(magic-fail! "Var " (:sym p) " is not a navigator")))
(coerce-nav o)))
(instance? SpecialFormUse p)
(if (->> p :code first (contains? #{'fn* 'fn}))
(do
(swap! params-atom conj (:code p))
pred*)
(magic-fail! "Special form " (:code p) " where navigator expected"))
(instance? FnInvocation p)
(let [op (:op p)
ps (:params p)]
(if (instance? VarUse op)
(let [v (:var op)
vv (:val op)]
(if (-> v meta :dynamic)
(magic-fail! "Var " (:sym op) " is dynamic")
(cond
(or (root-params-nav? vv) (instance? ParamsNeededPath vv))
(if (every? constant-node? ps)
(apply vv (map extract-constant ps))
(do
(swap! params-atom #(vec (concat % ps)))
(coerce-path vv)))
(and (fn? vv) (-> v meta :pathedfn))
;;TODO: update this to ignore args that aren't symbols or have :nopath
;;metadata on them (in the arglist)
(let [arglists (-> v meta :arglists)
al (arglist-for-params-count arglists (count ps) (:code p))
subpath (vec
(map
(fn [pdecl p]
(if (and (symbol? pdecl)
(-> pdecl meta :notpath not))
(magic-precompilation* p params-atom failed-atom)
(cond (and (instance? VarUse p)
(-> p :var meta :dynamic not))
(:val p)
(and (not (instance? LocalSym p))
(not (instance? VarUse p))
(not (instance? SpecialFormUse p))
(not (instance? FnInvocation p))
(not (coll? p)))
p
:else
(magic-fail! "Could not factor static param "
"of pathedfn because it's not a static var "
" or non-collection value: "
(extract-original-code p)))))
al
ps))]
(if @failed-atom
nil
(apply vv subpath)))
(and (fn? vv) (-> vv meta :layerednav))
(if (every? constant-node? ps)
(apply vv (map extract-constant ps))
(do
(swap! params-atom conj (:code p))
(if (= (-> vv meta :layerednav) :lean)
lean-compiled-path-proxy
rich-compiled-path-proxy)))
:else
(magic-fail! "Var " (:sym op) " must be either a parameterized "
"navigator, a higher order pathed constructor function, "
"or a nav constructor"))))
(magic-fail! "Code at " (extract-original-code p) " is in "
"function invocation position and must be either a parameterized "
"navigator, a higher order pathed constructor function, or a "
"nav constructor.")))
:else
(cond (set? p)
(if (constant-node? p)
(extract-constant p)
(do (swap! params-atom conj p)
pred*))
(keyword? p)
p
;; in case anyone extends String for their own use case
(and (string? p) (valid-navigator? p))
p
:else
(magic-fail! "Code " p " is not a valid navigator or can't be factored")))))
;; This is needed when aset is used on primitive values in mk-params-maker
;; to avoid reflection
#?(:clj
(defn aset-object [^objects a i ^Object v]
(aset a i v)))
#?(
:clj
(defn mk-params-maker [ns-str params-code possible-params-code used-locals]
(let [ns (find-ns (symbol ns-str))
array-sym (gensym "array")]
(binding [*ns* ns]
(eval
(defn magic-precompilation [path ns-str used-locals]
(let [path (magic-precompilation* path)
ns (find-ns ns-str)
maker (binding [*ns* ns]
(eval+
`(fn [~@used-locals]
(let [~array-sym (fast-object-array ~(count params-code))]
~@(map-indexed
(fn [i c]
`(aset-object ~array-sym ~i ~c))
params-code)
~array-sym))))))
:cljs
(defn mk-params-maker [ns-str params-code possible-params-code used-locals]
(let [indexed (->> possible-params-code
(map-indexed (comp vec reverse vector))
(into {}))]
;;TODO: may be more efficient as an array
(mapv (fn [c] (get indexed c)) params-code))))
;; possible-params-code is for cljs impl that can't use eval
(defn magic-precompilation [prepared-path ns-str used-locals possible-params-code]
(let [params-atom (atom [])
failed-atom (atom false)
path (magic-precompilation* prepared-path params-atom failed-atom)]
(if @failed-atom
(if (get-cell MUST-CACHE-PATHS)
(throw-illegal "Failed to cache path")
(->CachedPathInfo nil nil))
(let [precompiled (comp-paths* path)
params-code (mapv extract-original-code @params-atom)
params-maker (if-not (empty? params-code)
(mk-params-maker ns-str params-code possible-params-code used-locals))]
;; TODO: error if precompiled is compiledpath and there are params or
;; precompiled is paramsneededpath and there are no params...
(->CachedPathInfo precompiled params-maker)))))
~(resolve-magic-code (->DynamicPath path) true))))]
(if (static-path? path)
(->CachedPathInfo false (maker))
(->CachedPathInfo true maker))))
;; TODO: could have a global flag about whether or not to compile and cache static
;; portions, or whether to compile everything together on each invocation (so that
;; it can be redefined in repl
(defn compiled-setval* [path val structure]

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

@ -64,61 +64,29 @@
`(def ~name (collector ~@body)))
(defmacro late-bound-nav [bindings & impl])
;;TODO
;; if bindings are static, then immediately return a navigator
;; otherwise, return a function from params -> navigator (using nav)
;; function has metadata about what each arg should correspond to
(defn dynamic-param? [o]
(contains? #{DynamicPath DynamicVal DynamicFunction} (class o)))
;;TODO:
;; during inline caching analysis, defpathedfn can return:
;; - a path (in a sequence - vector or list from &), which can contain both static and dynamic params
;; - a navigator implementation
;; - a late-bound-nav or late-bound-collector
;; - which can have within the late paths other late-bound paths
;; - a record containing a function that takes in params, and then a vector of
;; what those params are (exactly what was put into bindings)
;; - should explicitly say in late-bound-nav which ones are paths and which aren't
;; - can use ^:path metadata? or wrap in: (late-path path)
;; - a non-vector constant (which will have indirect-nav run on it)
;;
(defn static-path? [path]
(if (sequential? path)
(every? (complement dynamic-param?) path)
(-> path dynamic-param? not)))
;; when `path` passes args to a pathedfn:
;; - needs to wrap all dynamic portions in "dynamicparam"
;; (VarUse, LocalSym, etc.)
;; - it should descend into vectors as well
;; inline caching should do the following:
;; - escape path as it's doing now (recursing into vectors)
;; - go through path and for each navigator position:
;; - if a localsym: then it's a dynamic call to (if (navigator? ...) ... (indirect-nav))
;; - if a varuse: if dynamic, then it's a dynamic call as above
;; - if static, then get the value. if a navigator then done, otherwise call indirect-nav
;; - if specialform: it's a dynamic call to if (navigator? ...) as above
;; - if fninvocation:
;; - if not pathedfn:
;; - if params are constant, then invoke. if return is not navigator, then call indirect-nav
;; - otherwise, label that point as "dynamic invocation" with the args
;; - if pathedfn:
;; - take all arguments that have anything dynamic in them and wrap in dynamicparam
;; - including inside vectors (just one level
;; - call the function:
;; - if return is constant, then do indirect-nav or use the nav
;; - if return is a sequence, then treat it as path for that point to be merged in
;; , strip "dynamicparam", and recurse inside the vector
;; - should also flatten the vector
;; - if return is a late-bound record, then:
;; - label point as dynamic invocation with the args
;; - args marked as "latepath" TODO
;; - if sequence: then flatten and recurse
;; - if constant, then call indirect-nav
;; for all (if (navigator ...)... (indirect-nav)) calls, use metadata to determine whether
;; return is definitely a navigator in which case that dynamic code can be omitted
;; annotation could be :tag or :direct-nav
;; defnav needs to annotate return appropriately
(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)
params (map first bindings)
curr-params (map second bindings)]
`(let [builder# (nav [~@params] ~@impl)
curr-params# [~@curr-params]]
(if (every? (complement dynamic-param?) curr-params#)
(apply builder# curr-params#)
;;TODO: should tag with metadata that the return is a direct navigator
(com.rpl.specter.impl/->DynamicFunction builder# curr-params#)))))
(defn- protpath-sym [name]
@ -250,18 +218,30 @@
attr)]
[(with-meta name attr) macro-args]))
(defmacro defpathedfn
(defmacro dynamicnav [& args]
`(vary-meta (fn ~@args) assoc :dynamicnav true))
(defmacro defdynamicnav
"Defines a higher order navigator that itself takes in one or more paths
as input. When inline caching is applied to a path containing
one of these higher order navigators, it will apply inline caching and
compilation to the subpaths as well. Use ^:notpath metadata on arguments
to indicate non-path arguments that should not be compiled"
[name & args]
(let [[name args] (name-with-attributes name args)
name (vary-meta name assoc :pathedfn true)]
`(defn ~name ~@args)))
(let [[name args] (name-with-attributes name args)]
`(def ~name (dynamicnav ~@args))))
(defn- used-locals [locals-set form]
(let [used-locals-cell (i/mutable-cell [])]
(cljwalk/postwalk
(fn [e]
(if (local-syms e)
(i/update-cell! used-locals-cell #(conj % e))
e))
form)
(i/get-cell used-locals-cell)))
(defn ^:no-doc ic-prepare-path [locals-set path]
(cond
(vector? path)
@ -287,7 +267,9 @@
:else
`(quote ~path)))
(if (empty? (used-locals locals-set path))
path
`(com.rpl.specter.impl/->DynamicVal ~path (quote ~path)))))
(defn ^:no-doc ic-possible-params [path]
@ -329,9 +311,8 @@
ret))
;; still possible to mess this up with alter-var-root
(defmacro path
"Same as calling comp-paths, except it caches the composition of the static part
"Same as calling comp-paths, except it caches the composition of the static parts
of the path for later re-use (when possible). For almost all idiomatic uses
of Specter provides huge speedup. This macro is automatically used by the
select/transform/setval/replace-in/etc. macros."
@ -342,15 +323,7 @@
(-> &env :locals keys set) ;cljs
(-> &env keys set)) ;clj
used-locals-cell (i/mutable-cell [])
_ (cljwalk/postwalk
(fn [e]
(if (local-syms e)
(i/update-cell! used-locals-cell #(conj % e))
e))
path)
used-locals (i/get-cell used-locals-cell)
used-locals (used-locals local-syms path)
;; note: very important to use riddley's macroexpand-all here, so that
;; &env is preserved in any potential nested calls to select (like via
@ -362,9 +335,6 @@
prepared-path (ic-prepare-path local-syms expanded)
possible-params (vec (ic-possible-params expanded))
;; - with invokedynamic here, could go directly to the code
;; to invoke and/or parameterize the precompiled path without
;; a bunch of checks beforehand
cache-sym (vary-meta
(gensym "pathcache")
assoc :cljs.analyzer/no-resolve true)
@ -381,20 +351,18 @@
(var ~cache-sym)
(fn [_#] (i/mutable-cell)))
nil))))
cache-sym)
add-cache-code (if (= platform :clj)
`(i/set-cell! ~cache-sym ~info-sym)
`(def ~cache-sym ~info-sym))
precompiled-sym (gensym "precompiled")
params-maker-sym (gensym "params-maker")
;;TODO: redo clojurescript portions
handle-params-code
(if (= platform :clj)
`(i/bind-params* ~precompiled-sym (~params-maker-sym ~@used-locals) 0)
`(~precompiled-sym ~@used-locals)
`(i/handle-params
~precompiled-sym
~params-maker-sym
@ -412,20 +380,16 @@
~(str *ns*)
(quote ~used-locals)
(quote ~possible-params))]
~add-cache-code
~info-sym)
info#)
~precompiled-sym (.-precompiled info#)
~params-maker-sym (.-params-maker info#)]
(if (nil? ~precompiled-sym)
(i/comp-paths* ~(if (= (count path) 1) (first path) (vec path)))
(if (nil? ~params-maker-sym)
~precompiled-sym
~handle-params-code)))))
dynamic?# (.-dynamic? info#)]
(if dynamic?#
~handle-params-code
~precompiled-sym))))

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

@ -443,12 +443,3 @@
(if (pred structure)
(on-match-fn structure)
(walk/walk (partial walk-until pred on-match-fn) identity structure)))
(defn codewalk-until [pred on-match-fn structure]
(if (pred structure)
(on-match-fn structure)
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
(if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure))
ret))))