- Implemented pattern-matching for records.

- Added some code to allow variant creation with existential types. (NOTE: Check if it's actually valid)
- Modify var cleanup to leave the var as-is if it has been deleted. (NOTE: Need to find out why a variable is left prior to being deleted)

4 files changed, 111 insertions, 44 deletions

diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 0c459f0de..8fa2bbaff 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -72,22 +72,31 @@
           [_]
           (fail "[Analyser Error] Tuple requires tuple-type."))
 
-        [["lux;Record" ?fields]]
-        (&type/with-vars (&/|length ?fields)
-          (fn [=vars]
-            (|do [_ (&type/check value-type (&/V "lux;RecordT" (&/zip2 (&/|keys ?fields) =vars)))
-                  [=tests =kont] (&/fold (fn [kont* vm]
-                                           (|let [[v [k m]] vm]
-                                             (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)]
-                                               (matchv ::M/objects [=kont]
-                                                 [["Expression" [?val ?type]]]
-                                                 (|do [=type (&type/clean v ?type)]
-                                                   (return (&/T (&/|put k =test =tests)
-                                                                (&/V "Expression" (&/T ?val =type)))))))))
-                                         (|do [=kont kont]
-                                           (return (&/T (&/|table) =kont)))
-                                         (&/|reverse (&/zip2 =vars ?fields)))]
-              (return (&/T (&/V "RecordTestAC" =tests) =kont)))))
+        [["lux;Record" ?slots]]
+        (|do [value-type* (resolve-type value-type)]
+          (matchv ::M/objects [value-type*]
+            [["lux;RecordT" ?slot-types]]
+            (if (not (= (&/|length ?slot-types) (&/|length ?slots)))
+              (fail (str "[Analyser error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]"))
+              (|do [[=tests =kont] (&/fold (fn [kont* slot]
+                                             (|let [[sn sv] slot]
+                                               (matchv ::M/objects [sn]
+                                                 [["lux;Meta" [_ ["lux;Tag" ?ident]]]]
+                                                 (|do [=tag (&&/resolved-ident ?ident)]
+                                                   (if-let [=slot-type (&/|get =tag ?slot-types)]
+                                                     (|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)]
+                                                       (return (&/T (&/|put =tag =test =tests) =kont)))
+                                                     (fail (str "[Pattern-Matching Error] Record-type lacks slot: " =tag))))
+
+                                                 [_]
+                                                 (fail (str "[Pattern-Matching Error] Record must use tags as slot-names: " (&/show-ast sn))))))
+                                           (|do [=kont kont]
+                                             (return (&/T (&/|table) =kont)))
+                                           (&/|reverse ?slots))]
+                (return (&/T (&/V "RecordTestAC" =tests) =kont))))
+
+            [_]
+            (fail "[Analyser Error] Record requires record-type.")))
 
         [["lux;Tag" ?ident]]
         (|do [=tag (&&/resolved-ident ?ident)
@@ -172,21 +181,27 @@
         [["DefaultTotal" total?] ["RecordTestAC" ?tests]]
         (|do [structs (&/map% (fn [t]
                                 (|let [[slot value] t]
-                                  (|do [struct (merge-total (&/V "DefaultTotal" total?) (&/T value ?body))]
-                                    (return (&/T slot struct)))))
-                              (sort compare-kv ?tests))]
+                                  (|do [struct* (merge-total (&/V "DefaultTotal" total?) (&/T value ?body))]
+                                    (return (&/T slot struct*)))))
+                              (->> ?tests
+                                   &/->seq
+                                   (sort compare-kv)
+                                   &/->list))]
           (return (&/V "RecordTotal" (&/T total? structs))))
 
         [["RecordTotal" [total? ?values]] ["RecordTestAC" ?tests]]
         (if (= (&/|length ?values) (&/|length ?tests))
           (|do [structs (&/map% (fn [lr]
-                                  (|let [[[lslot struct] [rslot value]] lr]
+                                  (|let [[[lslot sub-struct] [rslot value]] lr]
                                     (if (= lslot rslot)
-                                      (|do [struct (merge-total (&/V "DefaultTotal" total?) (&/T value ?body))]
-                                        (return (&/T lslot struct)))
+                                      (|do [sub-struct* (merge-total sub-struct (&/T value ?body))]
+                                        (return (&/T lslot sub-struct*)))
                                       (fail "[Pattern-matching error] Record slots mismatch."))))
                                 (&/zip2 ?values
-                                        (sort compare-kv ?tests)))]
+                                        (->> ?tests
+                                             &/->seq
+                                             (sort compare-kv)
+                                             &/->list)))]
             (return (&/V "RecordTotal" (&/T total? structs))))
           (fail "[Pattern-matching error] Inconsistent record-size."))
 
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 87db5a125..b9a3ffbf2 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -53,20 +53,26 @@
 
                     [_]
                     (&type/actual-type exo-type))
-        ?tag (&&/resolved-ident ident)
         ;; :let [_ (prn 'analyse-variant/exo-type* (&type/show-type exo-type*))]
         ]
     (matchv ::M/objects [exo-type*]
       [["lux;VariantT" ?cases]]
-      (if-let [vtype (&/|get ?tag ?cases)]
-        (|do [;; :let [_ (prn 'VARIANT_BODY ?tag (&/show-ast ?value) (&type/show-type vtype))]
-              =value (&&/analyse-1 analyse vtype ?value)
-              ;; :let [_ (prn 'GOT_VALUE =value)]
-              ]
-          (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value))
-                                                  exo-type)))))
-        (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*))))
-
+      (|do [?tag (&&/resolved-ident ident)]
+        (if-let [vtype (&/|get ?tag ?cases)]
+          (|do [;; :let [_ (prn 'VARIANT_BODY ?tag (&/show-ast ?value) (&type/show-type vtype))]
+                =value (&&/analyse-1 analyse vtype ?value)
+                ;; :let [_ (prn 'GOT_VALUE =value)]
+                ]
+            (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value))
+                                                    exo-type)))))
+          (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
+
+      [["lux;AllT" _]]
+      (&type/with-var
+        (fn [$var]
+          (|do [exo-type** (&type/apply-type exo-type* $var)]
+            (analyse-variant analyse exo-type** ident ?value))))
+      
       [_]
       (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
 
@@ -291,7 +297,7 @@
     [_]
     (fail (str "[Analyser Error] Functions require function types: "
                ;; (str (aget ?self 0) ";" (aget ?self 1))
-               ;; (str (aget ?arg 0) ";" (aget ?arg 1))
+               ;; (str( aget ?arg 0) ";" (aget ?arg 1))
                ;; (&/show-ast ?body)
                (&type/show-type exo-type)))))
 
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 2f051903b..4e33bd7b1 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -18,7 +18,8 @@
 ;; [Utils]
 (let [+tag-sig+ (&host/->type-signature "java.lang.String")
       +oclass+ (&host/->class "java.lang.Object")
-      +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")]
+      +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")
+      compare-kv #(compare (aget %1 0) (aget %2 0))]
   (defn ^:private compile-match [writer ?match $target $else]
     ;; (prn 'compile-match (aget ?match 0) $target $else)
     (matchv ::M/objects [?match]
@@ -95,6 +96,28 @@
                  (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?members)) ?members))])))
         (.visitInsn Opcodes/POP)
         (.visitJumpInsn Opcodes/GOTO $target))
+
+      [["RecordTestAC" ?slots]]
+      (doto writer
+        (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+        (-> (doto (.visitInsn Opcodes/DUP)
+              (.visitLdcInsn (int idx))
+              (.visitInsn Opcodes/AALOAD)
+              (compile-match test $next $sub-else)
+              (.visitLabel $sub-else)
+              (.visitInsn Opcodes/POP)
+              (.visitJumpInsn Opcodes/GOTO $else)
+              (.visitLabel $next))
+            (->> (|let [[idx [_ test]] idx+member
+                        $next (new Label)
+                        $sub-else (new Label)])
+                 (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?slots))
+                                                     (->> ?slots
+                                                          &/->seq
+                                                          (sort compare-kv)
+                                                          &/->list)))])))
+        (.visitInsn Opcodes/POP)
+        (.visitJumpInsn Opcodes/GOTO $target))
       
       [["VariantTestAC" [?tag ?test]]]
       (doto writer
diff --git a/src/lux/type.clj b/src/lux/type.clj
index b1b77d5ab..e5c96d7bd 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -235,7 +235,8 @@
   (matchv ::M/objects [type]
     [["lux;VarT" ?id]]
     (if (= ?tid ?id)
-      (deref ?id)
+      (&/try-all% (&/|list (deref ?id)
+                           (return type)))
       (return type))
     
     [["lux;LambdaT" [?arg ?return]]]
@@ -573,16 +574,32 @@
     ;; (|do [_ (check* fixpoints F1 F2)
     ;;       _ (check* fixpoints A1 A2)]
     ;;   (return (&/T fixpoints nil)))
-
-    [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
-    (|do [[fixpoints _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
-          [fixpoints _] (check* fixpoints A1 A2)]
+    [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
+    (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
+          _ (check* fixpoints A1 A2)]
       (return (&/T fixpoints nil)))
-
+    
+    ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+    ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+    ;;       [fixpoints** _] (check* fixpoints* A1 A2)]
+    ;;   (return (&/T fixpoints** nil)))
+    [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+    (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2)
+          e* (apply-type F2 A1)
+          a* (apply-type F2 A2)
+          [fixpoints** _] (check* fixpoints* e* a*)]
+      (return (&/T fixpoints** nil)))
+
+    ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
+    ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+    ;;       [fixpoints** _] (check* fixpoints* A1 A2)]
+    ;;   (return (&/T fixpoints** nil)))
     [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
-    (|do [[fixpoints _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
-          [fixpoints _] (check* fixpoints A1 A2)]
-      (return (&/T fixpoints nil)))
+    (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id))
+          e* (apply-type F1 A1)
+          a* (apply-type F1 A2)
+          [fixpoints** _] (check* fixpoints* e* a*)]
+      (return (&/T fixpoints** nil)))
 
     [["lux;AppT" [F A]] _]
     (let [fp-pair (&/T expected actual)
@@ -734,6 +751,12 @@
     (|do [type* (apply-type ?all ?param)]
       (actual-type type*))
 
+    ;; [["lux;AllT" [?env ?self ?arg ?body]]]
+    ;; (with-var
+    ;;   (fn [$var]
+    ;;     (|do [type* (apply-type type $var)]
+    ;;       (actual-type type*))))
+
     [_]
     (return type)
     ))