- Did a trick to make sure "this" always had the type of the class being defined, instead of the type of the super-class.

4 files changed, 60 insertions, 36 deletions

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 292d3d4b1..6c15c8bbc 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -425,7 +425,7 @@
     _
     (fail "[Analyser Error] Wrong syntax for field.")))
 
-(defn ^:private analyse-method [analyse name owner-class method]
+(defn ^:private analyse-method [analyse owner-class method]
   (|case method
     [idx [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
                                (&/$Cons [_ (&/$TupleS method-inputs)]
@@ -511,10 +511,12 @@
 (defn analyse-jvm-class [analyse compile-token name super-class interfaces fields methods]
   (&/with-closure
     (|do [module &/get-module-name
+          :let [full-name (str module "." name)]
           ;; :let [_ (prn 'analyse-jvm-class/_0)]
           =fields (&/map% analyse-field fields)
           ;; :let [_ (prn 'analyse-jvm-class/_1)]
-          =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods))
+          _ (&host/use-dummy-class name super-class interfaces =fields)
+          =methods (&/map% (partial analyse-method analyse full-name) (&/enumerate methods))
           ;; :let [_ (prn 'analyse-jvm-class/_2)]
           _ (check-method-completion (&/Cons$ super-class interfaces) =methods)
           ;; :let [_ (prn 'analyse-jvm-class/_3)]
@@ -549,7 +551,8 @@
             :let [name (&host/location (&/|tail scope))
                   anon-class (str module "." name)]
             ;; :let [_ (prn 'analyse-jvm-anon-class/_2 name anon-class)]
-            =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods))
+            _ (&host/use-dummy-class name super-class interfaces (&/|list))
+            =methods (&/map% (partial analyse-method analyse anon-class) (&/enumerate methods))
             ;; :let [_ (prn 'analyse-jvm-anon-class/_3 name anon-class)]
             _ (check-method-completion (&/Cons$ super-class interfaces) =methods)
             ;; :let [_ (prn 'analyse-jvm-anon-class/_4 name anon-class)]
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 179b5423c..89f830561 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -401,21 +401,6 @@
         :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig ?output-type))]]
     (return nil)))
 
-(defn ^:private modifiers->int [mods]
-  (+ (case (:visibility mods)
-       "default" 0
-       "public" Opcodes/ACC_PUBLIC
-       "private" Opcodes/ACC_PRIVATE
-       "protected" Opcodes/ACC_PROTECTED)
-     (if (:static? mods) Opcodes/ACC_STATIC 0)
-     (if (:final? mods) Opcodes/ACC_FINAL 0)
-     (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0)
-     (case (:concurrency mods)
-       "synchronized" Opcodes/ACC_SYNCHRONIZED
-       "volatile" Opcodes/ACC_VOLATILE
-       ;; else
-       0)))
-
 (defn compile-jvm-instanceof [compile class object]
   (|do [:let [class* (&host/->class class)]
         ^MethodVisitor *writer* &/get-writer
@@ -432,7 +417,7 @@
   ;; (prn 'compile-method/_3 (&/adt->text (:body method)))
   (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
                         (&host/->type-signature (:output method)))]
-    (&/with-writer (.visitMethod class-writer (modifiers->int (:modifiers method))
+    (&/with-writer (.visitMethod class-writer (&host/modifiers->int (:modifiers method))
                                  (:name method)
                                  signature nil nil)
       (|do [^MethodVisitor =method &/get-writer
@@ -447,7 +432,7 @@
 (defn ^:private compile-method-decl [class-writer method]
   (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")"
                         (&host/->type-signature (:output method)))]
-    (.visitMethod class-writer (modifiers->int (:modifiers method)) (:name method) signature nil nil)))
+    (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil nil)))
 
 (let [clo-field-sig (&host/->type-signature "java.lang.Object")
       <init>-return "V"]
@@ -484,7 +469,7 @@
                                full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))
                        (.visitSource file-name nil))
               _ (&/|map (fn [field]
-                          (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
+                          (doto (.visitField =class (&host/modifiers->int (:modifiers field)) (:name field)
                                              (&host/->type-signature (:type field)) nil nil)
                             (.visitEnd)))
                         ?fields)]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 6be162bf7..d2ade63c7 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -11,7 +11,11 @@
             (lux [base :as & :refer [|do return* return fail fail* |let |case]]
                  [type :as &type]))
   (:import (java.lang.reflect Field Method Constructor Modifier)
-           java.util.regex.Pattern))
+           java.util.regex.Pattern
+           (org.objectweb.asm Opcodes
+                              Label
+                              ClassWriter
+                              MethodVisitor)))
 
 ;; [Constants]
 (def prefix "lux.")
@@ -46,18 +50,18 @@
 (defn ^:private class->type [^Class class]
   "(-> Class Type)"
   (do ;; (prn 'class->type/_0 class (.getSimpleName class) (.getName class))
-    (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))]
-      (let [base (or arr-base simple-base)]
-        ;; (prn 'class->type/_1 class base arr-brackets)
-        (let [output-type (if (.equals "void" base)
-                            &type/Unit
-                            (reduce (fn [inner _] (&type/Data$ array-data-tag (&/|list inner)))
-                                    (&type/Data$ base &/Nil$)
-                                    (range (count (or arr-brackets ""))))
-                            )]
-          ;; (prn 'class->type/_2 class (&type/show-type output-type))
-          output-type)
-        ))))
+      (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))]
+        (let [base (or arr-base simple-base)]
+          ;; (prn 'class->type/_1 class base arr-brackets)
+          (let [output-type (if (.equals "void" base)
+                              &type/Unit
+                              (reduce (fn [inner _] (&type/Data$ array-data-tag (&/|list inner)))
+                                      (&type/Data$ base &/Nil$)
+                                      (range (count (or arr-brackets ""))))
+                              )]
+            ;; (prn 'class->type/_2 class (&type/show-type output-type))
+            output-type)
+          ))))
 
 (defn ^:private method->type [^Method method]
   "(-> Method Type)"
@@ -186,3 +190,37 @@
 
 (defn location [scope]
   (->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str "")))
+
+(defn modifiers->int [mods]
+  (+ (case (:visibility mods)
+       "default" 0
+       "public" Opcodes/ACC_PUBLIC
+       "private" Opcodes/ACC_PRIVATE
+       "protected" Opcodes/ACC_PROTECTED)
+     (if (:static? mods) Opcodes/ACC_STATIC 0)
+     (if (:final? mods) Opcodes/ACC_FINAL 0)
+     (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0)
+     (case (:concurrency mods)
+       "synchronized" Opcodes/ACC_SYNCHRONIZED
+       "volatile" Opcodes/ACC_VOLATILE
+       ;; else
+       0)))
+
+(defn use-dummy-class [name super-class interfaces fields]
+  (|do [module &/get-module-name
+        :let [full-name (str module "/" name)
+              =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                       (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+                               full-name nil (->class super-class) (->> interfaces (&/|map ->class) &/->seq (into-array String))))
+              _ (&/|map (fn [field]
+                          (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field)
+                                             (->type-signature (:type field)) nil nil)
+                            (.visitEnd)))
+                        fields)
+              bytecode (.toByteArray (doto =class .visitEnd))]
+        loader &/loader
+        !classes &/classes
+        :let [real-name (str (->class-name module) "." name)
+              _ (swap! !classes assoc real-name bytecode)
+              _ (.loadClass loader real-name)]]
+    (return nil)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index bc28dbde0..24486c85a 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -404,8 +404,6 @@
        "\n\nActual: " (show-type actual)
        "\n"))
 
-;; (def !flag (atom false))
-
 (defn beta-reduce [env type]
   ;; (when @!flag
   ;;   (prn 'beta-reduce (show-type type)))