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

View file

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

View file

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

View file

@ -1,4 +1,6 @@
(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]
[clojure.walk :as cljwalk])
)
@ -8,14 +10,14 @@
(defn ^:no-doc determine-params-impls [[name1 & impl1] [name2 & impl2]]
(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))
(if (= name1 'select*)
[impl1 impl2]
[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"))
(defn ^:no-doc paramsnav* [bindings num-params [impl1 impl2]]
@ -31,7 +33,7 @@
~@transform-body)
))
`(i/->ParamsNeededPath
(reify i/RichNavigator
(reify RichNavigator
(~'rich-select* [this# ~PARAMS-SYM ~PARAMS-IDX-SYM vals# ~s-structure-sym next-fn#]
(let [~s-next-fn-sym (fn [structure#]
(next-fn#
@ -51,7 +53,8 @@
structure#))
~@bindings]
~@transform-body
)))
))
)
~num-params
))))
@ -107,8 +110,8 @@
(->> params
(map-indexed
(fn [i p]
[p `(aget ~PARAMS-SYM
(+ ~PARAMS-IDX-SYM ~i))]
[p `(i/object-aget ~PARAMS-SYM
(+ ~PARAMS-IDX-SYM ~i))]
))
(apply concat)))
@ -139,11 +142,11 @@
t-pidx-sym (second t-params)
]
`(let [num-params# ~num-params
nav# (reify i/RichNavigator
(rich-select* ~s-params
nav# (reify RichNavigator
(~'rich-select* ~s-params
(let [~s-next-fn-sym (i/mk-jump-next-fn ~s-next-fn-sym ~s-pidx-sym num-params#)]
~@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#)]
~@t-body))
)]
@ -268,7 +271,7 @@
]
`(do
(defprotocol ~prot-name (~m [structure#]))
(let [nav# (reify i/RichNavigator
(let [nav# (reify RichNavigator
(~'rich-select* [this# ~@rargs]
(let [inav# ~retrieve]
(i/exec-rich-select* inav# ~@rargs)
@ -304,7 +307,7 @@
(def ~name
(if (= ~num-params 0)
(i/no-params-rich-compiled-path
(reify i/RichNavigator
(reify RichNavigator
(~'rich-select* [this# ~@rargs]
(let [inav# (i/compiled-path-rich-nav ~declared)]
(i/exec-rich-select* inav# ~@rargs)
@ -314,7 +317,7 @@
(i/exec-rich-transform* inav# ~@rargs)
))))
(i/->ParamsNeededPath
(reify i/RichNavigator
(reify RichNavigator
(~'rich-select* [this# ~@rargs]
(let [inav# (i/params-needed-nav ~declared)]
(i/exec-rich-select* inav# ~@rargs)

View file

@ -2,7 +2,9 @@
(:use [com.rpl.specter macros]
[com.rpl.specter.util-macros :only [doseqres]])
(: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]
@ -12,25 +14,25 @@
[compiled-path structure]
(->> structure
(i/compiled-select-any* compiled-path)
(identical? NONE)))
(identical? i/NONE)))
(defn selected?*
[compiled-path structure]
(not (not-selected?* compiled-path 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]
(if (pred structure)
(let [r (continue-fn structure)]
(if-not (identical? r NONE)
(set-cell! ret r))
(if-not (identical? r i/NONE)
(i/set-cell! ret r))
r
)
(walk/walk this identity structure)
))]
(walker structure)
(get-cell ret)
(i/get-cell ret)
))
(defn key-select [akey structure next-fn]
@ -41,7 +43,7 @@
))
(defn all-select [structure next-fn]
(doseqres NONE [e structure]
(doseqres i/NONE [e structure]
(next-fn e)))
#+cljs
@ -228,16 +230,7 @@
(defn srange-select [structure start end next-fn]
(next-fn (-> structure vec (subvec start end))))
(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
)))
(def srange-transform i/srange-transform*)
(defn- matching-indices [aseq p]
(keep-indexed (fn [i e] (if (p e) i)) aseq))
@ -291,6 +284,7 @@
next-fn
)))
(defn if-transform [params params-idx vals structure next-fn then-tester then-nav then-params else-nav]
(let [test? (then-tester structure)
tran (if test?
@ -316,7 +310,7 @@
(defn filter-select [afn structure next-fn]
(if (afn structure)
(next-fn structure)
NONE))
i/NONE))
(defn filter-transform [afn structure next-fn]
(if (afn structure)
@ -324,17 +318,6 @@
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
(append-all [structure elements])
(prepend-all [structure elements]))
@ -376,6 +359,16 @@
(defprotocol FastEmpty
(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]
(cons (afn (first l)) (rest l)))
@ -455,17 +448,11 @@
(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]
(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))
(if (and (i/fn-invocation? structure) (i/fn-invocation? ret))
(with-meta ret (meta structure))
ret
))))
@ -478,7 +465,7 @@
(let [afn (aget ^objects params params-idx)]
(if (afn vals)
(next-fn params (inc params-idx) vals structure)
NONE
i/NONE
)))
(rich-transform* [this params params-idx vals structure next-fn]
(let [afn (aget ^objects params params-idx)]