- Now using the new utility methods in LuxUtils for working with variants/sums.

14 files changed, 123 insertions, 65 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index f143e2a12..e261420c3 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -21,19 +21,21 @@
 ;; [Utils]
 (defn analyse-variant+ [analyser exo-type ident values]
   (|do [[module tag-name] (&/normalize ident)
-        idx (&&module/tag-index module tag-name)]
+        idx (&&module/tag-index module tag-name)
+        group (&&module/tag-group module tag-name)
+        :let [is-last? (= idx (dec (&/|length group)))]]
     (|case exo-type
       (&/$VarT id)
       (|do [? (&type/bound? id)]
         (if (or ? (&&/type-tag? module tag-name))
-          (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+          (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx is-last? values)
           (|do [wanted-type (&&module/tag-type module tag-name)
-                [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx values))
+                [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx is-last? values))
                 _ (&type/check exo-type variant-type)]
             (return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
 
       _
-      (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+      (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx is-last? values)
       )))
 
 (defn ^:private add-loc [meta ^String msg]
@@ -661,7 +663,7 @@
       (&/with-expected-type exo-type
         (|case token
           [meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))]
-          (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx ?values)
+          (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx nil ?values)
 
           [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))]
           (analyse-variant+ (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 86e73723d..24a67be87 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -341,7 +341,7 @@
         _ (&type/check exo-type output-type)
         _cursor &/cursor]
     (return (&/|list (&&/|meta output-type _cursor
-                               (&/V &&/$jvm-null nil))))))
+                               (&/V &&/$jvm-null &/unit-tag))))))
 
 (defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
   (|case gtype-vars
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 68e329af2..7adc32b22 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -158,7 +158,7 @@
       _
       (fail "[Analyser Error] Can't expand to other than 1 element."))))
 
-(defn analyse-variant [analyse ?exo-type idx ?values]
+(defn analyse-variant [analyse ?exo-type idx is-last? ?values]
   (|case ?exo-type
     (&/$Left exo-type)
     (|do [exo-type* (&type/actual-type exo-type)]
@@ -167,7 +167,7 @@
         (&type/with-var
           (fn [$var]
             (|do [exo-type** (&type/apply-type exo-type* $var)
-                  [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx ?values))
+                  [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx is-last? ?values))
                   =var (&type/resolve-type $var)
                   inferred-type (|case =var
                                   (&/$VarT iid)
@@ -182,7 +182,7 @@
                                          variant-analysis))))))
 
         _
-        (analyse-variant analyse (&/V &/$Right exo-type*) idx ?values)))
+        (analyse-variant analyse (&/V &/$Right exo-type*) idx is-last? ?values)))
 
     (&/$Right exo-type)
     (|do [exo-type* (|case exo-type
@@ -198,6 +198,9 @@
         (|case exo-type*
           (&/$SumT _)
           (|do [vtype (&type/sum-at idx exo-type*)
+                :let [is-last?* (if (nil? is-last?)
+                                  (= idx (dec (&/|length (&type/flatten-sum exo-type*))))
+                                  is-last?)]
                 =value (&/with-attempt
                          (analyse-variant-body analyse vtype ?values)
                          (fn [err]
@@ -208,23 +211,23 @@
                                              _
                                              (return exo-type))]
                              (fail (str err "\n"
-                                        'analyse-variant " " idx " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
+                                        'analyse-variant " " idx " " is-last? " " is-last?* " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
                                         " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
                 _cursor &/cursor]
             (return (&/|list (&&/|meta exo-type _cursor
-                                       (&/V &&/$variant (&/T [idx =value]))
+                                       (&/V &&/$variant (&/T [idx is-last?* =value]))
                                        ))))
 
           (&/$UnivQ _)
           (|do [$var &type/existential
                 exo-type** (&type/apply-type exo-type* $var)]
-            (analyse-variant analyse (&/V &/$Right exo-type**) idx ?values))
+            (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values))
 
           (&/$ExQ _)
           (&type/with-var
             (fn [$var]
               (|do [exo-type** (&type/apply-type exo-type* $var)]
-                (analyse-variant analyse (&/V &/$Right exo-type**) idx ?values))))
+                (analyse-variant analyse (&/V &/$Right exo-type**) idx is-last? ?values))))
           
           _
           (fail (str "[Analyser Error] Can't create variant if the expected type is " (&type/show-type exo-type*))))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 611d65a83..f30b73692 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -38,7 +38,7 @@
 (defn parse-gclass [ast]
   (|case ast
     [_ (&/$TextS "*")]
-    (return (&/V &/$GenericWildcard nil))
+    (return (&/V &/$GenericWildcard &/unit-tag))
 
     [_ (&/$TextS var-name)]
     (return (&/V &/$GenericTypeVar var-name))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index d74b02402..044f22df6 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -144,13 +144,14 @@
 (def tags-field "_tags")
 (def module-class-name "_")
 (def +name-separator+ ";")
+(def unit-tag (.intern (str (char 0) "unit" (char 0))))
 (def sum-tag (.intern (str (char 0) "sum" (char 0))))
 (def product-tag (.intern (str (char 0) "product" (char 0))))
 
 (defn T [elems]
   (case (count elems)
     0
-    nil
+    unit-tag
 
     1
     (first elems)
@@ -159,13 +160,13 @@
     (to-array (conj elems product-tag))))
 
 (defn V [^Long tag value]
-  (to-array [sum-tag tag value]))
+  (to-array [sum-tag (int tag) false value]))
 
 ;; Constructors
-(def None$ (V $None nil))
+(def None$ (V $None unit-tag))
 (defn Some$ [x] (V $Some x))
 
-(def Nil$ (V $Nil nil))
+(def Nil$ (V $Nil unit-tag))
 (defn Cons$ [h t] (V $Cons (T [h t])))
 
 (def empty-cursor (T ["" -1 -1]))
@@ -191,21 +192,17 @@
 (defn transform-pattern [pattern]
   (cond (vector? pattern) (case (count pattern)
                             0
-                            nil
+                            unit-tag
 
                             1
-                            (first pattern)
+                            (transform-pattern (first pattern))
 
                             ;; else
                             (conj (mapv transform-pattern pattern) '_))
-        (seq? pattern) (let [parts (mapv transform-pattern (rest pattern))]
-                         ['_
-                          (eval (first pattern))
-                          (case (count parts)
-                            0 nil
-                            1 (first parts)
-                            ;; else
-                            (conj parts '_))])
+        (seq? pattern) ['_
+                        (eval (first pattern))
+                        '_
+                        (transform-pattern (vec (rest pattern)))]
         :else pattern
         ))
 
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 8d748df53..31e0ca3a2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -79,8 +79,8 @@
         (&o/$apply ?fn ?args)
         (&&lux/compile-apply compile-expression ?fn ?args)
 
-        (&o/$variant ?tag ?members)
-        (&&lux/compile-variant compile-expression ?tag ?members)
+        (&o/$variant ?tag ?tail ?members)
+        (&&lux/compile-variant compile-expression ?tag ?tail ?members)
 
         (&o/$case ?value ?match)
         (&&case/compile-case compile-expression ?value ?match)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 6ad21aef7..b046b237f 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -31,6 +31,7 @@
 (def ^String output-package (str output-dir "/" "program.jar"))
 (def ^String function-class "lux/Function")
 (def ^String lux-utils-class "lux/LuxUtils")
+(def ^String unit-tag-field "unit_tag")
 (def ^String sum-tag-field "sum_tag")
 (def ^String product-tag-field "product_tag")
 
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 314e7a6d3..1b0e023eb 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -23,6 +23,7 @@
 
 ;; [Utils]
 (defn ^:private compile-match [^MethodVisitor writer ?match $target $else]
+  "(-> [MethodVisitor CaseAnalysis Label Label] Unit)"
   (|case ?match
     (&a-case/$StoreTestAC ?idx)
     (if (< ?idx 0)
@@ -115,27 +116,27 @@
           (.visitJumpInsn Opcodes/GOTO $target))))
 
     (&a-case/$VariantTestAC ?tag ?count ?test)
-    (doto writer
-      (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
-      (.visitInsn Opcodes/DUP)
-      (.visitLdcInsn (int 1))
-      (.visitInsn Opcodes/AALOAD)
-      (.visitLdcInsn ?tag)
-      (&&/wrap-long)
-      (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
-      (.visitJumpInsn Opcodes/IFEQ $else)
-      (.visitInsn Opcodes/DUP)
-      (.visitLdcInsn (int 2))
-      (.visitInsn Opcodes/AALOAD)
-      (-> (doto (compile-match ?test $value-then $value-else)
-            (.visitLabel $value-then)
-            (.visitInsn Opcodes/POP)
-            (.visitJumpInsn Opcodes/GOTO $target)
-            (.visitLabel $value-else)
-            (.visitInsn Opcodes/POP)
-            (.visitJumpInsn Opcodes/GOTO $else))
-          (->> (let [$value-then (new Label)
-                     $value-else (new Label)]))))
+    (let [$variant-else (new Label)]
+      (doto writer
+        (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+        (.visitInsn Opcodes/DUP)
+        (.visitLdcInsn (int ?tag))
+        (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;")
+        (.visitInsn Opcodes/DUP)
+        (.visitInsn Opcodes/ACONST_NULL)
+        (.visitJumpInsn Opcodes/IF_ACMPEQ $variant-else)
+        (-> (doto (compile-match ?test $value-then $value-else)
+              (.visitLabel $value-then)
+              (.visitInsn Opcodes/POP)
+              (.visitJumpInsn Opcodes/GOTO $target)
+              (.visitLabel $value-else)
+              (.visitInsn Opcodes/POP)
+              (.visitJumpInsn Opcodes/GOTO $else))
+            (->> (let [$value-then (new Label)
+                       $value-else (new Label)])))
+        (.visitLabel $variant-else)
+        (.visitInsn Opcodes/POP)
+        (.visitJumpInsn Opcodes/GOTO $else)))
     ))
 
 (defn ^:private separate-bodies [patterns]
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index f4e7ab740..e7982a8ca 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -699,6 +699,8 @@
               =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                        (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
                                full-name nil super-class (into-array String [])))
+              =unit-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/unit-tag-field tag-sig nil &/unit-tag)
+                          (.visitEnd))
               =sum-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/sum-tag-field tag-sig nil &/sum-tag)
                          (.visitEnd))
               =product-tag (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) &&/product-tag-field tag-sig nil &/product-tag)
@@ -768,7 +770,55 @@
                                            (.visitInsn Opcodes/AALOAD) ;; elem
                                            (.visitInsn Opcodes/ARETURN)
                                            (.visitMaxs 0 0)
-                                           (.visitEnd)))]]
+                                           (.visitEnd)))
+              =sum-get-method (let [$begin (new Label)
+                                    $then (new Label)
+                                    $further (new Label)
+                                    $not-right (new Label)]
+                                (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
+                                  (.visitCode)
+                                  (.visitLabel $begin)
+                                  (.visitVarInsn Opcodes/ILOAD 1) ;; tag
+                                  (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum
+                                  (.visitLdcInsn (int 1)) ;; tag, sum, sum-tag-idx
+                                  (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag'
+                                  &&/unwrap-int ;; tag, sum-tag
+                                  (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
+                                  (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; tag, sum-tag
+                                  (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
+                                  (.visitJumpInsn Opcodes/IF_ICMPGT $further) ;; tag, sum-tag
+                                  (.visitInsn Opcodes/POP2)
+                                  (.visitInsn Opcodes/ACONST_NULL)
+                                  (.visitInsn Opcodes/ARETURN)
+                                  (.visitLabel $then) ;; tag, sum-tag
+                                  (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+                                  (.visitInsn Opcodes/POP2)
+                                  (.visitVarInsn Opcodes/ALOAD 0)
+                                  (.visitLdcInsn (int 3))
+                                  (.visitInsn Opcodes/AALOAD)
+                                  (.visitInsn Opcodes/ARETURN)
+                                  (.visitLabel $further) ;; tag, sum-tag
+                                  (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+                                  (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum-tag, sum
+                                  (.visitLdcInsn (int 2)) ;; tag, sum-tag, sum, last-index?
+                                  (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, last?'
+                                  &&/unwrap-boolean ;; tag, sum-tag, last?
+                                  (.visitJumpInsn Opcodes/IFEQ $not-right) ;; tag, sum-tag
+                                  (.visitInsn Opcodes/ISUB) ;; sub-tag
+                                  (.visitVarInsn Opcodes/ALOAD 0) ;; sub-tag, sum
+                                  (.visitLdcInsn (int 3)) ;; sub-tag, sum, sub-sum-idx
+                                  (.visitInsn Opcodes/AALOAD) ;; sub-tag, sub-sum
+                                  (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+                                  (.visitVarInsn Opcodes/ASTORE 0) ;; sub-tag
+                                  (.visitVarInsn Opcodes/ISTORE 1) ;;
+                                  (.visitJumpInsn Opcodes/GOTO $begin)
+                                  (.visitLabel $not-right) ;; tag, sum-tag
+                                  (.visitFrame Opcodes/F_NEW (int 2) (to-array ["[Ljava/lang/Object;" Opcodes/INTEGER]) (int 2) (to-array [Opcodes/INTEGER Opcodes/INTEGER]))
+                                  (.visitInsn Opcodes/POP2)
+                                  (.visitInsn Opcodes/ACONST_NULL)
+                                  (.visitInsn Opcodes/ARETURN)
+                                  (.visitMaxs 0 0)
+                                  (.visitEnd)))]]
     (&&/save-class! (second (string/split &&/lux-utils-class #"/"))
                     (.toByteArray (doto =class .visitEnd)))))
 
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 31f2fdb8c..3c09f6362 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -58,7 +58,7 @@
         :let [num-elems (&/|length ?elems)]]
     (|case num-elems
       0
-      (|do [:let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
+      (|do [:let [_ (.visitLdcInsn *writer* &/unit-tag)]]
         (return nil))
 
       1
@@ -83,10 +83,10 @@
                       (.visitInsn Opcodes/AASTORE))]]
         (return nil)))))
 
-(defn compile-variant [compile ?tag ?value]
+(defn compile-variant [compile ?tag tail? ?value]
   (|do [^MethodVisitor *writer* &/get-writer
         :let [_ (doto *writer*
-                  (.visitLdcInsn (int 3))
+                  (.visitLdcInsn (int 4))
                   (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
                   (.visitInsn Opcodes/DUP)
                   (.visitLdcInsn (int 0))
@@ -94,11 +94,15 @@
                   (.visitInsn Opcodes/AASTORE)
                   (.visitInsn Opcodes/DUP)
                   (.visitLdcInsn (int 1))
-                  (.visitLdcInsn ?tag)
-                  (&&/wrap-long)
+                  (.visitLdcInsn (int ?tag))
+                  (&&/wrap-int)
                   (.visitInsn Opcodes/AASTORE)
                   (.visitInsn Opcodes/DUP)
-                  (.visitLdcInsn (int 2)))]
+                  (.visitLdcInsn (int 2))
+                  (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Boolean" (if tail? "TRUE" "FALSE") "Ljava/lang/Boolean;")
+                  (.visitInsn Opcodes/AASTORE)
+                  (.visitInsn Opcodes/DUP)
+                  (.visitLdcInsn (int 3)))]
         _ (compile ?value)
         :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
     (return nil)))
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 1bfca2c1f..8a63aaa17 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -13,9 +13,9 @@
 
 ;; [Utils]
 (defn ^:private variant$ [tag body]
-  "(-> Text Analysis Analysis)"
+  "(-> Int Analysis Analysis)"
   (&a/|meta &type/$Void &/empty-cursor
-            (&/V &a/$variant (&/T [tag body]))))
+            (&/V &a/$variant (&/T [tag false body]))))
 
 (defn ^:private tuple$ [members]
   "(-> (List Analysis) Analysis)"
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index b6de8091b..59f49d6a1 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -172,7 +172,7 @@
 (do-template [<name> <text> <tag>]
   (def <name>
     (|do [[meta _] (&reader/read-text <text>)]
-      (return (&/T [meta (&/V <tag> nil)]))))
+      (return (&/T [meta (&/V <tag> &/unit-tag)]))))
 
   ^:private lex-open-paren    "(" $Open_Paren
   ^:private lex-close-paren   ")" $Close_Paren
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 33c012806..cae91e588 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -47,8 +47,8 @@
 (defn Named$ [name type]
   (&/V &/$NamedT (&/T [name type])))
 
-(def $Void (&/V &/$VoidT nil))
-(def Unit (&/V &/$UnitT nil))
+(def $Void (&/V &/$VoidT &/unit-tag))
+(def Unit (&/V &/$UnitT &/unit-tag))
 (def Bool (Named$ (&/T ["lux" "Bool"]) (Data$ "java.lang.Boolean" &/Nil$)))
 (def Int (Named$ (&/T ["lux" "Int"]) (Data$ "java.lang.Long" &/Nil$)))
 (def Real (Named$ (&/T ["lux" "Real"]) (Data$ "java.lang.Double" &/Nil$)))
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index b06895945..ae225db1f 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -64,7 +64,7 @@
 
 ;; [Exports]
 (let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"
-      Unit (&/V &/$UnitT nil)
+      Unit (&/V &/$UnitT &/unit-tag)
       jprim->lprim (fn [prim]
                      (case prim
                        "Z" "boolean"
@@ -272,4 +272,4 @@
         (instance? WildcardType gtype)
         (if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)]
           (gtype->gclass bound)
-          (&/V &/$GenericWildcard nil))))
+          (&/V &/$GenericWildcard &/unit-tag))))