From 479cb7d02355b846289423bddae28a52fb05b75d Mon Sep 17 00:00:00 2001 From: Nathan Marz Date: Thu, 1 Sep 2016 13:56:51 -0400 Subject: [PATCH] re-implemented declarepath and providepath, added local-declarepath for making recursive/mutually-recursive navigators locally --- src/clj/com/rpl/specter.cljc | 5 ++ src/clj/com/rpl/specter/impl.cljc | 44 ++++++++++----- src/clj/com/rpl/specter/macros.clj | 90 ++++++++---------------------- 3 files changed, 60 insertions(+), 79 deletions(-) diff --git a/src/clj/com/rpl/specter.cljc b/src/clj/com/rpl/specter.cljc index c5fbe73..777509f 100644 --- a/src/clj/com/rpl/specter.cljc +++ b/src/clj/com/rpl/specter.cljc @@ -156,6 +156,11 @@ (def late-path i/late-path) + +;; Helpers for making recursive or mutually recursive navs + +(def local-declarepath i/local-declarepath) + ;; Built-in pathing and context operations (defnav diff --git a/src/clj/com/rpl/specter/impl.cljc b/src/clj/com/rpl/specter/impl.cljc index 4eb0598..2920816 100644 --- a/src/clj/com/rpl/specter/impl.cljc +++ b/src/clj/com/rpl/specter/impl.cljc @@ -139,6 +139,7 @@ (defn- coerce-object [this] (cond (satisfies? p/ImplicitNav this) (p/implicit-nav this) + (rich-nav? this) this :else (throw-illegal "Not a navigator: " this))) @@ -192,7 +193,7 @@ (coerce-path o)) #?(:clj java.util.List :cljs cljs.core/PersistentVector) (do-comp-paths [navigators] - (reduce combine-two-navs navigators))) + (reduce combine-two-navs (map coerce-path navigators)))) ;; cell implementation idea taken from prismatic schema library #?(:cljs @@ -441,7 +442,7 @@ (next-fn structure) structure)) -(defn pred* [afn] +(defn ^:direct-nav pred* [afn] (reify RichNavigator (select* [this vals structure next-fn] (if (afn structure) @@ -459,6 +460,34 @@ (transform* [this vals structure next-fn] (next-fn vals structure)))) +(defn ^:direct-nav collected?* [afn] + (reify RichNavigator + (select* [this vals structure next-fn] + (if (afn vals) + (next-fn vals structure) + NONE)) + (transform* [this vals structure next-fn] + (if (afn vals) + (next-fn vals structure) + structure)))) + +(defn ^:direct-nav cell-nav [cell] + (reify RichNavigator + (select* [this vals structure next-fn] + (exec-select* (get-cell cell) vals structure next-fn)) + (transform* [this vals structure next-fn] + (exec-transform* (get-cell cell) vals structure next-fn)))) + +(defn local-declarepath [] + (let [cell (mutable-cell nil)] + (vary-meta (cell-nav cell) assoc ::cell cell))) + +(defn providepath* [declared compiled-path] + (let [cell (-> declared meta ::cell)] + (set-cell! cell compiled-path))) + + + (defn gensyms [amt] (vec (repeatedly amt gensym))) @@ -479,17 +508,6 @@ (mk-comp-navs) -(defn collected?* [afn] - (reify RichNavigator - (select* [this vals structure next-fn] - (if (afn vals) - (next-fn vals structure) - NONE)) - (transform* [this vals structure next-fn] - (if (afn vals) - (next-fn vals structure) - structure)))) - (defn srange-transform* [structure start end next-fn] (let [structurev (vec structure) newpart (next-fn (-> structurev (subvec start end))) diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index 4ca8e5a..fa23a0e 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -127,60 +127,18 @@ (i/no-params-rich-compiled-path nav#) (i/->ParamsNeededPath nav# ~num-params)))))))) - - - - -(defn ^:no-doc declared-name [name] - (vary-meta (symbol (str name "-declared")) - assoc :no-doc true)) - -;;TODO: redesign so can be recursive -(defmacro declarepath - ([name] - `(declarepath ~name [])) - ([name params] - (let [platform (if (contains? &env :locals) :cljs :clj) - select-exec (if (= platform :clj) - `i/exec-rich-select* - `i/rich-select*) - transform-exec (if (= platform :clj) - `i/exec-rich-transform* - `i/rich-transform*) - num-params (count params) - declared (declared-name name) - rargs [(gensym "params") (gensym "pidx") (gensym "vals") - (gensym "structure") (gensym "next-fn")]] - `(do - (declare ~declared) - (def ~name - (let [nav# (reify RichNavigator - (~'rich-select* [this# ~@rargs] - (~select-exec ~declared ~@rargs)) - (~'rich-transform* [this# ~@rargs] - (~transform-exec ~declared ~@rargs)))] - - (if (= ~num-params 0) - (i/no-params-rich-compiled-path nav#) - (i/->ParamsNeededPath nav# ~num-params)))))))) - - -(defmacro providepath [name apath] - `(let [comped# (i/comp-paths-internalized ~apath) - expected-params# (i/num-needed-params ~name) - needed-params# (i/num-needed-params comped#)] - (if-not (= needed-params# expected-params#) - (i/throw-illegal "Invalid number of params in provided path, expected " - expected-params# " but got " needed-params#)) - (def ~(declared-name name) - (i/extract-rich-nav (i/coerce-compiled->rich-nav comped#))))) - - (defmacro extend-protocolpath "Used in conjunction with `defprotocolpath`. See [[defprotocolpath]]." [protpath & extensions] `(i/extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions))) + +(defmacro declarepath [name] + `(def ~name (i/local-declarepath))) + +(defmacro providepath [name apath] + `(i/providepath* ~name (path ~apath))) + ;; copied from tools.macro to avoid the dependency (defn ^:no-doc name-with-attributes "To be used in macro definitions. @@ -261,23 +219,23 @@ `(com.rpl.specter.impl/->DynamicVal ~path (quote ~path))))) -(defn ^:no-doc ic-possible-params [path] - (do - (mapcat - (fn [e] - (cond (or (set? e) - (map? e) ; in case inline maps are ever extended - (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) - [e] - - (i/fn-invocation? e) - ;; the [e] here handles nav constructors - (concat [e] (rest e) (ic-possible-params e)) - - (vector? e) - (ic-possible-params e))) - - path))) +; (defn ^:no-doc ic-possible-params [path] +; (do +; (mapcat +; (fn [e] +; (cond (or (set? e) +; (map? e) ; in case inline maps are ever extended +; (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) +; [e] +; +; (i/fn-invocation? e) +; ;; the [e] here handles nav constructors +; (concat [e] (rest e) (ic-possible-params e)) +; +; (vector? e) +; (ic-possible-params e))) +; +; path))) (defn cljs-macroexpand [env form]