Now the language has full closures.

1 files changed, 125 insertions, 103 deletions

diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index f2c57f410..bd64563e8 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -119,16 +119,16 @@
 
 (defcompiler ^:private compile-local
   [::&analyser/local ?env ?idx]
-  (do (prn 'LOCAL ?idx)
+  (do ;; (prn 'LOCAL ?idx)
       (doto *writer*
         (.visitVarInsn Opcodes/ALOAD (int ?idx)))))
 
 (defcompiler ^:private compile-captured
-  [::&analyser/captured ?closure-id ?captured-id ?source]
-  (do (prn 'CAPTURED [?closure-id ?captured-id])
+  [::&analyser/captured ?scope ?captured-id ?source]
+  (do (prn 'CAPTURED [?scope ?captured-id])
     (doto *writer*
       (.visitVarInsn Opcodes/ALOAD 0)
-      (.visitFieldInsn Opcodes/GETFIELD (str "test2" "$" "lambda") (str "__" (inc ?captured-id)) "Ljava/lang/Object;"))))
+      (.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;"))))
 
 (defcompiler ^:private compile-global
   [::&analyser/global ?owner-class ?name]
@@ -311,10 +311,10 @@
                           ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/Object;)V")
 
                           (.visitVarInsn Opcodes/ALOAD 0)
-                          (.visitVarInsn Opcodes/ILOAD 1)
+                        (.visitVarInsn Opcodes/ILOAD 1)
                         ;; (.visitInsn Opcodes/ICONST_0)
                         
-                          (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
+                        (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
                         (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
                               (.visitVarInsn Opcodes/ALOAD (+ clo_idx 2))
                               (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig))
@@ -414,118 +414,140 @@
               (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*)))
         )))
 
+(defn ^:private captured? [form]
+  (match form
+    [::&analyser/captured ?closure-id ?captured-id ?source]
+    true
+    _
+    false))
+
 (defcompiler ^:private compile-lambda
-  [::&analyser/lambda ?frame ?args ?body]
-  (let [_ (prn '?frame ?frame)
+  [::&analyser/lambda ?scope ?frame ?args ?body]
+  (let [_ (prn '[?scope ?frame] ?scope ?frame)
         num-args (count ?args)
         outer-class (->class *class-name*)
         clo-field-sig (->type-signature "java.lang.Object")
         counter-sig "I"
         apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;"
         real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;")
-        current-class (str outer-class "$" "lambda")
+        current-class (apply str (interpose "$" ?scope))
         num-captured (dec num-args)
-        init-signature (if (not= 0 num-captured)
-                         (str "(" (apply str (repeat (count (:mappings ?frame)) clo-field-sig))
-                              counter-sig
-                              (apply str (repeat num-captured clo-field-sig)) ")" "V")
-                         (str "()" "V"))]
-    ;; (.visitInnerClass *parent* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
-    (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                   (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
-                           current-class nil "java/lang/Object" (into-array ["test2/Function"]))
-                   (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil)
-                         (.visitEnd))
-                       (->> (when (not= 0 num-captured)))))
-          =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil)
-                  (.visitCode)
-                  (.visitVarInsn Opcodes/ALOAD 0)
-                  (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
-                  (-> (doto (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                                  (.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
-                                  (.visitFieldInsn Opcodes/PUTFIELD current-class captured-name clo-field-sig))
-                                (do (doto =class
-                                      (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
-                                      (.visitEnd)))
-                                (->> (let [captured-name (str "__" (inc ?captured-id))])
-                                     (match (:form ?captured)
-                                       [::&analyser/captured ?closure-id ?captured-id ?source])
-                                     (doseq [[?name ?captured] (:mappings ?frame)])))
-                        (.visitVarInsn Opcodes/ALOAD 0)
-                        (.visitVarInsn Opcodes/ILOAD (inc (count (:mappings ?frame))))
-                        (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
-                        (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                              (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
-                              (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig))
-                            (->> (let [field-name (str "_" clo_idx)]
-                                   (doto (.visitField =class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil)
-                                     (.visitEnd)))
-                                 (dotimes [clo_idx num-captured])
-                                 (let [offset (+ 2 (count (:mappings ?frame)))]))))
-                      (->> (when (not= 0 num-captured))))
-                  (.visitInsn Opcodes/RETURN)
-                  (.visitMaxs 0 0)
-                  (.visitEnd))
-          =method (let [default-label (new Label)
-                        branch-labels (for [_ (range num-captured)]
-                                        (new Label))]
-                    (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil)
-                      (.visitCode)
-                      (.visitVarInsn Opcodes/ALOAD 0)
+        init-signature (str "(" (apply str (repeat (->> (:mappings ?frame)
+                                                        (map (comp :form second))
+                                                        (filter captured?)
+                                                        count)
+                                                   clo-field-sig))
+                            (if (not= 0 num-captured)
+                              (apply str counter-sig (repeat num-captured clo-field-sig)))
+                            ")"
+                            "V")
+        _ (prn current-class 'init-signature init-signature)
+        _ (prn current-class 'real-signature real-signature)
+        =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                 (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
+                         current-class nil "java/lang/Object" (into-array ["test2/Function"]))
+                 (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
+                       (.visitEnd))
+                     (->> (let [captured-name (str "__" ?captured-id)])
+                          (match (:form ?captured)
+                            [::&analyser/captured ?closure-id ?captured-id ?source])
+                          (doseq [[?name ?captured] (:mappings ?frame)
+                                  :when (captured? (:form ?captured))])))
+                 (-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) "_counter" counter-sig nil nil)
+                       (.visitEnd))
+                     (->> (when (not= 0 num-captured)))))
+        =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil)
+                (.visitCode)
+                (.visitVarInsn Opcodes/ALOAD 0)
+                (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+                (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                      (.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
+                      (.visitFieldInsn Opcodes/PUTFIELD current-class captured-name clo-field-sig))
+                    (->> (let [captured-name (str "__" ?captured-id)])
+                         (match (:form ?captured)
+                           [::&analyser/captured ?closure-id ?captured-id ?source])
+                         (doseq [[?name ?captured] (:mappings ?frame)
+                                 :when (captured? (:form ?captured))])))
+                (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                      (.visitVarInsn Opcodes/ILOAD (inc (count (:mappings ?frame))))
+                      (.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
                       (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                            (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
-                            (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels))
-                            (-> (doto (.visitLabel branch-label)
-                                  (.visitTypeInsn Opcodes/NEW current-class)
-                                  (.visitInsn Opcodes/DUP)
-                                  (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                                        (.visitFieldInsn Opcodes/GETFIELD current-class (str "__" (inc capt_idx)) clo-field-sig))
-                                      (->> (dotimes [capt_idx (count (:mappings ?frame))])))
-                                  (.visitVarInsn Opcodes/ALOAD 0)
-                                  (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
-                                  (.visitInsn Opcodes/ICONST_1)
-                                  (.visitInsn Opcodes/IADD)
-                                  (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                                        (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
-                                      (->> (dotimes [clo_idx current-captured])))
-                                  (.visitVarInsn Opcodes/ALOAD 1)
-                                  (-> (.visitInsn Opcodes/ACONST_NULL)
-                                      (->> (dotimes [clo_idx (- (dec num-captured) current-captured)])))
-                                  (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)
-                                  ;; (.visitJumpInsn Opcodes/GOTO end-label)
-                                  (.visitInsn Opcodes/ARETURN))
-                                (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))
-                                             ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])]
-                                             ])))
-                            (.visitLabel default-label)
-                            (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
-                                  (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
-                                (->> (dotimes [clo_idx num-captured]))))
-                          (->> (when (not= 0 num-captured))))
-                      (.visitVarInsn Opcodes/ALOAD 1)
-                      (.visitMethodInsn Opcodes/INVOKEVIRTUAL current-class "impl" real-signature)
-                      ;; (.visitLabel end-label)
-                      (.visitInsn Opcodes/ARETURN)
-                      (.visitMaxs 0 0)
-                      (.visitEnd)))
-          _ (prn 'LAMBDA/?body ?body)
-          =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC ;; Opcodes/ACC_STATIC
-                                              ) "impl" real-signature nil nil)
-                  (.visitCode)
-                  (->> (assoc *state* :form ?body :writer)
-                       compile-form)
-                  (.visitInsn Opcodes/ARETURN)
-                  (.visitMaxs 0 0)
-                  (.visitEnd))
-          _ (.visitEnd =class)]
-      (write-file (str current-class ".class") (.toByteArray =class)))
+                            (.visitVarInsn Opcodes/ALOAD (+ clo_idx offset))
+                            (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig))
+                          (->> (let [field-name (str "_" clo_idx)]
+                                 (doto (.visitField =class (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) field-name clo-field-sig nil nil)
+                                   (.visitEnd)))
+                               (dotimes [clo_idx num-captured])
+                               (let [offset (+ 2 (count (:mappings ?frame)))]))))
+                    (->> (when (not= 0 num-captured))))
+                (.visitInsn Opcodes/RETURN)
+                (.visitMaxs 0 0)
+                (.visitEnd))
+        =method (let [default-label (new Label)
+                      branch-labels (for [_ (range num-captured)]
+                                      (new Label))]
+                  (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil)
+                    (.visitCode)
+                    (.visitVarInsn Opcodes/ALOAD 0)
+                    (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                          (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
+                          (.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels))
+                          (-> (doto (.visitLabel branch-label)
+                                (.visitTypeInsn Opcodes/NEW current-class)
+                                (.visitInsn Opcodes/DUP)
+                                (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                                      (.visitFieldInsn Opcodes/GETFIELD current-class (str "__" capt_idx) clo-field-sig))
+                                    (->> (dotimes [capt_idx (count (:mappings ?frame))])))
+                                (.visitVarInsn Opcodes/ALOAD 0)
+                                (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
+                                (.visitInsn Opcodes/ICONST_1)
+                                (.visitInsn Opcodes/IADD)
+                                (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                                      (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
+                                    (->> (dotimes [clo_idx current-captured])))
+                                (.visitVarInsn Opcodes/ALOAD 1)
+                                (-> (.visitInsn Opcodes/ACONST_NULL)
+                                    (->> (dotimes [clo_idx (- (dec num-captured) current-captured)])))
+                                (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)
+                                ;; (.visitJumpInsn Opcodes/GOTO end-label)
+                                (.visitInsn Opcodes/ARETURN))
+                              (->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))
+                                           ;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])]
+                                           ])))
+                          (.visitLabel default-label)
+                          (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
+                                (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
+                              (->> (dotimes [clo_idx num-captured]))))
+                        (->> (when (not= 0 num-captured))))
+                    (.visitVarInsn Opcodes/ALOAD 1)
+                    (.visitMethodInsn Opcodes/INVOKEVIRTUAL current-class "impl" real-signature)
+                    ;; (.visitLabel end-label)
+                    (.visitInsn Opcodes/ARETURN)
+                    (.visitMaxs 0 0)
+                    (.visitEnd)))
+        ;; _ (prn 'LAMBDA/?body ?body)
+        =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC ;; Opcodes/ACC_STATIC
+                                            ) "impl" real-signature nil nil)
+                (.visitCode)
+                (->> (assoc *state* :form ?body :writer)
+                     compile-form)
+                (.visitInsn Opcodes/ARETURN)
+                (.visitMaxs 0 0)
+                (.visitEnd))
+        _ (.visitEnd =class)]
+    (write-file (str current-class ".class") (.toByteArray =class))
+    (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
+                                         (map second)
+                                         (map :form)
+                                         (filter captured?)))
     (doto *writer*
       (.visitTypeInsn Opcodes/NEW current-class)
       (.visitInsn Opcodes/DUP)
       (-> (do (compile-form (assoc *state* :form ?source)))
           (->> (match (:form ?captured)
                  [::&analyser/captured ?closure-id ?captured-id ?source])
-               (doseq [[?name ?captured] (:mappings ?frame)])))
+               (doseq [[?name ?captured] (:mappings ?frame)
+                       :when (captured? (:form ?captured))])))
       (-> (doto (.visitInsn Opcodes/ICONST_0)
             ;; (.visitInsn Opcodes/ICONST_0)
             (-> (.visitInsn Opcodes/ACONST_NULL)