Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

make pr-str-ed fn-literal work (3) #36

Merged
merged 1 commit into from
Aug 19, 2019
Merged

make pr-str-ed fn-literal work (3) #36

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/sci/impl/fns.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
17 changes: 6 additions & 11 deletions src/sci/impl/interpreter.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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
Expand Down
98 changes: 52 additions & 46 deletions src/sci/impl/macros.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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))
Expand All @@ -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))
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions test/sci/core_test.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
5 changes: 2 additions & 3 deletions test/sci/performance.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))")]
Expand All @@ -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 :-)
Expand Down