complete no protocol execution, speed is generally now just as good or far better than equivalent clojure code

src/clj/com/rpl/specter.clj

@@ -11,84 +11,89 @@
 
 ;; Selector functions
 
-(defn select
+(defn compiled-select
-  "Navigates to and returns a sequence of all the elements specified by the selector."
+  "Version of select that takes in a selector pre-compiled with comp-paths"
-  [selector structure]
-  (let [sp (comp-paths* selector)]
-    (select-full* sp
-                  []
-                  structure
-                  (fn [vals structure]
-                    (if-not (empty? vals) [(conj vals structure)] [structure])))
-    ))
-
-(defn select-fast
   [^com.rpl.specter.impl.StructureValsPathFunctions selfns structure]
   ((.selector selfns) [] structure
    (fn [vals structure]
-     (if-not (empty? vals) [(conj vals structure)] [structure])))
+     (if-not (empty? vals) [(conj vals structure)] [structure]))))
-  )
 
-(defn select-one
+(defn select
-  "Like select, but returns either one element or nil. Throws exception if multiple elements found"
+  "Navigates to and returns a sequence of all the elements specified by the selector."
   [selector structure]
-  (let [res (select selector structure)]
+  (compiled-select (comp-paths* selector)
+                   structure))
+
+(defn compiled-select-one
+  "Version of select-one that takes in a selector pre-compiled with comp-paths"
+  [selector structure]
+  (let [res (compiled-select selector structure)]
     (when (> (count res) 1)
       (throw-illegal "More than one element found for params: " selector structure))
     (first res)
     ))
 
-(defn select-one!
+(defn select-one
-  "Returns exactly one element, throws exception if zero or multiple elements found"
+  "Like select, but returns either one element or nil. Throws exception if multiple elements found"
   [selector structure]
-  (let [res (select-one selector structure)]
+  (compiled-select-one (comp-paths* selector) structure))
+
+(defn compiled-select-one!
+  "Version of select-one! that takes in a selector pre-compiled with comp-paths"
+  [selector structure]
+  (let [res (compiled-select-one selector structure)]
     (when (nil? res) (throw-illegal "No elements found for params: " selector structure))
     res
     ))
 
+(defn select-one!
+  "Returns exactly one element, throws exception if zero or multiple elements found"
+  [selector structure]
+  (compiled-select-one! (comp-paths* selector) structure))
+
+(defn compiled-select-first
+  "Version of select-first that takes in a selector pre-compiled with comp-paths"
+  [selector structure]
+  (first (compiled-select selector structure)))
+
 (defn select-first
   "Returns first element found. Not any more efficient than select, just a convenience"
   [selector structure]
-  (first (select selector structure)))
+  (compiled-select-first (comp-paths* selector) structure))
 
 ;; Update functions
 
-(defn update
+(defn compiled-update
-  "Navigates to each value specified by the selector and replaces it by the result of running
+  "Version of update that takes in a selector pre-compiled with comp-paths"
-  the update-fn on it"
+  [^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure]
-  [selector update-fn structure]
-  (let [selector (comp-paths* selector)]
-    (update-full* selector
-                  []
-                  structure
-                  (fn [vals structure]
-                    (if (empty? vals)
-                      (update-fn structure)
-                      (apply update-fn (conj vals structure)))
-                    ))))
-
-(defn update-fast [^com.rpl.specter.impl.StructureValsPathFunctions selfns update-fn structure]
   ((.updater selfns) [] structure
    (fn [vals structure]
      (if (empty? vals)
        (update-fn structure)
        (apply update-fn (conj vals structure)))
-     ))
+     )))
-  )
+
+(defn update
+  "Navigates to each value specified by the selector and replaces it by the result of running
+  the update-fn on it"
+  [selector update-fn structure]
+  (compiled-update (comp-paths* selector) update-fn structure))
+
+(defn compiled-setval
+  "Version of setval that takes in a selector pre-compiled with comp-paths"
+  [selector val structure]
+  (compiled-update selector (fn [_] val) structure))
 
 (defn setval
   "Navigates to each value specified by the selector and replaces it by val"
   [selector val structure]
-  (update selector (fn [_] val) structure))
+  (compiled-setval (comp-paths* selector) val structure))
 
-(defn replace-in [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
+(defn compiled-replace-in
-  "Similar to update, except returns a pair of [updated-structure sequence-of-user-ret].
+  "Version of replace-in that takes in a selector pre-compiled with comp-paths"
-  The update-fn in this case is expected to return [ret user-ret]. ret is
+  [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
-   what's used to update the data structure, while user-ret will be added to the user-ret sequence
-   in the final return. replace-in is useful for situations where you need to know the specific values
-   of what was updated in the data structure."
   (let [state (mutable-cell nil)]
-    [(update selector
+    [(compiled-update selector
              (fn [e]
                (let [res (update-fn e)]
                  (if res
@@ -103,6 +108,15 @@
      (get-cell state)]
     ))
 
+(defn replace-in
+  "Similar to update, except returns a pair of [updated-structure sequence-of-user-ret].
+  The update-fn in this case is expected to return [ret user-ret]. ret is
+   what's used to update the data structure, while user-ret will be added to the user-ret sequence
+   in the final return. replace-in is useful for situations where you need to know the specific values
+   of what was updated in the data structure."
+  [selector update-fn structure & {:keys [merge-fn] :or {merge-fn concat}}]
+  (compiled-replace-in (comp-paths* selector) update-fn structure :merge-fn merge-fn))
+
 ;; Built-in pathing and context operations
 
 (def ALL (->AllStructurePath))

src/clj/com/rpl/specter/impl.clj

@@ -4,61 +4,84 @@
             [clojure.core.reducers :as r])
   )
 
+(defmacro throw* [etype & args]
+  `(throw (new ~etype (pr-str ~@args))))
+
+(defmacro throw-illegal [& args]
+  `(throw* IllegalArgumentException ~@args))
+
 (defn benchmark [iters afn]
   (time
    (dotimes [_ iters]
      (afn))))
 
-(deftype StructureValsPathFunctions [selector updater]
+(deftype StructureValsPathFunctions [selector updater])
-  StructureValsPath
-  (select-full* [this vals structure next-fn]
-    (selector vals structure next-fn))
-  (update-full* [this vals structure next-fn]
-    (updater vals structure next-fn)))
 
 (defprotocol CoerceStructureValsPathFunctions
   (coerce-path [this]))
 
+(defn no-prot-error-str [obj]
+  (str "Protocol implementation cannot be found for object.
+        Extending Specter protocols should not be done inline in a deftype definition
+        because that prevents Specter from finding the protocol implementations for 
+        optimized performance. Instead, you should extend the protocols via an 
+        explicit extend-protocol call. \n" obj))
+
+(defn find-protocol-impl! [prot obj]
+  (let [ret (find-protocol-impl prot obj)]
+    (if (= ret obj)
+      (throw-illegal (no-prot-error-str obj))
+      ret
+      )))
+
+(defn coerce-structure-vals-path [this]
+  (let [pimpl (find-protocol-impl! StructureValsPath this)
+        selector (:select-full* pimpl)
+        updater (:update-full* pimpl)]
+    (->StructureValsPathFunctions
+      (fn [vals structure next-fn]
+        (selector this vals structure next-fn))
+      (fn [vals structure next-fn]
+        (updater this vals structure next-fn)))
+    ))
+
+(defn coerce-collector [this]
+  (let [cfn (->> this
+                 (find-protocol-impl! Collector)
+                 :collect-val
+                 )
+        afn (fn [vals structure next-fn]
+              (next-fn (conj vals (cfn this structure)) structure)
+              )]
+    (->StructureValsPathFunctions afn afn)))
+
+(defn coerce-structure-path [this]
+  (let [pimpl (find-protocol-impl! StructurePath this)
+        selector (:select* pimpl)
+        updater (:update* pimpl)]
+    (->StructureValsPathFunctions
+      (fn [vals structure next-fn]
+        (selector this structure (fn [structure] (next-fn vals structure))))
+      (fn [vals structure next-fn]
+        (updater this structure (fn [structure] (next-fn vals structure))))
+    )))
+
+(defn obj-extends? [prot obj]
+  (->> obj (find-protocol-impl prot) nil? not))
+
 (extend-protocol CoerceStructureValsPathFunctions
 
-  com.rpl.specter.protocols.StructureValsPath
+  StructureValsPathFunctions
   (coerce-path [this]
-    (let [pimpl (->> this
+    this)
-                     (find-protocol-impl StructureValsPath))
-          selector (:select-full* pimpl)
-          updater (:update-full* pimpl)]
-      (->StructureValsPathFunctions
-        (fn [vals structure next-fn]
-          (selector this vals structure next-fn))
-        (fn [vals structure next-fn]
-          (updater this vals structure next-fn)))
-      ))
 
-  com.rpl.specter.protocols.Collector
-  (coerce-path [collector]
-    (let [pimpl (->> collector
-                     (find-protocol-impl Collector)
-                     :collect-val
-                     )
-          afn (fn [vals structure next-fn]
-                (next-fn (conj vals (pimpl collector structure)) structure)
-                )]
-      (->StructureValsPathFunctions afn afn)))
-
-  ;; need to say Object instead of StructurePath so that things like Keyword are properly coerced
   Object
   (coerce-path [this]
-    (let [pimpl (->> this
+    (cond (obj-extends? StructurePath this) (coerce-structure-path this)
-                     (find-protocol-impl StructurePath))
+          (obj-extends? Collector this) (coerce-collector this)
-          selector (:select* pimpl)
+          (obj-extends? StructureValsPath this) (coerce-structure-vals-path this)
-          updater (:update* pimpl)]
+          :else (throw-illegal (no-prot-error-str this))
-      (->StructureValsPathFunctions
-        (fn [vals structure next-fn]
-          (selector this structure (fn [structure] (next-fn vals structure))))
-        (fn [vals structure next-fn]
-          (updater this structure (fn [structure] (next-fn vals structure))))
       )))
-  )
 
 
 (extend-protocol StructureValsPathComposer
@@ -67,9 +90,6 @@
     (coerce-path sp))
   java.util.List
   (comp-paths* [structure-paths]
-    ;;TODO: don't reify any protocols... instead coerce to a "StructureValsPathFunctions" record
-    ;; and compose functions directly
-
     (reduce (fn [^StructureValsPathFunctions sp-curr ^StructureValsPathFunctions sp]
               (let [curr-selector (.selector sp-curr)
                     selector (.selector sp)
@@ -110,12 +130,6 @@
 (defn get-cell [^PMutableCell cell]
   (.get_cell cell))
 
-(defmacro throw* [etype & args]
-  `(throw (new ~etype (pr-str ~@args))))
-
-(defmacro throw-illegal [& args]
-  `(throw* IllegalArgumentException ~@args))
-
 (defn update-cell! [cell afn]
   (let [ret (afn (get-cell cell))]
     (set-cell! cell ret)
@@ -202,8 +216,10 @@
   (assoc structure akey (next-fn (get structure akey))
   ))
 
-(deftype AllStructurePath []
+(deftype AllStructurePath [])
-  StructurePath
+
+(extend-protocol StructurePath
+  AllStructurePath
   (select* [this structure next-fn]
     (into [] (r/mapcat next-fn structure)))
   (update* [this structure next-fn]
@@ -214,45 +230,58 @@
         (->> structure (r/map next-fn) (into empty-structure))
         ))))
 
-(deftype ValCollect []
+(deftype ValCollect [])
-  Collector
+
+(extend-protocol Collector
+  ValCollect
   (collect-val [this structure]
     structure))
 
-(deftype LastStructurePath []
+(deftype LastStructurePath [])
-  StructurePath
+
+(extend-protocol StructurePath
+  LastStructurePath
   (select* [this structure next-fn]
     (next-fn (last structure)))
   (update* [this structure next-fn]
     (set-last structure (next-fn (last structure)))))
 
-(deftype FirstStructurePath []
+(deftype FirstStructurePath [])
-  StructurePath
+
+(extend-protocol StructurePath
+  FirstStructurePath
   (select* [this structure next-fn]
     (next-fn (first structure)))
   (update* [this structure next-fn]
     (set-first structure (next-fn (first structure)))))
 
-(deftype WalkerStructurePath [afn]
+(deftype WalkerStructurePath [afn])
-  StructurePath
-  (select* [this structure next-fn]
-    (walk-select afn next-fn structure))
-  (update* [this structure next-fn]
-    (walk-until afn next-fn structure)))
 
-(deftype CodeWalkerStructurePath [afn]
+(extend-protocol StructurePath
-  StructurePath
+  WalkerStructurePath
-  (select* [this structure next-fn]
+  (select* [^WalkerStructurePath this structure next-fn]
-    (walk-select afn next-fn structure))
+    (walk-select (.afn this) next-fn structure))
-  (update* [this structure next-fn]
+  (update* [^WalkerStructurePath this structure next-fn]
-    (codewalk-until afn next-fn structure)))
+    (walk-until (.afn this) next-fn structure)))
 
-(deftype FilterStructurePath [afn]
+(deftype CodeWalkerStructurePath [afn])
-  StructurePath
+
-  (select* [this structure next-fn]
+(extend-protocol StructurePath
-    (->> structure (filter afn) doall next-fn))
+  CodeWalkerStructurePath
-  (update* [this structure next-fn]
+  (select* [^CodeWalkerStructurePath this structure next-fn]
-    (let [[filtered ancestry] (filter+ancestry afn structure)
+    (walk-select (.afn this) next-fn structure))
+  (update* [^CodeWalkerStructurePath this structure next-fn]
+    (codewalk-until (.afn this) next-fn structure)))
+
+
+(deftype FilterStructurePath [afn])
+
+(extend-protocol StructurePath
+  FilterStructurePath
+  (select* [^FilterStructurePath this structure next-fn]
+    (->> structure (filter (.afn this)) doall next-fn))
+  (update* [^FilterStructurePath this structure next-fn]
+    (let [[filtered ancestry] (filter+ancestry (.afn this) structure)
           ;; the vec is necessary so that we can get by index later
           ;; (can't get by index for cons'd lists)
           next (vec (next-fn filtered))]
@@ -261,29 +290,36 @@
               (vec structure)
               ancestry))))
 
-(deftype KeyPath [akey]
+(deftype KeyPath [akey])
-  StructurePath
+  
-  (select* [this structure next-fn]
+
-    (key-select akey structure next-fn))
+(extend-protocol StructurePath
-  (update* [this structure next-fn]
+  KeyPath
-    (key-update akey structure next-fn)
+  (select* [^KeyPath this structure next-fn]
+    (key-select (.akey this) structure next-fn))
+  (update* [^KeyPath this structure next-fn]
+    (key-update (.akey this) structure next-fn)
     ))
 
-(deftype SelectCollector [sel-fn selector]
+(deftype SelectCollector [sel-fn selector])
-  Collector
-  (collect-val [this structure]
-    (sel-fn selector structure)))
   
-(deftype SRangePath [start-fn end-fn]
+(extend-protocol Collector
-  StructurePath
+  SelectCollector
-  (select* [this structure next-fn]
+  (collect-val [^SelectCollector this structure]
-    (let [start (start-fn structure)
+    ((.sel-fn this) (.selector this) structure)))
-          end (end-fn structure)]
+
+(deftype SRangePath [start-fn end-fn])
+
+(extend-protocol StructurePath
+  SRangePath
+  (select* [^SRangePath this structure next-fn]
+    (let [start ((.start-fn this) structure)
+          end ((.end-fn this) structure)]
       (next-fn (-> structure vec (subvec start end)))
       ))
-  (update* [this structure next-fn]
+  (update* [^SRangePath this structure next-fn]
-    (let [start (start-fn structure)
+    (let [start ((.start-fn this) structure)
-          end (end-fn structure)
+          end ((.end-fn this) structure)
           structurev (vec structure)
           newpart (next-fn (-> structurev (subvec start end)))
           res (concat (subvec structurev 0 start)
@@ -294,12 +330,14 @@
         res
         ))))
 
-(deftype ViewPath [view-fn]
+(deftype ViewPath [view-fn])
-  StructurePath
+
-  (select* [this structure next-fn]
+(extend-protocol StructurePath
-    (-> structure view-fn next-fn))
+  ViewPath
-  (update* [this structure next-fn]
+  (select* [^ViewPath this structure next-fn]
-    (-> structure view-fn next-fn)
+    (->> structure ((.view-fn this)) next-fn))
+  (update* [^ViewPath this structure next-fn]
+    (->> structure ((.view-fn this)) next-fn)
     ))
 
 

src/clj/com/rpl/specter/protocols.clj

@@ -1,7 +1,5 @@
 (ns com.rpl.specter.protocols)
 
-
-;;TODO: can use find-protocol-impl function to avoid all the protocol calls
 (defprotocol StructureValsPath
   (select-full* [this vals structure next-fn])
   (update-full* [this vals structure next-fn]))