added nav constructors + tests, fixed bug with clj platform eval'd params fn to bind to the namesapace where the path was defined
This commit is contained in:
parent
cd7b759c3a
commit
e70cfb3623
3 changed files with 53 additions and 20 deletions
|
|
@ -857,8 +857,10 @@
|
||||||
)))
|
)))
|
||||||
|
|
||||||
#+clj
|
#+clj
|
||||||
(defn mk-params-maker [params-code possible-params-code used-locals]
|
(defn mk-params-maker [ns-str params-code possible-params-code used-locals]
|
||||||
(let [array-sym (gensym "array")]
|
(let [ns (find-ns (symbol ns-str))
|
||||||
|
array-sym (gensym "array")]
|
||||||
|
(binding [*ns* ns]
|
||||||
(eval
|
(eval
|
||||||
`(fn [~@used-locals]
|
`(fn [~@used-locals]
|
||||||
(let [~array-sym (fast-object-array ~(count params-code))]
|
(let [~array-sym (fast-object-array ~(count params-code))]
|
||||||
|
|
@ -868,10 +870,10 @@
|
||||||
params-code
|
params-code
|
||||||
)
|
)
|
||||||
~array-sym
|
~array-sym
|
||||||
)))))
|
))))))
|
||||||
|
|
||||||
#+cljs
|
#+cljs
|
||||||
(defn mk-params-maker [params-code possible-params-code used-locals]
|
(defn mk-params-maker [ns-str params-code possible-params-code used-locals]
|
||||||
(let [indexed (->> possible-params-code
|
(let [indexed (->> possible-params-code
|
||||||
(map-indexed (comp vec reverse vector))
|
(map-indexed (comp vec reverse vector))
|
||||||
(into {}))]
|
(into {}))]
|
||||||
|
|
@ -879,7 +881,7 @@
|
||||||
(mapv (fn [c] (get indexed c)) params-code)))
|
(mapv (fn [c] (get indexed c)) params-code)))
|
||||||
|
|
||||||
;; possible-params-code is for cljs impl that can't use eval
|
;; possible-params-code is for cljs impl that can't use eval
|
||||||
(defn magic-precompilation [prepared-path used-locals possible-params-code]
|
(defn magic-precompilation [prepared-path ns-str used-locals possible-params-code]
|
||||||
(let [params-atom (atom [])
|
(let [params-atom (atom [])
|
||||||
failed-atom (atom false)
|
failed-atom (atom false)
|
||||||
path (magic-precompilation* prepared-path params-atom failed-atom)
|
path (magic-precompilation* prepared-path params-atom failed-atom)
|
||||||
|
|
@ -891,7 +893,7 @@
|
||||||
(let [precompiled (comp-paths* path)
|
(let [precompiled (comp-paths* path)
|
||||||
params-code (mapv extract-original-code @params-atom)
|
params-code (mapv extract-original-code @params-atom)
|
||||||
params-maker (if-not (empty? params-code)
|
params-maker (if-not (empty? params-code)
|
||||||
(mk-params-maker params-code possible-params-code used-locals))
|
(mk-params-maker ns-str params-code possible-params-code used-locals))
|
||||||
]
|
]
|
||||||
;; TODO: error if precompiled is compiledpath and there are params or
|
;; TODO: error if precompiled is compiledpath and there are params or
|
||||||
;; precompiled is paramsneededpath and there are no params...
|
;; precompiled is paramsneededpath and there are no params...
|
||||||
|
|
|
||||||
|
|
@ -319,7 +319,7 @@
|
||||||
`(def ~name (vary-meta (fn ~@args) assoc :pathedfn true))))
|
`(def ~name (vary-meta (fn ~@args) assoc :pathedfn true))))
|
||||||
|
|
||||||
(defmacro defnavconstructor [name & args]
|
(defmacro defnavconstructor [name & args]
|
||||||
(let [[name [anav & body-or-bodies]] (m/name-with-attributes name args)
|
(let [[name [[csym anav] & body-or-bodies]] (m/name-with-attributes name args)
|
||||||
bodies (if (-> body-or-bodies first vector?) [body-or-bodies] body-or-bodies)
|
bodies (if (-> body-or-bodies first vector?) [body-or-bodies] body-or-bodies)
|
||||||
|
|
||||||
checked-code
|
checked-code
|
||||||
|
|
@ -330,11 +330,13 @@
|
||||||
(if (i/layered-nav? ret#)
|
(if (i/layered-nav? ret#)
|
||||||
(i/layered-nav-underlying ret#)
|
(i/layered-nav-underlying ret#)
|
||||||
(i/throw-illegal "Expected result navigator '" (quote ~anav)
|
(i/throw-illegal "Expected result navigator '" (quote ~anav)
|
||||||
"' from nav constructor '" (quote ~name) "'"))
|
"' from nav constructor '" (quote ~name) "'"
|
||||||
|
" constructed with the provided constructor '" (quote ~csym)
|
||||||
|
"'"))
|
||||||
))))]
|
))))]
|
||||||
`(def ~name
|
`(def ~name
|
||||||
(vary-meta
|
(vary-meta
|
||||||
(let [~anav (i/layered-wrapper ~anav)]
|
(let [~csym (i/layered-wrapper ~anav)]
|
||||||
(fn ~@checked-code))
|
(fn ~@checked-code))
|
||||||
assoc :layerednav true))
|
assoc :layerednav true))
|
||||||
))
|
))
|
||||||
|
|
@ -428,6 +430,7 @@
|
||||||
(if (nil? info#)
|
(if (nil? info#)
|
||||||
(let [info# (i/magic-precompilation
|
(let [info# (i/magic-precompilation
|
||||||
~prepared-path
|
~prepared-path
|
||||||
|
~(str *ns*)
|
||||||
(quote ~used-locals)
|
(quote ~used-locals)
|
||||||
;;possible-params is wrong atm
|
;;possible-params is wrong atm
|
||||||
;;as is used-locals in cljs...
|
;;as is used-locals in cljs...
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@
|
||||||
[com.rpl.specter.macros
|
[com.rpl.specter.macros
|
||||||
:refer [paramsfn defprotocolpath defnav extend-protocolpath
|
:refer [paramsfn defprotocolpath defnav extend-protocolpath
|
||||||
nav declarepath providepath select select-one select-one!
|
nav declarepath providepath select select-one select-one!
|
||||||
select-first transform setval replace-in]])
|
select-first transform setval replace-in defnavconstructor]])
|
||||||
(:use
|
(:use
|
||||||
#+clj [clojure.test :only [deftest is]]
|
#+clj [clojure.test :only [deftest is]]
|
||||||
#+clj [clojure.test.check.clojure-test :only [defspec]]
|
#+clj [clojure.test.check.clojure-test :only [defspec]]
|
||||||
|
|
@ -15,7 +15,7 @@
|
||||||
#+clj [com.rpl.specter.macros
|
#+clj [com.rpl.specter.macros
|
||||||
:only [paramsfn defprotocolpath defnav extend-protocolpath
|
:only [paramsfn defprotocolpath defnav extend-protocolpath
|
||||||
nav declarepath providepath select select-one select-one!
|
nav declarepath providepath select select-one select-one!
|
||||||
select-first transform setval replace-in]]
|
select-first transform setval replace-in defnavconstructor]]
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -859,6 +859,27 @@
|
||||||
(= q1 q2)
|
(= q1 q2)
|
||||||
(= (type q1) (type q2))))))
|
(= (type q1) (type q2))))))
|
||||||
|
|
||||||
|
(defnavconstructor double-str-keypath
|
||||||
|
[p s/keypath]
|
||||||
|
[s1 s2]
|
||||||
|
(p (str s1 s2)))
|
||||||
|
|
||||||
|
(defnavconstructor some-keypath
|
||||||
|
[p s/keypath]
|
||||||
|
([] (p "a"))
|
||||||
|
([k1] (p (str k1 "!")))
|
||||||
|
([k & args] (p "bbb")))
|
||||||
|
|
||||||
|
(deftest nav-constructor-test
|
||||||
|
;; this also tests that the eval done by clj platform during inline
|
||||||
|
;; caching rebinds to the correct namespace since this is run
|
||||||
|
;; by clojure.test in a different namespace
|
||||||
|
(is (= 1 (select-one! (double-str-keypath "a" "b") {"ab" 1 "c" 2})))
|
||||||
|
(is (= 1 (select-one! (some-keypath) {"a" 1 "a!" 2 "bbb" 3 "d" 4})))
|
||||||
|
(is (= 2 (select-one! (some-keypath "a") {"a" 1 "a!" 2 "bbb" 3 "d" 4})))
|
||||||
|
(is (= 3 (select-one! (some-keypath 1 2 3 4 5) {"a" 1 "a!" 2 "bbb" 3 "d" 4})))
|
||||||
|
)
|
||||||
|
|
||||||
(def ^:dynamic *APATH* s/keypath)
|
(def ^:dynamic *APATH* s/keypath)
|
||||||
|
|
||||||
(deftest inline-caching-test
|
(deftest inline-caching-test
|
||||||
|
|
@ -883,6 +904,13 @@
|
||||||
inc
|
inc
|
||||||
{:a 1 :b 2}
|
{:a 1 :b 2}
|
||||||
[[true] [false]])
|
[[true] [false]])
|
||||||
|
(ic-test
|
||||||
|
true
|
||||||
|
[v]
|
||||||
|
[s/ALL (double-str-keypath v (inc v))]
|
||||||
|
str
|
||||||
|
[{"12" :a "1011" :b} {"1011" :c}]
|
||||||
|
[[1] [10]])
|
||||||
(ic-test
|
(ic-test
|
||||||
false
|
false
|
||||||
[k]
|
[k]
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue