Skip to content

Commit db83a75

Browse files
borkdudeborkdude
authored
make pr-str-ed fn-literal work (3)
1 parent bf93373 commit db83a75

File tree

5 files changed

+64
-63
lines changed

5 files changed

+64
-63
lines changed

‎src/sci/impl/fns.cljc

+2-1
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,8 @@
5555
(let [self-ref (atom nil)
5656
call-self (fn [& args]
5757
(apply @self-ref args))
58-
ctx (assoc-in ctx [:bindings fn-name] call-self)
58+
ctx (if fn-name (assoc-in ctx [:bindings fn-name] call-self)
59+
ctx)
5960
arities (map #(parse-fn-args+body interpret ctx %) fn-bodies)
6061
f (if (= 1 (count arities))
6162
(first arities)

‎src/sci/impl/interpreter.cljc

+6-11
Original file line numberDiff line numberDiff line change
@@ -130,15 +130,14 @@
130130
:cljs js/Error)
131131
(str "Could not resolve symbol: " (str expr)))))))))
132132

133-
(defn apply-fn [f i args]
134-
(let [args (mapv i args)]
133+
(defn apply-fn [ctx f args]
134+
(let [args (mapv #(interpret ctx %) args)]
135135
(apply f args)))
136136

137137
(def constant? (some-fn fn? number? string? keyword?))
138138

139139
(defn interpret
140140
[ctx expr]
141-
;; (prn "EXPR" expr)
142141
(cond (constant? expr) expr
143142
(symbol? expr) (resolve-symbol ctx expr)
144143
(:sci/fn expr) (fns/eval-fn ctx interpret expr)
@@ -152,11 +151,8 @@
152151
(into (empty expr) (map i expr))
153152
(seq? expr)
154153
(if-let [f (first expr)]
155-
(let [;;_ (prn "FST" f)
156-
f (or (get macros f)
157-
(i f))
158-
;;_ (prn ">" f)
159-
]
154+
(let [f (or (get macros f)
155+
(i f))]
160156
(case f
161157
do
162158
(eval-do ctx expr)
@@ -174,7 +170,7 @@
174170
def (eval-def ctx expr)
175171
;; else
176172
(if (ifn? f)
177-
(apply-fn f i (rest expr))
173+
(apply-fn ctx f (rest expr))
178174
(throw #?(:clj (Exception. (format "Cannot call %s as a function." (pr-str f)))
179175
:cljs (js/Error. (str "Cannot call " (pr-str f) " as a function.")))))))
180176
expr)
@@ -199,8 +195,7 @@
199195
(str "#sci/quote " (second m))))))
200196

201197
;; _ (def e edn)
202-
expr (macros/macroexpand ctx edn)
203-
]
198+
expr (macros/macroexpand ctx edn)]
204199
(interpret ctx expr))))
205200

206201
;;;; Scratch

‎src/sci/impl/macros.cljc

+52-46
Original file line numberDiff line numberDiff line change
@@ -6,41 +6,40 @@
66
[sci.impl.functions :as f]
77
[clojure.string :as str]))
88

9-
(def macros '#{do if when and or -> ->> as-> quote let fn def defn})
9+
(def macros '#{do if when and or -> ->> as-> quote quote* let fn def defn})
1010

1111
(defn lookup [{:keys [:env :bindings]} sym]
12-
(when-let [[k v :as kv]
13-
(or (when-let [v (get macros sym)]
14-
[v v])
15-
(find bindings sym)
16-
(find @env sym)
17-
(find f/functions sym)
18-
(when-let [ns (namespace sym)]
19-
(when (or (= "clojure.core" ns)
20-
(= "cljs.core" ns))
21-
(find f/functions (symbol (name sym))))))]
22-
(if-let [m (meta k)]
23-
(if (:sci/deref! m)
24-
;; the evaluation of this expression has been delayed by
25-
;; the caller and now is the time to deref it
26-
[k @v] kv)
27-
kv)))
12+
(let [res (or (when-let [v (get macros sym)]
13+
[v v])
14+
(when-let [[k _v]
15+
(find bindings sym)]
16+
;; never inline a binding at macro time!
17+
[k nil])
18+
(find @env sym)
19+
(find f/functions sym)
20+
(when-let [ns (namespace sym)]
21+
(when (or (= "clojure.core" ns)
22+
(= "cljs.core" ns))
23+
(find f/functions (symbol (name sym))))))]
24+
;; (prn 'lookup sym '-> res)
25+
res))
2826

2927
(defn resolve-symbol [ctx expr]
30-
;; (prn "resolve sym" expr)
31-
(second
32-
(or
33-
(lookup ctx expr)
34-
;; TODO: check if symbol is in macros and then emit an error: cannot take
35-
;; the value of a macro
36-
(let [n (name expr)]
37-
(if (str/starts-with? n "'")
38-
(let [v (symbol (subs n 1))]
39-
[v v])
40-
(throw (new #?(:clj Exception
41-
:cljs js/Error)
42-
(str "Could not resolve symbol: " (str expr)
43-
(keys (:bindings expr))))))))))
28+
(let [res (second
29+
(or
30+
(lookup ctx expr)
31+
;; TODO: check if symbol is in macros and then emit an error: cannot take
32+
;; the value of a macro
33+
(let [n (name expr)]
34+
(if (str/starts-with? n "'")
35+
(let [v (symbol (subs n 1))]
36+
[v v])
37+
(throw (new #?(:clj Exception
38+
:cljs js/Error)
39+
(str "Could not resolve symbol: " (str expr)
40+
(keys (:bindings expr)))))))))]
41+
;; (prn 'resolve expr '-> res)
42+
res))
4443

4544
(declare macroexpand macroexpand-1)
4645

@@ -202,7 +201,6 @@
202201
(swap! (:env ctx) assoc var-name :sci/var.unbound)
203202
(list 'def var-name init)))
204203

205-
206204
(defn expand-defn [ctx [_defn fn-name docstring? & body]]
207205
(let [docstring (when (string? docstring?) docstring?)
208206
body (if docstring body (cons docstring? body))
@@ -218,7 +216,8 @@
218216
(:sci/fn expr) expr
219217
(symbol? expr)
220218
(or (let [v (resolve-symbol ctx expr)]
221-
(when-not (identical? :sci/var.unbound v)))
219+
(when-not (identical? :sci/var.unbound v)
220+
v))
222221
expr)
223222
(map? expr)
224223
(zipmap (map #(macroexpand ctx %) (keys expr))
@@ -227,22 +226,29 @@
227226
(into (empty expr) (map #(macroexpand ctx %) expr))
228227
(seq? expr)
229228
(if-let [f (first expr)]
230-
(case f
231-
do expr ;; do will call macroexpand on every subsequent expression
232-
let
233-
(expand-let ctx expr)
234-
(fn fn*) (expand-fn ctx expr)
235-
quote expr
236-
def (expand-def ctx expr)
237-
defn (expand-defn ctx expr)
238-
-> (expand-> ctx (rest expr))
239-
->> (expand->> ctx (rest expr))
240-
as-> (expand-as-> ctx expr)
241-
;; else:
229+
(if (symbol? f)
230+
(let [f (if-let [ns (namespace f)]
231+
(if (or (= "clojure.core" ns)
232+
(= "cljs.core" ns))
233+
(symbol (name f))
234+
f)
235+
f)]
236+
(case f
237+
do expr ;; do will call macroexpand on every subsequent expression
238+
let
239+
(expand-let ctx expr)
240+
(fn fn*) (expand-fn ctx expr)
241+
quote expr
242+
def (expand-def ctx expr)
243+
defn (expand-defn ctx expr)
244+
-> (expand-> ctx (rest expr))
245+
->> (expand->> ctx (rest expr))
246+
as-> (expand-as-> ctx expr)
247+
;; else:
248+
(doall (map #(macroexpand ctx %) expr))))
242249
(doall (map #(macroexpand ctx %) expr)))
243250
expr)
244251
:else expr)]
245-
;; (prn expr (meta expr) '-> res)
246252
res))
247253

248254
;;;; Scratch

‎test/sci/core_test.cljc

+2-2
Original file line numberDiff line numberDiff line change
@@ -175,8 +175,8 @@
175175
(deftest macroexpand-test
176176
(is (= [6] (eval* "[(-> 3 inc inc inc)]")))
177177
(is (= [{3 6}] (eval* "[{(->> 2 inc) (-> 3 inc inc inc)}]")))
178-
(when-not tu/native?
179-
(is (eval* (str `(#(< 10 % 18) 15))))))
178+
(is (eval* (str `(#(< 10 % 18) 15))))
179+
(is (eval* (str `(#(and (int? %) (< 10 % 18)))) 15)))
180180

181181
;;;; Scratch
182182

‎test/sci/performance.clj

+2-3
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@
88
(def f (sci/eval-string "#(assoc (hash-map :a 1 :b 2) %1 %2))"))
99
(f :b 3)
1010
(meta f)
11-
(prof/profile (dotimes [_ 10000] (f :b 3)))
12-
(System/getProperty "jdk.attach.allowAttachSelf"))
11+
(prof/profile (dotimes [_ 10000] (f :b 3))))
1312

1413
(defn bench-sci []
1514
(let [f (sci/eval-string "#(assoc (hash-map :a 1 :b 2) %1 %2))")]
@@ -22,7 +21,7 @@
2221
(cc/quick-bench (f :b 3))))
2322

2423
(comment
25-
(bench-sci) ;; Execution time mean : 13 µs
24+
(bench-sci) ;; Execution time mean : 13 µs (7µs on MBP2019 8core)
2625
(bench-clojure) ;; Execution time mean : 410 ns
2726
(sci/eval-string "#(inc x1)") ;; yay, error
2827
(sci/eval-string "(#(do %1))") ;; arity error is coming from Clojure :-)

0 commit comments

Comments
 (0)