feat: fn meta evaluates (#11)

Author: erdos

src/uclj/core.clj

@@ -162,11 +162,13 @@
            fn*
            (let [[fname & bodies] (parsed-fn expanded)
                  &env             (if fname (add-env &env fname) &env)]
-             (concat '[fn*]
+             (with-meta
+               (concat '[fn*]
                      (when fname [fname])
                      (for [[args & bodies] bodies
                            :let [&env (reduce add-env &env args)]]
-                       (list* args (map (partial iter &env) bodies)))))
+                       (list* args (map (partial iter &env) bodies))))
+               (meta exp)))
 
            ;; else
            (map (partial iter &env) expanded))
@@ -316,9 +318,8 @@
        ;; else
        (let [butlast-body (doall (butlast bodies))
              last-body    (last bodies)]
-         (gen-eval-node
-          (do (doseq [x butlast-body] (evalme x &b))
-              (evalme last-body &b))))))))
+         (gen-eval-node (do (doseq [x butlast-body] (evalme x &b))
+                            (evalme last-body &b))))))))
 
 (defmethod seq->eval-node 'letfn* seq-eval-letfn [iden->idx recur-indices [_ bindings & bodies :as form]]
   (let [promises (for [[k f] (partition 2 bindings)
@@ -398,8 +399,10 @@
                                                                               (::fn-sym-introduced (meta def)))
                                                                       (range))
                                                     recur-indices (mapv iden->idx (::symbol-loop (meta def)))]]
-                                          [arity (->eval-node iden->idx recur-indices (list* 'do bodies))]))]
-    (make-fn-body fname symbol-used arity->body-node arity->symbols-introduced iden->idx vararg-arity)))
+                                          [arity (->eval-node iden->idx recur-indices (list* 'do bodies))]))
+        meta-node                 (->eval-node iden->idx nil (::meta-exp (meta form)))]
+    (cond-> (make-fn-body fname symbol-used arity->body-node arity->symbols-introduced iden->idx vararg-arity)
+      meta-node (-> (evalme &b) (with-meta (evalme meta-node &b)) (gen-eval-node)))))
 
 (def ^:const max-let-bindings 32)
 
@@ -707,10 +710,13 @@
                      ::fn-sym-introduced (-> symbol-loop ;; arguments + let vars
                                              (into (set (mapcat (comp ::symbol-introduced meta) bodies))))
                      ::symbol-loop       symbol-loop
-                     #_(set (keys new-acc-1))}))]
+                     #_(set (keys new-acc-1))}))
+        meta-map (-> (meta fn-expression) (dissoc :line :column :file) (not-empty))
+        meta-exp (enhance-code sym->iden meta-map)]
     (with-meta (if fname (list* 'fn* fname fbodies) (list* 'fn* fbodies))
       ;; symbol-introduced is nil because it is a new closure!
-      {::symbol-used (set (mapcat (comp ::symbol-used meta) fbodies))})))
+      {::meta-exp    meta-exp
+       ::symbol-used (set (mapcat (comp ::symbol-used meta) fbodies))})))
 
 (defmethod enhance-code 'try [sym->iden [_ & xs]]
   (let [bodies  (remove (fn [x] (and (seq? x) ('#{finally catch} (first x)))) xs)

test/uclj/core_test.clj

@@ -46,6 +46,10 @@
   (testing "Function name is used"
     (is (fn? (evaluator '((fn f [] f))))))
 
+  (testing "Meta is evaluated on fn"
+    (is (= {:a 1} (meta (evaluator '(do ^{:a (inc 0)} (fn []))))))
+    (is (= "1" (evaluator '(with-out-str ^{:a (print 1)} (fn ^{:b (print 2)} x []))))))
+
   (testing "Recur with single arg"
     (is (= :b (evaluator '((fn [a] (if (pos? a) (recur (dec a)) :b)) 4)))))