fixes + manual inlining for keypath, must, view

This commit is contained in:
Nathan Marz 2016-09-01 11:24:15 -04:00
parent c80a2d3c50
commit 4c570e5de4
2 changed files with 36 additions and 20 deletions

View file

@ -359,38 +359,38 @@
next-val)) next-val))
structure))))) structure)))))
(defnav (defrichnav
^{:doc "Navigates to the specified key, navigating to nil if it does not exist."} ^{:doc "Navigates to the specified key, navigating to nil if it does not exist."}
keypath keypath
[key] [key]
(select* [this structure next-fn] (select* [this vals structure next-fn]
(next-fn (get structure key))) (next-fn vals (get structure key)))
(transform* [this structure next-fn] (transform* [this vals structure next-fn]
(assoc structure key (next-fn (get structure key))))) (assoc structure key (next-fn vals (get structure key)))))
(defnav (defrichnav
^{:doc "Navigates to the key only if it exists in the map."} ^{:doc "Navigates to the key only if it exists in the map."}
must must
[k] [k]
(select* [this structure next-fn] (select* [this vals structure next-fn]
(if (contains? structure k) (if (contains? structure k)
(next-fn (get structure k)) (next-fn vals (get structure k))
NONE)) NONE))
(transform* [this structure next-fn] (transform* [this vals structure next-fn]
(if (contains? structure k) (if (contains? structure k)
(assoc structure k (next-fn (get structure k))) (assoc structure k (next-fn vals (get structure k)))
structure))) structure)))
(defnav (defrichnav
^{:doc "Navigates to result of running `afn` on the currently navigated value."} ^{:doc "Navigates to result of running `afn` on the currently navigated value."}
view view
[afn] [afn]
(select* [this structure next-fn] (select* [this vals structure next-fn]
(next-fn (afn structure))) (next-fn vals (afn structure)))
(transform* [this structure next-fn] (transform* [this vals structure next-fn]
(next-fn (afn structure)))) (next-fn vals (afn structure))))
(defnav (defnav

View file

@ -583,7 +583,7 @@
(defn dynamic-var? [v] (defn dynamic-var? [v]
(-> v meta :dynamic not)) (-> v meta :dynamic))
;; don't do coerce-nav here... save that for resolve-magic-code ;; don't do coerce-nav here... save that for resolve-magic-code
(defn- magic-precompilation* [o] (defn- magic-precompilation* [o]
@ -643,6 +643,19 @@
:else :else
o)) o))
(defn resolve-dynamic-fn-arg-code [o]
(cond (instance? DynamicFunction o)
(let [op (resolve-dynamic-fn-arg-code (:op o))
params (map resolve-dynamic-fn-arg-code (:params o))]
`(~op ~@params))
(instance? DynamicVal o)
(:code o)
:else
o))
(defn resolve-magic-code [o] (defn resolve-magic-code [o]
(cond (cond
(instance? DynamicPath o) (instance? DynamicPath o)
@ -655,7 +668,7 @@
rich-nav? rich-nav?
resolved resolved
(fn [s] [(comp-paths* s)]))] (fn [s] [(comp-paths* s)]))]
(if (and (= 1 (count combined)) (rich-nav? (first combined))) (if (= 1 (count combined))
(first combined) (first combined)
`(comp-navs ~@combined)))) `(comp-navs ~@combined))))
(resolve-magic-code path))) (resolve-magic-code path)))
@ -675,7 +688,8 @@
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-dynamic-fn-arg-code op)
~@(map resolve-dynamic-fn-arg-code params)))))
:else :else
(coerce-nav o))) (coerce-nav o)))
@ -683,9 +697,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)
; _ (println "magic-precompilation*" path)
ns (find-ns (symbol ns-str)) ns (find-ns (symbol ns-str))
maker (binding [*ns* ns] maker (binding [*ns* ns]
(eval+ (eval+
; (spy
`(fn [~@used-locals] `(fn [~@used-locals]
~(resolve-magic-code (->DynamicPath path)))))] ~(resolve-magic-code (->DynamicPath path)))))]
(if (static-path? path) (if (static-path? path)