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-08-04 13:47:54 -04:00
parent 3ba0926251
commit 73312bffd7
4 changed files with 93 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/clj/com/rpl/specter.cljx
View file

@ -176,10 +176,10 @@
needed (i/num-needed-params params-path)] needed (i/num-needed-params params-path)]
(richnav 0 (richnav 0
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn) (i/exec-rich-select* nav params (- params-idx needed) vals structure next-fn))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn) (i/exec-rich-transform* nav params (- params-idx needed) vals structure next-fn)
))))) ))))
;; Built-in pathing and context operations ;; Built-in pathing and context operations
@ -198,6 +198,7 @@
(defnav (defnav
^{:doc "Stays navigated at the current point. Essentially a no-op navigator."} ^{:doc "Stays navigated at the current point. Essentially a no-op navigator."}
STAY STAY
[]
(select* [this structure next-fn] (select* [this structure next-fn]
(next-fn structure)) (next-fn structure))
(transform* [this structure next-fn] (transform* [this structure next-fn]
@ -255,13 +256,13 @@
^{:doc "Navigate to the last element of the collection. If the collection is ^{:doc "Navigate to the last element of the collection. If the collection is
empty navigation is stopped at this point."} empty navigation is stopped at this point."}
LAST LAST
(n/PosNavigator i/get-last i/update-last)) (n/PosNavigator n/get-last n/update-last))
(def (def
^{:doc "Navigate to the first element of the collection. If the collection is ^{:doc "Navigate to the first element of the collection. If the collection is
empty navigation is stopped at this point."} empty navigation is stopped at this point."}
FIRST FIRST
(n/PosNavigator i/get-first i/update-first)) (n/PosNavigator n/get-first n/update-first))
(defnav (defnav
^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence ^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
@ -460,7 +461,7 @@
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] [& path]
(if-let [afn (i/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
afn afn
(fixed-pathed-nav [late path] (fixed-pathed-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
@ -475,7 +476,7 @@
next-fn))))) next-fn)))))
(defpathedfn not-selected? [& path] (defpathedfn not-selected? [& path]
(if-let [afn (i/extract-basic-filter-fn path)] (if-let [afn (n/extract-basic-filter-fn path)]
(fn [s] (not (afn s))) (fn [s] (not (afn s)))
(fixed-pathed-nav [late path] (fixed-pathed-nav [late path]
(select* [this structure next-fn] (select* [this structure next-fn]
@ -624,10 +625,10 @@
else-needed (i/num-needed-params else-comp) else-needed (i/num-needed-params else-comp)
then-nav (i/extract-rich-nav then-comp) then-nav (i/extract-rich-nav then-comp)
else-nav (i/extract-rich-nav else-comp)] else-nav (i/extract-rich-nav else-comp)]
(if-let [afn (i/extract-basic-filter-fn cond-p)] (if-let [afn (n/extract-basic-filter-fn cond-p)]
(richnav (+ then-needed else-needed) (richnav (+ then-needed else-needed)
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(i/if-select (n/if-select
params params
params-idx params-idx
vals vals
@ -639,7 +640,7 @@
else-nav else-nav
)) ))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(i/if-transform (n/if-transform
params params
params-idx params-idx
vals vals
@ -655,26 +656,26 @@
(richnav (+ then-needed else-needed cond-needed) (richnav (+ then-needed else-needed cond-needed)
(select* [this params params-idx vals structure next-fn] (select* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)] (let [late-cond (i/parameterize-path cond-comp params params-idx)]
(i/if-select (n/if-select
params params
(+ params-idx cond-needed) (+ params-idx cond-needed)
vals vals
structure structure
next-fn next-fn
#(i/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav
))) )))
(transform* [this params params-idx vals structure next-fn] (transform* [this params params-idx vals structure next-fn]
(let [late-cond (i/parameterize-path cond-comp params params-idx)] (let [late-cond (i/parameterize-path cond-comp params params-idx)]
(i/if-transform (n/if-transform
params params
(+ params-idx cond-needed) (+ params-idx cond-needed)
vals vals
structure structure
next-fn next-fn
#(i/selected?* late-cond %) #(n/selected?* late-cond %)
then-nav then-nav
then-needed then-needed
else-nav else-nav

65
src/clj/com/rpl/specter/impl.cljx
View file

@ -10,7 +10,6 @@
#+clj [com.rpl.specter.util-macros :only [doseqres]] #+clj [com.rpl.specter.util-macros :only [doseqres]]
) )
(:require [com.rpl.specter.protocols :as p] (:require [com.rpl.specter.protocols :as p]
#+clj [clojure.core.reducers :as r]
[clojure.string :as s] [clojure.string :as s]
#+clj [com.rpl.specter.defhelpers :as dh] #+clj [com.rpl.specter.defhelpers :as dh]
#+clj [riddley.walk :as riddley] #+clj [riddley.walk :as riddley]
@ -34,6 +33,9 @@
(defn smart-str [& elems] (defn smart-str [& elems]
(apply str (map smart-str* elems))) (apply str (map smart-str* elems)))
(defn object-aget [^objects a i]
(aget a i))
(defn fast-constantly [v] (defn fast-constantly [v]
(fn ([] v) (fn ([] v)
([a1] v) ([a1] v)
@ -115,7 +117,7 @@
#+clj #+clj
(defmacro exec-rich-select* [this & args] (defmacro exec-rich-select* [this & args]
(let [hinted (with-meta this {:tag com.rpl.specter.impl.RichNavigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})]
`(.rich-select* ~hinted ~@args) `(.rich-select* ~hinted ~@args)
)) ))
@ -125,7 +127,7 @@
#+clj #+clj
(defmacro exec-rich-transform* [this & args] (defmacro exec-rich-transform* [this & args]
(let [hinted (with-meta this {:tag com.rpl.specter.impl.RichNavigator})] (let [hinted (with-meta this {:tag 'com.rpl.specter.impl.RichNavigator})]
`(.rich-transform* ~hinted ~@args) `(.rich-transform* ~hinted ~@args)
)) ))
@ -135,7 +137,7 @@
#+clj #+clj
(defmacro exec-select* [this & args] (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.Navigator})]
`(.select* ~hinted ~@args) `(.select* ~hinted ~@args)
)) ))
@ -145,7 +147,7 @@
#+clj #+clj
(defmacro exec-transform* [this & args] (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.Navigator})]
`(.transform* ~hinted ~@args) `(.transform* ~hinted ~@args)
)) ))
@ -157,7 +159,7 @@
(def RichPathExecutor (def RichPathExecutor
(->ExecutorFunctions (->ExecutorFunctions
(fn [^ParameterizedRichNav richnavp result-fn structure] (fn [^ParameterizedRichNav richnavp result-fn structure]
(exec-rich-select* (.-rich-nav nav) (exec-rich-select* (.-rich-nav richnavp)
(.-params richnavp) (.-params-idx richnavp) (.-params richnavp) (.-params-idx richnavp)
[] structure [] structure
(fn [_ _ vals structure] (fn [_ _ vals structure]
@ -166,7 +168,7 @@
structure structure
(conj vals structure)))))) (conj vals structure))))))
(fn [^ParameterizedRichNav richnavp transform-fn structure] (fn [^ParameterizedRichNav richnavp transform-fn structure]
(exec-rich-transform* (.-rich-nav nav) (exec-rich-transform* (.-rich-nav richnavp)
(.-params richnavp) (.-params-idx richnavp) (.-params richnavp) (.-params-idx richnavp)
[] structure [] structure
(fn [_ _ vals structure] (fn [_ _ vals structure]
@ -315,7 +317,7 @@
(coerce-object this))) (coerce-object this)))
(defn- combine-same-types [n & _ :as all]] (defn- combine-same-types [[n & _ :as all]]
(let [combiner (let [combiner
(if (satisfies? RichNavigator n) (if (satisfies? RichNavigator n)
(fn [curr next] (fn [curr next]
@ -348,14 +350,13 @@
(defn coerce-rich-navigator [nav] (defn coerce-rich-navigator [nav]
(if (satisfies? RichNavigator nav) (if (satisfies? RichNavigator nav)
nav nav
(let [nav] (reify RichNavigator
(reify RichNavigator (rich-select* [this params params-idx vals structure next-fn]
(rich-select* [this params params-idx vals structure next-fn] (exec-select* nav structure (fn [structure] (next-fn params params-idx vals structure)))
(exec-select* nav structure (fn [structure] (next-fn params params-idx vals structure))) )
) (rich-transform* [this params params-idx vals structure next-fn]
(rich-transform* [this params params-idx vals structure next-fn] (exec-transform* nav structure (fn [structure] (next-fn params params-idx vals structure)))
(exec-transform* nav structure (fn [structure] (next-fn params params-idx vals structure))) ))))
)))))
(defn extract-rich-nav [p] (defn extract-rich-nav [p]
(coerce-rich-navigator (extract-nav p))) (coerce-rich-navigator (extract-nav p)))
@ -365,14 +366,14 @@
(not (instance? CompiledPath path)) (not (instance? CompiledPath path))
path path
(instance? Navigator (:nav path)) (satisfies? Navigator (:nav path))
path path
:else :else
(let [prich-nav (:nav path) (let [^ParameterizedRichNav prich-nav (:nav path)
rich-nav (:rich-nav prich-nav) rich-nav (.-rich-nav prich-nav)
params (:params prich-nav) params (.-params prich-nav)
params-idx (:params-idx prich-nav)] params-idx (.-params-idx prich-nav)]
(if (empty? params) (if (empty? params)
path path
(no-params-rich-compiled-path (no-params-rich-compiled-path
@ -591,7 +592,7 @@
(defn compiled-transform* (defn compiled-transform*
[^com.rpl.specter.impl.CompiledPath path transform-fn structure] [^com.rpl.specter.impl.CompiledPath path transform-fn structure]
(let [nav (.-nav path) (let [nav (.-nav path)
^com.rpl.specter.impl.ExecutorFunctions ex (.-executors tfns)] ^com.rpl.specter.impl.ExecutorFunctions ex (.-executors path)]
((.-transform-executor ex) nav transform-fn structure) ((.-transform-executor ex) nav transform-fn structure)
)) ))
@ -617,8 +618,11 @@
path path
)))) ))))
;;TODO: continue from here (defn fn-invocation? [f]
(or #+clj (instance? clojure.lang.Cons f)
#+clj (instance? clojure.lang.LazySeq f)
#+cljs (instance? cljs.core.LazySeq f)
(list? f)))
(defrecord LayeredNav [underlying]) (defrecord LayeredNav [underlying])
@ -746,6 +750,17 @@
1 1
)) ))
(defn srange-transform* [structure start end next-fn]
(let [structurev (vec structure)
newpart (next-fn (-> structurev (subvec start end)))
res (concat (subvec structurev 0 start)
newpart
(subvec structurev end (count structure)))]
(if (vector? structure)
(vec res)
res
)))
(defn- variadic-arglist? [al] (defn- variadic-arglist? [al]
(contains? (set al) '&)) (contains? (set al) '&))
@ -761,7 +776,7 @@
(when-not ret (when-not ret
(throw-illegal "Invalid # arguments at " code)) (throw-illegal "Invalid # arguments at " code))
(if (variadic-arglist? ret) (if (variadic-arglist? ret)
(srange-transform ret (- len 2) len (srange-transform* ret (- len 2) len
(fn [_] (repeatedly (- c (- len 2)) gensym))) (fn [_] (repeatedly (- c (- len 2)) gensym)))
ret ret
))) )))

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

@ -1,4 +1,6 @@
(ns com.rpl.specter.macros (ns com.rpl.specter.macros
(:use [com.rpl.specter.protocols :only [Navigator]]
[com.rpl.specter.impl :only [RichNavigator]])
(:require [com.rpl.specter.impl :as i] (:require [com.rpl.specter.impl :as i]
[clojure.walk :as cljwalk]) [clojure.walk :as cljwalk])
) )
@ -8,14 +10,14 @@
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]] (defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
(if-not (= #{name1 name2} #{'select* 'transform*}) (if-not (= #{name1 name2} #{'select* 'transform*})
(i/throw-illegal "defpath must implement select* and transform*, instead got " (i/throw-illegal "defnav must implement select* and transform*, instead got "
name1 " and " name2)) name1 " and " name2))
(if (= name1 'select*) (if (= name1 'select*)
[impl1 impl2] [impl1 impl2]
[impl2 impl1])) [impl2 impl1]))
(def ^:no-doc PARAMS-SYM (vary-meta (gensym "params") assoc :tag 'objects)) (def ^:no-doc PARAMS-SYM (gensym "params"))
(def ^:no-doc PARAMS-IDX-SYM (gensym "params-idx")) (def ^:no-doc PARAMS-IDX-SYM (gensym "params-idx"))
(defn ^:no-doc paramsnav* [bindings num-params [impl1 impl2]] (defn ^:no-doc paramsnav* [bindings num-params [impl1 impl2]]
@ -31,7 +33,7 @@
~@transform-body) ~@transform-body)
)) ))
`(i/->ParamsNeededPath `(i/->ParamsNeededPath
(reify i/RichNavigator (reify RichNavigator
(~'rich-select* [this# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#] (~'rich-select* [this# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#]
(let [~s-next-fn-sym (fn [structure#] (let [~s-next-fn-sym (fn [structure#]
(next-fn# (next-fn#
@ -51,7 +53,8 @@
structure#)) structure#))
~@bindings] ~@bindings]
~@transform-body ~@transform-body
))) ))
)
~num-params ~num-params
)))) ))))
@ -107,8 +110,8 @@
(->> params (->> params
(map-indexed (map-indexed
(fn [i p] (fn [i p]
[p `(aget ~PARAMS-SYM [p `(i/object-aget ~PARAMS-SYM
(+ ~PARAMS-IDX-SYM ~i))] (+ ~PARAMS-IDX-SYM ~i))]
)) ))
(apply concat))) (apply concat)))
@ -139,11 +142,11 @@
t-pidx-sym (second t-params) t-pidx-sym (second t-params)
] ]
`(let [num-params# ~num-params `(let [num-params# ~num-params
nav# (reify i/RichNavigator nav# (reify RichNavigator
(rich-select* ~s-params (~'rich-select* ~s-params
(let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)] (let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)]
~@s-body)) ~@s-body))
(rich-transform* ~t-params (~'rich-transform* ~t-params
(let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)] (let [~t-next-fn-sym (i/mk-jump-next-fn ~t-next-fn-sym ~t-pidx-sym num-params#)]
~@t-body)) ~@t-body))
)] )]
@ -268,7 +271,7 @@
] ]
`(do `(do
(defprotocol ~prot-name (~m [structure#])) (defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify i/RichNavigator (let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# ~retrieve] (let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)
@ -304,7 +307,7 @@
(def ~name (def ~name
(if (= ~num-params 0) (if (= ~num-params 0)
(i/no-params-rich-compiled-path (i/no-params-rich-compiled-path
(reify i/RichNavigator (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# (i/compiled-path-rich-nav ~declared)] (let [inav# (i/compiled-path-rich-nav ~declared)]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)
@ -314,7 +317,7 @@
(i/exec-rich-transform* inav# ~@rargs) (i/exec-rich-transform* inav# ~@rargs)
)))) ))))
(i/->ParamsNeededPath (i/->ParamsNeededPath
(reify i/RichNavigator (reify RichNavigator
(~'rich-select* [this# ~@rargs] (~'rich-select* [this# ~@rargs]
(let [inav# (i/params-needed-nav ~declared)] (let [inav# (i/params-needed-nav ~declared)]
(i/exec-rich-select* inav# ~@rargs) (i/exec-rich-select* inav# ~@rargs)

61
src/clj/com/rpl/specter/navs.cljx
View file

@ -2,7 +2,9 @@
(:use [com.rpl.specter macros] (:use [com.rpl.specter macros]
[com.rpl.specter.util-macros :only [doseqres]]) [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]
)
) )
(defn- append [coll elem] (defn- append [coll elem]
@ -12,25 +14,25 @@
[compiled-path structure] [compiled-path structure]
(->> structure (->> structure
(i/compiled-select-any* compiled-path) (i/compiled-select-any* compiled-path)
(identical? NONE))) (identical? i/NONE)))
(defn selected?* (defn selected?*
[compiled-path structure] [compiled-path structure]
(not (not-selected?* compiled-path structure))) (not (not-selected?* compiled-path structure)))
(defn walk-select [pred continue-fn structure] (defn walk-select [pred continue-fn structure]
(let [ret (i/mutable-cell NONE) (let [ret (i/mutable-cell i/NONE)
walker (fn this [structure] walker (fn this [structure]
(if (pred structure) (if (pred structure)
(let [r (continue-fn structure)] (let [r (continue-fn structure)]
(if-not (identical? r NONE) (if-not (identical? r i/NONE)
(set-cell! ret r)) (i/set-cell! ret r))
r r
) )
(walk/walk this identity structure) (walk/walk this identity structure)
))] ))]
(walker structure) (walker structure)
(get-cell ret) (i/get-cell ret)
)) ))
(defn key-select [akey structure next-fn] (defn key-select [akey structure next-fn]
@ -41,7 +43,7 @@
)) ))
(defn all-select [structure next-fn] (defn all-select [structure next-fn]
(doseqres NONE [e structure] (doseqres i/NONE [e structure]
(next-fn e))) (next-fn e)))
#+cljs #+cljs
@ -228,16 +230,7 @@
(defn srange-select [structure start end next-fn] (defn srange-select [structure start end next-fn]
(next-fn (-> structure vec (subvec start end)))) (next-fn (-> structure vec (subvec start end))))
(defn srange-transform [structure start end next-fn] (def srange-transform i/srange-transform*)
(let [structurev (vec structure)
newpart (next-fn (-> structurev (subvec start end)))
res (concat (subvec structurev 0 start)
newpart
(subvec structurev end (count structure)))]
(if (vector? structure)
(vec res)
res
)))
(defn- matching-indices [aseq p] (defn- matching-indices [aseq p]
(keep-indexed (fn [i e] (if (p e) i)) aseq)) (keep-indexed (fn [i e] (if (p e) i)) aseq))
@ -291,6 +284,7 @@
next-fn next-fn
))) )))
(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav] (defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
(let [test? (then-tester structure) (let [test? (then-tester structure)
tran (if test? tran (if test?
@ -316,7 +310,7 @@
(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)
NONE)) i/NONE))
(defn filter-transform [afn structure next-fn] (defn filter-transform [afn structure next-fn]
(if (afn structure) (if (afn structure)
@ -324,17 +318,6 @@
structure)) structure))
(defnav PosNavigator [getter updater]
(select* [this structure next-fn]
(if-not (i/fast-empty? structure)
(next-fn (getter structure))
NONE))
(transform* [this structure next-fn]
(if (i/fast-empty? structure)
structure
(updater structure next-fn))))
(defprotocol AddExtremes (defprotocol AddExtremes
(append-all [structure elements]) (append-all [structure elements])
(prepend-all [structure elements])) (prepend-all [structure elements]))
@ -376,6 +359,16 @@
(defprotocol FastEmpty (defprotocol FastEmpty
(fast-empty? [s])) (fast-empty? [s]))
(defnav PosNavigator [getter updater]
(select* [this structure next-fn]
(if-not (fast-empty? structure)
(next-fn (getter structure))
i/NONE))
(transform* [this structure next-fn]
(if (fast-empty? structure)
structure
(updater structure next-fn))))
(defn- update-first-list [l afn] (defn- update-first-list [l afn]
(cons (afn (first l)) (rest l))) (cons (afn (first l)) (rest l)))
@ -455,17 +448,11 @@
(walk/walk (partial walk-until pred on-match-fn) identity structure) (walk/walk (partial walk-until pred on-match-fn) identity structure)
)) ))
(defn fn-invocation? [f]
(or #+clj (instance? clojure.lang.Cons f)
#+clj (instance? clojure.lang.LazySeq f)
#+cljs (instance? cljs.core.LazySeq f)
(list? f)))
(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)
(let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)] (let [ret (walk/walk (partial codewalk-until pred on-match-fn) identity structure)]
(if (and (fn-invocation? structure) (fn-invocation? ret)) (if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure)) (with-meta ret (meta structure))
ret ret
)))) ))))
@ -478,7 +465,7 @@
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]
(if (afn vals) (if (afn vals)
(next-fn params (inc params-idx) vals structure) (next-fn params (inc params-idx) vals structure)
NONE i/NONE
))) )))
(rich-transform* [this params params-idx vals structure next-fn] (rich-transform* [this params params-idx vals structure next-fn]
(let [afn (aget ^objects params params-idx)] (let [afn (aget ^objects params params-idx)]