Made sure the "phase" parameter of extensions is always usable (even across language boundaries)

3 files changed, 60 insertions, 22 deletions

diff --git a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj
index cc77bf72c..78362601d 100644
--- a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj
+++ b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj
@@ -854,7 +854,8 @@
           =fields (&/map% (partial analyse-field analyse class-env) ?fields)
           _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods)
           =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods)
-          _ (check-method-completion all-supers =methods)
+          ;; TODO: Uncomment
+          ;; _ (check-method-completion all-supers =methods)
           _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None)
           _ &/pop-dummy-name
           :let [_ (println 'CLASS full-name)]
@@ -869,7 +870,8 @@
 
 (defn- analyse-methods [analyse class-decl all-supers methods]
   (|do [=methods (&/map% (partial analyse-method analyse class-decl &/$Nil all-supers) methods)
-        _ (check-method-completion all-supers =methods)
+        ;; TODO: Uncomment
+        ;; _ (check-method-completion all-supers =methods)
         =captured &&env/captured-vars]
     (return (&/T [=methods =captured]))))
 
@@ -878,14 +880,16 @@
         scope &/get-scope-name]
     (return (&/T [module scope]))))
 
-(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
-                                                       false
-                                                       &/$Nil
-                                                       &/$Nil
-                                                       &/$Nil
-                                                       &/$Nil
-                                                       &/$Nil
-                                                       (&/$Tuple &/$Nil)]))
+(let [default-<init> (fn [ctor-args]
+                       (&/$ConstructorMethodSyntax (&/T [&/$PublicPM ;; privacy-modifier
+                                                         false ;; strict
+                                                         &/$Nil ;; anns
+                                                         &/$Nil ;; gvars
+                                                         &/$Nil ;; exceptions
+                                                         &/$Nil ;; inputs
+                                                         ctor-args ;; ctor-args
+                                                         (&/$Tuple &/$Nil) ;; body
+                                                         ])))
       captured-slot-class "java.lang.Object"
       captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
   (defn- analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods]
@@ -902,7 +906,7 @@
                                      (return (&/T [arg-type =arg-term])))))
                                ctor-args)
             _ (->> methods
-                   (&/$Cons default-<init>)
+                   (&/$Cons (default-<init> =ctor-args))
                    (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
             [=methods =captured] (let [all-supers (&/$Cons super-class interfaces)]
                                    (analyse-methods analyse class-type-decl all-supers methods))
diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
index 034d503a7..a1039f0b3 100644
--- a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
+++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj
@@ -407,7 +407,7 @@
 (let [clo-field-sig (&host-generics/->type-signature "java.lang.Object")
       <init>-return "V"]
   (defn ^:private anon-class-<init>-signature [env]
-    (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
+    (str "(" (->> clo-field-sig (&/|repeat (&/|length env)) (&/fold str "")) ")"
          <init>-return))
 
   (defn ^:private add-anon-class-<init> [^ClassWriter class-writer compile class-name super-class env ctor-args]
diff --git a/lux-bootstrapper/src/lux/host.clj b/lux-bootstrapper/src/lux/host.clj
index 562d582f6..4da818db2 100644
--- a/lux-bootstrapper/src/lux/host.clj
+++ b/lux-bootstrapper/src/lux/host.clj
@@ -273,15 +273,19 @@
 (def init-method-name "<init>")
 
 (defn ^:private dummy-ctor [^MethodVisitor writer real-name store-name super-class ctor-args]
-  (|let [ctor-arg-types (->> ctor-args (&/|map (comp &host-generics/->type-signature (comp (partial ->dummy-type real-name store-name) &/|first))) (&/fold str ""))]
+  (|let [ctor-arg-types (->> ctor-args
+                             (&/|map (comp &host-generics/gclass->signature (comp (partial ->dummy-type real-name store-name) &/|first)))
+                             (&/fold str ""))]
     (doto writer
       (.visitVarInsn Opcodes/ALOAD 0)
       (-> (doto (dummy-value arg-type)
-            (-> (.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name arg-type))
+            (-> (.visitTypeInsn Opcodes/CHECKCAST arg-type)
                 (->> (when (not (primitive-jvm-type? arg-type))))))
           (->> (doseq [ctor-arg (&/->seq ctor-args)
-                       :let [;; arg-term (&/|first ctor-arg)
-                             arg-type (->dummy-type real-name store-name (&/|first ctor-arg))]])))
+                       :let [arg-type (->> ctor-arg
+                                           &/|first
+                                           (->dummy-type real-name store-name)
+                                           &host-generics/gclass->class-name)]])))
       (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class)) init-method-name (str "(" ctor-arg-types ")V"))
       (.visitInsn Opcodes/RETURN))))
 
@@ -289,7 +293,12 @@
   (|case method-def
     (&/$ConstructorMethodSyntax =privacy-modifier ?strict =anns =gvars =exceptions =inputs =ctor-args body)
     (|let [=output (&/$GenericClass "void" (&/|list))
-           method-decl [init-method-name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+           method-decl [init-method-name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class Opcodes/ACC_PUBLIC
                           init-method-name
@@ -302,7 +311,12 @@
         (.visitEnd)))
 
     (&/$VirtualMethodSyntax =name =privacy-modifier =final? ?strict =anns =gvars =exceptions =inputs =output body)
-    (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+    (|let [method-decl [=name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC
                                     (if =final? Opcodes/ACC_FINAL 0))
@@ -316,7 +330,12 @@
         (.visitEnd)))
     
     (&/$OverridenMethodSyntax =class-decl =name ?strict =anns =gvars =exceptions =inputs =output body)
-    (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+    (|let [method-decl [=name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class Opcodes/ACC_PUBLIC
                           =name
@@ -329,7 +348,12 @@
         (.visitEnd)))
 
     (&/$StaticMethodSyntax =name =privacy-modifier ?strict =anns =gvars =exceptions =inputs =output body)
-    (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+    (|let [method-decl [=name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC)
                           =name
@@ -342,7 +366,12 @@
         (.visitEnd)))
 
     (&/$AbstractMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output)
-    (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+    (|let [method-decl [=name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT)
                           =name
@@ -352,7 +381,12 @@
         (.visitEnd)))
 
     (&/$NativeMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output)
-    (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)]
+    (|let [method-decl [=name
+                        =anns
+                        =gvars
+                        (&/|map (partial ->dummy-type real-name store-name) =exceptions)
+                        (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs)
+                        (->dummy-type real-name store-name =output)]
            [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
       (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_NATIVE)
                           =name