- 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)

5 files changed, 134 insertions, 105 deletions

diff --git a/source/lux.lux b/source/lux.lux
index e9b4484c5..32fde1d8a 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -752,10 +752,6 @@
          #Nil
          ys))
 
-## (: (All [a b]
-##      (-> (-> a b) (List a) (List b)))
-##    map)
-
 (def (splice untemplate tag elems)
   (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
   (case' (any? spliced? elems)
@@ -779,29 +775,6 @@
          false
          (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
 
-## (def (splice untemplate tag elems)
-##   (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
-##   (case' (any? spliced? elems)
-##          true
-##          (let [elems' (map (:' (->' Syntax Syntax)
-##                                (lambda [elem]
-##                                  (case' elem
-##                                         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))])
-##                                         spliced
-
-##                                         _
-##                                         ($form (list ($symbol ["" ":'"])
-##                                                      ($symbol ["lux" "SyntaxList"])
-##                                                      ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))))
-##                            elems)]
-##            (wrap-meta ($form (list tag
-##                                    ($form (list& ($symbol ["lux" "$"])
-##                                                  ($symbol ["lux" "list:++"])
-##                                                  elems'))))))
-
-##          false
-##          (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
-
 (def (untemplate token)
   (->' Syntax Syntax)
   (case' token
@@ -939,18 +912,6 @@
   (return (:' SyntaxList
               (list (` (#TupleT (list (~@ tokens))))))))
 
-## (: (All [a b]
-##      (-> (-> a b a) a (List b) a))
-##    fold)
-
-## (: (All [a]
-##      (-> (List a) (List a)))
-##    reverse)
-
-## (: (All [a]
-##      (-> (List a) (List (, a a))))
-##    as-pairs)
-
 (defmacro (do tokens)
   (case' tokens
          (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
@@ -979,33 +940,39 @@
             (-> (B' a) ($' (B' m) (B' b)))
             ($' List (B' a))
             ($' (B' m) ($' List (B' b)))))
-  (let [{#;return ;return #;bind ;bind} m]
+  (let [{#;return ;return #;bind _} m]
     (case' xs
            #Nil
-           (;return #Nil)
+           (;return (:' List #Nil))
            
            (#Cons [x xs'])
            (do m
              [y (f x)
               ys (map% m f xs')]
-             (;return (#Cons [y ys])))
+             (;return (:' List (#Cons [y ys]))))
            )))
 
+(def (ident->text ident)
+  (-> Ident Text)
+  (let [[module name] ident]
+    ($ text:++ module ";" name)))
+
 (defmacro #export (| tokens)
   (do Lux:Monad
     [pairs (map% Lux:Monad
-                 (lambda [token]
-                   (case' token
-                          (#Tag ident)
-                          (;return (` [(~ ($text (ident->text ident))) (,)]))
-
-                          (#Form (#Cons [(#Tag ident) (#Cons [value #Nil])]))
-                          (;return (` [(~ ($text (ident->text ident))) (~ value)]))
-                          
-                          _
-                          (fail "Wrong syntax for |")))
+                 (:' (-> Syntax ($' Lux Syntax))
+                     (lambda [token]
+                       (case' token
+                              (#Meta [_ (#Tag ident)])
+                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (,)])))
+
+                              (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
+                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)])))
+                              
+                              _
+                              (fail "Wrong syntax for |"))))
                  tokens)]
-    (` (#VariantT (list (~@ pairs))))))
+    (;return (:' SyntaxList (list (` (#VariantT (list (~@ pairs)))))))))
 
 (defmacro #export (& tokens)
   (if (not (int:= 2 (length tokens)))
@@ -1014,13 +981,13 @@
       [pairs (map% Lux:Monad
                    (lambda [pair]
                      (case' pair
-                            [(#Tag ident) value]
-                            (;return (` [(~ ($text (ident->text ident))) (~ value)]))
+                            [(#Meta [_ (#Tag ident)]) value]
+                            (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)])))
                             
                             _
                             (fail "Wrong syntax for &")))
                    (as-pairs tokens))]
-      (` (#RecordT (list (~@ pairs)))))))
+      (;return (:' SyntaxList (list (` (#RecordT (list (~@ pairs))))))))))
 
 ## (defmacro #export (All tokens)
 ##   (case' (:' (, Ident SyntaxList)
@@ -1061,11 +1028,6 @@
 ##                 (fail "Wrong syntax for All"))
 ##          ))
 
-## (def (ident->text ident)
-##   (->' Ident Text)
-##   (let [[module name] ident]
-##     ($ text:++ module ";" name)))
-
 ## (def #export (find-macro ident state)
 ##   (->' Ident ($' Lux Macro))
 ##   (let [[module name] ident]
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)
     ))