diff --git a/src/sci/impl/analyzer.cljc b/src/sci/impl/analyzer.cljc index 79739e67..e21226d0 100644 --- a/src/sci/impl/analyzer.cljc +++ b/src/sci/impl/analyzer.cljc @@ -154,6 +154,13 @@ (declare analyze analyze-call) +(defn analyzed-meta [ctx m] + (let [meta-needs-eval? (> (count m) 4) + m (if meta-needs-eval? (mark-eval (analyze ctx m)) + m)] + ;; (prn :>> (:foo m) (meta (:foo m))) + m)) + (defn analyze-children [ctx children] (mapv #(analyze ctx %) children)) @@ -252,11 +259,17 @@ :min-var-args nil :max-fixed -1} bodies) arities (:bodies analyzed-bodies) - arglists (:arglists analyzed-bodies)] + arglists (:arglists analyzed-bodies) + fn-meta (meta fn-expr) + ana-fn-meta (analyzed-meta ctx fn-meta) + fn-meta (when-not (identical? fn-meta ana-fn-meta) + ;; fn-meta contains more than only location info + (-> ana-fn-meta (dissoc :line :end-line :column :end-column)))] (with-meta #:sci.impl{:fn-bodies arities :fn-name fn-name :arglists arglists - :fn true} + :fn true + :fn-meta fn-meta} {:sci.impl/op :fn}))) (defn expand-let* @@ -724,12 +737,6 @@ (let [ret (mark-eval-call (analyze-children ctx expr))] ret)))) -(defn analyzed-meta [ctx m] - (let [meta-needs-eval? (> (count m) 4) - m (if meta-needs-eval? (mark-eval (analyze ctx m)) - m)] - m)) - (def ^:const constant-colls true) ;; see GH #452 (defn analyze diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc index 1d6bdd8c..4a7da31d 100644 --- a/src/sci/impl/fns.cljc +++ b/src/sci/impl/fns.cljc @@ -101,8 +101,7 @@ arg-count)] (str "Cannot call " fn-name " with " actual-count " arguments"))))))))) f (if macro? - (vary-meta - f + (vary-meta f #(assoc % :sci/macro macro?)) f)] (reset! self-ref f) diff --git a/src/sci/impl/interpreter.cljc b/src/sci/impl/interpreter.cljc index d1ba807a..f7df1c3b 100644 --- a/src/sci/impl/interpreter.cljc +++ b/src/sci/impl/interpreter.cljc @@ -625,6 +625,7 @@ (defn interpret [ctx expr] + ;; (prn expr (meta expr)) (try (if (instance? sci.impl.types.EvalVar expr) (let [v (t/getVal expr)] @@ -643,7 +644,12 @@ (case op :call (eval-call ctx expr) :try (eval-try ctx expr) - :fn (fns/eval-fn ctx interpret eval-do* expr) + :fn (let [fn-meta (:sci.impl/fn-meta expr) + the-fn (fns/eval-fn ctx interpret eval-do* expr) + fn-meta (when fn-meta (handle-meta ctx fn-meta))] + (if fn-meta + (vary-meta the-fn merge fn-meta) + the-fn)) :static-access (interop/get-static-field expr) :var-value (nth expr 0) :deref! (let [v (first expr) diff --git a/test/sci/core_test.cljc b/test/sci/core_test.cljc index 97c74324..32b9b678 100644 --- a/test/sci/core_test.cljc +++ b/test/sci/core_test.cljc @@ -1065,7 +1065,11 @@ (testing "Reader metadata is evaluated on colls" (is (true? (eval* "(symbol? (:foo (meta ^{:foo 'bar} {})))"))) (is (true? (eval* "(= 6 (:foo (meta ^{:foo (+ 1 2 3)} [])))"))) - (is (true? (eval* "(= 6 (:foo (meta ^{:foo (+ 1 2 3)} #{})))"))))) + (is (true? (eval* "(= 6 (:foo (meta ^{:foo (+ 1 2 3)} #{})))")))) + (testing "Reader metadata is evaluated on fns" + (is (true? (eval* "(= 6 (:foo (meta ^{:foo (+ 1 2 3)} (fn []))))"))) + (testing "Fns don't have :line and :column metadata" + (is (true? (eval* "(nil? (:line (meta ^{:foo (+ 1 2 3)} (fn []))))")))))) ;;;; Scratch