From d7d1d264ef2b63dab78c7bad5b5b3af5768deb1c Mon Sep 17 00:00:00 2001 From: Nathan Marz Date: Sat, 3 Sep 2016 17:35:13 -0400 Subject: [PATCH] basic cljs inline caching working --- src/clj/com/rpl/specter/impl.cljc | 193 ++++++++++++------------ src/clj/com/rpl/specter/macros.clj | 49 +++--- src/clj/com/rpl/specter/util_macros.clj | 9 +- 3 files changed, 118 insertions(+), 133 deletions(-) diff --git a/src/clj/com/rpl/specter/impl.cljc b/src/clj/com/rpl/specter/impl.cljc index fd6a251..f963672 100644 --- a/src/clj/com/rpl/specter/impl.cljc +++ b/src/clj/com/rpl/specter/impl.cljc @@ -1,13 +1,14 @@ (ns com.rpl.specter.impl #?(:cljs (:require-macros - [com.rpl.specter.util-macros :refer [doseqres mk-comp-navs]])) + [com.rpl.specter.util-macros + :refer [doseqres mk-comp-navs mk-late-fn mk-late-fn-records]])) (:use [com.rpl.specter.protocols :only [select* transform* collect-val RichNavigator]] #?(:clj [com.rpl.specter.util-macros :only [doseqres mk-comp-navs]])) (:require [com.rpl.specter.protocols :as p] - [clojure.pprint] + #?(:clj [clojure.pprint :as pp] :cljs [cljs.pprint :as pp]) [clojure.string :as s] [clojure.walk :as walk] #?(:clj [riddley.walk :as riddley])) @@ -135,7 +136,8 @@ (do-comp-paths [paths])) (defn rich-nav? [n] - (instance? com.rpl.specter.protocols.RichNavigator n)) + #?(:clj (instance? com.rpl.specter.protocols.RichNavigator n) + :cljs (satisfies? RichNavigator n))) (defn comp-paths* [p] (if (rich-nav? p) p (do-comp-paths p))) @@ -143,7 +145,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))) + :else (throw-illegal "Not a navigator: " this " " (pr-str (type this))))) (defprotocol CoercePath @@ -168,6 +170,9 @@ #?(:cljs (coerce-path [this] (coerce-path (vec this)))) #?(:cljs cljs.core/LazySeq) + #?(:cljs (coerce-path [this] + (coerce-path (vec this)))) + #?(:cljs cljs.core/Subvec) #?(:cljs (coerce-path [this] (coerce-path (vec this)))) @@ -399,7 +404,7 @@ [op params]) (defn dynamic-param? [o] - (contains? #{DynamicPath DynamicVal DynamicFunction} (class o))) + (contains? #{DynamicPath DynamicVal DynamicFunction} (type o))) (defn static-path? [path] (if (sequential? path) @@ -417,44 +422,6 @@ [dynamic? precompiled]) -(defn constant-node? [node] - (cond (and (instance? VarUse node) - (-> node :var meta :dynamic not)) true - (record? node) false - (number? node) true - (keyword? node) true - (string? node) true - (vector? node) (every? constant-node? node) - (set? node) (every? constant-node? node) - (map? node) (and (every? constant-node? (vals node)) - (every? constant-node? (keys node))) - :else false)) - -(defn extract-constant [node] - (cond (some #(% node) [number? keyword? string?]) node - (instance? VarUse node) (:val node) - (vector? node) (vec (map extract-constant node)) - (set? node) (set (map extract-constant node)) - (map? node) (->> node - (map (fn [[k v]] [(extract-constant k) (extract-constant v)])) - (into {})) - :else (throw-illegal "Unknown node " node))) - - -(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 (satisfies? p/ImplicitNav v) - (rich-nav? v))) - - (defn filter-select [afn structure next-fn] (if (afn structure) (next-fn structure) @@ -561,14 +528,6 @@ (with-meta ret (meta structure)) ret)))) - -(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))))) - (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] @@ -576,34 +535,45 @@ (some #(% obj) preds))) -(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)))) +#?(:clj + (do + (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))))) + + + (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] - (cond (instance? com.rpl.specter.protocols.RichNavigator o) + (cond #?(:clj (instance? com.rpl.specter.protocols.RichNavigator o) + :cljs (satisfies? RichNavigator o)) o (vector? o) @@ -678,10 +648,13 @@ (if-not nav-pos? ;; should never happen... (throw-illegal "Cannot statically combine sequential when not in nav pos")) - (continuous-subseqs-transform* - rich-nav? - (doall (map static-combine (flatten o))) - (fn [s] [(comp-paths* s)]))) + (let [res (continuous-subseqs-transform* + rich-nav? + (doall (map static-combine (flatten o))) + (fn [s] [(comp-paths* s)]))] + (if (= 1 (count res)) + (first res) + res))) (instance? DynamicFunction o) (->DynamicFunction @@ -742,10 +715,12 @@ :cljs (defn dynamic-val-code [code possible-params] - ;;TODO: need to compute index from possible-params - (maybe-direct-nav - (local-param possible-params code) - (direct-nav? code)))) + (let [[i] (keep-indexed (fn [i v] (if (= v code) i)) possible-params)] + (if (nil? i) + (throw-illegal "Could not find " code " in possible params " possible-params)) + (maybe-direct-nav + (->LocalParam i) + (direct-nav? code))))) #?(:clj (defn static-val-code [o] @@ -789,15 +764,16 @@ (resolve-nav-code path possible-params))) (instance? DynamicVal o) - (let [code (:code o)] + (let [code (:code o) + d (dynamic-val-code code possible-params)] (cond (direct-nav? code) - (dynamic-val-code code possible-params) + d (or (set? code) (and (fn-invocation? code) (= 'fn* (first code)))) - (static-fn-code pred* [code]) + (static-fn-code pred* [d]) :else - (static-fn-code coerce-nav [code]))) + (static-fn-code coerce-nav [d]))) (instance? DynamicFunction o) (let [res (resolve-arg-code o possible-params)] @@ -819,9 +795,33 @@ (def ^:dynamic *DEBUG-INLINE-CACHING* false) +#?(:clj + (defn mk-dynamic-path-maker [resolved-code ns-str used-locals-list possible-param] + (let [code `(fn [~@used-locals-list] ~resolved-code) + ns (find-ns (symbol ns-str))] + (when *DEBUG-INLINE-CACHING* + (println "Produced code:") + (pp/pprint code) + (println)) + (binding [*ns* ns] (eval+ code)))) + + :cljs + (defn mk-dynamic-path-maker [resolved-code ns-str used-locals-list possible-param] + (when *DEBUG-INLINE-CACHING* + (println "Produced dynamic object:") + (println resolved-code) + (println)) + (fn [dynamic-params] + (late-resolve resolved-code dynamic-params)))) + + ;; 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 +;; could have three levels: +;; 1. NO-COERCION (never allow coerce-nav at runtime) +;; 2. REGULAR (allow coerce-nav at runtime, cache static parts together) +;; 3. REDEFINABLE-VARS (don't cache static parts together) (defn magic-precompilation [path ns-str used-locals-list possible-params] (let [magic-path (-> path magic-precompilation* static-combine)] (when *DEBUG-INLINE-CACHING* @@ -834,15 +834,11 @@ (when *DEBUG-INLINE-CACHING* (println "Static result:" magic-path)) (->CachedPathInfo false magic-path)) - (let [code `(fn [~@used-locals-list] - ~(resolve-nav-code (->DynamicPath magic-path) possible-params)) - ns (find-ns (symbol ns-str)) - maker (binding [*ns* ns] (eval+ code))] - - (when *DEBUG-INLINE-CACHING* - (println "Produced code:") - (clojure.pprint/pprint code) - (println)) + (let [maker (mk-dynamic-path-maker + (resolve-nav-code (->DynamicPath magic-path) possible-params) + ns-str + used-locals-list + possible-params)] (->CachedPathInfo true maker))))) @@ -863,7 +859,6 @@ (set-cell! state)) ret) (last args)))) - structure) (get-cell state)])) diff --git a/src/clj/com/rpl/specter/macros.clj b/src/clj/com/rpl/specter/macros.clj index c558c29..68fa9b0 100644 --- a/src/clj/com/rpl/specter/macros.clj +++ b/src/clj/com/rpl/specter/macros.clj @@ -171,23 +171,21 @@ `(com.rpl.specter.impl/->DynamicVal (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 + (symbol? e) + (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) + [e] + + (sequential? e) + (ic-possible-params e))) + + + path))) (defn cljs-macroexpand [env form] @@ -232,7 +230,7 @@ (cljs-macroexpand-all &env (vec path))) prepared-path (ic-prepare-path local-syms expanded) - ; possible-params (vec (ic-possible-params expanded)) + possible-params (vec (ic-possible-params expanded)) cache-sym (vary-meta (gensym "pathcache") @@ -258,16 +256,10 @@ precompiled-sym (gensym "precompiled") - ;;TODO: redo clojurescript portions handle-params-code (if (= platform :clj) - `(~precompiled-sym ~@used-locals))] - ; `(i/handle-params - ; ~precompiled-sym - ; ~params-maker-sym - ; ~(mapv (fn [p] `(fn [] ~p)) possible-params)))] - - + `(~precompiled-sym ~@used-locals) + `(~precompiled-sym ~possible-params))] (if (= platform :clj) (i/intern* *ns* cache-sym (i/mutable-cell))) `(let [info# ~get-cache-code @@ -278,12 +270,11 @@ ~prepared-path ~(str *ns*) (quote ~used-locals) - nil)] + (quote ~possible-params))] ~add-cache-code ~info-sym) info#) - ~precompiled-sym (.-precompiled info#) dynamic?# (.-dynamic? info#)] (if dynamic?# @@ -291,8 +282,6 @@ ~precompiled-sym)))) - - (defmacro select "Navigates to and returns a sequence of all the elements specified by the path. This macro will do inline caching of the path." diff --git a/src/clj/com/rpl/specter/util_macros.clj b/src/clj/com/rpl/specter/util_macros.clj index 3f41bcf..7ef9752 100644 --- a/src/clj/com/rpl/specter/util_macros.clj +++ b/src/clj/com/rpl/specter/util_macros.clj @@ -42,7 +42,7 @@ (let [fields (gensyms (inc i)) dparams (gensym "dynamic-params") resolvers (for [f fields] - `(late-resolve ~f ~dparams))] + `(~'late-resolve ~f ~dparams))] `(defrecord ~(late-fn-record-name i) [~@fields] ~'LateResolve (~'late-resolve [this# ~dparams] @@ -57,11 +57,12 @@ (let [f (gensym "afn") args (gensym "args") cases (for [i (range 19)] - (let [gets (for [j i] `(nth ~args ~j))] + [i + (let [gets (for [j (range i)] `(nth ~args ~j))] `(~(late-fn-record-constructor-name i) ~f - ~@gets)))] + ~@gets))])] `(defn ~'late-fn [~f ~args] (case (count ~args) - ~@cases + ~@(apply concat cases) (com.rpl.specter.impl/throw-illegal "Cannot have late function with more than 18 args")))))