- Changing tags so they're actually indices (part 4).

- Bug fixes and adjustments.

4 files changed, 73 insertions, 38 deletions

diff --git a/source/lux.lux b/source/lux.lux
index 04f9df811..22d49315b 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -2140,14 +2140,7 @@
       _
       ($ text:++ "(| "
          (|> cases
-             (map (: (-> (, Text Type) Text)
-                     (lambda [kv]
-                       (case kv
-                         [k (#TupleT #;Nil)]
-                         ($ text:++ "#" k)
-
-                         [k v]
-                         ($ text:++ "(#" k " " (type:show v) ")")))))
+             (map type:show)
              (interpose " ")
              (foldL text:++ ""))
          ")"))
@@ -2160,11 +2153,7 @@
       _
       ($ text:++ "(& "
          (|> fields
-             (map (: (-> (, Text Type) Text)
-                     (: (-> (, Text Type) Text)
-                        (lambda [kv]
-                          (let [[k v] kv]
-                            ($ text:++ "(#" k " " (type:show v) ")"))))))
+             (map type:show)
              (interpose " ")
              (foldL text:++ ""))
          ")"))
@@ -2192,18 +2181,10 @@
   (-> (List (, Text Type)) Type Type)
   (case type
     (#VariantT ?cases)
-    (#VariantT (map (: (-> (, Text Type) (, Text Type))
-                       (lambda [kv]
-                         (let [[k v] kv]
-                           [k (beta-reduce env v)])))
-                    ?cases))
+    (#VariantT (map (beta-reduce env) ?cases))
 
     (#RecordT ?fields)
-    (#RecordT (map (: (-> (, Text Type) (, Text Type))
-                      (lambda [kv]
-                        (let [[k v] kv]
-                          [k (beta-reduce env v)])))
-                   ?fields))
+    (#RecordT (map (beta-reduce env) ?fields))
 
     (#TupleT ?members)
     (#TupleT (map (beta-reduce env) ?members))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 34cbf8b48..148e2822a 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -223,13 +223,14 @@
             value-type* (adjust-type value-type)
             ;; :let [_ (println "#02")]
             idx (&module/tag-index =module =name)
+            group (&module/tag-group =module =name)
             ;; :let [_ (println "#03")]
             case-type (&type/variant-case idx value-type*)
             ;; :let [_ (println "#04")]
             [=test =kont] (analyse-pattern case-type unit kont)
             ;; :let [_ (println "#05")]
             ]
-        (return (&/T (&/V $VariantTestAC (&/T idx =test)) =kont)))
+        (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont)))
 
       (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident))
                          ?values))
@@ -239,6 +240,7 @@
             value-type* (adjust-type value-type)
             ;; :let [_ (println "#12" (&type/show-type value-type*))]
             idx (&module/tag-index =module =name)
+            group (&module/tag-group =module =name)
             ;; :let [_ (println "#13")]
             case-type (&type/variant-case idx value-type*)
             ;; :let [_ (println "#14" (&type/show-type case-type))]
@@ -249,7 +251,7 @@
                             (analyse-pattern case-type (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values))) kont))
             ;; :let [_ (println "#15")]
             ]
-        (return (&/T (&/V $VariantTestAC (&/T idx =test)) =kont)))
+        (return (&/T (&/V $VariantTestAC (&/T idx (&/|length group) =test)) =kont)))
       )))
 
 (defn ^:private analyse-branch [analyse exo-type value-type pattern body patterns]
@@ -311,21 +313,40 @@
             (return (&/V $TupleTotal (&/T total? structs))))
           (fail "[Pattern-matching Error] Inconsistent tuple-size."))
 
-        [($DefaultTotal total?) ($VariantTestAC ?tag ?test)]
+        [($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)]
         (|do [sub-struct (merge-total (&/V $DefaultTotal total?)
-                                      (&/T ?test ?body))]
-          (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct (&/|table))))))
-
-        [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?test)]
-        (|do [sub-struct (merge-total (or (&/|get ?tag ?branches)
-                                          (&/V $DefaultTotal total?))
-                                      (&/T ?test ?body))]
-          (return (&/V $VariantTotal (&/T total? (&/|put ?tag sub-struct ?branches)))))
+                                      (&/T ?test ?body))
+              structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count (&/V $DefaultTotal total?)))
+                        (&/$Some list)
+                        (return list)
+
+                        (&/$None)
+                        (fail "[Pattern-matching Error] YOLO"))]
+          (return (&/V $VariantTotal (&/T total? structs))))
+
+        [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)]
+        (|do [sub-struct (merge-total (|case (&/|at ?tag ?branches)
+                                        (&/$Some sub)
+                                        sub
+                                        
+                                        (&/$None)
+                                        (&/V $DefaultTotal total?))
+                                      (&/T ?test ?body))
+              structs (|case (&/|list-put ?tag sub-struct ?branches)
+                        (&/$Some list)
+                        (return list)
+
+                        (&/$None)
+                        (fail "[Pattern-matching Error] YOLO"))]
+          (return (&/V $VariantTotal (&/T total? structs))))
         ))))
 
 (defn ^:private check-totality [value-type struct]
   ;; (prn 'check-totality (&type/show-type value-type) (&/adt->text struct))
   (|case struct
+    ($DefaultTotal ?total)
+    (return ?total)
+
     ($BoolTotal ?total ?values)
     (return (or ?total
                 (= #{true false} (set (&/->seq ?values)))))
@@ -369,6 +390,9 @@
         (|case value-type*
           (&/$VariantT ?members)
           (|do [totals (&/map2% (fn [sub-struct ?member]
+                                  ;; (prn '$VariantTotal
+                                  ;;      (&/adt->text sub-struct)
+                                  ;;      (&type/show-type ?member))
                                   (check-totality ?member sub-struct))
                                 ?structs ?members)]
             (return (&/fold #(and %1 %2) true totals)))
@@ -376,9 +400,6 @@
           _
           (fail "[Pattern-maching Error] Variant is not total."))))
     
-    ($DefaultTotal ?total)
-    (return ?total)
-
     ;; _
     ;; (assert false (prn-str 'check-totality (&type/show-type value-type)
     ;;                        (&/adt->text struct)))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index b8b7118f4..89620ce97 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -116,6 +116,13 @@
 (defn R [& kvs]
   (to-array kvs))
 
+;; Constructors
+(def None$ (V $None nil))
+(defn Some$ [x] (V $Some x))
+
+(def Nil$ (V $Nil nil))
+(defn Cons$ [h t] (V $Cons (T h t)))
+
 (defn get$ [slot ^objects record]
   (aget record slot))
 
@@ -894,3 +901,29 @@
          [ymodule yname] y]
     (and (= xmodule ymodule)
          (= xname yname))))
+
+;; (defn |list-put [idx val xs]
+;;   (|case [idx xs]
+;;     [_ ($Nil)]
+;;     (V $None nil)
+    
+;;     [0 ($Cons x xs*)]
+;;     (V $Some (V $Cons (T val xs*)))
+    
+;;     [_ ($Cons x xs*)]
+;;     (|case (|list-put idx val xs*)
+;;       ($None)      (V $None nil)
+;;       ($Some xs**) (V $Some (V $Cons (T x xs**))))))
+
+(defn |list-put [idx val xs]
+  (|case xs
+    ($Nil)
+    (V $None nil)
+    
+    ($Cons x xs*)
+    (if (= idx 0)
+      (V $Some (V $Cons (T val xs*)))
+      (|case (|list-put (dec idx) val xs*)
+        ($None)      (V $None nil)
+        ($Some xs**) (V $Some (V $Cons (T x xs**))))
+      )))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 4d8ac2190..dd3258059 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -102,7 +102,7 @@
         (.visitInsn Opcodes/POP)
         (.visitJumpInsn Opcodes/GOTO $target))
 
-      (&a-case/$VariantTestAC ?tag ?test)
+      (&a-case/$VariantTestAC ?tag ?count ?test)
       (doto writer
         (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
         (.visitInsn Opcodes/DUP)