From 953f49d5a46209f2d75e67b50edea378261108cd Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 29 May 2017 22:05:57 -0400
Subject: - 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.

---
 new-luxc/source/luxc/analyser/case.lux | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

(limited to 'new-luxc/source/luxc/analyser/case.lux')

diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 239d846d1..d5c84b7bf 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -20,7 +20,7 @@
               ["lp" pattern #+ Pattern])
         ["&;" env]
         (analyser ["&;" common]
-                  ["&;" struct])))
+                  ["&;" structure])))
 
 (type: #rec Coverage
   #PartialC
@@ -146,8 +146,8 @@
 
     [cursor (#;Record pairs)]
     (do Monad<Lux>
-      [pairs (&struct;normalize-record pairs)
-       [members recordT] (&struct;order-record pairs)
+      [pairs (&structure;normalize-record pairs)
+       [members recordT] (&structure;order-record pairs)
        _ (&;within-type-env
           (TC;check inputT recordT))]
       (analyse-pattern (#;Some (list;size members)) inputT [cursor (#;Tuple members)] next))
@@ -173,12 +173,12 @@
                 (do Monad<Lux>
                   [[testP nextA] (analyse-pattern #;None
                                                   (type;variant (list;drop (n.dec num-cases) flat-sum))
-                                                  (' [(~@ values)])
+                                                  (` [(~@ values)])
                                                   next)]
                   (wrap [(#lp;Variant idx num-cases testP)
                          nextA]))
                 (do Monad<Lux>
-                  [[testP nextA] (analyse-pattern #;None case-type (' [(~@ values)]) next)]
+                  [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
                   (wrap [(#lp;Variant idx num-cases testP)
                          nextA])))
 
@@ -195,7 +195,7 @@
          [idx group variantT] (macro;resolve-tag tag)
          _ (&;within-type-env
             (TC;check inputT variantT))]
-        (analyse-pattern (#;Some (list;size group)) inputT (' ((~ (code;nat idx)) (~@ values))) next)))
+        (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
 
     _
     (&;fail (format "Unrecognized pattern syntax: " (%code pattern)))
@@ -274,7 +274,7 @@
 (struct: _ (Eq Coverage)
   (def: (= reference sample)
     (case [reference sample]
-      (^or [#TotalC #TotalC] [#PartialC #PartialC])
+      [#TotalC #TotalC]
       true
 
       [(#BoolC sideR) (#BoolC sideS)]
@@ -339,7 +339,9 @@
                                #;None
                                (wrap (D;put tagA coverageA casesSF'))))
                            casesSF (D;entries casesA))]
-            (wrap (if (list;every? total? (D;values casesM))
+            (wrap (if (let [case-coverages (D;values casesM)]
+                        (and (n.= allSF (list;size case-coverages))
+                             (list;every? total? case-coverages)))
                     #TotalC
                     (#VariantC allSF casesM)))))
 
-- 
cgit v1.2.3