- Finished some missing bits of class definition analysis.

4 files changed, 165 insertions, 45 deletions

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 9d295edda..53ab1de5b 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -425,15 +425,45 @@
     _
     (fail "[Analyser Error] Wrong syntax for field.")))
 
+(defn ^:private dummy-method-desc [method]
+  (|case method
+    [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+                          (&/$Cons [_ (&/$TupleS method-modifiers)]
+                                   (&/$Cons [_ (&/$TupleS method-exs)]
+                                            (&/$Cons [_ (&/$TupleS method-inputs)]
+                                                     (&/$Cons [_ (&/$TextS method-output)]
+                                                              (&/$Cons method-body
+                                                                       (&/$Nil))))))))]
+    (|do [=method-modifiers (analyse-modifiers method-modifiers)
+          =method-exs (&/map% extract-text method-exs)
+          =method-inputs (&/map% (fn [minput]
+                                   (|case minput
+                                     [_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" input-name)]
+                                                           (&/$Cons [_ (&/$TextS input-type)]
+                                                                    (&/$Nil))))]
+                                     (return (&/T input-name input-type))
+
+                                     _
+                                     (fail "[Analyser Error] Wrong syntax for method input.")))
+                                 method-inputs)]
+      (return {:name method-name
+               :modifiers =method-modifiers
+               :exceptions =method-exs
+               :inputs (&/|map &/|second =method-inputs)
+               :output method-output}))
+    
+    _
+    (fail "[Analyser Error] Wrong syntax for method.")))
+
 (defn ^:private analyse-method [analyse owner-class method]
   (|case method
-    [idx [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
-                               (&/$Cons [_ (&/$TupleS method-modifiers)]
-                                        (&/$Cons [_ (&/$TupleS method-exs)]
-                                                 (&/$Cons [_ (&/$TupleS method-inputs)]
-                                                          (&/$Cons [_ (&/$TextS method-output)]
-                                                                   (&/$Cons method-body
-                                                                            (&/$Nil))))))))]]
+    [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+                          (&/$Cons [_ (&/$TupleS method-modifiers)]
+                                   (&/$Cons [_ (&/$TupleS method-exs)]
+                                            (&/$Cons [_ (&/$TupleS method-inputs)]
+                                                     (&/$Cons [_ (&/$TextS method-output)]
+                                                              (&/$Cons method-body
+                                                                       (&/$Nil))))))))]
     (|do [=method-modifiers (analyse-modifiers method-modifiers)
           =method-exs (&/map% extract-text method-exs)
           =method-inputs (&/map% (fn [minput]
@@ -521,8 +551,9 @@
           ;; :let [_ (prn 'analyse-jvm-class/_0)]
           =fields (&/map% analyse-field fields)
           ;; :let [_ (prn 'analyse-jvm-class/_1)]
-          _ (&host/use-dummy-class name super-class interfaces =fields)
-          =methods (&/map% (partial analyse-method analyse full-name) (&/enumerate methods))
+          =method-descs (&/map% dummy-method-desc methods)
+          _ (&host/use-dummy-class name super-class interfaces =fields =method-descs)
+          =methods (&/map% (partial analyse-method analyse full-name) methods)
           ;; :let [_ (prn 'analyse-jvm-class/_2)]
           _ (check-method-completion (&/Cons$ super-class interfaces) =methods)
           ;; :let [_ (prn 'analyse-jvm-class/_3)]
@@ -557,8 +588,9 @@
             :let [name (&host/location (&/|tail scope))
                   anon-class (str module "." name)]
             ;; :let [_ (prn 'analyse-jvm-anon-class/_2 name anon-class)]
-            _ (&host/use-dummy-class name super-class interfaces (&/|list))
-            =methods (&/map% (partial analyse-method analyse anon-class) (&/enumerate methods))
+            =method-descs (&/map% dummy-method-desc methods)
+            _ (&host/use-dummy-class name super-class interfaces (&/|list) =method-descs)
+            =methods (&/map% (partial analyse-method analyse anon-class) 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 b4858d789..95d63b0fb 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -410,6 +410,36 @@
                   (&&/wrap-boolean))]]
     (return nil)))
 
+(defn ^:private compile-method-return [writer output]
+  (case output
+    "void" (.visitInsn writer Opcodes/RETURN)
+    "boolean" (doto writer
+                &&/unwrap-boolean
+                (.visitInsn Opcodes/IRETURN))
+    "byte" (doto writer
+             &&/unwrap-byte
+             (.visitInsn Opcodes/IRETURN))
+    "short" (doto writer
+              &&/unwrap-short
+              (.visitInsn Opcodes/IRETURN))
+    "int" (doto writer
+            &&/unwrap-int
+            (.visitInsn Opcodes/IRETURN))
+    "long" (doto writer
+             &&/unwrap-long
+             (.visitInsn Opcodes/LRETURN))
+    "float" (doto writer
+              &&/unwrap-float
+              (.visitInsn Opcodes/FRETURN))
+    "double" (doto writer
+               &&/unwrap-double
+               (.visitInsn Opcodes/DRETURN))
+    "char" (doto writer
+             &&/unwrap-char
+             (.visitInsn Opcodes/IRETURN))
+    ;; else
+    (.visitInsn writer Opcodes/ARETURN)))
+
 (defn ^:private compile-method [compile class-writer method]
   ;; (prn 'compile-method/_0 (dissoc method :inputs :output :body))
   ;; (prn 'compile-method/_1 (&/adt->text (:inputs method)))
@@ -421,12 +451,12 @@
                                  (:name method)
                                  signature
                                  nil
-                                 (->> (:exceptions method) &/->seq (into-array java.lang.String)))
+                                 (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String)))
       (|do [^MethodVisitor =method &/get-writer
             :let [_ (.visitCode =method)]
             _ (compile (:body method))
             :let [_ (doto =method
-                      (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN))
+                      (compile-method-return (:output method))
                       (.visitMaxs 0 0)
                       (.visitEnd))]]
         (return nil)))))
@@ -434,7 +464,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 (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) &/->seq (into-array java.lang.String)))))
+    (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String)))))
 
 (let [clo-field-sig (&host/->type-signature "java.lang.Object")
       <init>-return "V"]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index d2ade63c7..b05c30ad3 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -68,14 +68,15 @@
   (class->type (.getReturnType method)))
 
 ;; [Resources]
-(defn ^String ->class [class]
-  (string/replace class (-> class-name-separator Pattern/quote re-pattern) class-separator))
-
-(defn ^String ->class-name [module]
-  (string/replace module (-> module-separator Pattern/quote re-pattern) class-name-separator))
-
-(defn ^String ->module-class [module-name]
-  (string/replace module-name (-> module-separator Pattern/quote re-pattern) class-separator))
+(do-template [<name> <old-sep> <new-sep>]
+  (let [regex (-> <old-sep> Pattern/quote re-pattern)]
+    (defn <name> [old]
+      (string/replace old regex <new-sep>)))
+
+  ^String ->class        class-name-separator class-separator
+  ^String ->class-name   module-separator     class-name-separator
+  ^String ->module-class module-separator     class-separator
+  )
 
 (def ->package ->module-class)
 
@@ -206,7 +207,45 @@
        ;; else
        0)))
 
-(defn use-dummy-class [name super-class interfaces fields]
+(let [object-real-class (->class "java.lang.Object")]
+  (defn ^:private dummy-return [writer name output]
+    (case output
+      "void" (if (= "<init>" name)
+               (doto writer
+                 (.visitVarInsn Opcodes/ALOAD 0)
+                 (.visitMethodInsn Opcodes/INVOKESPECIAL object-real-class "<init>" "()V")
+                 (.visitInsn Opcodes/RETURN))
+               (.visitInsn writer Opcodes/RETURN))
+      "boolean" (doto writer
+                  (.visitLdcInsn false)
+                  (.visitInsn Opcodes/IRETURN))
+      "byte" (doto writer
+               (.visitLdcInsn (byte 0))
+               (.visitInsn Opcodes/IRETURN))
+      "short" (doto writer
+                (.visitLdcInsn (short 0))
+                (.visitInsn Opcodes/IRETURN))
+      "int" (doto writer
+              (.visitLdcInsn (int 0))
+              (.visitInsn Opcodes/IRETURN))
+      "long" (doto writer
+               (.visitLdcInsn (long 0))
+               (.visitInsn Opcodes/LRETURN))
+      "float" (doto writer
+                (.visitLdcInsn (float 0.0))
+                (.visitInsn Opcodes/FRETURN))
+      "double" (doto writer
+                 (.visitLdcInsn (double 0.0))
+                 (.visitInsn Opcodes/DRETURN))
+      "char" (doto writer
+               (.visitLdcInsn (char 0))
+               (.visitInsn Opcodes/IRETURN))
+      ;; else
+      (doto writer
+        (.visitInsn Opcodes/ACONST_NULL)
+        (.visitInsn Opcodes/ARETURN)))))
+
+(defn use-dummy-class [name super-class interfaces fields methods]
   (|do [module &/get-module-name
         :let [full-name (str module "/" name)
               =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
@@ -217,6 +256,19 @@
                                              (->type-signature (:type field)) nil nil)
                             (.visitEnd)))
                         fields)
+              _ (&/|map (fn [method]
+                          (|let [signature (str "(" (&/fold str "" (&/|map ->type-signature (:inputs method))) ")"
+                                                (->type-signature (:output method)))]
+                            (doto (.visitMethod =class (modifiers->int (:modifiers method))
+                                                (:name method)
+                                                signature
+                                                nil
+                                                (->> (:exceptions method) (&/|map ->class) &/->seq (into-array java.lang.String)))
+                              .visitCode
+                              (dummy-return (:name method) (:output method))
+                              (.visitMaxs 0 0)
+                              (.visitEnd))))
+                        methods)
               bytecode (.toByteArray (doto =class .visitEnd))]
         loader &/loader
         !classes &/classes
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 24486c85a..0495e6b02 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -663,31 +663,37 @@
           (|do [actual* (apply-type actual $arg)]
             (check* class-loader fixpoints invariant?? expected actual*))))
 
-      [(&/$DataT e!name e!params) (&/$DataT "#Null" (&/$Nil))]
-      (if (contains? primitive-types e!name)
-        (fail (str "[Type Error] Can't use \"null\" with primitive types."))
-        (return (&/T fixpoints nil)))
-
       [(&/$DataT e!name e!params) (&/$DataT a!name a!params)]
-      (let [e!name (as-obj e!name)
-            a!name (as-obj a!name)]
-        (cond (and (.equals ^Object e!name a!name)
-                   (= (&/|length e!params) (&/|length a!params)))
-              (|do [_ (&/map2% (partial check* class-loader fixpoints true) e!params a!params)]
-                (return (&/T fixpoints nil)))
-
-              (and (not invariant??)
-                   ;; (do (println '[Data Data] [e!name a!name]
-                   ;;              [(str "(" (->> e!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")
-                   ;;               (str "(" (->> a!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")])
-                   ;;   true)
-                   (try (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader))
-                     (catch Exception e
-                       (prn 'FAILED_HERE e!name a!name))))
+      (cond (= "#Null" a!name)
+            (if (not (contains? primitive-types e!name))
               (return (&/T fixpoints nil))
+              (fail (check-error expected actual)))
 
-              :else
-              (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))
+            (= "#Null" e!name)
+            (if (= "#Null" a!name)
+              (return (&/T fixpoints nil))
+              (fail (check-error expected actual)))
+
+            :else
+            (let [e!name (as-obj e!name)
+                  a!name (as-obj a!name)]
+              (cond (and (.equals ^Object e!name a!name)
+                         (= (&/|length e!params) (&/|length a!params)))
+                    (|do [_ (&/map2% (partial check* class-loader fixpoints true) e!params a!params)]
+                      (return (&/T fixpoints nil)))
+
+                    (and (not invariant??)
+                         ;; (do (println '[Data Data] [e!name a!name]
+                         ;;              [(str "(" (->> e!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")
+                         ;;               (str "(" (->> a!params (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")])
+                         ;;   true)
+                         (try (.isAssignableFrom (Class/forName e!name true class-loader) (Class/forName a!name true class-loader))
+                           (catch Exception e
+                             (prn 'FAILED_HERE e!name a!name))))
+                    (return (&/T fixpoints nil))
+
+                    :else
+                    (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name)))))
 
       [(&/$LambdaT eI eO) (&/$LambdaT aI aO)]
       (|do [[fixpoints* _] (check* class-loader fixpoints invariant?? aI eI)]