initial impl working for basic use cases

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/clojure "1.7.0"]
-                         [org.clojure/clojurescript "0.0-3211"]]}
+                         [org.clojure/clojurescript "1.7.122"]]}
              :dev {:dependencies
                    [[org.clojure/test.check "0.7.0"]]
                    :plugins

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]

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]

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)
+         ))
+  ))