- Fixed a bug wherein type-variables were not getting properly cleaned and that was causing trouble with type-checking.

- Fixed a bug in the way arguments for method-definitions were getting compiled.
- Fixed a bug in the way double greater-than comparison was being compiled.
- Fixed how exception signatures were getting compiled for method-definitions.

7 files changed, 120 insertions, 73 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 80c8ef2ec..42d92b859 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -668,12 +668,14 @@
         (|case [?var ?output-type]
           [(&/$VarT ?e-id) (&/$VarT ?a-id)]
           (if (= ?e-id ?a-id)
-            (|do [?output-type* (&type/deref ?e-id)]
-              (return (&&/|meta ?output-type* ?output-cursor ?output-term)))
-            (return (&&/|meta ?output-type ?output-cursor ?output-term)))
+            (|do [=output-type (&type/clean ?var ?output-type)]
+              (return (&&/|meta =output-type ?output-cursor ?output-term)))
+            (|do [=output-type (&type/clean ?var ?var)]
+              (return (&&/|meta =output-type ?output-cursor ?output-term))))
 
           [_ _]
-          (return (&&/|meta ?output-type ?output-cursor ?output-term)))
+          (|do [=output-type (&type/clean ?var ?output-type)]
+            (return (&&/|meta =output-type ?output-cursor ?output-term))))
         ))))
 
 (defn ^:private analyse-ast [eval! compile-module compile-token exo-type token]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index d431ddb9f..a2d6fd592 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -575,6 +575,28 @@
               (return (&/T [gvar-name ex]))))
           type-params))
 
+(defn ^:private double-register-gclass? [gclass]
+  (|case gclass
+    (&/$GenericClass name _)
+    (|case name
+      "long"   true
+      "double" true
+      _        false)
+
+    _
+    false))
+
+(defn ^:private method-input-folder [full-env]
+  (fn [body* input*]
+    (|do [:let [[iname itype*] input*]
+          itype (generic-class->type full-env itype*)]
+      (if (double-register-gclass? itype*)
+        (&&env/with-local iname itype
+          (&&env/with-local "" &/$VoidT
+            body*))
+        (&&env/with-local iname itype
+          body*)))))
+
 (defn ^:private analyse-method [analyse class-decl class-env all-supers method]
   "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))"
   (|let [[?cname ?cparams] class-decl
@@ -592,11 +614,7 @@
                                ?ctor-args)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (fn [body* input*]
-                                (|do [:let [[iname itype*] input*]
-                                      itype (generic-class->type full-env itype*)]
-                                  (&&env/with-local iname itype
-                                    body*)))
+                      (&/fold (method-input-folder full-env)
                               (&&/analyse-1 analyse output-type ?body)
                               (&/|reverse ?inputs))))]
         (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
@@ -607,11 +625,7 @@
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (fn [body* input*]
-                                (|do [:let [[iname itype*] input*]
-                                      itype (generic-class->type full-env itype*)]
-                                  (&&env/with-local iname itype
-                                    body*)))
+                      (&/fold (method-input-folder full-env)
                               (&&/analyse-1 analyse output-type ?body)
                               (&/|reverse ?inputs))))]
         (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
@@ -623,11 +637,7 @@
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (fn [body* input*]
-                                (|do [:let [[iname itype*] input*]
-                                      itype (generic-class->type full-env itype*)]
-                                  (&&env/with-local iname itype
-                                    body*)))
+                      (&/fold (method-input-folder full-env)
                               (&&/analyse-1 analyse output-type ?body)
                               (&/|reverse ?inputs))))]
         (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
@@ -637,11 +647,7 @@
             :let [full-env method-env]
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
-                    (&/fold (fn [body* input*]
-                              (|do [:let [[iname itype*] input*]
-                                    itype (generic-class->type full-env itype*)]
-                                (&&env/with-local iname itype
-                                  body*)))
+                    (&/fold (method-input-folder full-env)
                             (&&/analyse-1 analyse output-type ?body)
                             (&/|reverse ?inputs)))]
         (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 88fc2f4ee..4ffa7a9c2 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -339,8 +339,9 @@
                   (|do [? (&type/bound? ?id)
                         type** (if ?
                                  (&type/clean $var =output-t)
-                                 (|do [_ (&type/set-var ?id (&/$BoundT 1))]
-                                   (&type/clean $var =output-t)))]
+                                 (|do [_ (&type/set-var ?id (next-bound-type =output-t))]
+                                   (&type/clean $var =output-t)))
+                        _ (&type/clean $var exo-type)]
                     (return (&/T [type** ==args])))
                   ))))
 
@@ -385,7 +386,7 @@
                                                    (throw e))))))
                 module-name &/get-module-name
                 ;; :let [[r-prefix r-name] real-name
-                ;;       _ (when (or (= "jvm-import" r-name)
+                ;;       _ (when (or (= "get@" r-name)
                 ;;                   ;; (= "defclass" r-name)
                 ;;                   )
                 ;;           (->> (&/|map &/show-ast macro-expansion)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 4074efae7..56a59e31b 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -693,16 +693,9 @@
     (proxy [java.lang.ClassLoader]
       []
       (findClass [^String class-name]
-        ;; (prn 'findClass class-name)
         (if-let [^bytes bytecode (get @store class-name)]
-          (try (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
-            (catch java.lang.reflect.InvocationTargetException e
-              ;; (prn 'InvocationTargetException (.getCause e))
-              ;; (prn 'InvocationTargetException (.getTargetException e))
-              ;; (prn 'memory-class-loader/findClass class-name (get @store class-name))
-              (throw e)))
-          (do ;; (prn 'memory-class-loader/store class-name (keys @store))
-              (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))))
+          (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
+          (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
 
 ;; (deftype Host
 ;;   (& #writer         (^ org.objectweb.asm.ClassWriter)
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index acbe2e6b9..8ae2eb113 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -108,6 +108,8 @@
                           (let [real-name (second (re-find #"^(.*)\.class$" file-name))
                                 bytecode (read-file file)]
                             (swap! !classes assoc (str module* "." real-name) bytecode)))
+                      ;; (doseq [_class-name_ (keys @!classes)]
+                      ;;   (&&/load-class! loader _class-name_))
                       (let [defs (string/split (get-field &/defs-field module-meta) def-separator-re)
                             tag-groups (let [all-tags (get-field &/tags-field module-meta)]
                                          (if (= "" all-tags)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 88cb1ee6e..79658e6d5 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -193,9 +193,9 @@
                     (.visitLabel $end))]]
       (return nil)))
 
-  compile-jvm-leq Opcodes/LCMP  0 "java.lang.Long"   "longValue"   "()J"
-  compile-jvm-llt Opcodes/LCMP -1 "java.lang.Long"   "longValue"   "()J"
-  compile-jvm-lgt Opcodes/LCMP  1 "java.lang.Long"   "longValue"   "()J"
+  compile-jvm-leq Opcodes/LCMP   0 "java.lang.Long"   "longValue"   "()J"
+  compile-jvm-llt Opcodes/LCMP  -1 "java.lang.Long"   "longValue"   "()J"
+  compile-jvm-lgt Opcodes/LCMP   1 "java.lang.Long"   "longValue"   "()J"
 
   compile-jvm-feq Opcodes/FCMPG  0 "java.lang.Float"  "floatValue"  "()F"
   compile-jvm-flt Opcodes/FCMPG -1 "java.lang.Float"  "floatValue"  "()F"
@@ -203,7 +203,7 @@
   
   compile-jvm-deq Opcodes/DCMPG  0 "java.lang.Double" "doubleValue" "()D"
   compile-jvm-dlt Opcodes/DCMPG -1 "java.lang.Double" "doubleValue" "()D"
-  compile-jvm-dgt Opcodes/FCMPG  1 "java.lang.Double" "doubleValue" "()D"
+  compile-jvm-dgt Opcodes/DCMPG  1 "java.lang.Double" "doubleValue" "()D"
   )
 
 (defn compile-jvm-invokestatic [compile ?class ?method ?classes ?args ?output-type]
@@ -515,65 +515,66 @@
                       (.visitVarInsn Opcodes/ILOAD idx)
                       &&/wrap-boolean
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Boolean" (&/|list))))])))
       "byte"    (do (doto method-visitor
                       (.visitVarInsn Opcodes/ILOAD idx)
                       &&/wrap-byte
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Byte" (&/|list))))])))
       "short"   (do (doto method-visitor
                       (.visitVarInsn Opcodes/ILOAD idx)
                       &&/wrap-short
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Short" (&/|list))))])))
       "int"     (do (doto method-visitor
                       (.visitVarInsn Opcodes/ILOAD idx)
                       &&/wrap-int
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return Opcodes/INTEGER))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Integer" (&/|list))))])))
       "long"    (do (doto method-visitor
                       (.visitVarInsn Opcodes/LLOAD idx)
                       &&/wrap-long
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return Opcodes/LONG))
+                  (return (&/T [(+ 2 idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Long" (&/|list))) Opcodes/TOP)])))
       "float"   (do (doto method-visitor
                       (.visitVarInsn Opcodes/FLOAD idx)
                       &&/wrap-float
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return Opcodes/FLOAT))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Float" (&/|list))))])))
       "double"  (do (doto method-visitor
                       (.visitVarInsn Opcodes/DLOAD idx)
                       &&/wrap-double
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return Opcodes/DOUBLE))
+                  (return (&/T [(+ 2 idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Double" (&/|list))) Opcodes/TOP)])))
       "char"    (do (doto method-visitor
                       (.visitVarInsn Opcodes/ILOAD idx)
                       &&/wrap-char
                       (.visitVarInsn Opcodes/ASTORE idx))
-                  (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+                  (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass "java.lang.Character" (&/|list))))])))
       ;; else
-      (return (&host-generics/gclass->class-name (&/$GenericClass name params))))
+      (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name (&/$GenericClass name params)))])))
 
     [_ gclass]
-    (return (&host-generics/gclass->class-name gclass))
+    (return (&/T [(inc idx) (&/|list (&host-generics/gclass->class-name gclass))]))
     ))
 
 (defn ^:private prepare-method-inputs [idx inputs method-visitor]
   "(-> Int (List GenericClass) MethodVisitor (Lux (List FrameTag)))"
   (|case inputs
     (&/$Nil)
-    (return &/unit-tag)
+    (return &/$Nil)
     
     (&/$Cons input inputs*)
-    (let [!idx (atom idx)]
-      (&/map% (fn [input]
-                (|do [output (prepare-method-input @!idx input method-visitor)
-                      :let [_ (swap! !idx inc)]]
-                  (return output)))
-              inputs))
+    (|do [[_ outputs*] (&/fold% (fn [idx+outputs input]
+                                  (|do [:let [[_idx _outputs] idx+outputs]
+                                        [idx* output] (prepare-method-input _idx input method-visitor)]
+                                    (return (&/T [idx* (&/$Cons output _outputs)]))))
+                                (&/T [idx &/$Nil])
+                                inputs)]
+      (return (&/list-join (&/|reverse outputs*))))
     ))
 
-(defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
+(defn ^:private compile-method-def [compile ^ClassWriter class-writer bytecode-class-name ?super-class method-def]
   (|case method-def
     (&/$ConstructorMethodAnalysis ?privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
     (|let [?output (&/$GenericClass "void" (&/|list))
@@ -585,7 +586,7 @@
                                    init-method
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [[super-class-name super-class-params] ?super-class
                     init-types (->> ?ctor-args (&/|map (comp &host-generics/gclass->signature &/|first)) (&/fold str ""))
@@ -593,6 +594,7 @@
                     _ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
               =input-tags (prepare-method-inputs 1 ?inputs =method)
+              :let [_ (.visitFrame =method Opcodes/F_NEW (int (inc (&/|length =input-tags))) (to-array (&/->seq (&/$Cons Opcodes/UNINITIALIZED_THIS =input-tags))) (int 0) (to-array []))]
               :let [_ (.visitVarInsn =method Opcodes/ALOAD 0)]
               _ (->> ?ctor-args (&/|map &/|second) (&/map% compile))
               :let [_ (.visitMethodInsn =method Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method init-sig)]
@@ -613,11 +615,12 @@
                                    ?name
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
               =input-tags (prepare-method-inputs 1 ?inputs =method)
+              :let [_ (.visitFrame =method Opcodes/F_NEW (int (inc (&/|length =input-tags))) (to-array (&/->seq (&/$Cons bytecode-class-name =input-tags))) (int 0) (to-array []))]
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -634,11 +637,12 @@
                                    ?name
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
               =input-tags (prepare-method-inputs 1 ?inputs =method)
+              :let [_ (.visitFrame =method Opcodes/F_NEW (int (inc (&/|length =input-tags))) (to-array (&/->seq (&/$Cons bytecode-class-name =input-tags))) (int 0) (to-array []))]
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -656,11 +660,12 @@
                                    ?name
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitCode =method)]
               =input-tags (prepare-method-inputs 0 ?inputs =method)
+              :let [_ (.visitFrame =method Opcodes/F_NEW (int (&/|length =input-tags)) (to-array (&/->seq =input-tags)) (int 0) (to-array []))]
               _ (compile ?body)
               :let [_ (doto =method
                         (compile-method-return ?output)
@@ -677,7 +682,7 @@
                                    ?name
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitEnd =method)]]
@@ -692,7 +697,7 @@
                                    ?name
                                    simple-signature
                                    generic-signature
-                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+                                   (->> ?exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
         (|do [^MethodVisitor =method &/get-writer
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitEnd =method)]]
@@ -806,7 +811,7 @@
               _ (&/|map (partial compile-annotation =class) ?anns)
               _ (&/|map (partial compile-field =class)
                         ?fields)]
-        _ (&/map% (partial compile-method-def compile =class ?super-class) ?methods)
+        _ (&/map% (partial compile-method-def compile =class full-name ?super-class) ?methods)
         _ (|case ??ctor-args
             (&/$Some ctor-args)
             (add-anon-class-<init> =class compile full-name ?super-class env ctor-args)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index b09db681d..e9ebcc361 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -192,6 +192,24 @@
                  nil))
       (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))))))
 
+(defn reset-var [id type]
+  (fn [state]
+    (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
+      (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/$Some type) %)
+                                                          ts))
+                          state)
+               nil)
+      (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))))))
+
+(defn unset-var [id]
+  (fn [state]
+    (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
+      (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id &/$None %)
+                                                          ts))
+                          state)
+               nil)
+      (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))))))
+
 ;; [Exports]
 ;; Type vars
 (def ^:private create-var
@@ -256,7 +274,23 @@
         (if ?
           (deref ?id)
           (return type)))
-      (return type))
+      (|do [? (bound? ?id)]
+        (if ?
+          (|do [=type (deref ?id)
+                ==type (clean* ?tid =type)]
+            (|case ==type
+              (&/$VarT =id)
+              (if (.equals ^Object ?tid =id)
+                (|do [_ (unset-var ?id)]
+                  (return type))
+                (|do [_ (reset-var ?id ==type)]
+                  (return type)))
+
+              _
+              (|do [_ (reset-var ?id ==type)]
+                (return type))))
+          (return type)))
+      )
 
     (&/$DataT ?name ?params)
     (|do [=params (&/map% (partial clean* ?tid) ?params)]
@@ -714,17 +748,21 @@
         [_ (&/$UnivQ _)]
         (with-var
           (fn [$arg]
-            (|do [actual* (apply-type actual $arg)]
-              (check* class-loader fixpoints invariant?? expected actual*))))
+            (|do [actual* (apply-type actual $arg)
+                  =output (check* class-loader fixpoints invariant?? expected actual*)
+                  _ (clean $arg expected)]
+              (return =output))))
 
         [(&/$ExQ e!env e!def) _]
         (with-var
           (fn [$arg]
-            (|let [expected* (beta-reduce (->> e!env
-                                               (&/$Cons $arg)
-                                               (&/$Cons expected))
-                                          e!def)]
-              (check* class-loader fixpoints invariant?? expected* actual))))
+            (|do [:let [expected* (beta-reduce (->> e!env
+                                                    (&/$Cons $arg)
+                                                    (&/$Cons expected))
+                                               e!def)]
+                  =output (check* class-loader fixpoints invariant?? expected* actual)
+                  _ (clean $arg actual)]
+              (return =output))))
 
         [_ (&/$ExQ a!env a!def)]
         (|do [$arg existential]