luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

basic cljs inline caching working

Browse source
This commit is contained in:
Nathan Marz 2016-09-03 17:35:13 -04:00
parent 8a71d5241d
commit d7d1d264ef
3 changed files with 118 additions and 133 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

193
src/clj/com/rpl/specter/impl.cljc
View file

@ -1,13 +1,14 @@
(ns com.rpl.specter.impl (ns com.rpl.specter.impl
#?(:cljs (:require-macros #?(: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 (:use [com.rpl.specter.protocols :only
[select* transform* collect-val RichNavigator]] [select* transform* collect-val RichNavigator]]
#?(:clj [com.rpl.specter.util-macros :only [doseqres mk-comp-navs]])) #?(:clj [com.rpl.specter.util-macros :only [doseqres mk-comp-navs]]))
(:require [com.rpl.specter.protocols :as p] (:require [com.rpl.specter.protocols :as p]
[clojure.pprint] #?(:clj [clojure.pprint :as pp] :cljs [cljs.pprint :as pp])
[clojure.string :as s] [clojure.string :as s]
[clojure.walk :as walk] [clojure.walk :as walk]
#?(:clj [riddley.walk :as riddley])) #?(:clj [riddley.walk :as riddley]))
@ -135,7 +136,8 @@
(do-comp-paths [paths])) (do-comp-paths [paths]))
(defn rich-nav? [n] (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] (defn comp-paths* [p]
(if (rich-nav? p) p (do-comp-paths p))) (if (rich-nav? p) p (do-comp-paths p)))
@ -143,7 +145,7 @@
(defn- coerce-object [this] (defn- coerce-object [this]
(cond (satisfies? p/ImplicitNav this) (p/implicit-nav this) (cond (satisfies? p/ImplicitNav this) (p/implicit-nav this)
(rich-nav? this) 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 (defprotocol CoercePath
@ -168,6 +170,9 @@
#?(:cljs (coerce-path [this] #?(:cljs (coerce-path [this]
(coerce-path (vec this)))) (coerce-path (vec this))))
#?(:cljs cljs.core/LazySeq) #?(:cljs cljs.core/LazySeq)
#?(:cljs (coerce-path [this]
(coerce-path (vec this))))
#?(:cljs cljs.core/Subvec)
#?(:cljs (coerce-path [this] #?(:cljs (coerce-path [this]
(coerce-path (vec this)))) (coerce-path (vec this))))
@ -399,7 +404,7 @@
[op params]) [op params])
(defn dynamic-param? [o] (defn dynamic-param? [o]
(contains? #{DynamicPath DynamicVal DynamicFunction} (class o))) (contains? #{DynamicPath DynamicVal DynamicFunction} (type o)))
(defn static-path? [path] (defn static-path? [path]
(if (sequential? path) (if (sequential? path)
@ -417,44 +422,6 @@
[dynamic? precompiled]) [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] (defn filter-select [afn structure next-fn]
(if (afn structure) (if (afn structure)
(next-fn structure) (next-fn structure)
@ -561,14 +528,6 @@
(with-meta ret (meta structure)) (with-meta ret (meta structure))
ret)))) 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? (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" "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] [& preds]
@ -576,34 +535,45 @@
(some #(% obj) preds))) (some #(% obj) preds)))
(let [embeddable? (any? number? #?(:clj
symbol? (do
keyword? (def ^:dynamic *tmp-closure*)
string? (defn closed-code [closure body]
char? (let [lv (mapcat #(vector % `(*tmp-closure* '~%))
list? (keys closure))]
vector? (binding [*tmp-closure* closure]
set? (eval `(let [~@lv] ~body)))))
#(and (map? %) (not (record? %)))
nil?
#(instance? clojure.lang.Cons %) (let [embeddable? (any? number?
#(instance? clojure.lang.LazySeq %))] symbol?
(defn eval+ keyword?
"Automatically extracts non-evalable stuff into a closure and then evals" string?
[form] char?
(let [replacements (mutable-cell {}) list?
new-form (codewalk-until vector?
#(-> % embeddable? not) set?
(fn [o] #(and (map? %) (not (record? %)))
(let [s (gensym)] nil?
(update-cell! replacements #(assoc % s o)) #(instance? clojure.lang.Cons %)
s)) #(instance? clojure.lang.LazySeq %))]
form) (defn eval+
closure (get-cell replacements)] "Automatically extracts non-evalable stuff into a closure and then evals"
(closed-code closure new-form)))) [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] (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 o
(vector? o) (vector? o)
@ -678,10 +648,13 @@
(if-not nav-pos? (if-not nav-pos?
;; should never happen... ;; should never happen...
(throw-illegal "Cannot statically combine sequential when not in nav pos")) (throw-illegal "Cannot statically combine sequential when not in nav pos"))
(continuous-subseqs-transform* (let [res (continuous-subseqs-transform*
rich-nav? rich-nav?
(doall (map static-combine (flatten o))) (doall (map static-combine (flatten o)))
(fn [s] [(comp-paths* s)]))) (fn [s] [(comp-paths* s)]))]
(if (= 1 (count res))
(first res)
res)))
(instance? DynamicFunction o) (instance? DynamicFunction o)
(->DynamicFunction (->DynamicFunction
@ -742,10 +715,12 @@
:cljs :cljs
(defn dynamic-val-code [code possible-params] (defn dynamic-val-code [code possible-params]
;;TODO: need to compute index from possible-params (let [[i] (keep-indexed (fn [i v] (if (= v code) i)) possible-params)]
(maybe-direct-nav (if (nil? i)
(local-param possible-params code) (throw-illegal "Could not find " code " in possible params " possible-params))
(direct-nav? code)))) (maybe-direct-nav
(->LocalParam i)
(direct-nav? code)))))
#?(:clj #?(:clj
(defn static-val-code [o] (defn static-val-code [o]
@ -789,15 +764,16 @@
(resolve-nav-code path possible-params))) (resolve-nav-code path possible-params)))
(instance? DynamicVal o) (instance? DynamicVal o)
(let [code (:code o)] (let [code (:code o)
d (dynamic-val-code code possible-params)]
(cond (direct-nav? code) (cond (direct-nav? code)
(dynamic-val-code code possible-params) d
(or (set? code) (and (fn-invocation? code) (= 'fn* (first code)))) (or (set? code) (and (fn-invocation? code) (= 'fn* (first code))))
(static-fn-code pred* [code]) (static-fn-code pred* [d])
:else :else
(static-fn-code coerce-nav [code]))) (static-fn-code coerce-nav [d])))
(instance? DynamicFunction o) (instance? DynamicFunction o)
(let [res (resolve-arg-code o possible-params)] (let [res (resolve-arg-code o possible-params)]
@ -819,9 +795,33 @@
(def ^:dynamic *DEBUG-INLINE-CACHING* false) (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 ;; 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 ;; portions, or whether to compile everything together on each invocation (so that
;; it can be redefined in repl ;; 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] (defn magic-precompilation [path ns-str used-locals-list possible-params]
(let [magic-path (-> path magic-precompilation* static-combine)] (let [magic-path (-> path magic-precompilation* static-combine)]
(when *DEBUG-INLINE-CACHING* (when *DEBUG-INLINE-CACHING*
@ -834,15 +834,11 @@
(when *DEBUG-INLINE-CACHING* (when *DEBUG-INLINE-CACHING*
(println "Static result:" magic-path)) (println "Static result:" magic-path))
(->CachedPathInfo false magic-path)) (->CachedPathInfo false magic-path))
(let [code `(fn [~@used-locals-list] (let [maker (mk-dynamic-path-maker
~(resolve-nav-code (->DynamicPath magic-path) possible-params)) (resolve-nav-code (->DynamicPath magic-path) possible-params)
ns (find-ns (symbol ns-str)) ns-str
maker (binding [*ns* ns] (eval+ code))] used-locals-list
possible-params)]
(when *DEBUG-INLINE-CACHING*
(println "Produced code:")
(clojure.pprint/pprint code)
(println))
(->CachedPathInfo true maker))))) (->CachedPathInfo true maker)))))
@ -863,7 +859,6 @@
(set-cell! state)) (set-cell! state))
ret) ret)
(last args)))) (last args))))
structure) structure)
(get-cell state)])) (get-cell state)]))

49
src/clj/com/rpl/specter/macros.clj
View file

@ -171,23 +171,21 @@
`(com.rpl.specter.impl/->DynamicVal (quote ~path))))) `(com.rpl.specter.impl/->DynamicVal (quote ~path)))))
; (defn ^:no-doc ic-possible-params [path] (defn ^:no-doc ic-possible-params [path]
; (do (do
; (mapcat (mapcat
; (fn [e] (fn [e]
; (cond (or (set? e) (cond (or (set? e)
; (map? e) ; in case inline maps are ever extended (map? e) ; in case inline maps are ever extended
; (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e)))) (symbol? e)
; [e] (and (i/fn-invocation? e) (contains? #{'fn* 'fn} (first e))))
; [e]
; (i/fn-invocation? e)
; ;; the [e] here handles nav constructors (sequential? e)
; (concat [e] (rest e) (ic-possible-params e)) (ic-possible-params e)))
;
; (vector? e)
; (ic-possible-params e))) path)))
;
; path)))
(defn cljs-macroexpand [env form] (defn cljs-macroexpand [env form]
@ -232,7 +230,7 @@
(cljs-macroexpand-all &env (vec path))) (cljs-macroexpand-all &env (vec path)))
prepared-path (ic-prepare-path local-syms expanded) 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 cache-sym (vary-meta
(gensym "pathcache") (gensym "pathcache")
@ -258,16 +256,10 @@
precompiled-sym (gensym "precompiled") precompiled-sym (gensym "precompiled")
;;TODO: redo clojurescript portions
handle-params-code handle-params-code
(if (= platform :clj) (if (= platform :clj)
`(~precompiled-sym ~@used-locals))] `(~precompiled-sym ~@used-locals)
; `(i/handle-params `(~precompiled-sym ~possible-params))]
; ~precompiled-sym
; ~params-maker-sym
; ~(mapv (fn [p] `(fn [] ~p)) possible-params)))]
(if (= platform :clj) (if (= platform :clj)
(i/intern* *ns* cache-sym (i/mutable-cell))) (i/intern* *ns* cache-sym (i/mutable-cell)))
`(let [info# ~get-cache-code `(let [info# ~get-cache-code
@ -278,12 +270,11 @@
~prepared-path ~prepared-path
~(str *ns*) ~(str *ns*)
(quote ~used-locals) (quote ~used-locals)
nil)] (quote ~possible-params))]
~add-cache-code ~add-cache-code
~info-sym) ~info-sym)
info#) info#)
~precompiled-sym (.-precompiled info#) ~precompiled-sym (.-precompiled info#)
dynamic?# (.-dynamic? info#)] dynamic?# (.-dynamic? info#)]
(if dynamic?# (if dynamic?#
@ -291,8 +282,6 @@
~precompiled-sym)))) ~precompiled-sym))))
(defmacro select (defmacro select
"Navigates to and returns a sequence of all the elements specified by the path. "Navigates to and returns a sequence of all the elements specified by the path.
This macro will do inline caching of the path." This macro will do inline caching of the path."

9
src/clj/com/rpl/specter/util_macros.clj
View file

@ -42,7 +42,7 @@
(let [fields (gensyms (inc i)) (let [fields (gensyms (inc i))
dparams (gensym "dynamic-params") dparams (gensym "dynamic-params")
resolvers (for [f fields] resolvers (for [f fields]
`(late-resolve ~f ~dparams))] `(~'late-resolve ~f ~dparams))]
`(defrecord ~(late-fn-record-name i) [~@fields] `(defrecord ~(late-fn-record-name i) [~@fields]
~'LateResolve ~'LateResolve
(~'late-resolve [this# ~dparams] (~'late-resolve [this# ~dparams]
@ -57,11 +57,12 @@
(let [f (gensym "afn") (let [f (gensym "afn")
args (gensym "args") args (gensym "args")
cases (for [i (range 19)] 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) `(~(late-fn-record-constructor-name i)
~f ~f
~@gets)))] ~@gets))])]
`(defn ~'late-fn [~f ~args] `(defn ~'late-fn [~f ~args]
(case (count ~args) (case (count ~args)
~@cases ~@(apply concat cases)
(com.rpl.specter.impl/throw-illegal "Cannot have late function with more than 18 args"))))) (com.rpl.specter.impl/throw-illegal "Cannot have late function with more than 18 args")))))