- Added pattern-matching compilation.

7 files changed, 525 insertions, 42 deletions

diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux
new file mode 100644
index 000000000..1f351325e
--- /dev/null
+++ b/new-luxc/source/luxc/generator/case.jvm.lux
@@ -0,0 +1,214 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       [macro "lux/" Monad<Lux>])
+  (luxc (lang ["ls" synthesis])
+        (generator (host ["$" jvm]
+                         (jvm ["$t" type]
+                              ["$i" inst]))
+                   [expr]))
+  [../runtime])
+
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+
+(def: (pop-altI stack-depth)
+  (-> Nat $;Inst)
+  (case stack-depth
+    +0 id
+    +1 $i;POP
+    +2 $i;POP2
+    _ ## (n.> +2)
+    (|>. $i;POP2
+         (pop-altI (n.- +2 stack-depth)))))
+
+(def: peekI
+  $;Inst
+  (|>. $i;DUP
+       ($i;INVOKESTATIC ../runtime;runtime-name
+                        "pm_peek"
+                        ($t;method (list ../runtime;$Stack)
+                                   (#;Some $Object)
+                                   (list))
+                        false)))
+
+(def: popI
+  $;Inst
+  (|>. ($i;INVOKESTATIC ../runtime;runtime-name
+                        "pm_pop"
+                        ($t;method (list ../runtime;$Stack)
+                                   (#;Some ../runtime;$Stack)
+                                   (list))
+                        false)))
+
+(def: pushI
+  $;Inst
+  (|>. ($i;INVOKESTATIC ../runtime;runtime-name
+                        "pm_push"
+                        ($t;method (list ../runtime;$Stack $Object)
+                                   (#;Some ../runtime;$Stack)
+                                   (list))
+                        false)))
+
+(def: (generate-pattern' stack-depth @else @end path)
+  (-> Nat $;Label $;Label ls;Path (Lux $;Inst))
+  (case path
+    (#ls;ExecP bodyS)
+    (do macro;Monad<Lux>
+      [bodyI (expr;generate bodyS)]
+      (wrap (|>. (pop-altI stack-depth)
+                 bodyI
+                 ($i;GOTO @end))))
+
+    #ls;UnitP
+    (lux/wrap popI)
+
+    (#ls;BindP register)
+    (lux/wrap (|>. peekI
+                   ($i;ASTORE register)
+                   popI))
+
+    (#ls;BoolP value)
+    (lux/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
+                (|>. peekI
+                     ($i;unwrap #$;Boolean)
+                     (jumpI @else))))
+
+    (^template [<tag> <prep>]
+      (<tag> value)
+      (lux/wrap (|>. peekI
+                     ($i;unwrap #$;Long)
+                     ($i;long (|> value <prep>))
+                     $i;LCMP
+                     ($i;IFNE @else))))
+    ([#ls;NatP (:! Int)]
+     [#ls;IntP (: Int)]
+     [#ls;DegP (:! Int)])
+
+    (#ls;FracP value)
+    (lux/wrap (|>. peekI
+                   ($i;unwrap #$;Double)
+                   ($i;double value)
+                   $i;DCMPL
+                   ($i;IFNE @else)))
+    
+    (#ls;TextP value)
+    (lux/wrap (|>. peekI
+                   ($i;string value)
+                   ($i;INVOKEVIRTUAL "java.lang.Object"
+                                     "equals"
+                                     ($t;method (list $Object)
+                                                (#;Some $t;boolean)
+                                                (list))
+                                     false)
+                   ($i;IFEQ @else)))
+
+    (#ls;TupleP idx subP)
+    (do macro;Monad<Lux>
+      [subI (generate-pattern' stack-depth @else @end subP)
+       #let [[idx tail?] (case idx
+                           (#;Left idx)
+                           [idx false]
+
+                           (#;Right idx)
+                           [idx true])]]
+      (wrap (case idx
+              +0
+              (|>. peekI
+                   ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
+                   ($i;int 0)
+                   $i;AALOAD
+                   pushI
+                   subI)
+              
+              _
+              (|>. peekI
+                   ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
+                   ($i;int (nat-to-int idx))
+                   ($i;INVOKESTATIC ../runtime;runtime-name
+                                    (if tail? "pm_right" "pm_left")
+                                    ($t;method (list ../runtime;$Tuple $t;int)
+                                               (#;Some $Object)
+                                               (list))
+                                    false)
+                   pushI
+                   subI))))
+
+    (#ls;VariantP idx subP)
+    (do macro;Monad<Lux>
+      [subI (generate-pattern' stack-depth @else @end subP)
+       #let [[idx last?] (case idx
+                           (#;Left idx)
+                           [idx false]
+
+                           (#;Right idx)
+                           [idx true])
+             flagI (if last?
+                     ($i;string "")
+                     $i;NULL)]]
+      (wrap (<| $i;with-label (function [@success])
+                $i;with-label (function [@fail])
+                (|>. peekI
+                     ($i;CHECKCAST ($t;descriptor ../runtime;$Variant))
+                     ($i;int (nat-to-int idx))
+                     flagI
+                     ($i;INVOKESTATIC ../runtime;runtime-name "pm_variant"
+                                      ($t;method (list ../runtime;$Variant ../runtime;$Tag ../runtime;$Flag)
+                                                 (#;Some ../runtime;$Datum)
+                                                 (list))
+                                      false)
+                     $i;DUP
+                     ($i;IFNULL @fail)
+                     ($i;GOTO @success)
+                     ($i;label @fail)
+                     $i;POP
+                     ($i;GOTO @else)
+                     ($i;label @success)
+                     pushI
+                     subI))))
+
+    (#ls;SeqP leftP rightP)
+    (do macro;Monad<Lux>
+      [leftI (generate-pattern' stack-depth @else @end leftP)
+       rightI (generate-pattern' stack-depth @else @end rightP)]
+      (wrap (|>. leftI
+                 rightI)))
+
+    (#ls;AltP leftP rightP)
+    (do macro;Monad<Lux>
+      [@alt-else $i;make-label
+       leftI (generate-pattern' (n.inc stack-depth) @alt-else @end leftP)
+       rightI (generate-pattern' stack-depth @else @end rightP)]
+      (wrap (|>. $i;DUP
+                 leftI
+                 ($i;label @alt-else)
+                 $i;POP
+                 rightI)))
+    ))
+
+(def: (generate-pattern path @end)
+  (-> ls;Path $;Label (Lux $;Inst))
+  (do macro;Monad<Lux>
+    [@else $i;make-label
+     pathI (generate-pattern' +1 @else @end path)]
+    (wrap (|>. pathI
+               ($i;label @else)
+               $i;POP
+               ($i;INVOKESTATIC ../runtime;runtime-name
+                                "pm_fail"
+                                ($t;method (list) #;None (list))
+                                false)
+               $i;NULL
+               ($i;GOTO @end)))))
+
+(def: #export (generate valueS path)
+  (-> ls;Synthesis ls;Path (Lux $;Inst))
+  (do macro;Monad<Lux>
+    [@end $i;make-label
+     valueI (expr;generate valueS)
+     pathI (generate-pattern path @end)]
+    (wrap (|>. valueI
+               $i;NULL
+               $i;SWAP
+               pushI
+               pathI
+               ($i;label @end)))))
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 6085ff72b..0f947925c 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -3,6 +3,7 @@
   (lux (control monad
                 ["p" parser])
        (data text/format
+             ["R" result]
              (coll [list "L/" Functor<List>]))
        [host #+ do-to]
        [macro]
@@ -25,14 +26,16 @@
                   <stack> (declare DUP DUP2 DUP2_X1 DUP2_X2
                                    POP POP2
                                    SWAP)
-                  <jump> (declare IF_ICMPEQ IF_ACMPEQ IFNULL
-                                  IFEQ IFLT IFLE IFGT IFGE
+                  <jump> (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL
+                                  IFEQ IFNE IFLT IFLE IFGT IFGE
                                   GOTO)
                   <var> (declare ILOAD LLOAD DLOAD ALOAD
-                                 ISTORE LSTORE)
+                                 ISTORE LSTORE ASTORE)
                   <arithmethic> (declare IADD ISUB
-                                         LADD LSUB LMUL LDIV LREM LCMP
-                                         DADD DSUB DMUL DDIV DREM DCMPG)
+                                         LADD LSUB LMUL LDIV LREM
+                                         LCMP
+                                         DADD DSUB DMUL DDIV DREM
+                                         DCMPG DCMPL)
                   <return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)]
   (host;import org.objectweb.asm.Opcodes
     <primitive>
@@ -101,9 +104,16 @@
   (visitMethodInsn [int String String String boolean] void)
   (visitLabel [Label] void)
   (visitJumpInsn [int Label] void)
-  (visitTryCatchBlock [Label Label Label String] void))
+  (visitTryCatchBlock [Label Label Label String] void)
+  (visitTableSwitchInsn [int int Label (Array  Label)] void)
+  )
 
 ## [Insts]
+(def: #export make-label
+  (Lux Label)
+  (function [compiler]
+    (#R;Success [compiler (Label.new [])])))
+
 (def: #export (with-label action)
   (-> (-> Label $;Inst) $;Inst)
   (action (Label.new [])))
@@ -149,10 +159,12 @@
   [IADD] [ISUB]
   
   ## Long arithmethic
-  [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP]
+  [LADD] [LSUB] [LMUL] [LDIV] [LREM]
+  [LCMP]
 
   ## Double arithmetic
-  [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DCMPG]
+  [DADD] [DSUB] [DMUL] [DDIV] [DREM]
+  [DCMPG] [DCMPL]
 
   ## Conversions
   [I2L] [L2I] [L2D] [D2L] [I2C]
@@ -175,7 +187,7 @@
          (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
 
   [ILOAD] [LLOAD] [DLOAD] [ALOAD]
-  [ISTORE] [LSTORE]
+  [ISTORE] [LSTORE] [ASTORE]
   )
 
 (do-template [<name> <inst>]
@@ -237,11 +249,26 @@
        (do-to visitor
          (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
 
-  [IF_ICMPEQ] [IF_ACMPEQ] [IFNULL]
-  [IFEQ] [IFLT] [IFLE] [IFGT] [IFGE]
+  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
+  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
   [GOTO]
   )
 
+(def: #export (TABLESWITCH min max default labels)
+  (-> Int Int $;Label (List $;Label) $;Inst)
+  (function [visitor]
+    (let [num-labels (list;size labels)
+          labels-array (host;array Label num-labels)
+          _ (loop [idx +0]
+              (if (n.< num-labels idx)
+                (exec (host;array-write idx
+                                        (assume (list;nth idx labels))
+                                        labels-array)
+                  (recur (n.inc idx)))
+                []))]
+      (do-to visitor
+        (MethodVisitor.visitTableSwitchInsn [min max default labels-array])))))
+
 (def: #export (try @from @to @handler exception)
   (-> $;Label $;Label $;Label Text $;Inst)
   (function [visitor]
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index e094334c0..68e18deaa 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -47,6 +47,12 @@
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
 (def: $Object-Array $;Type ($t;array +1 $Object))
 (def: $String $;Type ($t;class "java.lang.String" (list)))
+(def: #export $Stack $;Type ($t;array +1 $Object))
+(def: #export $Tuple $;Type ($t;array +1 $Object))
+(def: #export $Variant $;Type ($t;array +1 $Object))
+(def: #export $Tag $;Type $t;int)
+(def: #export $Flag $;Type $Object)
+(def: #export $Datum $;Type $Object)
 
 (def: logI
   $;Inst
@@ -55,41 +61,45 @@
     (|>. outI ($i;string "LOG: ") (printI "print")
          outI $i;SWAP (printI "println"))))
 
-(def: sum-method
+(def: variant-method
   $;Method
   ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list)))
 
+(def: variant-makeI
+  $;Inst
+  ($i;INVOKESTATIC runtime-name "variant_make" variant-method false))
+
 (def: #export someI
   $;Inst
   (|>. ($i;int 1)
        ($i;string "")
        $i;DUP2_X1
        $i;POP2
-       ($i;INVOKESTATIC runtime-name "sum_make" sum-method false)))
+       variant-makeI))
 
 (def: #export noneI
   $;Inst
   (|>. ($i;int 0)
        $i;NULL
        ($i;string unit)
-       ($i;INVOKESTATIC runtime-name "sum_make" sum-method false)))
+       variant-makeI))
 
-(def: add-adt-methods
+(def: adt-methods
   $;Def
-  (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE)
-        store-flag (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
-        store-value (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)]
-    (|>. ($d;method #$;Public $;staticM "sum_make"
+  (let [store-tagI (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE)
+        store-flagI (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
+        store-valueI (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)]
+    (|>. ($d;method #$;Public $;staticM "variant_make"
                     ($t;method (list $t;int $Object $Object)
-                               (#;Some ($t;array +1 $Object))
+                               (#;Some $Variant)
                                (list))
                     (|>. ($i;array $Object +3)
-                         store-tag
-                         store-flag
-                         store-value
+                         store-tagI
+                         store-flagI
+                         store-valueI
                          $i;ARETURN)))))
 
-(def: add-nat-methods
+(def: nat-methods
   $;Def
   (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
         less-thanI (function [@where] (|>. ($i;INVOKESTATIC runtime-name "compare_nat" compare-nat-method false) ($i;IFLT @where)))
@@ -183,7 +193,7 @@
 
 (def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0)))
 
-(def: add-frac-methods
+(def: frac-methods
   $;Def
   (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list))
                   (<| $i;with-label (function [@from])
@@ -229,7 +239,7 @@
 (def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list)))
 (def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list)))
 
-(def: add-deg-methods
+(def: deg-methods
   $;Def
   (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits.
         low-half (|>. ($i;int -1) $i;I2L $i;LAND)
@@ -301,14 +311,143 @@
                            $i;DRETURN)))
          )))
 
+(def: pm-methods
+  $;Def
+  (let [tuple-sizeI (|>. ($i;ALOAD +0) $i;ARRAYLENGTH)
+        tuple-elemI (|>. ($i;ALOAD +0) ($i;ILOAD +1) $i;AALOAD)
+        expected-last-sizeI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD)
+        tuple-tailI (|>. ($i;ALOAD +0) tuple-sizeI ($i;int 1) $i;ISUB $i;AALOAD ($i;CHECKCAST ($t;descriptor $Tuple)))]
+    (|>. ($d;method #$;Public $;staticM "pm_fail" ($t;method (list) #;None (list))
+                    (|>. ($i;NEW "java.lang.IllegalStateException")
+                         $i;DUP
+                         ($i;string "Invalid expression for pattern-matching.")
+                         ($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
+                         $i;ATHROW))
+         ($d;method #$;Public $;staticM "pm_push" ($t;method (list $Stack $Object) (#;Some $Stack) (list))
+                    (|>. ($i;int 2)
+                         ($i;ANEWARRAY "java.lang.Object")
+                         $i;DUP
+                         ($i;int 0)
+                         ($i;ALOAD +0)
+                         $i;AASTORE
+                         $i;DUP
+                         ($i;int 1)
+                         ($i;ALOAD +1)
+                         $i;AASTORE
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_pop" ($t;method (list $Stack) (#;Some $Stack) (list))
+                    (|>. ($i;ALOAD +0)
+                         ($i;int 0)
+                         $i;AALOAD
+                         ($i;CHECKCAST ($t;descriptor $Stack))
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_peek" ($t;method (list $Stack) (#;Some $Object) (list))
+                    (|>. ($i;ALOAD +0)
+                         ($i;int 1)
+                         $i;AALOAD
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_variant" ($t;method (list $Stack $t;int $Object) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@just-return])
+                        $i;with-label (function [@then])
+                        $i;with-label (function [@further])
+                        $i;with-label (function [@shorten])
+                        $i;with-label (function [@wrong])
+                        (let [variant-partI (: (-> Nat $;Inst)
+                                               (function [idx]
+                                                 (|>. ($i;int (nat-to-int idx)) $i;AALOAD)))
+                              tagI (: $;Inst
+                                      (|>. (variant-partI +0) ($i;unwrap #$;Int)))
+                              flagI (variant-partI +1)
+                              datumI (variant-partI +2)
+                              shortenI (|>. ($i;ALOAD +0) tagI ## Get tag
+                                            ($i;ILOAD +1) $i;ISUB ## Shorten tag
+                                            ($i;ALOAD +0) flagI ## Get flag
+                                            ($i;ALOAD +0) datumI ## Get value
+                                            variant-makeI ## Build sum
+                                            $i;ARETURN)
+                              update-tagI (|>. $i;ISUB ($i;ISTORE +1))
+                              update-variantI (|>. ($i;ALOAD +0) datumI ($i;CHECKCAST ($t;descriptor $Variant)) ($i;ASTORE +0))
+                              wrongI (|>. $i;NULL $i;ARETURN)
+                              return-datumI (|>. ($i;ALOAD +0) datumI $i;ARETURN)])
+                        (|>. ($i;label @begin)
+                             ($i;ILOAD +1) ## tag
+                             ($i;ALOAD +0) tagI ## tag, sumT
+                             $i;DUP2 ($i;IF_ICMPEQ @then)
+                             $i;DUP2 ($i;IF_ICMPGT @further)
+                             $i;DUP2 ($i;IF_ICMPLT @shorten)
+                             ## $i;POP2
+                             wrongI
+                             ($i;label @then) ## tag, sumT
+                             ($i;ALOAD +2) ## tag, sumT, wants-last?
+                             ($i;ALOAD +0) flagI ## tag, sumT, wants-last?, is-last?
+                             ($i;IF_ACMPEQ @just-return) ## tag, sumT
+                             ($i;label @further) ## tag, sumT
+                             ($i;ALOAD +0) flagI ## tag, sumT, last?
+                             ($i;IFNULL @wrong) ## tag, sumT
+                             update-tagI
+                             update-variantI
+                             ($i;GOTO @begin)
+                             ($i;label @just-return) ## tag, sumT
+                             ## $i;POP2
+                             return-datumI
+                             ($i;label @shorten) ## tag, sumT
+                             ($i;ALOAD +2) ($i;IFNULL @wrong)
+                             ## $i;POP2
+                             shortenI
+                             ($i;label @wrong) ## tag, sumT
+                             ## $i;POP2
+                             wrongI)))
+         ($d;method #$;Public $;staticM "pm_left" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@not-recursive])
+                        (let [updated-idxI (|>. $i;SWAP $i;ISUB)])
+                        (|>. ($i;label @begin)
+                             tuple-sizeI
+                             expected-last-sizeI
+                             $i;DUP2 ($i;IF_ICMPGT @not-recursive)
+                             ## Recursive
+                             updated-idxI ($i;ISTORE +1)
+                             tuple-tailI ($i;ASTORE +0)
+                             ($i;GOTO @begin)
+                             ($i;label @not-recursive)
+                             ## $i;POP2
+                             tuple-elemI
+                             $i;ARETURN)))
+         ($d;method #$;Public $;staticM "pm_right" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@tail])
+                        $i;with-label (function [@slice])
+                        (let [updated-idxI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD tuple-sizeI $i;ISUB)
+                              sliceI (|>. ($i;ALOAD +0) ($i;ILOAD +1) tuple-sizeI
+                                          ($i;INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t;method (list $Object-Array $t;int $t;int) (#;Some $Object-Array) (list)) false))])
+                        (|>. ($i;label @begin)
+                             tuple-sizeI
+                             expected-last-sizeI
+                             $i;DUP2 ($i;IF_ICMPEQ @tail)
+                             ($i;IF_ICMPGT @slice)
+                             ## Must recurse
+                             tuple-tailI ($i;ASTORE +0)
+                             updated-idxI ($i;ISTORE +1)
+                             ($i;GOTO @begin)
+                             ($i;label @slice)
+                             sliceI
+                             $i;ARETURN
+                             ($i;label @tail)
+                             ## $i;POP2
+                             tuple-elemI
+                             $i;ARETURN)))
+         )))
+
 (def: #export generate
   (Lux &common;Bytecode)
   (do Monad<Lux>
     [_ (wrap [])
      #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list)
-                              (|>. add-adt-methods
-                                   add-nat-methods
-                                   add-frac-methods
-                                   add-deg-methods))]
+                              (|>. adt-methods
+                                   nat-methods
+                                   frac-methods
+                                   deg-methods
+                                   pm-methods))]
      _ (&common;store-class runtime-name bytecode)]
     (wrap bytecode)))
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index 64848546f..9adff1a55 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -52,7 +52,7 @@
                (flagI tail?)
                memberI
                ($i;INVOKESTATIC ../runtime;runtime-name
-                                "sum_make"
+                                "variant_make"
                                 ($t;method (list $t;int $Object $Object)
                                            (#;Some ($t;array +1 $Object))
                                            (list))
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux
index 3c05f5dad..983dff6f5 100644
--- a/new-luxc/test/test/luxc/analyser/case.lux
+++ b/new-luxc/test/test/luxc/analyser/case.lux
@@ -40,7 +40,7 @@
        head head+]
       (wrap (#;Cons head tail+)))))
 
-(def: (exhaustive-branches-for allow-literals? variantTC inputC)
+(def: #export (exhaustive-branches allow-literals? variantTC inputC)
   (-> Bool (List [Code Code]) Code (r;Random (List Code)))
   (case inputC
     [_ (#;Bool _)]
@@ -54,7 +54,7 @@
           (case ?sample
             (#;Some sample)
             (do @
-              [else (exhaustive-branches-for allow-literals? variantTC inputC)]
+              [else (exhaustive-branches allow-literals? variantTC inputC)]
               (wrap (list& (<wrapper> sample) else)))
 
             #;None
@@ -74,7 +74,7 @@
 
     [_ (#;Tuple members)]
     (do r;Monad<Random>
-      [member-wise-patterns (monad;map @ (exhaustive-branches-for allow-literals? variantTC) members)]
+      [member-wise-patterns (monad;map @ (exhaustive-branches allow-literals? variantTC) members)]
       (wrap (|> member-wise-patterns
                 exhaustive-weaving
                 (L/map code;tuple))))
@@ -83,7 +83,7 @@
     (do r;Monad<Random>
       [#let [ks (L/map product;left kvs)
              vs (L/map product;right kvs)]
-       member-wise-patterns (monad;map @ (exhaustive-branches-for allow-literals? variantTC) vs)]
+       member-wise-patterns (monad;map @ (exhaustive-branches allow-literals? variantTC) vs)]
       (wrap (|> member-wise-patterns
                 exhaustive-weaving
                 (L/map (|>. (list;zip2 ks) code;record)))))
@@ -93,7 +93,7 @@
       [bundles (monad;map @
                           (function [[_tag _code]]
                             (do @
-                              [v-branches (exhaustive-branches-for allow-literals? variantTC _code)]
+                              [v-branches (exhaustive-branches allow-literals? variantTC _code)]
                               (wrap (L/map (function [pattern] (` ((~ _tag) (~ pattern))))
                                            v-branches))))
                           variantTC)]
@@ -103,10 +103,10 @@
     (r/wrap (list))
     ))
 
-(def: (gen-input variant-tags record-tags primitivesC)
+(def: #export (input variant-tags record-tags primitivesC)
   (-> (List Code) (List Code) (List Code) (r;Random Code))
   (r;rec
-   (function [gen-input]
+   (function [input]
      ($_ r;either
          (r/map product;right gen-primitive)
          (do r;Monad<Random>
@@ -116,7 +116,7 @@
            (wrap (` ((~ choiceT) (~ choiceC)))))
          (do r;Monad<Random>
            [size (|> r;nat (:: @ map (n.% +3)))
-            elems (r;list size gen-input)]
+            elems (r;list size input)]
            (wrap (code;tuple elems)))
          (r/wrap (code;record (list;zip2 record-tags primitivesC)))
          ))))
@@ -141,12 +141,12 @@
          variant-tags+ (L/map (|>. [module-name] code;tag) variant-tags)
          record-tags+ (L/map (|>. [module-name] code;tag) record-tags)
          variantTC (list;zip2 variant-tags+ primitivesC)]
-   inputC (gen-input variant-tags+ record-tags+ primitivesC)
+   inputC (input variant-tags+ record-tags+ primitivesC)
    [outputT outputC] gen-primitive
    [heterogeneousT heterogeneousC] (|> gen-primitive
                                        (r;filter (|>. product;left (tc;checks? outputT) not)))
-   exhaustive-patterns (exhaustive-branches-for true variantTC inputC)
-   redundant-patterns (exhaustive-branches-for false variantTC inputC)
+   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)
diff --git a/new-luxc/test/test/luxc/generator/case.lux b/new-luxc/test/test/luxc/generator/case.lux
new file mode 100644
index 000000000..9e6dbf928
--- /dev/null
+++ b/new-luxc/test/test/luxc/generator/case.lux
@@ -0,0 +1,102 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data text/format
+             [product]
+             ["R" result]
+             [bool "B/" Eq<Bool>]
+             [text "T/" Eq<Text>]
+             (coll ["a" array]
+                   [list "L/" Functor<List>]
+                   ["S" set]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Lux>]
+       (macro [code])
+       [host]
+       test)
+  (luxc (lang ["ls" synthesis])
+        [analyser]
+        [synthesizer]
+        (generator ["@" case]
+                   ["@;" eval]
+                   ["@;" runtime]
+                   ["@;" common]))
+  (test/luxc common))
+
+(def: struct-limit Nat +10)
+
+(def: (tail? size idx)
+  (-> Nat Nat Bool)
+  (n.= (n.dec size) idx))
+
+(def: gen-case
+  (r;Random [ls;Synthesis ls;Path])
+  (<| r;rec (function [gen-case])
+      (with-expansions [<simple> (do-template [<gen> <synth> <path>]
+                                   [(do r;Monad<Random>
+                                      [value <gen>]
+                                      (wrap [(<synth> value) (<path> value)]))]
+
+                                   [r;bool #ls;Bool #ls;BoolP]
+                                   [r;nat #ls;Nat #ls;NatP]
+                                   [r;int #ls;Int #ls;IntP]
+                                   [r;deg #ls;Deg #ls;DegP]
+                                   [r;frac #ls;Frac #ls;FracP]
+                                   [(r;text +5) #ls;Text #ls;TextP])]
+        ($_ r;either
+            (r/wrap [#ls;Unit #ls;UnitP])
+            <simple>
+            (do r;Monad<Random>
+              [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
+               idx (|> r;nat (:: @ map (n.% size)))
+               [subS subP] gen-case
+               #let [dummyS (list;repeat (n.dec size) #ls;Unit)
+                     caseS (#ls;Tuple (list;concat (list (list;take idx dummyS)
+                                                         (list subS)
+                                                         (list;drop idx dummyS))))
+                     caseP (#ls;TupleP (if (tail? idx idx)
+                                         (#;Right idx)
+                                         (#;Left idx))
+                                       subP)]]
+              (wrap [caseS caseP]))
+            (do r;Monad<Random>
+              [size (|> r;nat (:: @ map (|>. (n.% struct-limit) (n.max +2))))
+               idx (|> r;nat (:: @ map (n.% size)))
+               [subS subP] gen-case
+               #let [caseS (#ls;Variant idx (tail? idx idx) subS)
+                     caseP (#ls;VariantP (if (tail? idx idx)
+                                           (#;Right idx)
+                                           (#;Left idx))
+                                         subP)]]
+              (wrap [caseS caseP]))
+            ))))
+
+(context: "Pattern-matching."
+  [[valueS path] gen-case
+   to-bind r;nat]
+  ($_ seq
+      (test "Can generate pattern-matching."
+            (|> (do Monad<Lux>
+                  [runtime-bytecode @runtime;generate]
+                  (@eval;eval (@;generate valueS
+                                          (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true)))
+                                                    (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false)))))))
+                (macro;run (init-compiler []))
+                (case> (#R;Success valueG)
+                       (:! Bool valueG)
+
+                       _
+                       false)))
+      (test "Can bind values."
+            (|> (do Monad<Lux>
+                  [runtime-bytecode @runtime;generate]
+                  (@eval;eval (@;generate (#ls;Nat to-bind)
+                                          (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))))
+                (macro;run (init-compiler []))
+                (case> (#R;Success valueG)
+                       (n.= to-bind (:! Nat valueG))
+
+                       _
+                       false)))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 06f3e940e..d07822069 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -20,6 +20,7 @@
                            ["_;S" loop])
               (generator ["_;G" primitive]
                          ["_;G" structure]
+                         ["_;G" case]
                          (procedure ["_;G" common]))
               ))
   ## (luxc (generator ["_;G" function]))