diff --git a/project.clj b/project.clj index f6b51b0..9b5cfc3 100644 --- a/project.clj +++ b/project.clj @@ -7,9 +7,10 @@ :test-paths ["test", "target/test-classes"] :jar-exclusions [#"\.cljx"] :auto-clean false + :dependencies [[org.clojure/tools.macro "0.1.2"]] :profiles {:provided {:dependencies - [[org.clojure/clojure "1.6.0"] - [org.clojure/clojurescript "0.0-3211"]]} + [[org.clojure/clojure "1.7.0"] + [org.clojure/clojurescript "1.7.122"]]} :dev {:dependencies [[org.clojure/test.check "0.7.0"]] :plugins diff --git a/src/clj/com/rpl/specter.cljx b/src/clj/com/rpl/specter.cljx index 315c0fc..86f5ff6 100644 --- a/src/clj/com/rpl/specter.cljx +++ b/src/clj/com/rpl/specter.cljx @@ -7,6 +7,7 @@ fixed-pathed-path defcollector defpath + defpathedfn ]] ) (:use [com.rpl.specter.protocols :only [StructurePath]] @@ -15,7 +16,8 @@ variable-pathed-path fixed-pathed-path defcollector - defpath]] + defpath + defpathedfn]] ) (:require [com.rpl.specter.impl :as i] [clojure.set :as set]) @@ -248,7 +250,7 @@ (transform* [this structure next-fn] (i/codewalk-until afn next-fn structure))) -(defn subselect +(defpathedfn subselect "Navigates to a sequence that contains the results of (select ...), but is a view to the original structure that can be transformed. @@ -320,7 +322,7 @@ (swap! structure next-fn) structure))) -(defn selected? +(defpathedfn selected? "Filters the current value based on whether a path finds anything. e.g. (selected? :vals ALL even?) keeps the current element only if an even number exists for the :vals key. @@ -341,7 +343,7 @@ structure next-fn)))) -(defn not-selected? [& path] +(defpathedfn not-selected? [& path] (fixed-pathed-path [late path] (select* [this structure next-fn] (i/filter-select @@ -354,7 +356,7 @@ structure next-fn)))) -(defn filterer +(defpathedfn filterer "Navigates to a view of the current sequence that only contains elements that match the given path. An element matches the selector path if calling select on that element with the path yields anything other than an empty sequence. @@ -365,7 +367,7 @@ [& path] (subselect ALL (selected? path))) -(defn transformed +(defpathedfn transformed "Navigates to a view of the current value by transforming it with the specified path and update-fn. @@ -425,13 +427,13 @@ (def NIL->LIST (nil->val '())) (def NIL->VECTOR (nil->val [])) -(defn collect [& path] +(defpathedfn collect [& path] (pathed-collector [late path] (collect-val [this structure] (compiled-select late structure) ))) -(defn collect-one [& path] +(defpathedfn collect-one [& path] (pathed-collector [late path] (collect-val [this structure] (compiled-select-one late structure) @@ -450,7 +452,7 @@ (collect-val [this structure] val )) -(defn cond-path +(defpathedfn cond-path "Takes in alternating cond-path path cond-path path... Tests the structure if selecting with cond-path returns anything. If so, it uses the following path for this portion of the navigation. @@ -473,13 +475,13 @@ structure )))) -(defn if-path +(defpathedfn if-path "Like cond-path, but with if semantics." ([cond-p if-path] (cond-path cond-p if-path)) ([cond-p if-path else-path] (cond-path cond-p if-path nil else-path))) -(defn multi-path +(defpathedfn multi-path "A path that branches on multiple paths. For updates, applies updates to the paths in order." [& paths] @@ -498,13 +500,13 @@ compiled-paths )))) -(defn stay-then-continue +(defpathedfn stay-then-continue "Navigates to the current element and then navigates via the provided path. This can be used to implement pre-order traversal." [& path] (multi-path STAY path)) -(defn continue-then-stay +(defpathedfn continue-then-stay "Navigates to the provided path and then to the current element. This can be used to implement post-order traversal." [& path] diff --git a/src/clj/com/rpl/specter/impl.cljx b/src/clj/com/rpl/specter/impl.cljx index bd44a4e..94ecf0d 100644 --- a/src/clj/com/rpl/specter/impl.cljx +++ b/src/clj/com/rpl/specter/impl.cljx @@ -429,7 +429,7 @@ (walk/walk (partial walk-until pred on-match-fn) identity structure) )) -(defn- fn-invocation? [f] +(defn fn-invocation? [f] (or (instance? clojure.lang.Cons f) (instance? clojure.lang.LazySeq f) (list? f))) @@ -615,6 +615,149 @@ (.-transformer tfns))) +(defrecord LocalSym + [val sym]) + +(defrecord VarUse + [var sym]) + +(defrecord SpecialFormUse + [val code]) + +(defrecord FnInvocation + ;; op and params elems can be any of the above + [op params code]) + +(defrecord CachedPathInfo + [precompiled ; can be null + params-maker ; can be null + ]) + +(def CACHE + #+clj (java.util.concurrent.ConcurrentHashMap.) + #+cljs (atom {}) + ) + +#+clj +(defn add-cache! [k v] + (.put ^java.util.concurrent.ConcurrentHashMap CACHE k v)) + +#+clj +(defn get-cache [k] + (.get ^java.util.concurrent.ConcurrentHashMap CACHE k)) + +#+cljs +(defn add-cache! [k v] + (swap! CACHE (fn [m] (assoc m k v)))) + +#+cljs +(defn get-cache [k] + (get @CACHE k)) + +(defn- extract-original-code [p] + (cond + (instance? LocalSym p) (:sym p) + (instance? VarUse p) (:sym p) + (instance? SpecialFormUse p) (:code p) + (instance? FnInvocation p) (:code p) + :else p + )) + +(defn- valid-navigator? [v] + (or (structure-path? v) + (satisfies? p/Collector v) + (instance? CompiledPath v))) + +(defn magic-fail! [failed-atom] + (reset! failed-atom true) + nil) + +(defn- magic-precompilation* [p params-atom failed-atom] + (cond + (vector? p) + (mapv + #(magic-precompilation* % params-atom failed-atom) + p) + + (instance? LocalSym p) + (magic-fail! failed-atom) + + (instance? VarUse p) + (let [v (:var p) + vv (var-get v)] + (if (and (-> v meta :dynamic not) + (valid-navigator? vv)) + vv + (magic-fail! failed-atom) + )) + + (instance? SpecialFormUse p) + (magic-fail! failed-atom) + + (instance? FnInvocation p) + (let [op (:op p) + ps (:params p)] + (if (instance? VarUse op) + (let [v (:var op) + vv (var-get v)] + (if (-> v meta :dynamic) + (magic-fail! failed-atom) + (cond + (instance? ParamsNeededPath vv) + ;;TODO: if all params are constants, then just bind the path right here + ;;otherwise, add the params + (do + (swap! params-atom concat ps) + vv + ) + + (and (fn? vv) (-> vv meta :pathedfn)) + (let [subpath (mapv #(magic-precompilation* % params-atom failed-atom) + ps)] + (if @failed-atom + nil + (apply vv subpath) + )) + + :else + (magic-fail! failed-atom) + ))) + (magic-fail! failed-atom) + )) + + :else + (magic-fail! failed-atom) + )) + +(defn magic-precompilation [prepared-path used-locals] + (let [params-atom (atom []) + failed-atom (atom false) + path (magic-precompilation* prepared-path params-atom failed-atom) + ] + (if @failed-atom + (->CachedPathInfo nil nil) + (let [precompiled (comp-paths* path) + params-code (mapv extract-original-code @params-atom) + array-sym (gensym "array") + params-maker + (if-not (empty? params-code) + (eval + `(fn [~@used-locals] + (let [~array-sym (fast-object-array ~(count params-code))] + ~@(map-indexed + (fn [i c] + `(aset ~array-sym ~i ~c)) + params-code + ) + ~array-sym + )))) + ] + ;; TODO: error if precompiled is compiledpath and there are params or + ;; precompiled is paramsneededpath and there are no params... + (->CachedPathInfo precompiled params-maker) + )) + )) + #+clj (defn extend-protocolpath* [protpath protpath-prot extensions] diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index 10ed610..6888d78 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -1,5 +1,7 @@ (ns com.rpl.specter.macros - (:require [com.rpl.specter.impl :as i]) + (:require [com.rpl.specter.impl :as i] + [clojure.walk :as walk] + [clojure.tools.macro :as m]) ) (defn gensyms [amt] @@ -311,3 +313,68 @@ (defmacro extend-protocolpath [protpath & extensions] `(i/extend-protocolpath* ~protpath ~(protpath-sym protpath) ~(vec extensions))) + +(defmacro defpathedfn [name & args] + (let [[n args] (m/name-with-attributes name args)] + `(def ~n (vary-meta (fn ~@args) assoc :pathedfn true)))) + + +(defn ic-prepare-path [locals-set path] + (cond + (vector? path) + (mapv #(ic-prepare-path locals-set %) path) + + (symbol? path) + (if (contains? locals-set path) + `(com.rpl.specter.impl/->LocalSym ~path (quote ~path)) + `(com.rpl.specter.impl/->VarUse (var ~path) (quote ~path)) + ) + + (i/fn-invocation? path) + (let [[op & params] path] + (if (special-symbol? op) + `(com.rpl.specter.impl/->SpecialFormUse ~path (quote ~path)) + `(com.rpl.specter.impl/->FnInvocation + ~(ic-prepare-path locals-set op) + ~(mapv #(ic-prepare-path locals-set %) params) + (quote ~path))) + ) + + :else + path + )) + +;; still possible to mess this up with alter-var-root! +(defmacro ic! [& path] ; "inline cache" + (let [local-syms (-> &env keys set) + used-locals (vec (i/walk-select local-syms vector path)) + prepared-path (ic-prepare-path local-syms (walk/macroexpand-all (vec path))) + ;; TODO: will turning this into a keyword make it faster? + cache-id (str (java.util.UUID/randomUUID)) + ] + + `(let [info# (i/get-cache ~cache-id) + + ^com.rpl.specter.impl.CachedPathInfo info# + (if info# + info# + (let [info# (i/magic-precompilation + ~prepared-path + ~(mapv (fn [e] `(quote ~e)) used-locals) + )] + (i/add-cache! ~cache-id info#) + info# + )) + + precompiled# (.-precompiled info#) + params-maker# (.-params-maker info#)] + (cond (nil? precompiled#) + ~path + + (and precompiled# (nil? params-maker#)) + precompiled# + + :else + (i/bind-params* precompiled# (params-maker# ~@used-locals) 0) + )) + ))