From eb5de0bdd5da655dedbedb54456227ec05ab9e36 Mon Sep 17 00:00:00 2001 From: Nathan Marz Date: Wed, 31 Aug 2016 22:30:28 -0400 Subject: [PATCH] lots of progress --- src/clj/com/rpl/specter.cljc | 8 +- src/clj/com/rpl/specter/impl.cljc | 391 ++++++++++++++--------------- src/clj/com/rpl/specter/macros.clj | 132 ++++------ src/clj/com/rpl/specter/navs.cljc | 9 - 4 files changed, 238 insertions(+), 302 deletions(-) diff --git a/src/clj/com/rpl/specter.cljc b/src/clj/com/rpl/specter.cljc index dbda859..62ecdfd 100644 --- a/src/clj/com/rpl/specter.cljc +++ b/src/clj/com/rpl/specter.cljc @@ -164,14 +164,10 @@ -(defnav +(def ^{: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] - (next-fn structure))) + i/STAY*) (def ^{:doc "For usage with `multi-transform`, defines an endpoint in the navigation diff --git a/src/clj/com/rpl/specter/impl.cljc b/src/clj/com/rpl/specter/impl.cljc index d3292d4..f2d6cc8 100644 --- a/src/clj/com/rpl/specter/impl.cljc +++ b/src/clj/com/rpl/specter/impl.cljc @@ -3,11 +3,12 @@ [com.rpl.specter.util-macros :refer [doseqres]])) (:use [com.rpl.specter.protocols :only - [select* transform* collect-val Rich Navigator]] + [select* transform* collect-val RichNavigator]] #?(:clj [com.rpl.specter.util-macros :only [doseqres]])) (:require [com.rpl.specter.protocols :as p] [clojure.string :as s] + [clojure.walk :as walk] #?(:clj [riddley.walk :as riddley])) #?(:clj (:import [com.rpl.specter Util MutableCell]))) @@ -99,7 +100,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.RichNavigator})] `(.select* ~hinted ~@args))) @@ -111,7 +112,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.RichNavigator})] `(.transform* ~hinted ~@args))) @@ -128,13 +129,6 @@ (defn comp-paths* [p] (if (rich-nav? p) p (do-comp-paths p))) - -(defn- seq-contains? [aseq val] - (->> aseq - (filter (partial = val)) - empty? - not)) - (defn- coerce-object [this] (cond (satisfies? p/ImplicitNav this) (p/implicit-nav this) :else (throw-illegal "Not a navigator: " this))) @@ -173,13 +167,13 @@ (defn combine-two-navs [nav1 nav2] (reify RichNavigator (select* [this vals structure next-fn] - (exec-select* curr vals structure + (exec-select* nav1 vals structure (fn [vals-next structure-next] - (exec-select* next vals-next structure-next next-fn)))) + (exec-select* nav2 vals-next structure-next next-fn)))) (transform* [this vals structure next-fn] - (exec-transform* curr vals structure + (exec-transform* nav1 vals structure (fn [vals-next structure-next] - (exec-rich-transform* next vals-next structure-next next-fn)))))) + (exec-transform* nav2 vals-next structure-next next-fn)))))) (extend-protocol PathComposer nil @@ -192,7 +186,6 @@ (do-comp-paths [navigators] (reduce combine-two-navs navigators))) - ;; cell implementation idea taken from prismatic schema library #?(:cljs (defprotocol PMutableCell @@ -329,7 +322,7 @@ ;;TODO: could inline cache the transform-fn, or even have a different one ;;if know there are no vals at the end -(defn compiled-transform* [path transform-fn structure] +(defn compiled-transform* [nav transform-fn structure] (exec-transform* nav [] structure (fn [vals structure] (if (identical? vals []) @@ -355,8 +348,27 @@ ;; op and params elems can be any of the above [op params code]) +(defrecord DynamicVal + [code]) + +;; path is a vector with elements of: +;; - DynamicFunction +;; - DynamicVal +;; - constant navigators +(defrecord DynamicPath + [path]) + +;; params are either dynamicval, dynamicpath, or constants +;;TODO: what about path like: [((make-nav-maker a) :a :b) ALL] +;; should treat it like a special form if it's dynamic +;; if all static args, then resolve it at "compile" time +;; can have op be a dynamicfunction as well... or a dynamicval for that matter +(defrecord DynamicFunction + [op params]) + + (defrecord CachedPathInfo - [path-fn]) + [dynamic? precompiled]) (defn constant-node? [node] @@ -418,6 +430,22 @@ (next-fn vals structure) structure)))) +(def STAY* + (reify RichNavigator + (select* [this vals structure next-fn] + (next-fn vals structure)) + (transform* [this vals structure next-fn] + (next-fn vals structure)))) + +(defn comp-navs + ([] STAY*) + ([nav1] nav1) + ([nav1 nav2] (combine-two-navs nav1 nav2)) + ([nav1 nav2 nav3] (comp-navs nav1 (comp-navs nav2 nav3))) + ([nav1 nav2 nav3 nav4] (comp-navs nav1 (comp-navs nav2 nav3 nav4)))) + ;; ...TODO: make a macro for this + + (defn collected?* [afn] (reify RichNavigator @@ -440,215 +468,172 @@ (vec res) res))) - -(defn- variadic-arglist? [al] - (contains? (set al) '&)) - -(defn- arglist-for-params-count [arglists c code] - (let [ret (->> arglists - (filter - (fn [al] - (or (= (count al) c) - (variadic-arglist? al)))) - - first) - len (count ret)] - (when-not ret - (throw-illegal "Invalid # arguments at " code)) - (if (variadic-arglist? ret) - (srange-transform* ret (- len 2) len - (fn [_] (repeatedly (- c (- len 2)) gensym))) - ret))) - -;;TODO: all needs to change -(defn- magic-precompilation* [p params-atom failed-atom] - (let [magic-fail! (fn [& reason] - (if (get-cell MUST-CACHE-PATHS) - (println "Failed to cache path:" (apply str reason))) - (reset! failed-atom true) - nil)] - (cond - (vector? p) - (mapv - #(magic-precompilation* % params-atom failed-atom) - p) - - (instance? LocalSym p) - (magic-fail! "Local symbol " (:sym p) " where navigator expected") - - (instance? VarUse p) - (let [v (:var p) - vv (:val p)] - (cond (-> v meta :dynamic) - (magic-fail! "Var " (:sym p) " is dynamic") - - (and (fn? vv) (-> v meta :pathedfn)) - (throw-illegal "Cannot use pathed fn '" (:sym p) "' where navigator expected") - - (valid-navigator? vv) - vv - - :else - (magic-fail! "Var " (:sym p) " is not a navigator"))) +(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)) + (with-meta ret (meta structure)) + ret)))) - (instance? SpecialFormUse p) - (if (->> p :code first (contains? #{'fn* 'fn})) - (do - (swap! params-atom conj (:code p)) - pred*) +(def ^:dynamic *tmp-closure*) +(defn closed-code [closure body] + (let [lv (mapcat #(vector % `(*tmp-closure* '~%)) + (keys closure))] + (binding [*tmp-closure* closure] + (eval `(let [~@lv] ~body))))) - (magic-fail! "Special form " (:code p) " where navigator expected")) +(defn any? + "Accepts any number of predicates that take in one input and returns a new predicate that returns true if any of them are true" + [& preds] + (fn [obj] + (some #(% obj) preds))) - (instance? FnInvocation p) - (let [op (:op p) - ps (:params p)] - (if (instance? VarUse op) - (let [v (:var op) - vv (:val op)] - (if (-> v meta :dynamic) - (magic-fail! "Var " (:sym op) " is dynamic") - (cond - (or (root-params-nav? vv) (instance? ParamsNeededPath vv)) - (if (every? constant-node? ps) - (apply vv (map extract-constant ps)) - (do - (swap! params-atom #(vec (concat % ps))) - (coerce-path vv))) +(let [embeddable? (any? number? + symbol? + keyword? + string? + char? + list? + vector? + set? + #(and (map? %) (not (record? %))) + nil? + #(instance? clojure.lang.Cons %) + #(instance? clojure.lang.LazySeq %))] + (defn eval+ + "Automatically extracts non-evalable stuff into a closure and then evals" + [form] + (let [replacements (mutable-cell {}) + new-form (codewalk-until + #(-> % embeddable? not) + (fn [o] + (let [s (gensym)] + (update-cell! replacements #(assoc % s o)) + s)) + form) + closure (get-cell replacements)] + (closed-code closure new-form)))) + +(defn coerce-nav [o] + (if (instance? com.rpl.specter.protocols.RichNavigator o) + o + (implicit-nav o))) - (and (fn? vv) (-> v meta :pathedfn)) - ;;TODO: update this to ignore args that aren't symbols or have :nopath - ;;metadata on them (in the arglist) - (let [arglists (-> v meta :arglists) - al (arglist-for-params-count arglists (count ps) (:code p)) - subpath (vec - (map - (fn [pdecl p] - (if (and (symbol? pdecl) - (-> pdecl meta :notpath not)) - (magic-precompilation* p params-atom failed-atom) +(defn dynamic-var? [v] + (-> v meta :dynamic not)) - (cond (and (instance? VarUse p) - (-> p :var meta :dynamic not)) - (:val p) +;; don't do coerce-nav here... save that for resolve-magic-code +(defn- magic-precompilation* [o] + (cond (sequential? o) + (flatten (map magic-precompilation* o)) - (and (not (instance? LocalSym p)) - (not (instance? VarUse p)) - (not (instance? SpecialFormUse p)) - (not (instance? FnInvocation p)) - (not (coll? p))) - p + (instance? VarUse o) + (if (dynamic-var? (:var o)) + (->DynamicVal (:sym o)) + (:val o)) - :else - (magic-fail! "Could not factor static param " - "of pathedfn because it's not a static var " - " or non-collection value: " - (extract-original-code p))))) + (instance? LocalSym o) + ;; TODO: check metadata on locals to determine if it's definitely a direct-nav or not + (->DynamicVal (:sym o)) - al - ps))] - (if @failed-atom - nil - (apply vv subpath))) + (instance? SpecialForm o) + (let [code (:code o) + v (->DynamicVal code)] + (if (= 'fn* (first code)) + (->DynamicFunction pred* [v]))) + (instance? FnInvocation o) + (let [op (magic-precompilation* (:op o)) + params (map magic-precompilation* (:params o))] + (if (-> op meta :dynamicnav) + (apply op params) + (->DynamicFunction op params))) - (and (fn? vv) (-> vv meta :layerednav)) - (if (every? constant-node? ps) - (apply vv (map extract-constant ps)) - (do - (swap! params-atom conj (:code p)) - (if (= (-> vv meta :layerednav) :lean) - lean-compiled-path-proxy - rich-compiled-path-proxy))) - - - :else - (magic-fail! "Var " (:sym op) " must be either a parameterized " - "navigator, a higher order pathed constructor function, " - "or a nav constructor")))) - - (magic-fail! "Code at " (extract-original-code p) " is in " - "function invocation position and must be either a parameterized " - "navigator, a higher order pathed constructor function, or a " - "nav constructor."))) + :else + ;; this handles dynamicval as well + o)) - :else - (cond (set? p) - (if (constant-node? p) - (extract-constant p) - (do (swap! params-atom conj p) - pred*)) +(declare resolve-magic-code) - (keyword? p) - p +(defn all-static? [params] + (every? (complement dynamic-param?) params)) - ;; in case anyone extends String for their own use case - (and (string? p) (valid-navigator? p)) - p +(defn resolve-dynamic-fn-arg [o] + (cond (instance? DynamicFunction o) + (let [op (resolve-dynamic-fn-arg (:op o)) + params (map resolve-dynamic-fn-arg (:params o))] + (if (all-static? (conj params op)) + (apply op params) + (->DynamicFunction op params))) - :else - (magic-fail! "Code " p " is not a valid navigator or can't be factored"))))) + (instance? DynamicVal o) + o + + (instance? DynamicPath o) + (let [res (resolve-magic-code o)] + (if (rich-nav? res) + res + (->DynamicVal res))) + + :else + o)) + +(defn resolve-magic-code [o] + (cond + (instance? DynamicPath o) + (let [path (:path o)] + (if (empty? path) + STAY* + (if (sequential? path) + (let [resolved (map #(resolve-magic-code % true) path) + combined (continuous-subseqs-transform path rich-nav? comp-paths)] + (if (and (= 1 (count combined)) (rich-nav? (first combined))) + (first combined) + `(comp-navs ~@combined))) + (resolve-magic-code path)))) + + (instance? DynamicVal o) + ;;TODO: check ^:nav hint to see whether this is necessary + ;;this is relevant for localsyms and dynamicvars + ;;for localsyms can check metadata in the env as well as metadata on the symbol itself + ;;for dynamic vars check the var metadata + `(coerce-nav ~(:code o)) + + (instance? DynamicFunction o) + ;;TODO: check ^:nav hint on op to see whether coerce-nav is necessary + ;; checked when resolving varuse on the function to know if it returns a direct-nav or not + ;; ":direct-nav-fn" metadata as opposed to :direct-nav metadata which is used for symbols/values + (let [op (resolve-dynamic-fn-arg (:op o)) + params (map resolve-dynamic-fn-arg (:params o))] + (if (all-static? (conj params op)) + (coerce-nav (apply op params)) + `(coerce-nav ~(resolve-magic-code op) ~@(map resolve-magic-code params)))) + + :else + (coerce-nav o))) +(defn magic-precompilation [path ns-str used-locals] + (let [path (magic-precompilation* path) + ns (find-ns ns-str) + maker (binding [*ns* ns] + (eval+ + `(fn [~@used-locals] + ~(resolve-magic-code (->DynamicPath path) true))))] + (if (static-path? path) + (->CachedPathInfo false (maker)) + (->CachedPathInfo true maker)))) -;; This is needed when aset is used on primitive values in mk-params-maker -;; to avoid reflection -#?(:clj - (defn aset-object [^objects a i ^Object v] - (aset a i v))) - -#?( - :clj - (defn mk-params-maker [ns-str params-code possible-params-code used-locals] - (let [ns (find-ns (symbol ns-str)) - array-sym (gensym "array")] - (binding [*ns* ns] - (eval - `(fn [~@used-locals] - (let [~array-sym (fast-object-array ~(count params-code))] - ~@(map-indexed - (fn [i c] - `(aset-object ~array-sym ~i ~c)) - params-code) - - ~array-sym)))))) - - - :cljs - (defn mk-params-maker [ns-str params-code possible-params-code used-locals] - (let [indexed (->> possible-params-code - (map-indexed (comp vec reverse vector)) - (into {}))] - ;;TODO: may be more efficient as an array - (mapv (fn [c] (get indexed c)) params-code)))) - - -;; possible-params-code is for cljs impl that can't use eval -(defn magic-precompilation [prepared-path ns-str used-locals possible-params-code] - (let [params-atom (atom []) - failed-atom (atom false) - path (magic-precompilation* prepared-path params-atom failed-atom)] - - (if @failed-atom - (if (get-cell MUST-CACHE-PATHS) - (throw-illegal "Failed to cache path") - (->CachedPathInfo nil nil)) - (let [precompiled (comp-paths* path) - params-code (mapv extract-original-code @params-atom) - params-maker (if-not (empty? params-code) - (mk-params-maker ns-str params-code possible-params-code used-locals))] - - ;; TODO: error if precompiled is compiledpath and there are params or - ;; precompiled is paramsneededpath and there are no params... - (->CachedPathInfo precompiled params-maker))))) - - - + ;; TODO: could have a global flag about whether or not to compile and cache static + ;; portions, or whether to compile everything together on each invocation (so that + ;; it can be redefined in repl (defn compiled-setval* [path val structure] diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index 12d11e5..29fa79d 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -64,61 +64,29 @@ `(def ~name (collector ~@body))) -(defmacro late-bound-nav [bindings & impl]) - ;;TODO - ;; if bindings are static, then immediately return a navigator - ;; otherwise, return a function from params -> navigator (using nav) - ;; function has metadata about what each arg should correspond to +(defn dynamic-param? [o] + (contains? #{DynamicPath DynamicVal DynamicFunction} (class o))) - ;;TODO: - ;; during inline caching analysis, defpathedfn can return: - ;; - a path (in a sequence - vector or list from &), which can contain both static and dynamic params - ;; - a navigator implementation - ;; - a late-bound-nav or late-bound-collector - ;; - which can have within the late paths other late-bound paths - ;; - a record containing a function that takes in params, and then a vector of - ;; what those params are (exactly what was put into bindings) - ;; - should explicitly say in late-bound-nav which ones are paths and which aren't - ;; - can use ^:path metadata? or wrap in: (late-path path) - ;; - a non-vector constant (which will have indirect-nav run on it) - ;; +(defn static-path? [path] + (if (sequential? path) + (every? (complement dynamic-param?) path) + (-> path dynamic-param? not))) - ;; when `path` passes args to a pathedfn: - ;; - needs to wrap all dynamic portions in "dynamicparam" - ;; (VarUse, LocalSym, etc.) - ;; - it should descend into vectors as well - - - ;; inline caching should do the following: - ;; - escape path as it's doing now (recursing into vectors) - ;; - go through path and for each navigator position: - ;; - if a localsym: then it's a dynamic call to (if (navigator? ...) ... (indirect-nav)) - ;; - if a varuse: if dynamic, then it's a dynamic call as above - ;; - if static, then get the value. if a navigator then done, otherwise call indirect-nav - ;; - if specialform: it's a dynamic call to if (navigator? ...) as above - ;; - if fninvocation: - ;; - if not pathedfn: - ;; - if params are constant, then invoke. if return is not navigator, then call indirect-nav - ;; - otherwise, label that point as "dynamic invocation" with the args - ;; - if pathedfn: - ;; - take all arguments that have anything dynamic in them and wrap in dynamicparam - ;; - including inside vectors (just one level - ;; - call the function: - ;; - if return is constant, then do indirect-nav or use the nav - ;; - if return is a sequence, then treat it as path for that point to be merged in - ;; , strip "dynamicparam", and recurse inside the vector - ;; - should also flatten the vector - ;; - if return is a late-bound record, then: - ;; - label point as dynamic invocation with the args - ;; - args marked as "latepath" TODO - ;; - if sequence: then flatten and recurse - ;; - if constant, then call indirect-nav - - ;; for all (if (navigator ...)... (indirect-nav)) calls, use metadata to determine whether - ;; return is definitely a navigator in which case that dynamic code can be omitted - ;; annotation could be :tag or :direct-nav - ;; defnav needs to annotate return appropriately +(defn late-path [path] + (if (static-path? path) + (comp-paths path) + (com.rpl.specter.impl/->DynamicPath path))) +(defmacro late-bound-nav [bindings & impl] + (let [bindings (partition 2 bindings) + params (map first bindings) + curr-params (map second bindings)] + `(let [builder# (nav [~@params] ~@impl) + curr-params# [~@curr-params]] + (if (every? (complement dynamic-param?) curr-params#) + (apply builder# curr-params#) + ;;TODO: should tag with metadata that the return is a direct navigator + (com.rpl.specter.impl/->DynamicFunction builder# curr-params#))))) (defn- protpath-sym [name] @@ -250,18 +218,30 @@ attr)] [(with-meta name attr) macro-args])) -(defmacro defpathedfn +(defmacro dynamicnav [& args] + `(vary-meta (fn ~@args) assoc :dynamicnav true)) + +(defmacro defdynamicnav "Defines a higher order navigator that itself takes in one or more paths as input. When inline caching is applied to a path containing one of these higher order navigators, it will apply inline caching and compilation to the subpaths as well. Use ^:notpath metadata on arguments to indicate non-path arguments that should not be compiled" [name & args] - (let [[name args] (name-with-attributes name args) - name (vary-meta name assoc :pathedfn true)] - `(defn ~name ~@args))) + (let [[name args] (name-with-attributes name args)] + `(def ~name (dynamicnav ~@args)))) +(defn- used-locals [locals-set form] + (let [used-locals-cell (i/mutable-cell [])] + (cljwalk/postwalk + (fn [e] + (if (local-syms e) + (i/update-cell! used-locals-cell #(conj % e)) + e)) + form) + (i/get-cell used-locals-cell))) + (defn ^:no-doc ic-prepare-path [locals-set path] (cond (vector? path) @@ -277,7 +257,7 @@ (i/fn-invocation? path) (let [[op & params] path] ;; need special case for 'fn since macroexpand does NOT - ;; expand fn when run on cljs code, but it's also not considered a special symbol + ;; expand fn when run on cljs code, but it's also not considered a special symbol (if (or (= 'fn op) (special-symbol? op)) `(com.rpl.specter.impl/->SpecialFormUse ~path (quote ~path)) `(com.rpl.specter.impl/->FnInvocation @@ -287,7 +267,9 @@ :else - `(quote ~path))) + (if (empty? (used-locals locals-set path)) + path + `(com.rpl.specter.impl/->DynamicVal ~path (quote ~path))))) (defn ^:no-doc ic-possible-params [path] @@ -329,9 +311,8 @@ ret)) -;; still possible to mess this up with alter-var-root (defmacro path - "Same as calling comp-paths, except it caches the composition of the static part + "Same as calling comp-paths, except it caches the composition of the static parts of the path for later re-use (when possible). For almost all idiomatic uses of Specter provides huge speedup. This macro is automatically used by the select/transform/setval/replace-in/etc. macros." @@ -342,15 +323,7 @@ (-> &env :locals keys set) ;cljs (-> &env keys set)) ;clj - used-locals-cell (i/mutable-cell []) - _ (cljwalk/postwalk - (fn [e] - (if (local-syms e) - (i/update-cell! used-locals-cell #(conj % e)) - e)) - - path) - used-locals (i/get-cell used-locals-cell) + used-locals (used-locals local-syms path) ;; note: very important to use riddley's macroexpand-all here, so that ;; &env is preserved in any potential nested calls to select (like via @@ -362,9 +335,6 @@ prepared-path (ic-prepare-path local-syms expanded) possible-params (vec (ic-possible-params expanded)) - ;; - with invokedynamic here, could go directly to the code - ;; to invoke and/or parameterize the precompiled path without - ;; a bunch of checks beforehand cache-sym (vary-meta (gensym "pathcache") assoc :cljs.analyzer/no-resolve true) @@ -381,20 +351,18 @@ (var ~cache-sym) (fn [_#] (i/mutable-cell))) nil)))) - cache-sym) add-cache-code (if (= platform :clj) `(i/set-cell! ~cache-sym ~info-sym) `(def ~cache-sym ~info-sym)) - precompiled-sym (gensym "precompiled") - params-maker-sym (gensym "params-maker") + ;;TODO: redo clojurescript portions handle-params-code (if (= platform :clj) - `(i/bind-params* ~precompiled-sym (~params-maker-sym ~@used-locals) 0) + `(~precompiled-sym ~@used-locals) `(i/handle-params ~precompiled-sym ~params-maker-sym @@ -412,20 +380,16 @@ ~(str *ns*) (quote ~used-locals) (quote ~possible-params))] - ~add-cache-code ~info-sym) - info#) ~precompiled-sym (.-precompiled info#) - ~params-maker-sym (.-params-maker info#)] - (if (nil? ~precompiled-sym) - (i/comp-paths* ~(if (= (count path) 1) (first path) (vec path))) - (if (nil? ~params-maker-sym) - ~precompiled-sym - ~handle-params-code))))) + dynamic?# (.-dynamic? info#)] + (if dynamic?# + ~handle-params-code + ~precompiled-sym)))) diff --git a/src/clj/com/rpl/specter/navs.cljc b/src/clj/com/rpl/specter/navs.cljc index 8dabcca..1da60cc 100644 --- a/src/clj/com/rpl/specter/navs.cljc +++ b/src/clj/com/rpl/specter/navs.cljc @@ -443,12 +443,3 @@ (if (pred structure) (on-match-fn structure) (walk/walk (partial walk-until pred on-match-fn) identity structure))) - - -(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 (i/fn-invocation? structure) (i/fn-invocation? ret)) - (with-meta ret (meta structure)) - ret))))