From 2c4137b5fd7972118b7d2f4a952d0f99577532b9 Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Mon, 19 Aug 2019 17:37:48 +0200 Subject: [PATCH] make pr-str-ed fn-literal work (3) --- src/sci/impl/fns.cljc | 3 +- src/sci/impl/interpreter.cljc | 17 +++--- src/sci/impl/macros.cljc | 98 +++++++++++++++++++---------------- test/sci/core_test.cljc | 4 +- test/sci/performance.clj | 5 +- 5 files changed, 64 insertions(+), 63 deletions(-) diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc index 2646831f..7301a9e6 100644 --- a/src/sci/impl/fns.cljc +++ b/src/sci/impl/fns.cljc @@ -55,7 +55,8 @@ (let [self-ref (atom nil) call-self (fn [& args] (apply @self-ref args)) - ctx (assoc-in ctx [:bindings fn-name] call-self) + ctx (if fn-name (assoc-in ctx [:bindings fn-name] call-self) + ctx) arities (map #(parse-fn-args+body interpret ctx %) fn-bodies) f (if (= 1 (count arities)) (first arities) diff --git a/src/sci/impl/interpreter.cljc b/src/sci/impl/interpreter.cljc index 2bc0aadd..afb2e8f3 100644 --- a/src/sci/impl/interpreter.cljc +++ b/src/sci/impl/interpreter.cljc @@ -130,15 +130,14 @@ :cljs js/Error) (str "Could not resolve symbol: " (str expr))))))))) -(defn apply-fn [f i args] - (let [args (mapv i args)] +(defn apply-fn [ctx f args] + (let [args (mapv #(interpret ctx %) args)] (apply f args))) (def constant? (some-fn fn? number? string? keyword?)) (defn interpret [ctx expr] - ;; (prn "EXPR" expr) (cond (constant? expr) expr (symbol? expr) (resolve-symbol ctx expr) (:sci/fn expr) (fns/eval-fn ctx interpret expr) @@ -152,11 +151,8 @@ (into (empty expr) (map i expr)) (seq? expr) (if-let [f (first expr)] - (let [;;_ (prn "FST" f) - f (or (get macros f) - (i f)) - ;;_ (prn ">" f) - ] + (let [f (or (get macros f) + (i f))] (case f do (eval-do ctx expr) @@ -174,7 +170,7 @@ def (eval-def ctx expr) ;; else (if (ifn? f) - (apply-fn f i (rest expr)) + (apply-fn ctx f (rest expr)) (throw #?(:clj (Exception. (format "Cannot call %s as a function." (pr-str f))) :cljs (js/Error. (str "Cannot call " (pr-str f) " as a function."))))))) expr) @@ -199,8 +195,7 @@ (str "#sci/quote " (second m)))))) ;; _ (def e edn) - expr (macros/macroexpand ctx edn) - ] + expr (macros/macroexpand ctx edn)] (interpret ctx expr)))) ;;;; Scratch diff --git a/src/sci/impl/macros.cljc b/src/sci/impl/macros.cljc index 53bf9ef9..e292dfb2 100644 --- a/src/sci/impl/macros.cljc +++ b/src/sci/impl/macros.cljc @@ -6,41 +6,40 @@ [sci.impl.functions :as f] [clojure.string :as str])) -(def macros '#{do if when and or -> ->> as-> quote let fn def defn}) +(def macros '#{do if when and or -> ->> as-> quote quote* let fn def defn}) (defn lookup [{:keys [:env :bindings]} sym] - (when-let [[k v :as kv] - (or (when-let [v (get macros sym)] - [v v]) - (find bindings sym) - (find @env sym) - (find f/functions sym) - (when-let [ns (namespace sym)] - (when (or (= "clojure.core" ns) - (= "cljs.core" ns)) - (find f/functions (symbol (name sym))))))] - (if-let [m (meta k)] - (if (:sci/deref! m) - ;; the evaluation of this expression has been delayed by - ;; the caller and now is the time to deref it - [k @v] kv) - kv))) + (let [res (or (when-let [v (get macros sym)] + [v v]) + (when-let [[k _v] + (find bindings sym)] + ;; never inline a binding at macro time! + [k nil]) + (find @env sym) + (find f/functions sym) + (when-let [ns (namespace sym)] + (when (or (= "clojure.core" ns) + (= "cljs.core" ns)) + (find f/functions (symbol (name sym))))))] + ;; (prn 'lookup sym '-> res) + res)) (defn resolve-symbol [ctx expr] - ;; (prn "resolve sym" expr) - (second - (or - (lookup ctx expr) - ;; TODO: check if symbol is in macros and then emit an error: cannot take - ;; the value of a macro - (let [n (name expr)] - (if (str/starts-with? n "'") - (let [v (symbol (subs n 1))] - [v v]) - (throw (new #?(:clj Exception - :cljs js/Error) - (str "Could not resolve symbol: " (str expr) - (keys (:bindings expr)))))))))) + (let [res (second + (or + (lookup ctx expr) + ;; TODO: check if symbol is in macros and then emit an error: cannot take + ;; the value of a macro + (let [n (name expr)] + (if (str/starts-with? n "'") + (let [v (symbol (subs n 1))] + [v v]) + (throw (new #?(:clj Exception + :cljs js/Error) + (str "Could not resolve symbol: " (str expr) + (keys (:bindings expr)))))))))] + ;; (prn 'resolve expr '-> res) + res)) (declare macroexpand macroexpand-1) @@ -202,7 +201,6 @@ (swap! (:env ctx) assoc var-name :sci/var.unbound) (list 'def var-name init))) - (defn expand-defn [ctx [_defn fn-name docstring? & body]] (let [docstring (when (string? docstring?) docstring?) body (if docstring body (cons docstring? body)) @@ -218,7 +216,8 @@ (:sci/fn expr) expr (symbol? expr) (or (let [v (resolve-symbol ctx expr)] - (when-not (identical? :sci/var.unbound v))) + (when-not (identical? :sci/var.unbound v) + v)) expr) (map? expr) (zipmap (map #(macroexpand ctx %) (keys expr)) @@ -227,22 +226,29 @@ (into (empty expr) (map #(macroexpand ctx %) expr)) (seq? expr) (if-let [f (first expr)] - (case f - do expr ;; do will call macroexpand on every subsequent expression - let - (expand-let ctx expr) - (fn fn*) (expand-fn ctx expr) - quote expr - def (expand-def ctx expr) - defn (expand-defn ctx expr) - -> (expand-> ctx (rest expr)) - ->> (expand->> ctx (rest expr)) - as-> (expand-as-> ctx expr) - ;; else: + (if (symbol? f) + (let [f (if-let [ns (namespace f)] + (if (or (= "clojure.core" ns) + (= "cljs.core" ns)) + (symbol (name f)) + f) + f)] + (case f + do expr ;; do will call macroexpand on every subsequent expression + let + (expand-let ctx expr) + (fn fn*) (expand-fn ctx expr) + quote expr + def (expand-def ctx expr) + defn (expand-defn ctx expr) + -> (expand-> ctx (rest expr)) + ->> (expand->> ctx (rest expr)) + as-> (expand-as-> ctx expr) + ;; else: + (doall (map #(macroexpand ctx %) expr)))) (doall (map #(macroexpand ctx %) expr))) expr) :else expr)] - ;; (prn expr (meta expr) '-> res) res)) ;;;; Scratch diff --git a/test/sci/core_test.cljc b/test/sci/core_test.cljc index 838b56ab..1b316776 100644 --- a/test/sci/core_test.cljc +++ b/test/sci/core_test.cljc @@ -175,8 +175,8 @@ (deftest macroexpand-test (is (= [6] (eval* "[(-> 3 inc inc inc)]"))) (is (= [{3 6}] (eval* "[{(->> 2 inc) (-> 3 inc inc inc)}]"))) - (when-not tu/native? - (is (eval* (str `(#(< 10 % 18) 15)))))) + (is (eval* (str `(#(< 10 % 18) 15)))) + (is (eval* (str `(#(and (int? %) (< 10 % 18)))) 15))) ;;;; Scratch diff --git a/test/sci/performance.clj b/test/sci/performance.clj index 78b5bf71..e01cea35 100644 --- a/test/sci/performance.clj +++ b/test/sci/performance.clj @@ -8,8 +8,7 @@ (def f (sci/eval-string "#(assoc (hash-map :a 1 :b 2) %1 %2))")) (f :b 3) (meta f) - (prof/profile (dotimes [_ 10000] (f :b 3))) - (System/getProperty "jdk.attach.allowAttachSelf")) + (prof/profile (dotimes [_ 10000] (f :b 3)))) (defn bench-sci [] (let [f (sci/eval-string "#(assoc (hash-map :a 1 :b 2) %1 %2))")] @@ -22,7 +21,7 @@ (cc/quick-bench (f :b 3)))) (comment - (bench-sci) ;; Execution time mean : 13 µs + (bench-sci) ;; Execution time mean : 13 µs (7µs on MBP2019 8core) (bench-clojure) ;; Execution time mean : 410 ns (sci/eval-string "#(inc x1)") ;; yay, error (sci/eval-string "(#(do %1))") ;; arity error is coming from Clojure :-)