Now folding the classes for lambdas and putting the implementation code inside the classes, not inside the module.

1 files changed, 105 insertions, 74 deletions

diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 5b14410b3..9de072bc0 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -266,7 +266,7 @@
     (assert (compile-form (assoc *state* :form ?body)) "CAN't COMPILE LET-BODY")
     (.visitLabel *writer* end-label)))
 
-(defn ^:private compile-method-function [writer class-name fn-name num-args]
+(defn ^:private compile-method-function [writer class-name fn-name num-args body *state*]
   (let [outer-class (->class class-name)
         clo-field-sig (->type-signature "java.lang.Object")
         counter-sig "I"
@@ -277,13 +277,19 @@
         init-signature (if (not= 0 num-captured)
                          (str "(" (apply str counter-sig (repeat num-captured clo-field-sig)) ")" "V")
                          (str "()" "V"))]
-    (.visitInnerClass writer current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
+    ;; (.visitInnerClass writer 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)))))
+          =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))
           =init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" init-signature nil nil)
                   (.visitCode)
                   (.visitVarInsn Opcodes/ALOAD 0)
@@ -356,7 +362,7 @@
                                 (->> (dotimes [clo_idx num-captured]))))
                           (->> (when (not= 0 num-captured))))
                       (.visitVarInsn Opcodes/ALOAD 1)
-                      (.visitMethodInsn Opcodes/INVOKESTATIC outer-class fn-name real-signature)
+                      (.visitMethodInsn Opcodes/INVOKESTATIC current-class "impl" real-signature)
                       ;; (.visitLabel end-label)
                       (.visitInsn Opcodes/ARETURN)
                       (.visitMaxs 0 0)
@@ -388,88 +394,113 @@
                   (.visitInsn Opcodes/RETURN)
                   (.visitMaxs 0 0)
                   (.visitEnd)))
-              (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")
-                    ;; _ (prn 'signature signature)
-                    =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
-                              (.visitCode))]
-                (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
-                (doto =method
-                  (.visitInsn Opcodes/ARETURN)
-                  (.visitMaxs 0 0)
-                  (.visitEnd))
-                (compile-method-function *writer* *class-name* ?name (count ?args)))))
+              ;; (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")
+              ;;       ;; _ (prn 'signature signature)
+              ;;       =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
+              ;;                 (.visitCode))]
+              ;;   (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
+              ;;   (doto =method
+              ;;     (.visitInsn Opcodes/ARETURN)
+              ;;     (.visitMaxs 0 0)
+              ;;     (.visitEnd))
+              ;;   (compile-method-function *writer* *class-name* ?name (count ?args) ?body))
+              (compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*)))
         )))
 
 (defcompiler ^:private compile-lambda
   [::&analyser/lambda ?args ?body]
   (let [num-args (count ?args)
-        signature (str "(" (apply str (repeat num-args "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")
         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 "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")]
-    (doseq [idx (range num-args)
-            :let [has-next? (not= idx (dec num-args))
-                  local-name (str "lambda_" idx)
-                  current-class (str outer-class "$" local-name)
-                  next-class (str outer-class "$" "lambda_" (inc idx))
-                  current-signature (str "(" (apply str (repeat idx "Ljava/lang/Object;")) ")" "V")
-                  next-signature (str "(" (apply str (repeat (inc idx) "Ljava/lang/Object;")) ")" "V")]]
-      (.visitInnerClass *parent* current-class outer-class local-name (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC))
-      (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                     (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
-                             current-class nil "java/lang/Object" (into-array ["test2/Function"])))
-            _ (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" current-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 clo_idx))
-                      (.visitFieldInsn Opcodes/PUTFIELD current-class field-name clo-field-sig))
-                    (->> (let [field-name (str "_" clo_idx)]
-                           (doto (.visitField =class Opcodes/ACC_PUBLIC field-name clo-field-sig nil nil)
-                             (.visitEnd)))
-                         (dotimes [clo_idx idx])))
-                (.visitInsn Opcodes/RETURN)
-                (.visitMaxs 0 0)
-                (.visitEnd))
-            =method (doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil)
-                      (.visitCode))
-            _ (do (when has-next?
-                    (doto =method
-                      (.visitTypeInsn Opcodes/NEW next-class)
-                      (.visitInsn Opcodes/DUP)))
-                (doto =method
-                  (-> (doto (.visitVarInsn Opcodes/ALOAD (int 0))
-                        (.visitFieldInsn Opcodes/GETFIELD current-class (str "_" clo_idx) clo-field-sig))
-                      (->> (dotimes [clo_idx idx])))
-                  (.visitVarInsn Opcodes/ALOAD (int 1)))
-                (if has-next?
-                  (.visitMethodInsn =method Opcodes/INVOKESPECIAL next-class "<init>" next-signature)
-                  (.visitMethodInsn =method Opcodes/INVOKESTATIC outer-class "lambda_impl" real-signature))
-                (doto =method
+        real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;")
+        current-class (str outer-class "$" "lambda")
+        num-captured (dec num-args)
+        init-signature (if (not= 0 num-captured)
+                         (str "(" (apply str counter-sig (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 (.visitVarInsn Opcodes/ALOAD 0)
+                        (.visitVarInsn Opcodes/ILOAD 1)
+                        (.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))
+                            (->> (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]))))
+                      (->> (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)
+                      (-> (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)
+                                  (.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/INVOKESTATIC current-class "impl" real-signature)
+                      ;; (.visitLabel end-label)
+                      (.visitInsn Opcodes/ARETURN)
+                      (.visitMaxs 0 0)
+                      (.visitEnd)))
+          =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))]
-        (println "OUTPUT LAMBDA:" (str current-class ".class"))
-        (write-file (str current-class ".class") (.toByteArray =class))))
-    (let [=method (doto (.visitMethod *parent* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "lambda_impl" real-signature nil nil)
-                    (.visitCode))]
-      ;; (prn '(:form ?body) (:form ?body))
-      (compile-form (assoc *state* :parent *parent* :writer =method :form ?body))
-      (doto =method
-        (.visitInsn Opcodes/ARETURN)
-        (.visitMaxs 0 0)
-        (.visitEnd))
-      ;; (compile-form (assoc *state* :writer =method :form ?body))
-      ;; (compile-method-function *writer* *class-name* ?name (count ?args))
-      )
-    (let [init-class (str outer-class "$" "lambda_0")]
-      (doto *writer*
-        (.visitTypeInsn Opcodes/NEW init-class)
-        (.visitInsn Opcodes/DUP)
-        (.visitMethodInsn Opcodes/INVOKESPECIAL init-class "<init>" "()V")))
+          _ (.visitEnd =class)]
+      (write-file (str current-class ".class") (.toByteArray =class)))
+    (doto *writer*
+      (.visitTypeInsn Opcodes/NEW current-class)
+      (.visitInsn Opcodes/DUP)
+      (-> (doto (.visitInsn Opcodes/ICONST_0)
+            ;; (.visitInsn Opcodes/ICONST_0)
+            (-> (.visitInsn Opcodes/ACONST_NULL)
+                (->> (doseq [_ (butlast ?args)]))))
+          (->> (when (> (count ?args) 1))))
+      (.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature))
     ))
 
 (defcompiler ^:private compile-defclass