- Fixes for pattern-matching (case) analysis.

- Small refactorings.
- Improved common procedures analysis.
- Can now handle tagged structures (variants & records).
- Tests for pattern-matching, functions (definition & application), and common procedures.

1 files changed, 18 insertions, 15 deletions

diff --git a/new-luxc/source/luxc/analyser/struct.lux b/new-luxc/source/luxc/analyser/structure.lux
index 562e30294..ab6f6adae 100644
--- a/new-luxc/source/luxc/analyser/struct.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -82,7 +82,7 @@
                            "Expected: " (|> size-ts nat-to-int %i) "\n"
                            "  Actual: " (|> size-record nat-to-int %i) "\n"
                            "For type: " (%type recordT))))
-       #let [tuple-range (list;n.range +0 size-ts)
+       #let [tuple-range (list;n.range +0 (n.dec size-ts))
              tag->idx (D;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
        idx->val (foldM @
                        (function [[key val] idx->val]
@@ -203,13 +203,13 @@
   (case type
     (#;Named name unnamedT)
     (do Monad<Lux>
-      [unnamedT+ (record-function-type unnamedT)]
+      [unnamedT+ (variant-function-type tag expected-size unnamedT)]
       (wrap (#;Named name unnamedT+)))
 
     (^template [<tag>]
       (<tag> env bodyT)
       (do Monad<Lux>
-        [bodyT+ (record-function-type bodyT)]
+        [bodyT+ (variant-function-type tag expected-size bodyT)]
         (wrap (<tag> env bodyT+))))
     ([#;UnivQ]
      [#;ExQ])
@@ -265,20 +265,21 @@
 
 (def: (variant tag size temp value)
   (-> Nat Nat Nat Analysis Analysis)
-  (let [last-tag (n.dec size)]
-    (if (n.= last-tag tag)
+  (if (n.= (n.dec size) tag)
+    (if (n.= +1 tag)
+      (sum-right value)
       (L/fold (function;const sum-left)
               (sum-right value)
-              (list;n.range +0 last-tag))
-      (L/fold (function;const sum-left)
-              (case value
-                (#la;Sum _)
-                (#la;Case value (list [(#lp;Bind temp)
-                                       (#la;Relative (#;Local temp))]))
+              (list;n.range +0 (n.- +2 tag))))
+    (L/fold (function;const sum-left)
+            (case value
+              (#la;Sum _)
+              (#la;Case value (list [(#lp;Bind temp)
+                                     (#la;Relative (#;Local temp))]))
 
-                _
-                value)
-              (list;n.range +0 tag)))))
+              _
+              value)
+            (list;n.range +0 tag))))
 
 (def: #export (analyse-tagged-sum analyse tag value)
   (-> &;Analyser Ident Code (Lux Analysis))
@@ -345,4 +346,6 @@
               (analyse-sum analyse tag valueC))))
         
         _
-        (&;fail "")))))
+        (if (n.= +0 tag)
+          (analyse valueC)
+          (&;fail ""))))))