Fixes for pattern-matching/case synthesis & translation.

11 files changed, 222 insertions, 340 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index e11187787..ac7ab3b83 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -57,9 +57,8 @@
                                   (list))
                        #0)))
 
-(def: (path' translate stack-depth @else @end path)
-  (-> (-> Synthesis (Operation Inst))
-      Nat Label Label Path (Operation Inst))
+(def: (path' phase stack-depth @else @end path)
+  (-> Phase Nat Label Label Path (Operation Inst))
   (.case path
     #synthesis.Pop
     (operation/wrap popI)
@@ -101,15 +100,39 @@
     
     (#synthesis.Then bodyS)
     (do phase.Monad<Operation>
-      [bodyI (translate bodyS)]
+      [bodyI (phase bodyS)]
       (wrap (|>> (pop-altI stack-depth)
                  bodyI
                  (_.GOTO @end))))
     
     
-    (^template [<pattern> <method>]
+    (^template [<pattern> <flag> <prepare>]
       (^ (<pattern> idx))
-      (operation/wrap (.case idx
+      (operation/wrap (<| _.with-label (function (_ @success))
+                          _.with-label (function (_ @fail))
+                          (|>> peekI
+                               (_.CHECKCAST ($t.descriptor runtime.$Variant))
+                               (_.int (.int (<prepare> idx)))
+                               <flag>
+                               (_.INVOKESTATIC //.runtime-class "pm_variant"
+                                               ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
+                                                          (#.Some runtime.$Datum)
+                                                          (list))
+                                               #0)
+                               _.DUP
+                               (_.IFNULL @fail)
+                               (_.GOTO @success)
+                               (_.label @fail)
+                               _.POP
+                               (_.GOTO @else)
+                               (_.label @success)
+                               pushI))))
+    ([synthesis.side/left  _.NULL        .id]
+     [synthesis.side/right (_.string "") .inc])
+
+    (^template [<pattern> <method> <prepare>]
+      (^ (<pattern> idx))
+      (operation/wrap (.case (<prepare> idx)
                         0
                         (|>> peekI
                              (_.CHECKCAST ($t.descriptor runtime.$Tuple))
@@ -128,39 +151,14 @@
                                                         (list))
                                              #0)
                              pushI))))
-    ([synthesis.member/left  "pm_left"]
-     [synthesis.member/right "pm_right"])
-
-    (^template [<pattern> <flag> <mod>]
-      (^ (<pattern> idx))
-      (.let [idx (<mod> idx)]
-        (operation/wrap (<| _.with-label (function (_ @success))
-                            _.with-label (function (_ @fail))
-                            (|>> peekI
-                                 (_.CHECKCAST ($t.descriptor runtime.$Variant))
-                                 (_.int (.int idx))
-                                 <flag>
-                                 (_.INVOKESTATIC //.runtime-class "pm_variant"
-                                                 ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
-                                                            (#.Some runtime.$Datum)
-                                                            (list))
-                                                 #0)
-                                 _.DUP
-                                 (_.IFNULL @fail)
-                                 (_.GOTO @success)
-                                 (_.label @fail)
-                                 _.POP
-                                 (_.GOTO @else)
-                                 (_.label @success)
-                                 pushI)))))
-    ([synthesis.side/left  _.NULL        .id]
-     [synthesis.side/right (_.string "") .inc])
+    ([synthesis.member/left  "pm_left"  id]
+     [synthesis.member/right "pm_right" inc])
 
     (#synthesis.Alt leftP rightP)
     (do phase.Monad<Operation>
       [@alt-else _.make-label
-       leftI (path' translate (inc stack-depth) @alt-else @end leftP)
-       rightI (path' translate stack-depth @else @end rightP)]
+       leftI (path' phase (inc stack-depth) @alt-else @end leftP)
+       rightI (path' phase stack-depth @else @end rightP)]
       (wrap (|>> _.DUP
                  leftI
                  (_.label @alt-else)
@@ -169,17 +167,17 @@
     
     (#synthesis.Seq leftP rightP)
     (do phase.Monad<Operation>
-      [leftI (path' translate stack-depth @else @end leftP)
-       rightI (path' translate stack-depth @else @end rightP)]
+      [leftI (path' phase stack-depth @else @end leftP)
+       rightI (path' phase stack-depth @else @end rightP)]
       (wrap (|>> leftI
                  rightI)))
     ))
 
-(def: (path translate path @end)
+(def: (path phase path @end)
   (-> Phase Path Label (Operation Inst))
   (do phase.Monad<Operation>
     [@else _.make-label
-     pathI (..path' translate 1 @else @end path)]
+     pathI (..path' phase 1 @else @end path)]
     (wrap (|>> pathI
                (_.label @else)
                _.POP
@@ -190,12 +188,12 @@
                _.NULL
                (_.GOTO @end)))))
 
-(def: #export (if translate testS thenS elseS)
+(def: #export (if phase testS thenS elseS)
   (-> Phase Synthesis Synthesis Synthesis (Operation Inst))
   (do phase.Monad<Operation>
-    [testI (translate testS)
-     thenI (translate thenS)
-     elseI (translate elseS)]
+    [testI (phase testS)
+     thenI (phase thenS)
+     elseI (phase elseS)]
     (wrap (<| _.with-label (function (_ @else))
               _.with-label (function (_ @end))
               (|>> testI
@@ -207,21 +205,21 @@
                    elseI
                    (_.label @end))))))
 
-(def: #export (let translate inputS register exprS)
+(def: #export (let phase inputS register exprS)
   (-> Phase Synthesis Nat Synthesis (Operation Inst))
   (do phase.Monad<Operation>
-    [inputI (translate inputS)
-     exprI (translate exprS)]
+    [inputI (phase inputS)
+     exprI (phase exprS)]
     (wrap (|>> inputI
                (_.ASTORE register)
                exprI))))
 
-(def: #export (case translate valueS path)
+(def: #export (case phase valueS path)
   (-> Phase Synthesis Path (Operation Inst))
   (do phase.Monad<Operation>
     [@end _.make-label
-     valueI (translate valueS)
-     pathI (..path translate path @end)]
+     valueI (phase valueS)
+     pathI (..path phase path @end)]
     (wrap (|>> _.NULL
                valueI
                pushI
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index c92ab1026..20c31bd5d 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -106,59 +106,8 @@
   Def
   (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE)
         store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
-        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)
-        force-textMT ($t.method (list $Object) (#.Some $String) (list))]
-    (|>> ($d.method #$.Public $.staticM "force_text" force-textMT
-                    (<| _.with-label (function (_ @is-null))
-                        _.with-label (function (_ @normal-object))
-                        _.with-label (function (_ @array-loop))
-                        _.with-label (function (_ @within-bounds))
-                        _.with-label (function (_ @is-first))
-                        _.with-label (function (_ @elem-end))
-                        _.with-label (function (_ @fold-end))
-                        (let [on-normal-objectI (|>> (_.ALOAD 0)
-                                                     (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0))
-                              on-null-objectI (_.string "NULL")
-                              arrayI (|>> (_.ALOAD 0)
-                                          (_.CHECKCAST ($t.descriptor $Object-Array)))
-                              recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0)
-                              force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI)
-                              swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y
-                                         _.POP2 ## Y,X,Y => Y,X
-                                         )
-                              add-spacingI (|>> (_.string ", ") _.SWAP string-concatI)
-                              merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI
-                                                     swap2 ## TPSI => SITP
-                                                     string-concatI ## SITP => SIT
-                                                     _.DUP_X2 _.POP ## SIT => TSI
-                                                     )
-                              foldI (|>> _.DUP ## TSI => TSII
-                                         (_.IFEQ @is-first) ## TSI
-                                         force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end)
-                                         (_.label @is-first) ## TSI
-                                         force-elemI merge-with-totalI
-                                         (_.label @elem-end) ## TSI
-                                         )
-                              inc-idxI (|>> (_.int +1) _.IADD)
-                              on-array-objectI (|>> (_.string "[") ## T
-                                                    arrayI _.ARRAYLENGTH ## TS
-                                                    (_.int +0) ## TSI
-                                                    (_.label @array-loop) ## TSI
-                                                    _.DUP2
-                                                    (_.IF_ICMPGT @within-bounds) ## TSI
-                                                    _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end)
-                                                    (_.label @within-bounds)
-                                                    foldI inc-idxI (_.GOTO @array-loop)
-                                                    (_.label @fold-end))])
-                        (|>> (_.ALOAD 0)
-                             (_.IFNULL @is-null)
-                             (_.ALOAD 0)
-                             (_.INSTANCEOF ($t.descriptor $Object-Array))
-                             (_.IFEQ @normal-object)
-                             on-array-objectI _.ARETURN
-                             (_.label @normal-object) on-normal-objectI _.ARETURN
-                             (_.label @is-null) on-null-objectI _.ARETURN)))
-         ($d.method #$.Public $.staticM "variant_make"
+        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
+    (|>> ($d.method #$.Public $.staticM "variant_make"
                     ($t.method (list $t.int $Object $Object)
                                (#.Some $Variant)
                                (list))
@@ -169,10 +118,6 @@
                          store-valueI
                          _.ARETURN)))))
 
-(def: #export force-textI
-  Inst
-  (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
-
 (def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0)))
 
 (def: frac-methods
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 9bf515bdb..e5a992052 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -827,27 +827,27 @@
  ("lux check" Macro
   ([_ tokens]
    ({(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))
-     (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier "" ""))
+     (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier ["" ""]))
                                                              (#Cons arg #Nil))))
                                         (#Cons ({#Nil
                                                  body
 
                                                  _
-                                                 (_ann (#Form (#Cons (_ann (#Identifier "lux" "function''"))
+                                                 (_ann (#Form (#Cons (_ann (#Identifier ["lux" "function''"]))
                                                                      (#Cons (_ann (#Tuple args'))
                                                                             (#Cons body #Nil)))))}
                                                 args')
                                                #Nil))))
                     #Nil))
 
-     (#Cons [_ (#Identifier "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)))
-     (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier "" self))
+     (#Cons [_ (#Identifier ["" self])] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)))
+     (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier ["" self]))
                                                              (#Cons arg #Nil))))
                                         (#Cons ({#Nil
                                                  body
 
                                                  _
-                                                 (_ann (#Form (#Cons (_ann (#Identifier "lux" "function''"))
+                                                 (_ann (#Form (#Cons (_ann (#Identifier ["lux" "function''"]))
                                                                      (#Cons (_ann (#Tuple args'))
                                                                             (#Cons body #Nil)))))}
                                                 args')
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 19ef64af2..7663f6950 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -25,9 +25,16 @@
 
 (type: #export Tag Nat)
 
+(type: #export (Variant a)
+  {#lefts Nat
+   #right? Bit
+   #value a})
+
+(type: #export (Tuple a) (List a))
+
 (type: #export (Composite a)
-  (#Sum (Either a a))
-  (#Product [a a]))
+  (#Variant (Variant a))
+  (#Tuple (Tuple a)))
 
 (type: #export #rec Pattern
   (#Simple Primitive)
@@ -90,13 +97,6 @@
   [text Text #Text]
   )
 
-(type: #export (Variant a)
-  {#lefts Nat
-   #right? Bit
-   #value a})
-
-(type: #export (Tuple a) (List a))
-
 (type: #export Arity Nat)
 
 (type: #export (Abstraction c) [Environment Arity c])
@@ -112,92 +112,10 @@
       (#..Function (list))
       (#..Apply value)))
 
-(do-template [<name> <type> <structure> <prep-value>]
-  [(def: #export (<name> size tag value)
-     (-> Nat Tag <type> <type>)
-     (let [left (function.constant (|>> #.Left #Sum <structure>))
-           right (|>> #.Right #Sum <structure>)]
-       (if (last? size tag)
-         (list/fold left
-                    (right value)
-                    (list.indices (dec tag)))
-         (list/fold left
-                    (case value
-                      (<structure> (#Sum _))
-                      (<prep-value> value)
-
-                      _
-                      value)
-                    (list.indices (inc 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) Analysis)
   (list/fold (function (_ arg func) (#Apply arg func)) func args))
 
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> value)
-     (-> <type> (Tuple <type>))
-     (case value
-       (<tag> (#Product left right))
-       (#.Cons left (<name> right))
-
-       _
-       (list value)))]
-
-  [tuple         Analysis #Structure]
-  [tuple-pattern Pattern  #Complex]
-  )
-
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> value)
-     (-> <type> (Maybe (Variant <type>)))
-     (loop [lefts 0
-            variantA value]
-       (case variantA
-         (<tag> (#Sum (#.Left valueA)))
-         (case valueA
-           (<tag> (#Sum _))
-           (recur (inc lefts) valueA)
-
-           _
-           (#.Some {#lefts lefts
-                    #right? #0
-                    #value valueA}))
-         
-         (<tag> (#Sum (#.Right valueA)))
-         (#.Some {#lefts lefts
-                  #right? #1
-                  #value valueA})
-
-         _
-         #.None)))]
-
-  [variant         Analysis #Structure]
-  [variant-pattern Pattern  #Complex]
-  )
-
 (def: #export (application analysis)
   (-> Analysis (Application Analysis))
   (case analysis
@@ -208,6 +126,26 @@
     _
     [analysis (list)]))
 
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #Complex
+          <tag>
+          content))]
+
+  [pattern/variant #..Variant]
+  [pattern/tuple   #..Tuple]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Structure
+          <tag>
+          content))]
+
+  [variant #..Variant]
+  [tuple   #..Tuple]
+  )
+
 (template: #export (pattern/unit)
   (#..Simple #..Unit))
 
@@ -223,6 +161,9 @@
   [pattern/text #..Text]
   )
 
+(template: #export (pattern/bind register)
+  (#..Bind register))
+
 (def: #export (with-source-code source action)
   (All [a] (-> Source (Operation a) (Operation a)))
   (function (_ [bundle state])
@@ -314,13 +255,11 @@
     
     (#Structure structure)
     (case structure
-      (#Sum _)
-      (let [[lefts right? value] (maybe.assume (..variant analysis))]
-        (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")"))
+      (#Variant [lefts right? value])
+      (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")")
       
-      (#Product _)
-      (|> analysis
-          ..tuple
+      (#Tuple members)
+      (|> members
           (list/map %analysis)
           (text.join-with " ")
           (text.enclose ["[" "]"])))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
index 5b5b2038c..0d3536db3 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
@@ -208,7 +208,7 @@
                                              [nextA next]
                                              (wrap [(list) nextA]))
                                            (list.reverse matches))]
-              (wrap [(//.product-pattern memberP+)
+              (wrap [(//.pattern/tuple memberP+)
                      thenA])))
 
           _
@@ -246,8 +246,12 @@
                                                   (type.variant (list.drop (dec num-cases) flat-sum))
                                                   (` [(~+ values)])
                                                   next)
-                                 (analyse-pattern #.None caseT (` [(~+ values)]) next))]
-                (wrap [(//.sum-pattern num-cases idx testP)
+                                 (analyse-pattern #.None caseT (` [(~+ values)]) next))
+                 #let [right? (n/= (dec num-cases) idx)
+                       lefts (if right?
+                               (dec idx)
+                               idx)]]
+                (wrap [(//.pattern/variant [lefts right? testP])
                        nextA]))
 
               _
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
index df09bb0ec..6b2f307ac 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
@@ -17,30 +17,13 @@
   ["." //// ("operation/." Monad<Operation>)]
   ["." /// (#+ Pattern Variant Operation)])
 
+(exception: #export (invalid-tuple-pattern)
+  "Tuple size must be >= 2")
+
 (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
-        (#///.Complex (#///.Sum value-side))
-        (recur (inc lefts) value-side)
-
-        _
-        {#///.lefts lefts
-         #///.right? #0
-         #///.value valueP})
-      
-      (#.Right valueP)
-      {#///.lefts lefts
-       #///.right? #1
-       #///.value valueP})))
-
 ## The coverage of a pattern-matching expression summarizes how well
 ## all the possible values of an input are being covered by the
 ## different patterns involved.
@@ -96,31 +79,39 @@
 
     ## Tuple patterns can be exhaustive if there is exhaustiveness for all of
     ## their sub-patterns.
-    (#///.Complex (#///.Product [left right]))
-    (do ////.Monad<Operation>
-      [left (determine left)
-       right (determine right)]
-      (case right
-        (#Exhaustive _)
-        (wrap left)
-
-        _
-        (wrap (#Seq left right))))
-
-    (#///.Complex (#///.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.
+    (#///.Complex (#///.Tuple membersP+))
+    (case (list.reverse membersP+)
+      (^or #.Nil (#.Cons _ #.Nil))
+      (////.throw invalid-tuple-pattern [])
+      
+      (#.Cons lastP prevsP+)
       (do ////.Monad<Operation>
-        [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))))))))
+        [lastC (determine lastP)]
+        (monad.fold ////.Monad<Operation>
+                    (function (_ leftP rightC)
+                      (do ////.Monad<Operation>
+                        [leftC (determine leftP)]
+                        (case rightC
+                          #Exhaustive
+                          (wrap leftC)
+
+                          _
+                          (wrap (#Seq leftC rightC)))))
+                    lastC prevsP+)))
+
+    ## Variant patterns can be shown to be exhaustive if all the possible
+    ## cases are handled exhaustively.
+    (#///.Complex (#///.Variant [lefts right? value]))
+    (do ////.Monad<Operation>
+      [value-coverage (determine value)
+       #let [idx (if right?
+                   (inc lefts)
+                   lefts)]]
+      (wrap (#Variant (if right?
+                        (#.Some idx)
+                        #.None)
+                      (|> (dict.new number.Hash<Nat>)
+                          (dict.put idx value-coverage)))))))
 
 (def: (xor left right)
   (-> Bit Bit Bit)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
index 1ef523c76..3988349e0 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
@@ -2,12 +2,14 @@
   [lux #*
    [control
     ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
+    ["ex" exception (#+ exception:)]
+    ["." state]]
    [data
     ["." name]
     ["." number]
     ["." product]
     ["." maybe]
+    ["." error]
     [text
      format]
     [collection
@@ -86,13 +88,18 @@
       (case expectedT
         (#.Sum _)
         (let [flat (type.flatten-variant expectedT)
-              type-size (list.size flat)]
+              type-size (list.size flat)
+              right? (n/= (dec type-size)
+                          tag)
+              lefts (if right?
+                      (dec tag)
+                      tag)]
           (case (list.nth tag flat)
             (#.Some variant-type)
             (do @
               [valueA (//type.with-type variant-type
                         (analyse valueC))]
-              (wrap (//.sum-analysis type-size tag valueA)))
+              (wrap (//.variant [lefts right? valueA])))
 
             #.None
             (///.throw inference.variant-tag-out-of-bounds [type-size tag expectedT])))
@@ -151,44 +158,32 @@
         _
         (///.throw invalid-variant-type [expectedT tag valueC])))))
 
-(def: (typed-product analyse membersC+)
+(def: (typed-product analyse members)
   (-> Phase (List Code) (Operation Analysis))
   (do ///.Monad<Operation>
-    [expectedT (extension.lift macro.expected-type)]
-    (loop [expectedT expectedT
-           membersC+ membersC+]
-      (case [expectedT membersC+]
-        ## If the tuple runs out, whatever expression is the last gets
-        ## matched to the remaining type.
-        [tailT (#.Cons tailC #.Nil)]
-        (//type.with-type tailT
-          (analyse tailC))
-
-        ## If the type and the code are still ongoing, match each
-        ## sub-expression to its corresponding type.
-        [(#.Product leftT rightT) (#.Cons leftC rightC)]
-        (do @
-          [leftA (//type.with-type leftT
-                   (analyse leftC))
-           rightA (recur rightT rightC)]
-          (wrap (#//.Structure (#//.Product leftA rightA))))
-
-        ## If, however, the type runs out but there is still enough
-        ## tail, the remaining elements get packaged into another
-        ## tuple.
-        ## The reason for this is that it is assumed that the type of
-        ## the tuple represents the expectations of the user.
-        ## If the type is for a 3-tuple, but a 5-tuple is provided, it
-        ## is assumed that the user intended the following layout:
-        ## [+0, +1, [+2, +3, +4]]
-        ## but that, for whatever reason, it was written in a flat
-        ## way.
-        [tailT tailC]
-        (|> tailC
-            code.tuple
-            analyse
-            (//type.with-type tailT)
-            (:: @ map (|>> //.no-op)))))))
+    [expectedT (extension.lift macro.expected-type)
+     membersA+ (: (Operation (List Analysis))
+                  (loop [membersT+ (type.flatten-tuple expectedT)
+                         membersC+ members]
+                    (case [membersT+ membersC+]
+                      [(#.Cons memberT #.Nil) _]
+                      (//type.with-type memberT
+                        (:: @ map (|>> list) (analyse (code.tuple membersC+))))
+                      
+                      [_ (#.Cons memberC #.Nil)]
+                      (//type.with-type (type.tuple membersT+)
+                        (:: @ map (|>> list) (analyse memberC)))
+                      
+                      [(#.Cons memberT membersT+') (#.Cons memberC membersC+')]
+                      (do @
+                        [memberA (//type.with-type memberT
+                                   (analyse memberC))
+                         memberA+ (recur membersT+' membersC+')]
+                        (wrap (#.Cons memberA memberA+)))
+
+                      _
+                      (///.throw cannot-analyse-tuple [expectedT members]))))]
+    (wrap (//.tuple membersA+))))
 
 (def: #export (product analyse membersC)
   (-> Phase (List Code) (Operation Analysis))
@@ -220,7 +215,7 @@
                _ (//type.with-env
                    (check.check expectedT
                                 (type.tuple (list/map product.left membersTA))))]
-              (wrap (//.product-analysis (list/map product.right membersTA))))))
+              (wrap (//.tuple (list/map product.right membersTA))))))
 
         (^template [<tag> <instancer>]
           (<tag> _)
@@ -268,8 +263,12 @@
       (do @
         [#let [case-size (list.size group)]
          inferenceT (inference.variant idx case-size variantT)
-         [inferredT valueA+] (inference.general analyse inferenceT (list valueC))]
-        (wrap (//.sum-analysis case-size idx (|> valueA+ list.head maybe.assume))))
+         [inferredT valueA+] (inference.general analyse inferenceT (list valueC))
+         #let [right? (n/= (dec case-size) idx)
+               lefts (if right?
+                       (dec idx)
+                       idx)]]
+        (wrap (//.variant [lefts right? (|> valueA+ list.head maybe.assume)])))
 
       _
       (..sum analyse idx valueC))))
@@ -353,7 +352,7 @@
           (do @
             [inferenceT (inference.record recordT)
              [inferredT membersA] (inference.general analyse inferenceT membersC)]
-            (wrap (//.product-analysis membersA)))
+            (wrap (//.tuple membersA)))
 
           _
           (..product analyse membersC))))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
index 069ec4e1a..5406ac20a 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
@@ -1138,7 +1138,7 @@
   (|> inputsA
       (list.zip2 (list/map analysis.text typesT))
       (list/map (function (_ [type value])
-                  (analysis.product-analysis (list type value))))))
+                  (analysis.tuple (list type value))))))
 
 (def: invoke::static
   Handler
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
index 3e59637a8..c9de46ac9 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
@@ -19,18 +19,22 @@
     [//
      ["." reference]]]])
 
-(def: (path' pattern bodyC)
-  (-> Pattern (Operation Path) (Operation Path))
+(def: clean-up
+  (-> Path Path)
+  (|>> (#//.Seq #//.Pop)))
+
+(def: (path' pattern end? thenC)
+  (-> Pattern Bit (Operation Path) (Operation Path))
   (case pattern
     (#analysis.Simple simple)
     (case simple
       #analysis.Unit
-      bodyC
+      thenC
       
       (^template [<from> <to>]
         (<from> value)
         (operation/map (|>> (#//.Seq (#//.Test (|> value <to>))))
-                       bodyC))
+                       thenC))
       ([#analysis.Bit  #//.Bit]
        [#analysis.Nat  (<| #//.I64 .i64)]
        [#analysis.Int  (<| #//.I64 .i64)]
@@ -45,40 +49,33 @@
                                             (n/+ (dec arity) register)
                                             register)))))
         //.with-new-local
-        bodyC)
-
-    (#analysis.Complex _)
-    (case (analysis.variant-pattern pattern)
-      (#.Some [lefts right? value-pattern])
-      (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right?
-                                                           (#.Right lefts)
-                                                           (#.Left lefts))))))
-                     (path' value-pattern bodyC))
-      
-      #.None
-      (let [tuple (analysis.tuple-pattern pattern)
-            tuple/last (dec (list.size tuple))]
-        (list/fold (function (_ [tuple/idx tuple/member] thenC)
-                     (case tuple/member
-                       (#analysis.Simple #analysis.Unit)
-                       thenC
-
-                       _
-                       (let [last? (n/= tuple/last tuple/idx)]
-                         (|> (if (or last?
-                                     (is? bodyC thenC))
-                               thenC
-                               (operation/map (|>> (#//.Seq #//.Pop)) thenC))
-                             (path' tuple/member)
-                             (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if last?
-                                                                                    (#.Right (dec tuple/idx))
-                                                                                    (#.Left tuple/idx)))))))))))
-                   bodyC
-                   (list.reverse (list.enumerate tuple)))))))
+        thenC)
+
+    (#analysis.Complex (#analysis.Variant [lefts right? value-pattern]))
+    (<| (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right?
+                                                             (#.Right lefts)
+                                                             (#.Left lefts)))))))
+        (path' value-pattern end?)
+        (when (not end?) (operation/map ..clean-up))
+        thenC)
+
+    (#analysis.Complex (#analysis.Tuple tuple))
+    (let [tuple::last (dec (list.size tuple))]
+      (list/fold (function (_ [tuple::lefts tuple::member] nextC)
+                   (let [right? (n/= tuple::last tuple::lefts)
+                         end?' (and end? right?)]
+                     (<| (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if right?
+                                                                                (#.Right (dec tuple::lefts))
+                                                                                (#.Left tuple::lefts)))))))
+                         (path' tuple::member end?')
+                         (when (not end?') (operation/map ..clean-up))
+                         nextC)))
+                 thenC
+                 (list.reverse (list.enumerate tuple))))))
 
 (def: #export (path synthesize pattern bodyA)
   (-> Phase Pattern Analysis (Operation Path))
-  (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA))))
+  (path' pattern true (operation/map (|>> #//.Then) (synthesize bodyA))))
 
 (def: #export (weave leftP rightP)
   (-> Path Path Path)
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux b/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux
index e7db982d8..cd57c1d29 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux
@@ -43,10 +43,10 @@
 
     (#//.Structure structure)
     (case structure
-      (#//.Variant variantS)
+      (#analysis.Variant variantS)
       (proper? (get@ #analysis.value variantS))
       
-      (#//.Tuple membersS+)
+      (#analysis.Tuple membersS+)
       (list.every? proper? membersS+))
 
     (#//.Control controlS)
@@ -197,18 +197,18 @@
     (case exprS
       (#//.Structure structureS)
       (case structureS
-        (#//.Variant variantS)
+        (#analysis.Variant variantS)
         (do maybe.Monad<Maybe>
           [valueS' (|> variantS (get@ #analysis.value) recur)]
           (wrap (|> variantS
                     (set@ #analysis.value valueS')
-                    #//.Variant
+                    #analysis.Variant
                     #//.Structure)))
         
-        (#//.Tuple membersS+)
+        (#analysis.Tuple membersS+)
         (|> membersS+
             (monad.map maybe.Monad<Maybe> recur)
-            (maybe/map (|>> #//.Tuple #//.Structure))))
+            (maybe/map (|>> #analysis.Tuple #//.Structure))))
 
       (#//.Reference reference)
       (case reference
diff --git a/stdlib/source/lux/compiler/default/reference.lux b/stdlib/source/lux/compiler/default/reference.lux
index cde1f5b5c..b945c1327 100644
--- a/stdlib/source/lux/compiler/default/reference.lux
+++ b/stdlib/source/lux/compiler/default/reference.lux
@@ -77,3 +77,12 @@
     
     (#Foreign foreign)
     (format "-" (%n foreign))))
+
+(def: #export (%reference reference)
+  (Format Reference)
+  (case reference
+    (#Variable variable)
+    (%variable variable)
+    
+    (#Constant constant)
+    (%name constant)))