[#447] Preserve reader meta of fn

babashka · Nov 25, 2020 · 68b5dfd · 68b5dfd
1 parent b76003c
commit 68b5dfd
Show file tree

Hide file tree

Showing 4 changed files with 28 additions and 12 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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