Basic pattern-matching optimizations.

5 files changed, 437 insertions, 98 deletions

diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 30344aaa0..ca0df7c9f 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -39,11 +39,14 @@
   (Parser Code)
   (function (_ tokens)
     (case tokens
-      #.Nil                (#try.Failure "There are no tokens to parse!")
-      (#.Cons [t tokens']) (#try.Success [tokens' t]))))
+      #.Nil
+      (#try.Failure "There are no tokens to parse!")
+      
+      (#.Cons [t tokens'])
+      (#try.Success [tokens' t]))))
 
-(template [<query> <assertion> <type> <tag> <eq> <desc>]
-  [(with-expansions [<error> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+(template [<query> <check> <type> <tag> <eq> <desc>]
+  [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
      (def: #export <query>
        {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))}
        (Parser <type>)
@@ -53,19 +56,19 @@
            (#try.Success [tokens' x])
 
            _
-           <error>)))
+           <failure>)))
 
-     (def: #export (<assertion> expected)
+     (def: #export (<check> expected)
        (-> <type> (Parser Any))
        (function (_ tokens)
          (case tokens
            (#.Cons [[_ (<tag> actual)] tokens'])
            (if (:: <eq> = expected actual)
              (#try.Success [tokens' []])
-             <error>)
+             <failure>)
 
            _
-           <error>))))]
+           <failure>))))]
 
   [bit        bit!        Bit  #.Bit        bit.equivalence  "bit"]
   [nat        nat!        Nat  #.Nat        nat.equivalence  "nat"]
@@ -91,20 +94,33 @@
       _
       (#try.Failure "There are no tokens to parse!"))))
 
-(template [<name> <tag> <desc>]
-  [(def: #export <name>
-     {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
-     (Parser Text)
-     (function (_ tokens)
-       (case tokens
-         (#.Cons [[_ (<tag> ["" x])] tokens'])
-         (#try.Success [tokens' x])
+(template [<query> <check> <tag> <eq> <desc>]
+  [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+     (def: #export <query>
+       {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
+       (Parser Text)
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> ["" x])] tokens'])
+           (#try.Success [tokens' x])
 
-         _
-         (#try.Failure ($_ text@compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+           _
+           <failure>)))
+
+     (def: #export (<check> expected)
+       (-> Text (Parser Any))
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> ["" actual])] tokens'])
+           (if (:: <eq> = expected actual)
+             (#try.Success [tokens' []])
+             <failure>)
+
+           _
+           <failure>))))]
 
-  [local-identifier #.Identifier "identifier"]
-  [   local-tag     #.Tag        "tag"]
+  [local-identifier local-identifier! #.Identifier text.equivalence "local identifier"]
+  [       local-tag        local-tag! #.Tag        text.equivalence "local tag"]
   )
 
 (template [<name> <tag> <desc>]
@@ -177,5 +193,5 @@
   (All [a] (-> (List Code) (Parser a) (Parser a)))
   (function (_ real)
     (do try.monad
-      [value (run syntax inputs)]
+      [value (..run syntax inputs)]
       (wrap [real value]))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 8d3b7b2d5..3e2bbd321 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -65,14 +65,19 @@
     (#///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?)]
-                     (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right?
-                                                                       (#.Right (dec tuple::lefts))
-                                                                       (#.Left tuple::lefts)))))))
-                         (path' tuple::member end?')
-                         (when> [(new> (not end?') [])] [(///@map ..clean-up)])
-                         nextC)))
+                   (.case tuple::member
+                     (#///analysis.Simple #///analysis.Unit)
+                     nextC
+
+                     _
+                     (let [right? (n.= tuple::last tuple::lefts)
+                           end?' (and end? right?)]
+                       (<| (///@map (|>> (#/.Seq (#/.Access (#/.Member (if right?
+                                                                         (#.Right (dec tuple::lefts))
+                                                                         (#.Left tuple::lefts)))))))
+                           (path' tuple::member end?')
+                           (when> [(new> (not end?') [])] [(///@map ..clean-up)])
+                           nextC))))
                  thenC
                  (list.reverse (list.enumerate tuple))))
     ))
@@ -81,27 +86,32 @@
   (-> Archive Phase Pattern Analysis (Operation Path))
   (path' pattern true (///@map (|>> #/.Then) (synthesize archive bodyA))))
 
-(def: (weave leftP rightP)
+(def: (weave new old)
   (-> Path Path Path)
-  (with-expansions [<default> (as-is (#/.Alt leftP rightP))]
-    (case [leftP rightP]
-      [(#/.Seq preL postL)
-       (#/.Seq preR postR)]
-      (case (weave preL preR)
+  (with-expansions [<default> (as-is (#/.Alt old new))]
+    (case [new old]
+      [_
+       (#/.Alt old-left old-right)]
+      (#/.Alt old-left
+              (weave new old-right))
+
+      [(#/.Seq preN postN)
+       (#/.Seq preO postO)]
+      (case (weave preN preO)
         (#/.Alt _)
         <default>
 
-        weavedP
-        (#/.Seq weavedP (weave postL postR)))
+        woven
+        (#/.Seq woven (weave postN postO)))
 
       [#/.Pop #/.Pop]
-      rightP
+      old
 
       (^template [<tag> <eq>]
-        [(#/.Test (<tag> leftV))
-         (#/.Test (<tag> rightV))]
-        (if (<eq> leftV rightV)
-          rightP
+        [(#/.Test (<tag> newV))
+         (#/.Test (<tag> oldV))]
+        (if (<eq> newV oldV)
+          old
           <default>))
       ([#/.Bit bit@=]
        [#/.I64 "lux i64 ="]
@@ -109,19 +119,19 @@
        [#/.Text text@=])
 
       (^template [<access> <side>]
-        [(#/.Access (<access> (<side> leftL)))
-         (#/.Access (<access> (<side> rightL)))]
-        (if (n.= leftL rightL)
-          rightP
+        [(#/.Access (<access> (<side> newL)))
+         (#/.Access (<access> (<side> oldL)))]
+        (if (n.= newL oldL)
+          old
           <default>))
       ([#/.Side #.Left]
        [#/.Side #.Right]
        [#/.Member #.Left]
        [#/.Member #.Right])
 
-      [(#/.Bind leftR) (#/.Bind rightR)]
-      (if (n.= leftR rightR)
-        rightP
+      [(#/.Bind newR) (#/.Bind oldR)]
+      (if (n.= newR oldR)
+        old
         <default>)
 
       _
@@ -162,19 +172,12 @@
           _
           <failure>)))))
 
-(def: #export (synthesize-case synthesize archive input [headB tailB+])
+(def: #export (synthesize-case synthesize archive input [[headP headA] tailPA+])
   (-> Phase Archive Synthesis Match (Operation Synthesis))
-  (let [[[lastP lastA] prevsPA] (|> (#.Cons headB tailB+)
-                                    list.reverse
-                                    (case> (#.Cons [lastP lastA] prevsPA)
-                                           [[lastP lastA] prevsPA]
-                                           
-                                           _
-                                           (undefined)))]
-    (do {@ ///.monad}
-      [lastSP (path archive synthesize lastP lastA)
-       prevsSP+ (monad.map @ (product.uncurry (path archive synthesize)) prevsPA)]
-      (wrap (/.branch/case [input (list@fold weave lastSP prevsSP+)])))))
+  (do {@ ///.monad}
+    [headSP (path archive synthesize headP headA)
+     tailSP+ (monad.map @ (product.uncurry (path archive synthesize)) tailPA+)]
+    (wrap (/.branch/case [input (list@fold weave headSP tailSP+)]))))
 
 (template: (!masking <variable> <output>)
   [[(#///analysis.Bind <variable>)
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 29c34b430..bad67d90a 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -23,7 +23,8 @@
     ["#/." analysis]
     ["#/." binary]
     ["#/." text]
-    ["#/." cli]]
+    ["#/." cli]
+    ["#/." code]]
    ["#." pipe]
    ["#." reader]
    ["#." region]
@@ -63,6 +64,7 @@
       /parser/binary.test
       /parser/text.test
       /parser/cli.test
+      /parser/code.test
       ))
 
 (def: security
diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux
new file mode 100644
index 000000000..696f70265
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/code.lux
@@ -0,0 +1,135 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." function]
+    ["." try]
+    ["<>" parser]]
+   [data
+    ["." bit]
+    ["." name]
+    ["." text ("#@." equivalence)]
+    [number
+     ["." nat]
+     ["." int]
+     ["." rev]
+     ["." frac]]
+    [collection
+     ["." list]]]
+   [macro
+    ["." code ("#@." equivalence)]]
+   [math
+    ["." random (#+ Random)]]]
+  {1
+   ["." /]})
+
+(template: (!expect <pattern> <value>)
+  (case <value>
+    <pattern>
+    true
+    
+    _
+    false))
+
+(def: random-name
+  (Random Name)
+  (random.and (random.unicode 1)
+              (random.unicode 1)))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Parser])
+      (`` ($_ _.and
+              (do {@ random.monad}
+                [expected (:: @ map code.bit random.bit)]
+                (_.cover [/.run]
+                         (and (|> (/.run /.any (list expected))
+                                  (!expect (#try.Success _)))
+                              (|> (/.run /.any (list))
+                                  (!expect (#try.Failure _))))))
+              (~~ (template [<query> <check> <random> <code> <equivalence>]
+                    [(do {@ random.monad}
+                       [expected <random>
+                        dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))]
+                       ($_ _.and
+                           (_.cover [<query>]
+                                    (|> (/.run <query> (list (<code> expected)))
+                                        (!expect (^multi (#try.Success actual)
+                                                         (:: <equivalence> = expected actual)))))
+                           (_.cover [<check>]
+                                    (and (|> (/.run (<check> expected) (list (<code> expected)))
+                                             (!expect (#try.Success [])))
+                                         (|> (/.run (<check> expected) (list (<code> dummy)))
+                                             (!expect (#try.Failure _)))))
+                           ))]
+
+                    [/.any /.this! (:: @ map code.bit random.bit) function.identity code.equivalence]
+                    [/.bit /.bit! random.bit code.bit bit.equivalence]
+                    [/.nat /.nat! random.nat code.nat nat.equivalence]
+                    [/.int /.int! random.int code.int int.equivalence]
+                    [/.rev /.rev! random.rev code.rev rev.equivalence]
+                    [/.frac /.frac! random.frac code.frac frac.equivalence]
+                    [/.text /.text! (random.unicode 1) code.text text.equivalence]
+                    [/.identifier /.identifier! ..random-name code.identifier name.equivalence]
+                    [/.tag /.tag! ..random-name code.tag name.equivalence]
+                    [/.local-identifier /.local-identifier! (random.unicode 1) code.local-identifier text.equivalence]
+                    [/.local-tag /.local-tag! (random.unicode 1) code.local-tag text.equivalence]
+                    ))
+              (~~ (template [<query> <code>]
+                    [(do {@ random.monad}
+                       [expected-left random.nat
+                        expected-right random.int]
+                       (_.cover [<query>]
+                                (|> (/.run (<query> (<>.and /.nat /.int))
+                                           (list (<code> (list (code.nat expected-left)
+                                                               (code.int expected-right)))))
+                                    (!expect (^multi (#try.Success [actual-left actual-right])
+                                                     (and (:: nat.equivalence = expected-left actual-left)
+                                                          (:: int.equivalence = expected-right actual-right)))))))]
+
+                    [/.form code.form]
+                    [/.tuple code.tuple]
+                    ))
+              (do {@ random.monad}
+                [expected-left random.nat
+                 expected-right random.int]
+                (_.cover [/.record]
+                         (|> (/.run (/.record (<>.and /.nat /.int))
+                                    (list (code.record (list [(code.nat expected-left)
+                                                              (code.int expected-right)]))))
+                             (!expect (^multi (#try.Success [actual-left actual-right])
+                                              (and (:: nat.equivalence = expected-left actual-left)
+                                                   (:: int.equivalence = expected-right actual-right)))))))
+              (do {@ random.monad}
+                [expected-local random.nat
+                 expected-global random.int]
+                (_.cover [/.local]
+                         (|> (/.run (<>.and (/.local (list (code.nat expected-local)) /.nat)
+                                            /.int)
+                                    (list (code.int expected-global)))
+                             (!expect (^multi (#try.Success [actual-local actual-global])
+                                              (and (:: nat.equivalence = expected-local actual-local)
+                                                   (:: int.equivalence = expected-global actual-global)))))))
+              (do {@ random.monad}
+                [dummy (:: @ map code.bit random.bit)]
+                (_.cover [/.end?]
+                         (|> (/.run (do <>.monad
+                                      [pre /.end?
+                                       _ /.any
+                                       post /.end?]
+                                      (wrap (and (not pre)
+                                                 post)))
+                                    (list dummy))
+                             (!expect (^multi (#try.Success verdict)
+                                              verdict)))))
+              (do {@ random.monad}
+                [dummy (:: @ map code.bit random.bit)]
+                (_.cover [/.end!]
+                         (and (|> (/.run /.end! (list))
+                                  (!expect (#try.Success [])))
+                              (|> (/.run /.end! (list dummy))
+                                  (!expect (#try.Failure _))))))
+              ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index d084e0210..2209bf366 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -2,16 +2,23 @@
   [lux #*
    ["_" test (#+ Test)]
    [abstract
+    [hash (#+ Hash)]
     ["." monad (#+ do)]]
    [control
-    pipe
+    [pipe (#+ case>)]
     ["." try ("#@." functor)]]
    [data
     ["." sum]
+    ["." text
+     ["%" format (#+ format)]]
     [number
-     ["n" nat]]
+     ["n" nat]
+     ["." int]
+     ["." rev]
+     ["." frac]]
     [collection
-     ["." list ("#@." fold monoid)]]]
+     ["." list ("#@." functor fold monoid)]
+     ["." set]]]
    [math
     ["." random (#+ Random) ("#@." monad)]]]
   ["." // #_
@@ -23,8 +30,8 @@
       [extension
        ["#." bundle]]
       ["/#" //
-       ["#." analysis (#+ Branch Analysis)]
-       ["#." synthesis (#+ Synthesis)]
+       ["." analysis (#+ Branch Match Analysis)]
+       ["." synthesis (#+ Path Synthesis)]
        [///
         ["#." reference
          [variable (#+ Register)]]
@@ -37,15 +44,15 @@
   (do {@ random.monad}
     [maskedA //primitive.primitive
      temp (|> random.nat (:: @ map (n.% 100)))
-     #let [maskA (////analysis.control/case
+     #let [maskA (analysis.control/case
                   [maskedA
-                   [[(#////analysis.Bind temp)
-                     (#////analysis.Reference (////reference.local temp))]
+                   [[(#analysis.Bind temp)
+                     (#analysis.Reference (////reference.local temp))]
                     (list)]])]]
     (_.cover [/.synthesize-masking]
              (|> maskA
                  (//.phase archive.empty)
-                 (phase.run [///bundle.empty ////synthesis.init])
+                 (phase.run [///bundle.empty synthesis.init])
                  (try@map (//primitive.corresponds? maskedA))
                  (try.default false)))))
 
@@ -55,16 +62,16 @@
     [registerA random.nat
      inputA //primitive.primitive
      outputA //primitive.primitive
-     #let [letA (////analysis.control/case
+     #let [letA (analysis.control/case
                  [inputA
-                  [[(#////analysis.Bind registerA)
+                  [[(#analysis.Bind registerA)
                     outputA]
                    (list)]])]]
     (_.cover [/.synthesize-let]
              (|> letA
                  (//.phase archive.empty)
-                 (phase.run [///bundle.empty ////synthesis.init])
-                 (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
+                 (phase.run [///bundle.empty synthesis.init])
+                 (case> (^ (#try.Success (synthesis.branch/let [inputS registerS outputS])))
                         (and (n.= registerA registerS)
                              (//primitive.corresponds? inputA inputS)
                              (//primitive.corresponds? outputA outputS))
@@ -80,19 +87,19 @@
      thenA //primitive.primitive
      elseA //primitive.primitive
      #let [thenB (: Branch
-                    [(#////analysis.Simple (#////analysis.Bit true))
+                    [(#analysis.Simple (#analysis.Bit true))
                      thenA])
            elseB (: Branch
-                    [(#////analysis.Simple (#////analysis.Bit false))
+                    [(#analysis.Simple (#analysis.Bit false))
                      elseA])
            ifA (if then|else
-                 (////analysis.control/case [inputA [thenB (list elseB)]])
-                 (////analysis.control/case [inputA [elseB (list thenB)]]))]]
+                 (analysis.control/case [inputA [thenB (list elseB)]])
+                 (analysis.control/case [inputA [elseB (list thenB)]]))]]
     (_.cover [/.synthesize-if]
              (|> ifA
                  (//.phase archive.empty)
-                 (phase.run [///bundle.empty ////synthesis.init])
-                 (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
+                 (phase.run [///bundle.empty synthesis.init])
+                 (case> (^ (#try.Success (synthesis.branch/if [inputS thenS elseS])))
                         (and (//primitive.corresponds? inputA inputS)
                              (//primitive.corresponds? thenA thenS)
                              (//primitive.corresponds? elseA elseS))
@@ -101,7 +108,7 @@
                         false)))))
 
 (def: random-member
-  (Random ////synthesis.Member)
+  (Random synthesis.Member)
   (do {@ random.monad}
     [lefts (|> random.nat (:: @ map (n.% 10)))
      right? random.bit]
@@ -110,28 +117,28 @@
             (#.Left lefts)))))
 
 (def: random-path
-  (Random (////analysis.Tuple ////synthesis.Member))
+  (Random (analysis.Tuple synthesis.Member))
   (do {@ random.monad}
     [size-1 (|> random.nat (:: @ map (|>> (n.% 10) inc)))]
     (random.list size-1 ..random-member)))
 
 (def: (get-pattern path)
-  (-> (////analysis.Tuple ////synthesis.Member)
-      (Random [////analysis.Pattern Register]))
+  (-> (analysis.Tuple synthesis.Member)
+      (Random [analysis.Pattern Register]))
   (do random.monad
     [@member random.nat]
     (wrap [(list@fold (function (_ member inner)
                         (case member
                           (#.Left lefts)
-                          (////analysis.pattern/tuple
-                           (list@compose (list.repeat lefts (////analysis.pattern/unit))
-                                         (list inner (////analysis.pattern/unit))))
+                          (analysis.pattern/tuple
+                           (list@compose (list.repeat lefts (analysis.pattern/unit))
+                                         (list inner (analysis.pattern/unit))))
                           
                           (#.Right lefts)
-                          (////analysis.pattern/tuple
-                           (list@compose (list.repeat (inc lefts) (////analysis.pattern/unit))
+                          (analysis.pattern/tuple
+                           (list@compose (list.repeat (inc lefts) (analysis.pattern/unit))
                                          (list inner)))))
-                      (#////analysis.Bind @member)
+                      (#analysis.Bind @member)
                       (list.reverse path))
            @member])))
 
@@ -139,25 +146,200 @@
   Test
   (do {@ random.monad}
     [recordA (|> random.nat
-                 (:: @ map (|>> ////analysis.nat))
+                 (:: @ map (|>> analysis.nat))
                  (random.list 10)
-                 (:: @ map (|>> ////analysis.tuple)))
+                 (:: @ map (|>> analysis.tuple)))
      pathA ..random-path
      [pattern @member] (get-pattern pathA)
-     #let [getA (////analysis.control/case [recordA [[pattern
-                                                      (#////analysis.Reference (////reference.local @member))]
-                                                     (list)]])]]
+     #let [getA (analysis.control/case [recordA [[pattern
+                                                  (#analysis.Reference (////reference.local @member))]
+                                                 (list)]])]]
     (_.cover [/.synthesize-get]
              (|> getA
                  (//.phase archive.empty)
-                 (phase.run [///bundle.empty ////synthesis.init])
-                 (case> (^ (#try.Success (////synthesis.branch/get [pathS recordS])))
+                 (phase.run [///bundle.empty synthesis.init])
+                 (case> (^ (#try.Success (synthesis.branch/get [pathS recordS])))
                         (and (:: (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS)
                              (//primitive.corresponds? recordA recordS))
 
                         _
                         false)))))
 
+(def: random-bit
+  (Random [Path Match])
+  (do {@ random.monad}
+    [test random.bit
+     then random.nat
+     else random.nat]
+    (wrap [(#synthesis.Alt (#synthesis.Seq (synthesis.path/bit test)
+                                           (#synthesis.Then (synthesis.i64 (.i64 then))))
+                           (#synthesis.Seq (synthesis.path/bit (not test))
+                                           (#synthesis.Then (synthesis.i64 (.i64 else)))))
+           [{#analysis.when (analysis.pattern/bit test)
+             #analysis.then (analysis.nat then)}
+            (list {#analysis.when (analysis.pattern/bit (not test))
+                   #analysis.then (analysis.nat else)})]])))
+
+(def: (random-five hash random-element)
+  (All [a] (-> (Hash a) (Random a) (Random [a a a a a])))
+  (|> random-element
+      (random.set hash 5)
+      (:: random.monad map (|>> set.to-list
+                                (case> (^ (list s0 s1 s2 s3 s4))
+                                       [s0 s1 s2 s3 s4]
+
+                                       _
+                                       (undefined))))))
+
+(template [<name> <hash> <random> <path> <synthesis> <pattern> <analysis>]
+  [(def: <name>
+     (Random [Path Match])
+     (do {@ random.monad}
+       [[test/0 test/1 test/2 test/3 test/4] (random-five <hash> <random>)
+        [body/0 body/1 body/2 body/3 body/4] (random-five <hash> <random>)]
+       (wrap [($_ #synthesis.Alt
+                  (#synthesis.Seq (<path> test/0) (#synthesis.Then (<synthesis> body/0)))
+                  (#synthesis.Seq (<path> test/1) (#synthesis.Then (<synthesis> body/1)))
+                  (#synthesis.Seq (<path> test/2) (#synthesis.Then (<synthesis> body/2)))
+                  (#synthesis.Seq (<path> test/3) (#synthesis.Then (<synthesis> body/3)))
+                  (#synthesis.Seq (<path> test/4) (#synthesis.Then (<synthesis> body/4))))
+              [{#analysis.when (<pattern> test/0) #analysis.then (<analysis> body/0)}
+               (list {#analysis.when (<pattern> test/1) #analysis.then (<analysis> body/1)}
+                     {#analysis.when (<pattern> test/2) #analysis.then (<analysis> body/2)}
+                     {#analysis.when (<pattern> test/3) #analysis.then (<analysis> body/3)}
+                     {#analysis.when (<pattern> test/4) #analysis.then (<analysis> body/4)})]])))]
+
+  [random-nat n.hash random.nat (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/nat analysis.nat]
+  [random-int int.hash random.int (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/int analysis.int]
+  [random-rev rev.hash random.rev (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/rev analysis.rev]
+  [random-frac frac.hash random.frac synthesis.path/f64 synthesis.f64 analysis.pattern/frac analysis.frac]
+  [random-text text.hash (random.unicode 1) synthesis.path/text synthesis.text analysis.pattern/text analysis.text]
+  )
+
+(def: random-simple
+  ($_ random.either
+      ..random-bit
+      ..random-nat
+      ..random-int
+      ..random-rev
+      ..random-frac
+      ..random-text
+      ))
+
+(def: random-variant
+  (Random [Path Match])
+  (do {@ random.monad}
+    [[lefts/0 lefts/1 lefts/2 lefts/3 lefts/4] (random-five n.hash random.nat)
+     [value/0 value/1 value/2 value/3 value/4] (random-five text.hash (random.unicode 1))
+     last-is-right? random.bit
+     [body/0 body/1 body/2 body/3 body/4] (random-five frac.hash random.frac)
+     #let [path (: (-> Nat Bit Text Frac Path)
+                   (function (_ lefts right? value body)
+                     ($_ #synthesis.Seq
+                         (synthesis.path/side (if right?
+                                                (#.Right lefts)
+                                                (#.Left lefts)))
+                         (synthesis.path/text value)
+                         (#synthesis.Then (synthesis.f64 body)))))
+           branch (: (-> Nat Bit Text Frac Branch)
+                     (function (_ lefts right? value body)
+                       {#analysis.when (analysis.pattern/variant {#analysis.lefts lefts
+                                                                  #analysis.right? right?
+                                                                  #analysis.value (analysis.pattern/text value)})
+                        #analysis.then (analysis.frac body)}))]]
+    (wrap [($_ #synthesis.Alt
+               (path lefts/0 false value/0 body/0)
+               (path lefts/1 false value/1 body/1)
+               (path lefts/2 false value/2 body/2)
+               (path lefts/3 false value/3 body/3)
+               (path lefts/4 last-is-right? value/4 body/4))
+           [(branch lefts/0 false value/0 body/0)
+            (list (branch lefts/1 false value/1 body/1)
+                  (branch lefts/2 false value/2 body/2)
+                  (branch lefts/3 false value/3 body/3)
+                  (branch lefts/4 last-is-right? value/4 body/4))]])))
+
+(def: random-tuple
+  (Random [Path Match])
+  (do {@ random.monad}
+    [mid-size (:: @ map (n.% 4) random.nat)
+
+     value/first (random.unicode 1)
+     value/mid (random.list mid-size (random.unicode 1))
+     value/last (random.unicode 1)
+
+     body/first random.frac
+     body/mid (random.list mid-size random.frac)
+     body/last random.frac
+     #let [path (: (-> Nat Bit Text Frac Path)
+                   (function (_ lefts right? value body)
+                     (if right?
+                       ($_ #synthesis.Seq
+                           (synthesis.path/member (if right?
+                                                    (#.Right lefts)
+                                                    (#.Left lefts)))
+                           (synthesis.path/text value)
+                           (#synthesis.Then (synthesis.f64 body)))
+                       ($_ #synthesis.Seq
+                           (synthesis.path/member (if right?
+                                                    (#.Right lefts)
+                                                    (#.Left lefts)))
+                           (synthesis.path/text value)
+                           #synthesis.Pop
+                           (#synthesis.Then (synthesis.f64 body))))))
+           branch (: (-> Nat Bit Text Frac Branch)
+                     (function (_ lefts right? value body)
+                       {#analysis.when (if right?
+                                         (analysis.pattern/tuple (list@compose (list.repeat (inc lefts) (analysis.pattern/unit))
+                                                                               (list (analysis.pattern/text value))))
+                                         (analysis.pattern/tuple ($_ list@compose
+                                                                     (list.repeat lefts (analysis.pattern/unit))
+                                                                     (list (analysis.pattern/text value)
+                                                                           (analysis.pattern/unit)))))
+                        #analysis.then (analysis.frac body)}))]]
+    (wrap [(list@fold (function (_ left right)
+                        (#synthesis.Alt left right))
+                      (path (inc mid-size) true value/last body/last)
+                      (|> (list.zip2 value/mid body/mid)
+                          (#.Cons [value/first body/first])
+                          list.enumerate
+                          (list@map (function (_ [lefts' [value body]])
+                                      (path lefts' false value body)))
+                          list.reverse))
+           [(branch 0 false value/first body/first)
+            (list@compose (|> (list.zip2 value/mid body/mid)
+                              list.enumerate
+                              (list@map (function (_ [lefts' [value body]])
+                                          (branch (inc lefts') false value body))))
+                          (list (branch (inc mid-size) true value/last body/last)))]])))
+
+(def: random-complex
+  ($_ random.either
+      ..random-variant
+      ..random-tuple
+      ))
+
+(def: random-case
+  ($_ random.either
+      ..random-simple
+      ..random-complex
+      ))
+
+(def: case-test
+  Test
+  (do {@ random.monad}
+    [expected-input (:: @ map (|>> .i64 synthesis.i64) random.nat)
+     [expected-path match] ..random-case]
+    (_.cover [/.synthesize-case]
+             (|> (/.synthesize-case //.phase archive.empty expected-input match)
+                 (phase.run [///bundle.empty synthesis.init])
+                 (case> (^ (#try.Success (synthesis.branch/case [actual-input actual-path])))
+                        (and (:: synthesis.equivalence = expected-input actual-input)
+                             (:: synthesis.path-equivalence = expected-path actual-path))
+
+                        _
+                        false)))))
+
 (def: #export test
   Test
   (<| (_.covering /._)
@@ -167,4 +349,5 @@
           ..let-test
           ..if-test
           ..get-test
+          ..case-test
           )))