- Migrated pattern-matching analysis to stdlib.

8 files changed, 280 insertions, 305 deletions

diff --git a/new-luxc/test/test/luxc/lang/analysis/common.lux b/new-luxc/test/test/luxc/lang/analysis/common.lux
deleted file mode 100644
index 7e343cc88..000000000
--- a/new-luxc/test/test/luxc/lang/analysis/common.lux
+++ /dev/null
@@ -1,31 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control pipe)
-       ["r" math/random "r/" Monad<Random>]
-       (data ["e" error])
-       [macro]
-       (macro [code]))
-  (luxc ["&" lang]
-        (lang (analysis [".A" expression])
-              [eval]))
-  (test/luxc common))
-
-(def: #export analyse
-  &.Analyser
-  (expressionA.analyser eval.eval))
-
-(do-template [<name> <on-success> <on-failure>]
-  [(def: #export (<name> analysis)
-     (All [a] (-> (Meta a) Bool))
-     (|> analysis
-         (macro.run (io.run init-jvm))
-         (case> (#e.Success _)
-                <on-success>
-
-                (#e.Error error)
-                <on-failure>)))]
-
-  [check-success true false]
-  [check-failure false true]
-  )
diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux
index 223f2fb29..0b48f803d 100644
--- a/stdlib/source/lux/lang/analysis.lux
+++ b/stdlib/source/lux/lang/analysis.lux
@@ -48,24 +48,15 @@
   (#Constant Ident)
   (#Special (Special Text)))
 
-(type: #export Variant
+(type: #export (Variant a)
   {#lefts Nat
    #right? Bool
-   #value Analysis})
+   #value a})
 
-(type: #export Tuple (List Analysis))
+(type: #export (Tuple a) (List a))
 
 (type: #export Application [Analysis (List Analysis)])
 
-(do-template [<name> <tag>]
-  [(def: <name>
-     (-> Analysis Analysis)
-     (|>> <tag> #Sum #Structure))]
-
-  [left #.Left]
-  [right #.Right]
-  )
-
 (def: (last? size tag)
   (-> Nat Tag Bool)
   (n/= (dec size) tag))
@@ -75,35 +66,47 @@
   (let [identity (#Function (list) (#Variable (#Local +1)))]
     (#Apply value identity)))
 
-(def: #export (sum size tag value)
-  (-> Nat Tag Analysis Analysis)
-  (if (last? size tag)
-    (if (n/= +1 tag)
-      (..right value)
-      (list/fold (function.const ..left)
-                 (..right value)
-                 (list.n/range +0 (n/- +2 tag))))
-    (list/fold (function.const ..left)
-               (case value
-                 (#Structure (#Sum _))
-                 (no-op value)
-
-                 _
-                 value)
-               (list.n/range +0 tag))))
-
-(def: #export (product members)
-  (-> Tuple Analysis)
-  (case (list.reverse members)
-    #.Nil
-    (#Primitive #Unit)
-
-    (#.Cons singleton #.Nil)
-    singleton
-
-    (#.Cons last prevs)
-    (list/fold (function (_ left right) (#Structure (#Product left right)))
-               last prevs)))
+(do-template [<name> <type> <structure> <prep-value>]
+  [(def: #export (<name> size tag value)
+     (-> Nat Tag <type> <type>)
+     (let [left (function.const (|>> #.Left #Sum <structure>))
+           right (|>> #.Right #Sum <structure>)]
+       (if (last? size tag)
+         (if (n/= +1 tag)
+           (right value)
+           (list/fold left
+                      (right value)
+                      (list.n/range +0 (n/- +2 tag))))
+         (list/fold left
+                    (case value
+                      (<structure> (#Sum _))
+                      (<prep-value> value)
+
+                      _
+                      value)
+                    (list.n/range +0 tag)))))]
+
+  [sum-analysis Analysis #Structure no-op]
+  [sum-pattern  Pattern  #Complex   id]
+  )
+
+(do-template [<name> <type> <primitive> <structure>]
+  [(def: #export (<name> members)
+     (-> (Tuple <type>) <type>)
+     (case (list.reverse members)
+       #.Nil
+       (<primitive> #Unit)
+
+       (#.Cons singleton #.Nil)
+       singleton
+
+       (#.Cons last prevs)
+       (list/fold (function (_ left right) (<structure> (#Product left right)))
+                  last prevs)))]
+
+  [product-analysis Analysis #Primitive #Structure]
+  [product-pattern  Pattern  #Simple    #Complex]
+  )
 
 (def: #export (apply [func args])
   (-> Application Analysis)
@@ -113,7 +116,7 @@
   (-> Code (Meta Analysis)))
 
 (def: #export (tuple analysis)
-  (-> Analysis Tuple)
+  (-> Analysis (Tuple Analysis))
   (case analysis
     (#Structure (#Product left right))
     (#.Cons left (tuple right))
@@ -122,7 +125,7 @@
     (list analysis)))
 
 (def: #export (variant analysis)
-  (-> Analysis (Maybe Variant))
+  (-> Analysis (Maybe (Variant Analysis)))
   (loop [lefts +0
          variantA analysis]
     (case variantA
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/stdlib/source/lux/lang/analysis/case.lux
index d9efa2bf4..3140a9d7e 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/stdlib/source/lux/lang/analysis/case.lux
@@ -1,8 +1,8 @@
 (.module:
-  lux
+  [lux #- case]
   (lux (control [monad #+ do]
                 ["ex" exception #+ exception:]
-                eq)
+                [equality #+ Eq])
        (data [bool]
              [number]
              [product]
@@ -11,38 +11,43 @@
              [text]
              text/format
              (coll [list "list/" Fold<List> Monoid<List> Functor<List>]))
+       [function]
        [macro]
        (macro [code])
+       [lang]
        (lang [type]
-             (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang ["&." scope]
-              ["la" analysis]
-              (analysis [".A" common]
-                        [".A" structure]
-                        (case [".A" coverage])))))
+             (type ["tc" check])
+             [".L" scope]
+             [".L" analysis #+ Pattern Analysis Analyser]
+             (analysis [".A" type]
+                       [".A" structure]
+                       (case [".A" coverage])))))
+
+(exception: #export (cannot-match-type-with-pattern {type Type} {pattern Code})
+  (ex.report ["Type" (%type type)]
+             ["Pattern" (%code pattern)]))
+
+(exception: #export (sum-type-has-no-case {case Nat} {type Type})
+  (ex.report ["Case" (%n case)]
+             ["Type" (%type type)]))
+
+(exception: #export (unrecognized-pattern-syntax {pattern Code})
+  (%code pattern))
+
+(exception: #export (cannot-simplify-type-for-pattern-matching {type Type})
+  (%type type))
 
 (do-template [<name>]
   [(exception: #export (<name> {message Text})
      message)]
 
-  [Cannot-Match-Type-With-Pattern]
-  [Sum-Type-Has-No-Case]
-  [Unrecognized-Pattern-Syntax]
-  [Cannot-Simplify-Type-For-Pattern-Matching]
-  [Cannot-Have-Empty-Branches]
-  [Non-Exhaustive-Pattern-Matching]
-  [Symbols-Must-Be-Unqualified-Inside-Patterns]
+  [cannot-have-empty-branches]
+  [non-exhaustive-pattern-matching]
   )
 
-(def: (pattern-error type pattern)
-  (-> Type Code Text)
-  (format "   Type: " (%type type) "\n"
-          "Pattern: " (%code pattern)))
-
 (def: (re-quantify envs baseT)
   (-> (List (List Type)) Type Type)
-  (case envs
+  (.case envs
     #.Nil
     baseT
 
@@ -61,17 +66,17 @@
   (loop [envs (: (List (List Type))
                  (list))
          caseT caseT]
-    (case caseT
+    (.case caseT
       (#.Var id)
       (do macro.Monad<Meta>
-        [?caseT' (&.with-type-env
+        [?caseT' (typeA.with-env
                    (tc.read id))]
-        (case ?caseT'
+        (.case ?caseT'
           (#.Some caseT')
           (recur envs caseT')
 
           _
-          (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+          (lang.throw cannot-simplify-type-for-pattern-matching caseT)))
 
       (#.Named name unnamedT)
       (recur envs unnamedT)
@@ -79,43 +84,34 @@
       (#.UnivQ env unquantifiedT)
       (recur (#.Cons env envs) unquantifiedT)
 
-      ## (^template [<tag> <instancer>]
-      ##   (<tag> _)
-      ##   (do macro.Monad<Meta>
-      ##     [[_ instanceT] (&.with-type-env
-      ##                      <instancer>)]
-      ##     (recur (maybe.assume (type.apply (list instanceT) caseT)))))
-      ## ([#.UnivQ tc.var]
-      ##  [#.ExQ tc.existential])
-      
       (#.ExQ _)
       (do macro.Monad<Meta>
-        [[ex-id exT] (&.with-type-env
+        [[ex-id exT] (typeA.with-env
                        tc.existential)]
         (recur envs (maybe.assume (type.apply (list exT) caseT))))
 
       (#.Apply inputT funcT)
-      (case funcT
+      (.case funcT
         (#.Var funcT-id)
         (do macro.Monad<Meta>
-          [funcT' (&.with-type-env
+          [funcT' (typeA.with-env
                     (do tc.Monad<Check>
                       [?funct' (tc.read funcT-id)]
-                      (case ?funct'
+                      (.case ?funct'
                         (#.Some funct')
                         (wrap funct')
 
                         _
-                        (tc.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))))]
+                        (tc.throw cannot-simplify-type-for-pattern-matching caseT))))]
           (recur envs (#.Apply inputT funcT')))
 
         _
-        (case (type.apply (list inputT) funcT)
+        (.case (type.apply (list inputT) funcT)
           (#.Some outputT)
           (recur envs outputT)
 
           #.None
-          (&.throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT))))
+          (lang.throw cannot-simplify-type-for-pattern-matching caseT)))
 
       (#.Product _)
       (|> caseT
@@ -127,6 +123,15 @@
       _
       (:: macro.Monad<Meta> wrap (re-quantify envs caseT)))))
 
+(def: (analyse-primitive type inputT cursor output next)
+  (All [a] (-> Type Type Cursor Pattern (Meta a) (Meta [Pattern a])))
+  (lang.with-cursor cursor
+    (do macro.Monad<Meta>
+      [_ (typeA.with-env
+           (tc.check inputT type))
+       outputA next]
+      (wrap [output outputA]))))
+
 ## This function handles several concerns at once, but it must be that
 ## way because those concerns are interleaved when doing
 ## pattern-matching and they cannot be separated.
@@ -144,74 +149,57 @@
 ## That is why the body must be analysed in the context of the
 ## pattern, and not separately.
 (def: (analyse-pattern num-tags inputT pattern next)
-  (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
-  (case pattern
+  (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [Pattern a])))
+  (.case pattern
     [cursor (#.Symbol ["" name])]
-    (&.with-cursor cursor
+    (lang.with-cursor cursor
       (do macro.Monad<Meta>
-        [outputA (&scope.with-local [name inputT]
+        [outputA (scopeL.with-local [name inputT]
                    next)
-         idx &scope.next-local]
-        (wrap [(` ("lux case bind" (~ (code.nat idx)))) outputA])))
-
-    [cursor (#.Symbol ident)]
-    (&.with-cursor cursor
-      (&.throw Symbols-Must-Be-Unqualified-Inside-Patterns (%ident ident)))
-
-    (^template [<type> <code-tag>]
-      [cursor (<code-tag> test)]
-      (&.with-cursor cursor
-        (do macro.Monad<Meta>
-          [_ (&.with-type-env
-               (tc.check inputT <type>))
-           outputA next]
-          (wrap [pattern outputA]))))
-    ([Bool #.Bool]
-     [Nat  #.Nat]
-     [Int  #.Int]
-     [Deg  #.Deg]
-     [Frac #.Frac]
-     [Text #.Text])
-
-    (^ [cursor (#.Tuple (list))])
-    (&.with-cursor cursor
-      (do macro.Monad<Meta>
-        [_ (&.with-type-env
-             (tc.check inputT Top))
-         outputA next]
-        (wrap [(` ("lux case tuple" [])) outputA])))
-
+         idx scopeL.next-local]
+        (wrap [(#analysisL.Bind idx) outputA])))
+
+    (^template [<type> <input> <output>]
+      [cursor <input>]
+      (analyse-primitive <type> inputT cursor (#analysisL.Simple <output>) next))
+    ([Bool (#.Bool pattern-value) (#analysisL.Bool pattern-value)]
+     [Nat  (#.Nat pattern-value)  (#analysisL.Nat pattern-value)]
+     [Int  (#.Int pattern-value)  (#analysisL.Int pattern-value)]
+     [Deg  (#.Deg pattern-value)  (#analysisL.Deg pattern-value)]
+     [Frac (#.Frac pattern-value) (#analysisL.Frac pattern-value)]
+     [Text (#.Text pattern-value) (#analysisL.Text pattern-value)]
+     [Top  (#.Tuple #.Nil)        #analysisL.Unit])
+    
     (^ [cursor (#.Tuple (list singleton))])
     (analyse-pattern #.None inputT singleton next)
     
     [cursor (#.Tuple sub-patterns)]
-    (&.with-cursor cursor
+    (lang.with-cursor cursor
       (do macro.Monad<Meta>
         [inputT' (simplify-case-type inputT)]
-        (case inputT'
+        (.case inputT'
           (#.Product _)
           (let [sub-types (type.flatten-tuple inputT')
                 num-sub-types (maybe.default (list.size sub-types)
                                              num-tags)
                 num-sub-patterns (list.size sub-patterns)
                 matches (cond (n/< num-sub-types num-sub-patterns)
-                              (let [[prefix suffix] (list.split (n/dec num-sub-patterns) sub-types)]
+                              (let [[prefix suffix] (list.split (dec num-sub-patterns) sub-types)]
                                 (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
 
                               (n/> num-sub-types num-sub-patterns)
-                              (let [[prefix suffix] (list.split (n/dec num-sub-types) sub-patterns)]
+                              (let [[prefix suffix] (list.split (dec num-sub-types) sub-patterns)]
                                 (list.zip2 sub-types (list/compose prefix (list (code.tuple suffix)))))
                               
                               ## (n/= num-sub-types num-sub-patterns)
-                              (list.zip2 sub-types sub-patterns)
-                              )]
+                              (list.zip2 sub-types sub-patterns))]
             (do @
               [[memberP+ thenA] (list/fold (: (All [a]
-                                                (-> [Type Code] (Meta [(List la.Pattern) a])
-                                                    (Meta [(List la.Pattern) a])))
+                                                (-> [Type Code] (Meta [(List Pattern) a])
+                                                    (Meta [(List Pattern) a])))
                                               (function (_ [memberT memberC] then)
                                                 (do @
-                                                  [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
+                                                  [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [Pattern a])))
                                                                                    analyse-pattern)
                                                                                #.None memberT memberC then)]
                                                   (wrap [(list& memberP memberP+) thenA]))))
@@ -219,81 +207,76 @@
                                              [nextA next]
                                              (wrap [(list) nextA]))
                                            (list.reverse matches))]
-              (wrap [(` ("lux case tuple" [(~+ memberP+)]))
+              (wrap [(analysisL.product-pattern memberP+)
                      thenA])))
 
           _
-          (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern))
+          (lang.throw cannot-match-type-with-pattern [inputT pattern])
           )))
 
     [cursor (#.Record record)]
     (do macro.Monad<Meta>
       [record (structureA.normalize record)
        [members recordT] (structureA.order record)
-       _ (&.with-type-env
+       _ (typeA.with-env
            (tc.check inputT recordT))]
       (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next))
 
     [cursor (#.Tag tag)]
-    (&.with-cursor cursor
+    (lang.with-cursor cursor
       (analyse-pattern #.None inputT (` ((~ pattern))) next))
 
     (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
-    (&.with-cursor cursor
+    (lang.with-cursor cursor
       (do macro.Monad<Meta>
         [inputT' (simplify-case-type inputT)]
-        (case inputT'
+        (.case inputT'
           (#.Sum _)
           (let [flat-sum (type.flatten-variant inputT')
                 size-sum (list.size flat-sum)
                 num-cases (maybe.default size-sum num-tags)]
-            (case (list.nth idx flat-sum)
+            (.case (list.nth idx flat-sum)
               (^multi (#.Some case-type)
                       (n/< num-cases idx))
-              (if (and (n/> num-cases size-sum)
-                       (n/= (n/dec num-cases) idx))
-                (do macro.Monad<Meta>
-                  [[testP nextA] (analyse-pattern #.None
-                                                  (type.variant (list.drop (n/dec num-cases) flat-sum))
+              (do macro.Monad<Meta>
+                [[testP nextA] (if (and (n/> num-cases size-sum)
+                                        (n/= (dec num-cases) idx))
+                                 (analyse-pattern #.None
+                                                  (type.variant (list.drop (dec num-cases) flat-sum))
                                                   (` [(~+ values)])
-                                                  next)]
-                  (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
-                         nextA]))
-                (do macro.Monad<Meta>
-                  [[testP nextA] (analyse-pattern #.None case-type (` [(~+ values)]) next)]
-                  (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP)))
-                         nextA])))
+                                                  next)
+                                 (analyse-pattern #.None case-type (` [(~+ values)]) next))]
+                (wrap [(analysisL.sum-pattern num-cases idx testP)
+                       nextA]))
 
               _
-              (&.throw Sum-Type-Has-No-Case
-                       (format "Case: " (%n idx) "\n"
-                               "Type: " (%type inputT)))))
+              (lang.throw sum-type-has-no-case [idx inputT])))
 
           _
-          (&.throw Cannot-Match-Type-With-Pattern (pattern-error inputT pattern)))))
+          (lang.throw cannot-match-type-with-pattern [inputT pattern]))))
 
     (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
-    (&.with-cursor cursor
+    (lang.with-cursor cursor
       (do macro.Monad<Meta>
         [tag (macro.normalize tag)
          [idx group variantT] (macro.resolve-tag tag)
-         _ (&.with-type-env
+         _ (typeA.with-env
              (tc.check inputT variantT))]
         (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next)))
 
     _
-    (&.throw Unrecognized-Pattern-Syntax (%code pattern))
+    (lang.throw unrecognized-pattern-syntax pattern)
     ))
 
-(def: #export (analyse-case analyse inputC branches)
-  (-> &.Analyser Code (List [Code Code]) (Meta la.Analysis))
-  (case branches
+(def: #export (case analyse inputC branches)
+  (-> Analyser Code (List [Code Code]) (Meta Analysis))
+  (.case branches
     #.Nil
-    (&.throw Cannot-Have-Empty-Branches "")
+    (lang.throw cannot-have-empty-branches "")
 
     (#.Cons [patternH bodyH] branchesT)
     (do macro.Monad<Meta>
-      [[inputT inputA] (commonA.with-unknown-type
+      [[inputT inputA] (typeA.with-inference
                          (analyse inputC))
        outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
        outputT (monad.map @
@@ -302,11 +285,11 @@
                           branchesT)
        outputHC (|> outputH product.left coverageA.determine)
        outputTC (monad.map @ (|>> product.left coverageA.determine) outputT)
-       _ (case (monad.fold e.Monad<Error> coverageA.merge outputHC outputTC)
+       _ (.case (monad.fold e.Monad<Error> coverageA.merge outputHC outputTC)
            (#e.Success coverage)
-           (&.assert Non-Exhaustive-Pattern-Matching ""
-                     (coverageA.exhaustive? coverage))
+           (lang.assert non-exhaustive-pattern-matching ""
+                        (coverageA.exhaustive? coverage))
 
            (#e.Error error)
-           (&.fail error))]
-      (wrap (` ("lux case" (~ inputA) (~ (code.record (list& outputH outputT)))))))))
+           (lang.fail error))]
+      (wrap (#analysisL.Case inputA [outputH outputT])))))
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/stdlib/source/lux/lang/analysis/case/coverage.lux
index 38f977011..da256206f 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/stdlib/source/lux/lang/analysis/case/coverage.lux
@@ -2,19 +2,41 @@
   lux
   (lux (control [monad #+ do]
                 ["ex" exception #+ exception:]
-                eq)
+                equality)
        (data [bool "bool/" Eq<Bool>]
              [number]
              ["e" error "error/" Monad<Error>]
+             [maybe]
              text/format
              (coll [list "list/" Fold<List>]
                    (dictionary ["dict" unordered #+ Dict])))
-       [macro "macro/" Monad<Meta>])
-  (luxc ["&" lang]
-        (lang ["la" analysis])))
-
-(exception: #export (Unknown-Pattern {message Text})
-  message)
+       [macro "macro/" Monad<Meta>]
+       [lang]
+       (lang [".L" analysis #+ Pattern Variant])))
+
+(def: cases
+  (-> (Maybe Nat) Nat)
+  (|>> (maybe.default +0)))
+
+(def: (variant sum-side)
+  (-> (Either Pattern Pattern) (Variant Pattern))
+  (loop [lefts +0
+         variantP sum-side]
+    (case variantP
+      (#.Left valueP)
+      (case valueP
+        (#analysisL.Complex (#analysisL.Sum value-side))
+        (recur (inc lefts) value-side)
+
+        _
+        {#analysisL.lefts lefts
+         #analysisL.right? false
+         #analysisL.value valueP})
+      
+      (#.Right valueP)
+      {#analysisL.lefts lefts
+       #analysisL.right? true
+       #analysisL.value valueP})))
 
 ## The coverage of a pattern-matching expression summarizes how well
 ## all the possible values of an input are being covered by the
@@ -31,7 +53,7 @@
 (type: #export #rec Coverage
   #Partial
   (#Bool Bool)
-  (#Variant Nat (Dict Nat Coverage))
+  (#Variant (Maybe Nat) (Dict Nat Coverage))
   (#Seq Coverage Coverage)
   (#Alt Coverage Coverage)
   #Exhaustive)
@@ -46,57 +68,56 @@
     false))
 
 (def: #export (determine pattern)
-  (-> la.Pattern (Meta Coverage))
+  (-> Pattern (Meta Coverage))
   (case pattern
-    ## Binding amounts to exhaustive coverage because any value can be
-    ## matched that way.
-    ## Unit [] amounts to exhaustive coverage because there is only one
-    ## possible value, so matching against it covers all cases.
-    (^or (^code ("lux case bind" (~ _))) (^code ("lux case tuple" [])))
+    (^or (#analysisL.Simple #analysisL.Unit)
+         (#analysisL.Bind _))
     (macro/wrap #Exhaustive)
 
-    (^code ("lux case tuple" [(~ singleton)]))
-    (determine singleton)
-
     ## Primitive patterns always have partial coverage because there
     ## are too many possibilities as far as values go.
-    (^or [_ (#.Nat _)]  [_ (#.Int _)]  [_ (#.Deg _)]
-         [_ (#.Frac _)] [_ (#.Text _)])
-    (macro/wrap #Partial)
+    (^template [<tag>]
+      (#analysisL.Simple (<tag> _))
+      (macro/wrap #Partial))
+    ([#analysisL.Nat]
+     [#analysisL.Int]
+     [#analysisL.Deg]
+     [#analysisL.Frac]
+     [#analysisL.Text])
 
     ## Bools are the exception, since there is only "true" and
     ## "false", which means it is possible for boolean
     ## pattern-matching to become exhaustive if complementary parts meet.
-    [_ (#.Bool value)]
+    (#analysisL.Simple (#analysisL.Bool value))
     (macro/wrap (#Bool value))
 
     ## Tuple patterns can be exhaustive if there is exhaustiveness for all of
     ## their sub-patterns.
-    (^code ("lux case tuple" [(~+ subs)]))
-    (loop [subs subs]
-      (case subs
-        #.Nil
-        (macro/wrap #Exhaustive)
-
-        (#.Cons sub subs')
-        (do macro.Monad<Meta>
-          [pre (determine sub)
-           post (recur subs')]
-          (if (exhaustive? post)
-            (wrap pre)
-            (wrap (#Seq pre post))))))
-
-    ## Variant patterns can be shown to be exhaustive if all the possible
-    ## cases are handled exhaustively.
-    (^code ("lux case variant" (~ [_ (#.Nat tag-id)]) (~ [_ (#.Nat num-tags)]) (~ sub)))
+    (#analysisL.Complex (#analysisL.Product [left right]))
     (do macro.Monad<Meta>
-      [=sub (determine sub)]
-      (wrap (#Variant num-tags
-                      (|> (dict.new number.Hash<Nat>)
-                          (dict.put tag-id =sub)))))
-
-    _
-    (&.throw Unknown-Pattern (%code pattern))))
+      [left (determine left)
+       right (determine right)]
+      (case right
+        (#Exhaustive _)
+        (wrap left)
+
+        _
+        (wrap (#Seq left right))))
+
+    (#analysisL.Complex (#analysisL.Sum sum-side))
+    (let [[variant-lefts variant-right? variant-value] (variant sum-side)]
+      ## Variant patterns can be shown to be exhaustive if all the possible
+      ## cases are handled exhaustively.
+      (do macro.Monad<Meta>
+        [value-coverage (determine variant-value)
+         #let [variant-idx (if variant-right?
+                             (inc variant-lefts)
+                             variant-lefts)]]
+        (wrap (#Variant (if variant-right?
+                          (#.Some variant-idx)
+                          #.None)
+                        (|> (dict.new number.Hash<Nat>)
+                            (dict.put variant-idx value-coverage))))))))
 
 (def: (xor left right)
   (-> Bool Bool Bool)
@@ -132,9 +153,10 @@
       (bool/= sideR sideS)
 
       [(#Variant allR casesR) (#Variant allS casesS)]
-      (and (n/= allR allS)
+      (and (n/= (cases allR)
+                (cases allS))
            (:: (dict.Eq<Dict> =) = casesR casesS))
-
+      
       [(#Seq leftR rightR) (#Seq leftS rightS)]
       (and (= leftR leftS)
            (= rightR rightS))
@@ -176,7 +198,7 @@
     (error/wrap #Exhaustive)
 
     [(#Variant allA casesA) (#Variant allSF casesSF)]
-    (cond (not (n/= allSF allA))
+    (cond (not (n/= (cases allSF) (cases allA)))
           (e.fail "Variants do not match.")
 
           (:: (dict.Eq<Dict> Eq<Coverage>) = casesSF casesA)
@@ -196,7 +218,7 @@
                                     (wrap (dict.put tagA coverageA casesSF'))))
                                 casesSF (dict.entries casesA))]
             (wrap (if (let [case-coverages (dict.values casesM)]
-                        (and (n/= allSF (list.size case-coverages))
+                        (and (n/= (cases allSF) (list.size case-coverages))
                              (list.every? exhaustive? case-coverages)))
                     #Exhaustive
                     (#Variant allSF casesM)))))
diff --git a/stdlib/source/lux/lang/analysis/structure.lux b/stdlib/source/lux/lang/analysis/structure.lux
index cc185ebe9..8e3611e67 100644
--- a/stdlib/source/lux/lang/analysis/structure.lux
+++ b/stdlib/source/lux/lang/analysis/structure.lux
@@ -89,7 +89,7 @@
             (do @
               [valueA (typeA.with-type variant-type
                         (analyse valueC))]
-              (wrap (analysis.sum type-size tag valueA)))
+              (wrap (analysis.sum-analysis type-size tag valueA)))
 
             #.None
             (lang.throw inferenceA.variant-tag-out-of-bounds [type-size tag expectedT])))
@@ -219,7 +219,7 @@
                _ (typeA.with-env
                    (tc.check expectedT
                              (type.tuple (list/map product.left membersTA))))]
-              (wrap (analysis.product (list/map product.right membersTA))))))
+              (wrap (analysis.product-analysis (list/map product.right membersTA))))))
 
         (^template [<tag> <instancer>]
           (<tag> _)
@@ -268,7 +268,7 @@
         [#let [case-size (list.size group)]
          inferenceT (inferenceA.variant idx case-size variantT)
          [inferredT valueA+] (inferenceA.general analyse inferenceT (list valueC))]
-        (wrap (analysis.sum case-size idx (|> valueA+ list.head maybe.assume))))
+        (wrap (analysis.sum-analysis case-size idx (|> valueA+ list.head maybe.assume))))
 
       _
       (..sum analyse idx valueC))))
@@ -352,7 +352,7 @@
           (do @
             [inferenceT (inferenceA.record recordT)
              [inferredT membersA] (inferenceA.general analyse inferenceT membersC)]
-            (wrap (analysis.product membersA)))
+            (wrap (analysis.product-analysis membersA)))
 
           _
           (..product analyse membersC))))))
diff --git a/new-luxc/test/test/luxc/lang/analysis/case.lux b/stdlib/test/test/lux/lang/analysis/case.lux
index 63dd60e14..9e775f8a3 100644
--- a/new-luxc/test/test/luxc/lang/analysis/case.lux
+++ b/stdlib/test/test/lux/lang/analysis/case.lux
@@ -9,22 +9,20 @@
              [maybe]
              [text "T/" Eq<Text>]
              text/format
-             (coll [list "L/" Monad<List>]
+             (coll [list "list/" Monad<List>]
                    (set ["set" unordered])))
        ["r" math/random "r/" Monad<Random>]
        [macro #+ Monad<Meta>]
        (macro [code])
+       [lang]
        (lang [type "type/" Eq<Type>]
-             (type ["tc" check]))
+             (type ["tc" check])
+             [".L" module]
+             (analysis [".A" type]
+                       ["/" case]))
        test)
-  (luxc ["&" lang]
-        (lang ["@." module]
-              ["la" analysis]
-              (analysis [".A" expression]
-                        ["@" case]
-                        ["@." common])))
-  (// common)
-  (test/luxc common))
+  (// ["_." primitive]
+      ["_." structure]))
 
 (def: (exhaustive-weaving branchings)
   (-> (List (List Code)) (List (List Code)))
@@ -33,7 +31,7 @@
     #.Nil
 
     (#.Cons head+ #.Nil)
-    (L/map (|>> list) head+)
+    (list/map (|>> list) head+)
 
     (#.Cons head+ tail++)
     (do list.Monad<List>
@@ -61,11 +59,11 @@
             #.None
             (wrap (list (' _)))))
         (r/wrap (list (' _)))))
-    ([#.Nat  r.nat       code.nat]
-     [#.Int  r.int       code.int]
-     [#.Deg  r.deg       code.deg]
-     [#.Frac r.frac      code.frac]
-     [#.Text (r.text +5) code.text])
+    ([#.Nat  r.nat          code.nat]
+     [#.Int  r.int          code.int]
+     [#.Deg  r.deg          code.deg]
+     [#.Frac r.frac         code.frac]
+     [#.Text (r.unicode +5) code.text])
     
     (^ [_ (#.Tuple (list))])
     (r/wrap (list (' [])))
@@ -78,16 +76,16 @@
       [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
       (wrap (|> member-wise-patterns
                 exhaustive-weaving
-                (L/map code.tuple))))
+                (list/map code.tuple))))
 
     [_ (#.Record kvs)]
     (do r.Monad<Random>
-      [#let [ks (L/map product.left kvs)
-             vs (L/map product.right kvs)]
+      [#let [ks (list/map product.left kvs)
+             vs (list/map product.right kvs)]
        member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
       (wrap (|> member-wise-patterns
                 exhaustive-weaving
-                (L/map (|>> (list.zip2 ks) code.record)))))
+                (list/map (|>> (list.zip2 ks) code.record)))))
 
     (^ [_ (#.Form (list [_ (#.Tag _)] _))])
     (do r.Monad<Random>
@@ -95,10 +93,10 @@
                           (function (_ [_tag _code])
                             (do @
                               [v-branches (exhaustive-branches allow-literals? variantTC _code)]
-                              (wrap (L/map (function (_ pattern) (` ((~ _tag) (~ pattern))))
-                                           v-branches))))
+                              (wrap (list/map (function (_ pattern) (` ((~ _tag) (~ pattern))))
+                                              v-branches))))
                           variantTC)]
-      (wrap (L/join bundles)))
+      (wrap (list/join bundles)))
 
     _
     (r/wrap (list))
@@ -109,7 +107,7 @@
   (r.rec
    (function (_ input)
      ($_ r.either
-         (r/map product.right gen-primitive)
+         (r/map product.right _primitive.primitive)
          (do r.Monad<Random>
            [choice (|> r.nat (:: @ map (n/% (list.size variant-tags))))
             #let [choiceT (maybe.assume (list.nth choice variant-tags))
@@ -132,32 +130,32 @@
   (<| (seed +5004137551292836565)
       ## (times +100)
       (do @
-        [module-name (r.text +5)
-         variant-name (r.text +5)
-         record-name (|> (r.text +5) (r.filter (|>> (T/= variant-name) not)))
+        [module-name (r.unicode +5)
+         variant-name (r.unicode +5)
+         record-name (|> (r.unicode +5) (r.filter (|>> (T/= variant-name) not)))
          size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         variant-tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map set.to-list))
-         record-tags (|> (r.set text.Hash<Text> size (r.text +5)) (:: @ map set.to-list))
-         primitivesTC (r.list size gen-primitive)
-         #let [primitivesT (L/map product.left primitivesTC)
-               primitivesC (L/map product.right primitivesTC)
+         variant-tags (|> (r.set text.Hash<Text> size (r.unicode +5)) (:: @ map set.to-list))
+         record-tags (|> (r.set text.Hash<Text> size (r.unicode +5)) (:: @ map set.to-list))
+         primitivesTC (r.list size _primitive.primitive)
+         #let [primitivesT (list/map product.left primitivesTC)
+               primitivesC (list/map product.right primitivesTC)
                code-tag (|>> [module-name] code.tag)
-               variant-tags+ (L/map code-tag variant-tags)
-               record-tags+ (L/map code-tag record-tags)
+               variant-tags+ (list/map code-tag variant-tags)
+               record-tags+ (list/map code-tag record-tags)
                variantTC (list.zip2 variant-tags+ primitivesC)]
          inputC (input variant-tags+ record-tags+ primitivesC)
-         [outputT outputC] gen-primitive
-         [heterogeneousT heterogeneousC] (|> gen-primitive
+         [outputT outputC] _primitive.primitive
+         [heterogeneousT heterogeneousC] (|> _primitive.primitive
                                              (r.filter (|>> product.left (tc.checks? outputT) not)))
          exhaustive-patterns (exhaustive-branches true variantTC inputC)
          redundant-patterns (exhaustive-branches false variantTC inputC)
          redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns))))
          heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns))))
-         #let [exhaustive-branchesC (L/map (branch outputC)
-                                           exhaustive-patterns)
-               non-exhaustive-branchesC (list.take (n/dec (list.size exhaustive-branchesC))
+         #let [exhaustive-branchesC (list/map (branch outputC)
+                                              exhaustive-patterns)
+               non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC))
                                                    exhaustive-branchesC)
-               redundant-branchesC (<| (L/map (branch outputC))
+               redundant-branchesC (<| (list/map (branch outputC))
                                        list.concat
                                        (list (list.take redundancy-idx redundant-patterns)
                                              (list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
@@ -165,32 +163,32 @@
                heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
                                                           (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
                                                                   [_pattern heterogeneousC]))
-                                                          (list.drop (n/inc heterogeneous-idx) exhaustive-branchesC)))
-               analyse-pm (|>> (@.analyse-case analyse inputC)
-                               (&.with-type outputT)
-                               &.with-scope
+                                                          (list.drop (inc heterogeneous-idx) exhaustive-branchesC)))
+               analyse-pm (|>> (/.case _primitive.analyse inputC)
+                               (typeA.with-type outputT)
+                               lang.with-scope
                                (do Monad<Meta>
-                                 [_ (@module.declare-tags variant-tags false
+                                 [_ (moduleL.declare-tags variant-tags false
                                                           (#.Named [module-name variant-name]
                                                                    (type.variant primitivesT)))
-                                  _ (@module.declare-tags record-tags false
+                                  _ (moduleL.declare-tags record-tags false
                                                           (#.Named [module-name record-name]
                                                                    (type.tuple primitivesT)))])
-                               (@module.with-module +0 module-name))]]
+                               (moduleL.with-module +0 module-name))]]
         ($_ seq
             (test "Will reject empty pattern-matching (no branches)."
                   (|> (analyse-pm (list))
-                      check-failure))
+                      _structure.check-fails))
             (test "Can analyse exhaustive pattern-matching."
                   (|> (analyse-pm exhaustive-branchesC)
-                      check-success))
+                      _structure.check-succeeds))
             (test "Will reject non-exhaustive pattern-matching."
                   (|> (analyse-pm non-exhaustive-branchesC)
-                      check-failure))
+                      _structure.check-fails))
             (test "Will reject redundant pattern-matching."
                   (|> (analyse-pm redundant-branchesC)
-                      check-failure))
+                      _structure.check-fails))
             (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
                   (|> (analyse-pm heterogeneous-branchesC)
-                      check-failure))
+                      _structure.check-fails))
             ))))
diff --git a/stdlib/test/test/lux/lang/analysis/primitive.lux b/stdlib/test/test/lux/lang/analysis/primitive.lux
index ed9d8bfc6..8e4ca6dde 100644
--- a/stdlib/test/test/lux/lang/analysis/primitive.lux
+++ b/stdlib/test/test/lux/lang/analysis/primitive.lux
@@ -17,7 +17,7 @@
                        [".A" expression]))
        test))
 
-(def: analyse (expressionA.analyser (:! lang.Eval [])))
+(def: #export analyse (expressionA.analyser (:! lang.Eval [])))
 
 (def: unit
   (r.Random Code)
diff --git a/stdlib/test/test/lux/lang/analysis/structure.lux b/stdlib/test/test/lux/lang/analysis/structure.lux
index ad6691287..20b911714 100644
--- a/stdlib/test/test/lux/lang/analysis/structure.lux
+++ b/stdlib/test/test/lux/lang/analysis/structure.lux
@@ -19,7 +19,7 @@
              (type ["tc" check])
              [".L" module]
              [".L" init]
-             [".L" analysis #+ Analysis]
+             [".L" analysis #+ Analysis Variant Tag]
              (analysis [".A" type]
                        ["/" structure]
                        [".A" expression]))
@@ -43,7 +43,7 @@
   )
 
 (def: (check-sum' size tag variant)
-  (-> Nat analysisL.Tag analysisL.Variant Bool)
+  (-> Nat Tag (Variant Analysis) Bool)
   (let [variant-tag (if (get@ #analysisL.right? variant)
                       (inc (get@ #analysisL.lefts variant))
                       (get@ #analysisL.lefts variant))]
@@ -52,7 +52,7 @@
         (and (n/= tag variant-tag)))))
 
 (def: (check-sum type size tag analysis)
-  (-> Type Nat analysisL.Tag (Meta Analysis) Bool)
+  (-> Type Nat Tag (Meta Analysis) Bool)
   (|> analysis
       (typeA.with-type type)
       (macro.run (initL.compiler []))
@@ -71,7 +71,7 @@
        (moduleL.with-module +0 module)))
 
 (def: (check-variant module tags type size tag analysis)
-  (-> Text (List moduleL.Tag) Type Nat analysisL.Tag (Meta Analysis) Bool)
+  (-> Text (List moduleL.Tag) Type Nat Tag (Meta Analysis) Bool)
   (|> analysis
       (tagged module tags type)
       (typeA.with-type type)