Fixes for the pure-Lux JVM compiler machinery. [Part 13 / Done!]

7 files changed, 775 insertions, 416 deletions

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 2b72f6dad..b859f456f 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -431,94 +431,97 @@
                              (n.= (..sum n/0 n/1 n/1)
                                   (..sum' n/0 n/1 n/1))))
                   (_.cover [/.using]
-                           (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer)
-                                             <alias> (static.random code.text (random.ascii/lower 1))
-                                             <definition> (static.random code.local_symbol (random.ascii/lower 1))
-                                             <module/0> (static.random code.text (random.ascii/lower 2))
-                                             <module/0>' (template.symbol [<module/0>])
-                                             <module/1> (static.random code.text (random.ascii/lower 3))
-                                             <module/1>' (template.symbol [<module/1>])
-                                             <module/2> (static.random code.text (random.ascii/lower 4))
-                                             <module/2>' (template.symbol [<module/2>])
-                                             <m0/1> (template.text [<module/0> "/" <module/1>])
-                                             <//> (template.text [// <module/2>'])
-                                             <//>' (template.symbol [<//>])
-                                             <\\> (template.text [\\ <module/2>'])
-                                             <\\>' (template.symbol [<\\>])
-                                             <m0/2> (template.text [<module/0> "/" <module/2>])
-                                             <m2/1> (template.text [<module/2> "/" <module/1>])
-                                             <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>])
-                                             <open/0> (template.text [<module/0> "#[0]"])]
-                             (and (~~ (template [<input> <pattern>]
-                                        [(with_expansions [<input>' (macro.final <input>)]
-                                           (case (' [<input>'])
-                                             (^code <pattern>)
-                                             true
-
-                                             _
-                                             false))]
-
-                                        [(.using [<module/0>'])
-                                         [("lux def module" [])]]
-                                        
-                                        [(.using [<alias> <module/0>' "*"])
-                                         [("lux def module" [[<module/0> <alias>]])
-                                          (<referral> <module/0> "*")]]
-                                        
-                                        [(.using [<alias> <module/0>' {"+" <definition>}])
-                                         [("lux def module" [[<module/0> <alias>]])
-                                          (<referral> <module/0> {"+" <definition>})]]
-                                        
-                                        [(.using [<alias> <module/0>' {"-" <definition>}])
-                                         [("lux def module" [[<module/0> <alias>]])
-                                          (<referral> <module/0> {"-" <definition>})]]
-                                        
-                                        [(.using [<alias> <module/0>' "_"])
-                                         [("lux def module" [])]]
-                                        
-                                        [(.using [<module/0>'
-                                                  [<alias> <module/1>']])
-                                         [("lux def module" [[<m0/1> <alias>]])
-                                          (<referral> <m0/1>)]]
-                                        
-                                        [(.using ["[0]" <module/0>'
-                                                  ["[0]" <module/1>']])
-                                         [("lux def module" [[<module/0> <module/0>]
-                                                             [<m0/1> <module/1>]])
-                                          (<referral> <module/0>)
-                                          (<referral> <m0/1>)]]
-                                        
-                                        [(.using ["[0]" <module/0>' "_"
-                                                  ["[1]" <module/1>']])
-                                         [("lux def module" [[<m0/1> <module/0>]])
-                                          (<referral> <m0/1>)]]
-                                        
-                                        [(.using ["[0]" <module/0>' "_"
-                                                  ["[1]" <module/1>' "_"
-                                                   ["[2]" <module/2>']]])
-                                         [("lux def module" [[<m0/1/2> <module/0>]])
-                                          (<referral> <m0/1/2>)]]
-                                        
-                                        [(.using [<module/0>'
-                                                  ["[0]" <module/1>'
-                                                   ["[0]" <//>']]])
-                                         [("lux def module" [[<m0/1> <module/1>]
-                                                             [<m0/2> <//>]])
-                                          (<referral> <m0/1>)
-                                          (<referral> <m0/2>)]]
-                                        
-                                        [(.using ["[0]" <module/0>'
-                                                  [<module/1>'
-                                                   ["[0]" <\\>']]])
-                                         [("lux def module" [[<module/0> <module/0>]
-                                                             [<m2/1> <\\>]])
-                                          (<referral> <module/0>)
-                                          (<referral> <m2/1>)]]
-                                        
-                                        [(.using ["[0]" <module/0>' ("[1]#[0]" <definition>)])
-                                         [("lux def module" [[<module/0> <module/0>]])
-                                          (<referral> <module/0> (<open/0> <definition>))]]
-                                        )))))
+                           (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer)
+                                                 <alias> (static.random code.text (random.ascii/lower 1))
+                                                 <definition> (static.random code.local_symbol (random.ascii/lower 1))
+                                                 <module/0> (static.random code.text (random.ascii/lower 2))
+                                                 <module/0>' (template.symbol [<module/0>])
+                                                 <module/1> (static.random code.text (random.ascii/lower 3))
+                                                 <module/1>' (template.symbol [<module/1>])
+                                                 <module/2> (static.random code.text (random.ascii/lower 4))
+                                                 <module/2>' (template.symbol [<module/2>])
+                                                 <m0/1> (template.text [<module/0> "/" <module/1>])
+                                                 <//> (template.text [// <module/2>'])
+                                                 <//>' (template.symbol [<//>])
+                                                 <\\> (template.text [\\ <module/2>'])
+                                                 <\\>' (template.symbol [<\\>])
+                                                 <m0/2> (template.text [<module/0> "/" <module/2>])
+                                                 <m2/1> (template.text [<module/2> "/" <module/1>])
+                                                 <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>])
+                                                 <open/0> (template.text [<module/0> "#[0]"])]
+                                 (and (~~ (template [<input> <pattern>]
+                                            [(with_expansions [<input>' (macro.final <input>)]
+                                               (let [scenario (: (-> Any Bit)
+                                                                 (function (_ _)
+                                                                   (case (' [<input>'])
+                                                                     (^code <pattern>)
+                                                                     true
+
+                                                                     _
+                                                                     false)))]
+                                                 (scenario [])))]
+
+                                            [(.using [<module/0>'])
+                                             [("lux def module" [])]]
+                                            
+                                            [(.using [<alias> <module/0>' "*"])
+                                             [("lux def module" [[<module/0> <alias>]])
+                                              (<referral> <module/0> "*")]]
+                                            
+                                            [(.using [<alias> <module/0>' {"+" <definition>}])
+                                             [("lux def module" [[<module/0> <alias>]])
+                                              (<referral> <module/0> {"+" <definition>})]]
+                                            
+                                            [(.using [<alias> <module/0>' {"-" <definition>}])
+                                             [("lux def module" [[<module/0> <alias>]])
+                                              (<referral> <module/0> {"-" <definition>})]]
+                                            
+                                            [(.using [<alias> <module/0>' "_"])
+                                             [("lux def module" [])]]
+                                            
+                                            [(.using [<module/0>'
+                                                      [<alias> <module/1>']])
+                                             [("lux def module" [[<m0/1> <alias>]])
+                                              (<referral> <m0/1>)]]
+                                            
+                                            [(.using ["[0]" <module/0>'
+                                                      ["[0]" <module/1>']])
+                                             [("lux def module" [[<module/0> <module/0>]
+                                                                 [<m0/1> <module/1>]])
+                                              (<referral> <module/0>)
+                                              (<referral> <m0/1>)]]
+                                            
+                                            [(.using ["[0]" <module/0>' "_"
+                                                      ["[1]" <module/1>']])
+                                             [("lux def module" [[<m0/1> <module/0>]])
+                                              (<referral> <m0/1>)]]
+
+                                            [(.using ["[0]" <module/0>' "_"
+                                                      ["[1]" <module/1>' "_"
+                                                       ["[2]" <module/2>']]])
+                                             [("lux def module" [[<m0/1/2> <module/0>]])
+                                              (<referral> <m0/1/2>)]]
+                                            
+                                            [(.using [<module/0>'
+                                                      ["[0]" <module/1>'
+                                                       ["[0]" <//>']]])
+                                             [("lux def module" [[<m0/1> <module/1>]
+                                                                 [<m0/2> <//>]])
+                                              (<referral> <m0/1>)
+                                              (<referral> <m0/2>)]]
+                                            
+                                            [(.using ["[0]" <module/0>'
+                                                      [<module/1>'
+                                                       ["[0]" <\\>']]])
+                                             [("lux def module" [[<module/0> <module/0>]
+                                                                 [<m2/1> <\\>]])
+                                              (<referral> <module/0>)
+                                              (<referral> <m2/1>)]]
+                                            
+                                            [(.using ["[0]" <module/0>' ("[1]#[0]" <definition>)])
+                                             [("lux def module" [[<module/0> <module/0>]])
+                                              (<referral> <module/0> (<open/0> <definition>))]]
+                                            ))))))
                   ))))))
 
 (/.type: for_type/variant
@@ -1278,7 +1281,7 @@
   (<| (_.covering /._)
       (`` (`` (_.in_parallel
                (list ..test|lux
-
+                     
                      /abstract.test
                      /control.test
                      /data.test
@@ -1288,7 +1291,7 @@
                      /locale.test
                      /macro.test
                      /math.test
-
+                     
                      /meta.test
                      /program.test
                      /static.test
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 63cb46691..4c923924b 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -9,8 +9,9 @@
               ["[0]" ruby]
               ["[0]" php]
               ["[0]" scheme]
-              ["[0]" jvm
-               (~~ (.for ["JVM" (~~ (.as_is ["[0]" class]
+              ["[0]" jvm "_"
+               (~~ (.for ["JVM" (~~ (.as_is ["[1]" bytecode]
+                                            ["[0]" class]
                                             ["[0]" version]
                                             [encoding
                                              ["[0]" name]]))]
@@ -113,9 +114,10 @@
               (# ! each (|>> {synthesis.#Extension self})))))
 
       (generation: (..generation self phase archive [pass_through <synthesis>.any])
-        (for [@.jvm
-              (# phase.monad each (|>> {jvm.#Embedded} sequence.sequence)
-                 (phase archive pass_through))]
+        (for [... @.jvm
+              ... (# phase.monad each (|>> {jvm.#Embedded} sequence.sequence)
+              ...    (phase archive pass_through))
+              ]
              (phase archive pass_through)))
 
       (analysis: (..dummy_generation self phase archive [])
@@ -127,7 +129,8 @@
       (generation: (..dummy_generation self phase archive [])
         (# phase.monad in
            (for [@.jvm
-                 (sequence.sequence {jvm.#Constant {jvm.#LDC {jvm.#String self}}})
+                 (jvm.string self)
+                 ... (sequence.sequence {jvm.#Constant {jvm.#LDC {jvm.#String self}}})
 
                  @.js (js.string self)
                  @.python (python.unicode self)
diff --git a/stdlib/source/test/lux/target/lua.lux b/stdlib/source/test/lux/target/lua.lux
index 2558f41c8..0bee11310 100644
--- a/stdlib/source/test/lux/target/lua.lux
+++ b/stdlib/source/test/lux/target/lua.lux
@@ -584,6 +584,18 @@
                                        (/.return $outcome)))
                                  (/.closure (list))
                                  (/.apply (list)))))
+        (_.cover [/.error/2]
+                 (expression (|>> (:as Frac) (f.= expected))
+                             (|> ($_ /.then
+                                     (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list)
+                                                                                           ($_ /.then
+                                                                                               (/.statement (/.error/2 (/.float expected) (/.int +2)))
+                                                                                               (/.return (/.float dummy))))))
+                                     (/.if $verdict
+                                       (/.return (/.float dummy))
+                                       (/.return $outcome)))
+                                 (/.closure (list))
+                                 (/.apply (list)))))
         )))
 
 (def: test|function
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 82e92e097..6fa62a7da 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -15,7 +15,8 @@
      ["[1][0]" phase "_"
       ["[1]/[0]" extension]
       ["[1]/[0]" analysis "_"
-       ["[1]/[0]" simple]]
+       ["[1]/[0]" simple]
+       ["[1]/[0]" complex]]
       ... ["[1]/[0]" synthesis]
       ]]]
    ["[1][0]" meta "_"
@@ -33,6 +34,7 @@
       /meta/archive.test
       /phase/extension.test
       /phase/analysis/simple.test
+      /phase/analysis/complex.test
       ... /syntax.test
       ... /synthesis.test
       ))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
index 672a8f25a..1a5ece06a 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux
@@ -37,7 +37,7 @@
      [phase
       ["[2][0]" analysis]
       ["[2][0]" extension
-       ["[1]/[0]"analysis "_"
+       ["[1]/[0]" analysis "_"
         ["[1]" lux]]]]
      [///
       ["[2][0]" phase ("[1]#[0]" monad)]
@@ -205,14 +205,14 @@
      [type/0 term/0] ..simple_parameter
      [type/1 term/1] (random.only (|>> product.left (same? type/0) not)
                                   ..simple_parameter)
-     types/*,terms,* (random.list arity ..simple_parameter)
+     types/*,terms/* (random.list arity ..simple_parameter)
      tag (# ! each (n.% arity) random.nat)
      .let [[lefts right?] (//complex.choice arity tag)]
      arbitrary_right? random.bit]
     ($_ _.and
         (_.cover [/.variant]
-                 (let [variantT (type.variant (list#each product.left types/*,terms,*))
-                       [tagT tagC] (|> types/*,terms,*
+                 (let [variantT (type.variant (list#each product.left types/*,terms/*))
+                       [tagT tagC] (|> types/*,terms/*
                                        (list.item tag)
                                        (maybe.else [Any (' [])]))
                        variant?' (: (-> Type (Maybe Type) Nat Bit Code Bit)
@@ -295,7 +295,7 @@
                         existential_types_affect_dependent_cases!
                         )))
         (_.cover [/.not_a_variant]
-                 (let [[tagT tagC] (|> types/*,terms,*
+                 (let [[tagT tagC] (|> types/*,terms/*
                                        (list.item tag)
                                        (maybe.else [Any (' [])]))]
                    (|> (/.variant lefts right? tagT)
@@ -314,7 +314,7 @@
      [type/0 term/0] ..simple_parameter
      [type/1 term/1] (random.only (|>> product.left (same? type/0) not)
                                   ..simple_parameter)
-     types/*,terms,* (random.list arity ..simple_parameter)
+     types/*,terms/* (random.list arity ..simple_parameter)
      .let [record? (: (-> Type (Maybe Type) Nat (List Code) Bit)
                       (function (_ record expected arity terms)
                         (|> (do /phase.monad
@@ -335,8 +335,8 @@
                             (/phase#each product.right)
                             (/phase.result state)
                             (try.else false))))
-           record (type.tuple (list#each product.left types/*,terms,*))
-           terms (list#each product.right types/*,terms,*)]]
+           record (type.tuple (list#each product.left types/*,terms/*))
+           terms (list#each product.right types/*,terms/*)]]
     ($_ _.and
         (_.cover [/.record]
                  (let [can_infer_record!
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
new file mode 100644
index 000000000..89c341c2a
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -0,0 +1,650 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" maybe ("[1]#[0]" functor)]
+    ["[0]" try {"+" Try} ("[1]#[0]" functor)]
+    ["[0]" exception {"+" Exception}]]
+   [data
+    ["[0]" product]
+    ["[0]" bit ("[1]#[0]" equivalence)]
+    ["[0]" text
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" list ("[1]#[0]" monad monoid)]
+     ["[0]" set]]]
+   [macro
+    ["[0]" code]]
+   [math
+    ["[0]" random {"+" Random} ("[1]#[0]" monad)]
+    [number
+     ["n" nat]
+     ["f" frac]]]
+   [meta
+    ["[0]" symbol
+     ["$[1]" \\test]]]
+   ["[0]" type ("[1]#[0]" equivalence)
+    ["[0]" check]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" //
+    [//
+     ["[1][0]" extension
+      ["[1]/[0]" analysis "_"
+       ["[1]" lux]]]
+     [//
+      ["[1][0]" analysis {"+" Analysis}
+       [evaluation {"+" Eval}]
+       ["[2][0]" macro]
+       ["[2][0]" type]
+       ["[2][0]" module]
+       ["[2][0]" complex]]
+      [///
+       ["[1][0]" phase ("[1]#[0]" monad)]
+       [meta
+        ["[0]" archive]]]]]]]])
+
+(def: (eval archive type term)
+  Eval
+  (//phase#in []))
+
+(def: (expander macro inputs state)
+  //macro.Expander
+  {try.#Success ((.macro macro) inputs state)})
+
+(def: random_state
+  (Random Lux)
+  (do random.monad
+    [version random.nat
+     host (random.ascii/lower 1)]
+    (in (//analysis.state (//analysis.info version host)))))
+
+(def: primitive
+  (Random Type)
+  (do random.monad
+    [name (random.ascii/lower 1)]
+    (in {.#Primitive name (list)})))
+
+(def: analysis
+  //analysis.Phase
+  (//.phase ..expander))
+
+(def: (failure? exception try)
+  (All (_ e a) (-> (Exception e) (Try a) Bit))
+  (case try
+    {try.#Success _}
+    false
+    
+    {try.#Failure error}
+    (text.contains? (value@ exception.#label exception) error)))
+
+(def: simple_parameter
+  (Random [Type Code])
+  (`` ($_ random.either
+          (~~ (template [<type> <random> <code>]
+                [(random#each (|>> <code> [<type>]) <random>)]
+
+                [.Bit random.bit code.bit]
+                [.Nat random.nat code.nat]
+                [.Int random.int code.int]
+                [.Rev random.rev code.rev]
+                [.Frac (random.only (|>> f.not_a_number? not) random.frac) code.frac]
+                [.Text (random.ascii/lower 1) code.text]
+                ))
+          )))
+
+(def: (analysed? expected actual)
+  (-> Code Analysis Bit)
+  (case [expected actual]
+    (^ [[_ {.#Tuple (list)}] (//analysis.unit)])
+    true
+
+    (^ [[_ {.#Tuple expected}] (//analysis.tuple actual)])
+    (and (n.= (list.size expected)
+              (list.size actual))
+         (list.every? (function (_ [expected actual])
+                        (analysed? expected actual))
+                      (list.zipped/2 expected actual)))
+    
+    (^template [<expected> <actual>]
+      [(^ [[_ {<expected> expected}] (<actual> actual)])
+       (same? expected actual)])
+    ([.#Bit //analysis.bit]
+     [.#Nat //analysis.nat]
+     [.#Int //analysis.int]
+     [.#Rev //analysis.rev]
+     [.#Frac //analysis.frac]
+     [.#Text //analysis.text])
+
+    _
+    false))
+
+(def: test|sum
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+                  //extension.#state lux]]
+     name ($symbol.random 1 1)
+     arity (# ! each (|>> (n.% 5) (n.+ 2)) random.nat)
+     types/*,terms/* (random.list arity ..simple_parameter)
+     tag (# ! each (n.% arity) random.nat)
+     .let [[lefts right?] (//complex.choice arity tag)
+           [tagT tagC] (|> types/*,terms/*
+                           (list.item tag)
+                           (maybe.else [Any (' [])]))]]
+    ($_ _.and
+        (_.cover [/.sum]
+                 (let [variantT (type.variant (list#each product.left types/*,terms/*))
+                       sum? (: (-> Type Nat Bit Code Bit)
+                               (function (_ type lefts right? code)
+                                 (|> (do //phase.monad
+                                       [analysis (|> (/.sum ..analysis lefts right? archive.empty code)
+                                                     (//type.expecting type))]
+                                       (in (case analysis
+                                             (^ (//analysis.variant [lefts' right?' analysis]))
+                                             (and (n.= lefts lefts')
+                                                  (bit#= right? right?')
+                                                  (..analysed? code analysis))
+
+                                             _
+                                             false)))
+                                     (//module.with_module 0 (product.left name))
+                                     (//phase#each product.right)
+                                     (//phase.result state)
+                                     (try.else false))))]
+                   (and (sum? variantT lefts right? tagC)
+                        (sum? {.#Named name variantT} lefts right? tagC)
+                        (|> (do //phase.monad
+                              [[@var varT] (//type.check check.var)
+                               _ (//type.check (check.check varT variantT))
+                               analysis (|> (/.sum ..analysis lefts right? archive.empty tagC)
+                                            (//type.expecting varT))]
+                              (in (case analysis
+                                    (^ (//analysis.variant [lefts' right?' it]))
+                                    (and (n.= lefts lefts')
+                                         (bit#= right? right?')
+                                         (..analysed? tagC it))
+
+                                    _
+                                    false)))
+                            (//module.with_module 0 (product.left name))
+                            (//phase#each product.right)
+                            (//phase.result state)
+                            (try.else false))
+                        (and (sum? (type (Maybe tagT)) 0 #0 (` []))
+                             (sum? (type (Maybe tagT)) 0 #1 tagC))
+                        (and (sum? (type (All (_ a) (Maybe a))) 0 #0 (` []))
+                             (not (sum? (type (All (_ a) (Maybe a))) 0 #1 tagC)))
+                        (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` []))
+                             (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC)))))
+        (_.for [/.cannot_analyse_variant]
+               (let [failure? (: (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit))
+                                 (function (_ exception analysis)
+                                   (let [it (//phase.result state analysis)]
+                                     (and (..failure? /.cannot_analyse_variant it)
+                                          (..failure? exception it)))))]
+                 ($_ _.and
+                     (_.cover [/.invalid_variant_type]
+                              (and (|> (/.sum ..analysis lefts right? archive.empty tagC)
+                                       (//type.expecting tagT)
+                                       (failure? /.invalid_variant_type))
+                                   (|> (do //phase.monad
+                                         [[@var varT] (//type.check check.var)]
+                                         (|> (/.sum ..analysis lefts right? archive.empty tagC)
+                                             (//type.expecting (type (varT tagT)))))
+                                       (failure? /.invalid_variant_type))))
+                     (_.cover [/.cannot_infer_sum]
+                              (|> (do //phase.monad
+                                    [[@var varT] (//type.check check.var)]
+                                    (|> (/.sum ..analysis lefts right? archive.empty tagC)
+                                        (//type.expecting varT)))
+                                  (failure? /.cannot_infer_sum)))
+                     )))
+        )))
+
+(def: test|variant
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+                  //extension.#state lux]]
+     name ($symbol.random 1 1)
+     arity (# ! each (|>> (n.% 5) (n.+ 2)) random.nat)
+     types/*,terms/* (random.list arity ..simple_parameter)
+     tag (# ! each (n.% arity) random.nat)
+     .let [[lefts right?] (//complex.choice arity tag)]
+     tags (|> (random.ascii/lower 1)
+              (random.set text.hash arity)
+              (# ! each set.list))
+     .let [module (product.left name)
+           sumT (type.variant (list#each product.left types/*,terms/*))
+           variantT {.#Named name sumT}
+           [tagT tagC] (|> types/*,terms/*
+                           (list.item tag)
+                           (maybe.else [Any (' [])]))
+           tag (|> tags
+                   (list.item tag)
+                   (maybe.else ""))]]
+    ($_ _.and
+        ..test|sum
+        (_.cover [/.variant]
+                 (let [expected_variant? (: (-> Symbol Bit)
+                                            (function (_ tag)
+                                              (|> (do //phase.monad
+                                                    [_ (//module.declare_labels false tags false variantT)
+                                                     analysis (|> (/.variant ..analysis tag archive.empty tagC)
+                                                                  (//type.expecting variantT))]
+                                                    (in (case analysis
+                                                          (^ (//analysis.variant [lefts' right?' analysis]))
+                                                          (and (n.= lefts lefts')
+                                                               (bit#= right? right?')
+                                                               (..analysed? tagC analysis))
+
+                                                          _
+                                                          false)))
+                                                  (//module.with_module 0 module)
+                                                  (//phase#each product.right)
+                                                  (//phase.result state)
+                                                  (try.else false))))
+                       inferred_variant? (: (-> Symbol Bit)
+                                            (function (_ tag)
+                                              (|> (do //phase.monad
+                                                    [_ (//module.declare_labels false tags false variantT)
+                                                     [actualT analysis] (|> (/.variant ..analysis tag archive.empty tagC)
+                                                                            //type.inferring)]
+                                                    (in (case analysis
+                                                          (^ (//analysis.variant [lefts' right?' analysis]))
+                                                          (and (n.= lefts lefts')
+                                                               (bit#= right? right?')
+                                                               (..analysed? tagC analysis)
+                                                               (type#= variantT actualT))
+
+                                                          _
+                                                          false)))
+                                                  (//module.with_module 0 module)
+                                                  (//phase#each product.right)
+                                                  (//phase.result state)
+                                                  (try.else false))))]
+                   (and (expected_variant? [module tag])
+                        (expected_variant? ["" tag])
+                        (inferred_variant? [module tag])
+                        (inferred_variant? ["" tag])
+
+                        ... TODO: Test what happens when tags are shadowed by local bindings.
+                        )))
+        )))
+
+(type: (Triple a)
+  [a a a])
+
+(def: test|product
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+                  //extension.#state lux]]
+     name ($symbol.random 1 1)
+     arity (# ! each (|>> (n.% 5) (n.+ 2)) random.nat)
+     types/*,terms/* (random.list arity ..simple_parameter)
+     [type/0 term/0] ..simple_parameter
+     [type/1 term/1] ..simple_parameter
+     [type/2 term/2] ..simple_parameter
+     .let [module (product.left name)
+           productT (type.tuple (list#each product.left types/*,terms/*))
+           expected (list#each product.right types/*,terms/*)]]
+    ($_ _.and
+        (_.cover [/.product]
+                 (let [product? (: (-> Type (List Code) Bit)
+                                   (function (_ type expected)
+                                     (|> (do //phase.monad
+                                           [analysis (|> expected
+                                                         (/.product ..analysis archive.empty)
+                                                         (//type.expecting type))]
+                                           (in (case analysis
+                                                 (^ (//analysis.tuple actual))
+                                                 (and (n.= (list.size expected)
+                                                           (list.size actual))
+                                                      (list.every? (function (_ [expected actual])
+                                                                     (..analysed? expected actual))
+                                                                   (list.zipped/2 expected actual)))
+
+                                                 _
+                                                 false)))
+                                         (//module.with_module 0 module)
+                                         (//phase#each product.right)
+                                         (//phase.result state)
+                                         (try.else false))))]
+                   (and (product? productT expected)
+                        (product? {.#Named name productT} expected)
+                        (product? (type (Ex (_ a) [a a])) (list term/0 term/0))
+                        (not (product? (type (All (_ a) [a a])) (list term/0 term/0)))
+                        (product? (type (Triple type/0)) (list term/0 term/0 term/0))
+                        (|> (do //phase.monad
+                              [[@var varT] (//type.check check.var)
+                               _ (//type.check (check.check varT productT))
+                               analysis (|> expected
+                                            (/.product ..analysis archive.empty)
+                                            (//type.expecting varT))]
+                              (in (case analysis
+                                    (^ (//analysis.tuple actual))
+                                    (and (n.= (list.size expected)
+                                              (list.size actual))
+                                         (list.every? (function (_ [expected actual])
+                                                        (..analysed? expected actual))
+                                                      (list.zipped/2 expected actual)))
+
+                                    _
+                                    false)))
+                            (//module.with_module 0 module)
+                            (//phase#each product.right)
+                            (//phase.result state)
+                            (try.else false))
+                        (|> (do //phase.monad
+                              [[:inferred: analysis] (|> expected
+                                                         (/.product ..analysis archive.empty)
+                                                         //type.inferring)]
+                              (in (case analysis
+                                    (^ (//analysis.tuple actual))
+                                    (and (n.= (list.size expected)
+                                              (list.size actual))
+                                         (list.every? (function (_ [expected actual])
+                                                        (..analysed? expected actual))
+                                                      (list.zipped/2 expected actual))
+                                         (type#= productT :inferred:))
+
+                                    _
+                                    false)))
+                            (//module.with_module 0 module)
+                            (//phase#each product.right)
+                            (//phase.result state)
+                            (try.else false))
+                        (|> (do [! //phase.monad]
+                              [[@var varT] (//type.check check.var)
+                               [:inferred: analysis] (//type.inferring
+                                                      (do !
+                                                        [_ (//type.inference (Tuple type/0 type/1 varT))]
+                                                        (/.product ..analysis archive.empty
+                                                                   (list term/0 term/1 term/2 term/2 term/2))))]
+                              (in (case analysis
+                                    (^ (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4)))))
+                                    (and (type#= (Tuple type/0 type/1 type/2 type/2 type/2)
+                                                 :inferred:)
+                                         (..analysed? term/0 analysis/0)
+                                         (..analysed? term/1 analysis/1)
+                                         (..analysed? term/2 analysis/2)
+                                         (..analysed? term/2 analysis/3)
+                                         (..analysed? term/2 analysis/4))
+
+                                    _
+                                    false)))
+                            (//module.with_module 0 module)
+                            (//phase#each product.right)
+                            (//phase.result state)
+                            (try.else false))
+                        (|> (do [! //phase.monad]
+                              [analysis (|> (list term/0 term/1 (code.tuple (list term/2 term/2 term/2)))
+                                            (/.product ..analysis archive.empty)
+                                            (//type.expecting (Tuple type/0 type/1 type/2 type/2 type/2)))]
+                              (in (case analysis
+                                    (^ (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4)))))
+                                    (and (..analysed? term/0 analysis/0)
+                                         (..analysed? term/1 analysis/1)
+                                         (..analysed? term/2 analysis/2)
+                                         (..analysed? term/2 analysis/3)
+                                         (..analysed? term/2 analysis/4))
+
+                                    _
+                                    false)))
+                            (//module.with_module 0 module)
+                            (//phase#each product.right)
+                            (//phase.result state)
+                            (try.else false)))))
+        (_.for [/.cannot_analyse_tuple]
+               (_.cover [/.invalid_tuple_type]
+                        (let [failure? (: (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit))
+                                          (function (_ exception operation)
+                                            (let [it (//phase.result state operation)]
+                                              (and (..failure? /.cannot_analyse_tuple it)
+                                                   (..failure? exception it)))))]
+                          (and (|> expected
+                                   (/.product ..analysis archive.empty)
+                                   (//type.expecting (|> types/*,terms/*
+                                                         list.head
+                                                         (maybe#each product.left)
+                                                         (maybe.else .Any)))
+                                   (failure? /.invalid_tuple_type))
+                               (|> (do //phase.monad
+                                     [[@var varT] (//type.check check.var)]
+                                     (|> expected
+                                         (/.product ..analysis archive.empty)
+                                         (//type.expecting (type (varT type/0)))))
+                                   (failure? /.invalid_tuple_type))))))
+        )))
+
+(def: test|record
+  (do [! random.monad]
+    [lux ..random_state
+     .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+                  //extension.#state lux]]
+     name ($symbol.random 1 1)
+     arity (# ! each (|>> (n.% 5) (n.+ 2)) random.nat)
+     slice (# ! each (|>> (n.% (-- arity)) ++) random.nat)
+     [type/0 term/0] ..simple_parameter
+     slot/0 (random.ascii/lower 1)
+     types/*,terms/* (random.list arity ..simple_parameter)
+     slots/0 (|> (random.ascii/lower 1)
+                 (random.set text.hash arity))
+     slots/1 (|> (random.ascii/lower 1)
+                 (random.only (|>> (set.member? slots/0) not))
+                 (random.set text.hash arity))
+     .let [slots/0 (set.list slots/0)
+           slots/1 (set.list slots/1)
+           module (product.left name)
+           :record: {.#Named name (type.tuple (list#each product.left types/*,terms/*))}
+           tuple (list#each product.right types/*,terms/*)
+           local_record (|> tuple
+                            (list.zipped/2 (list#each (|>> [""] code.symbol) slots/0))
+                            (list#each (function (_ [slot value])
+                                         (list slot value)))
+                            list#conjoint)
+           global_record (|> tuple
+                             (list.zipped/2 (list#each (|>> [module] code.symbol) slots/0))
+                             (list#each (function (_ [slot value])
+                                          (list slot value)))
+                             list#conjoint)
+           expected_record (list.zipped/2 (list#each (|>> [module]) slots/0)
+                                          tuple)
+           head_slot/0 (|> slots/0 list.head maybe.trusted)
+           head_term/0 (|> types/*,terms/* list.head maybe.trusted product.right)
+           head_slot/1 (|> slots/1 list.head maybe.trusted)
+           slots/01 (case slots/1
+                      {.#Item _ tail}
+                      {.#Item head_slot/0 tail}
+
+                      _
+                      slots/0)]]
+    ($_ _.and
+        (_.cover [/.normal]
+                 (let [normal? (: (-> (List [Symbol Code]) (List Code) Bit)
+                                  (function (_ expected input)
+                                    (|> (do //phase.monad
+                                          [_ (//module.declare_labels true slots/0 false :record:)]
+                                          (/.normal input))
+                                        (//module.with_module 0 module)
+                                        (//phase#each product.right)
+                                        (//phase.result state)
+                                        (case> {try.#Success {.#Some actual}}
+                                               (let [(^open "list#[0]") (list.equivalence (product.equivalence symbol.equivalence code.equivalence))]
+                                                 (list#= expected (list.reversed actual)))
+                                               
+                                               _
+                                               false))))]
+                   (and (normal? (list) (list))
+                        (normal? expected_record global_record)
+                        (normal? expected_record local_record)
+                        (|> (/.normal tuple)
+                            (//phase.result state)
+                            (case> {try.#Success {.#None}}
+                                   true
+                        
+                                   _
+                                   false)))))
+        (_.cover [/.order]
+                 (let [local_record (list.zipped/2 (list#each (|>> [""]) slots/0) tuple)
+                       global_record (list.zipped/2 (list#each (|>> [module]) slots/0) tuple)
+                       ordered? (: (-> Bit (List [Symbol Code]) Bit)
+                                   (function (_ pattern_matching? input)
+                                     (|> (do //phase.monad
+                                           [_ (//module.declare_labels true slots/0 false :record:)]
+                                           (/.order pattern_matching? input))
+                                         //analysis.with_scope
+                                         (//module.with_module 0 module)
+                                         (//phase#each (|>> product.right product.right))
+                                         (//phase.result state)
+                                         (case> {try.#Success {.#Some [actual_arity actual_tuple actual_type]}}
+                                                (and (n.= arity actual_arity)
+                                                     (# code.equivalence = (code.tuple tuple) (code.tuple actual_tuple))
+                                                     (type#= :record: actual_type))
+
+                                                _
+                                                false))))
+                       unit? (: (-> Bit Bit)
+                                (function (_ pattern_matching?)
+                                  (|> (/.order false (list))
+                                      (//phase.result state)
+                                      (case> (^ {try.#Success {.#Some [0 (list) actual_type]}})
+                                             (same? .Any actual_type)
+
+                                             _
+                                             false))))]
+                   (and (ordered? false global_record)
+                        (ordered? false (list.reversed global_record))
+                        (ordered? false local_record)
+                        (ordered? false (list.reversed local_record))
+
+                        (ordered? true global_record)
+                        (ordered? true (list.reversed global_record))
+                        (not (ordered? true local_record))
+                        (not (ordered? true (list.reversed local_record)))
+
+                        (unit? false)
+                        (unit? true)
+
+                        ... TODO: Test what happens when slots are shadowed by local bindings.
+                        )))
+        (_.cover [/.cannot_repeat_slot]
+                 (let [repeated? (: (-> Bit Bit)
+                                    (function (_ pattern_matching?)
+                                      (|> (do //phase.monad
+                                            [_ (//module.declare_labels true slots/0 false :record:)]
+                                            (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0])))
+                                          (//module.with_module 0 module)
+                                          (//phase#each product.right)
+                                          (//phase.result state)
+                                          (..failure? /.cannot_repeat_slot))))]
+                   (and (repeated? false)
+                        (repeated? true))))
+        (_.cover [/.record_size_mismatch]
+                 (let [local_record (list.zipped/2 (list#each (|>> [""]) slots/0) tuple)
+                       global_record (list.zipped/2 (list#each (|>> [module]) slots/0) tuple)
+                       mismatched? (: (-> Bit (List [Symbol Code]) Bit)
+                                      (function (_ pattern_matching? input)
+                                        (|> (do //phase.monad
+                                              [_ (//module.declare_labels true slots/0 false :record:)]
+                                              (/.order pattern_matching? input))
+                                            //analysis.with_scope
+                                            (//module.with_module 0 module)
+                                            (//phase.result state)
+                                            (..failure? /.record_size_mismatch))))]
+                   (and (mismatched? false (list.first slice local_record))
+                        (mismatched? false (list#composite local_record (list.first slice local_record)))
+
+                        (mismatched? false (list.first slice global_record))
+                        (mismatched? true (list.first slice global_record))
+                        (mismatched? false (list#composite global_record (list.first slice global_record)))
+                        (mismatched? true (list#composite global_record (list.first slice global_record))))))
+        (_.cover [/.slot_does_not_belong_to_record]
+                 (let [local_record (list.zipped/2 (list#each (|>> [""]) slots/01) tuple)
+                       global_record (list.zipped/2 (list#each (|>> [module]) slots/01) tuple)
+                       mismatched? (: (-> Bit (List [Symbol Code]) Bit)
+                                      (function (_ pattern_matching? input)
+                                        (|> (do //phase.monad
+                                              [_ (//module.declare_labels true slots/0 false :record:)
+                                               _ (//module.declare_labels true slots/1 false :record:)]
+                                              (/.order pattern_matching? input))
+                                            //analysis.with_scope
+                                            (//module.with_module 0 module)
+                                            (//phase.result state)
+                                            (..failure? /.slot_does_not_belong_to_record))))]
+                   (and (mismatched? false local_record)
+
+                        (mismatched? false global_record)
+                        (mismatched? true global_record))))
+        (_.cover [/.record]
+                 (let [record? (: (-> Type (List Text) (List Code) Code Bit)
+                                  (function (_ type slots tuple expected)
+                                    (|> (do //phase.monad
+                                          [_ (//module.declare_labels true slots false type)]
+                                          (/.record ..analysis archive.empty tuple))
+                                        (//type.expecting type)
+                                        //analysis.with_scope
+                                        (//module.with_module 0 module)
+                                        (//phase#each (|>> product.right product.right))
+                                        (//phase.result state)
+                                        (try#each (analysed? expected))
+                                        (try.else false))))
+                       inferred? (: (-> (List Code) Bit)
+                                    (function (_ record)
+                                      (|> (do //phase.monad
+                                            [_ (//module.declare_labels true slots/0 false :record:)]
+                                            (//type.inferring
+                                             (/.record ..analysis archive.empty record)))
+                                          //analysis.with_scope
+                                          (//module.with_module 0 module)
+                                          (//phase#each (|>> product.right product.right))
+                                          (//phase.result state)
+                                          (try#each (function (_ [actual_type actual_term])
+                                                      (and (same? :record: actual_type)
+                                                           (analysed? (code.tuple tuple) actual_term))))
+                                          (try.else false))))]
+                   (and (record? {.#Named name .Any} (list) (list) (' []))
+                        (record? {.#Named name type/0} (list) (list term/0) term/0)
+                        (record? {.#Named name type/0} (list slot/0) (list term/0) term/0)
+                        (record? :record: slots/0 tuple (code.tuple tuple))
+                        (record? :record: slots/0 local_record (code.tuple tuple))
+                        (record? :record: slots/0 global_record (code.tuple tuple))
+                        (inferred? local_record)
+                        (inferred? global_record))))
+        )))
+
+(def: .public test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [lux ..random_state
+         .let [state [//extension.#bundle (//extension/analysis.bundle ..eval)
+                      //extension.#state lux]]
+         arity (# ! each (|>> (n.% 5) (n.+ 2)) random.nat)
+         types/*,terms/* (random.list arity ..simple_parameter)
+         [type/0 term/0] ..simple_parameter
+         [type/1 term/1] ..simple_parameter
+         tag (# ! each (n.% arity) random.nat)
+         .let [[lefts right?] (//complex.choice arity tag)]]
+        ($_ _.and
+            ..test|sum
+            ..test|variant
+            ..test|product
+            ..test|record
+            (_.cover [/.not_a_quantified_type]
+                     (and (|> (/.sum ..analysis lefts right? archive.empty term/0)
+                              (//type.expecting (type (type/0 type/1)))
+                              (//phase.result state)
+                              (..failure? /.not_a_quantified_type))
+                          (|> types/*,terms/*
+                              (list#each product.right)
+                              (/.product ..analysis archive.empty)
+                              (//type.expecting (type (type/0 type/1)))
+                              (//phase.result state)
+                              (..failure? /.not_a_quantified_type))))
+            ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
deleted file mode 100644
index 7521d7878..000000000
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ /dev/null
@@ -1,311 +0,0 @@
-(.using
-  [lux "*"
-   [abstract
-    ["[0]" monad {"+" do}]]
-   [data
-    ["%" text/format {"+" format}]]
-   ["r" math/random {"+" Random}]
-   ["_" test {"+" Test}]
-   [control
-    pipe
-    ["[0]" maybe]
-    ["[0]" try]]
-   [data
-    ["[0]" bit ("[1]#[0]" equivalence)]
-    ["[0]" product]
-    ["[0]" text]
-    [number
-     ["n" nat]]
-    [collection
-     ["[0]" list ("[1]#[0]" functor)]
-     ["[0]" set]]]
-   ["[0]" type
-    ["[0]" check]]
-   [macro
-    ["[0]" code]]
-   [meta
-    ["[0]" symbol]]]
-  [//
-   ["_[0]" primitive]]
-  [\\
-   ["[0]" /
-    ["/[1]" //
-     ["[1][0]" module]
-     ["[1][0]" type]
-     ["/[1]" // "_"
-      ["/[1]" //
-       ["[1][0]" analysis {"+" Analysis Variant Tag Operation}]
-       [///
-        ["[0]" phase]
-        [meta
-         ["[0]" archive]]]]]]]])
-
-(template [<name> <on_success> <on_error>]
-  [(def: .public <name>
-     (All (_ a) (-> (Operation a) Bit))
-     (|>> (phase.result _primitive.state)
-          (case> {try.#Success _}
-                 <on_success>
-
-                 _
-                 <on_error>)))]
-
-  [check_succeeds true  false]
-  [check_fails    false true]
-  )
-
-(def: (check_sum' tag size variant)
-  (-> Tag Nat (Variant Analysis) Bit)
-  (let [expected//right? (n.= (-- size) tag)
-        expected//lefts (if expected//right?
-                          (-- tag)
-                          tag)
-        actual//right? (value@ ////analysis.#right? variant)
-        actual//lefts (value@ ////analysis.#lefts variant)]
-    (and (n.= expected//lefts
-              actual//lefts)
-         (bit#= expected//right?
-                actual//right?))))
-
-(def: (check_sum type tag size analysis)
-  (-> Type Tag Nat (Operation Analysis) Bit)
-  (|> analysis
-      (//type.with_type type)
-      (phase.result _primitive.state)
-      (case> (^ {try.#Success (////analysis.variant variant)})
-             (check_sum' tag size variant)
-
-             _
-             false)))
-
-(def: (with_tags module tags type)
-  (All (_ a) (-> Text (List //module.Tag) Type (Operation a) (Operation [Module a])))
-  (|>> (do phase.monad
-         [_ (//module.declare_tags tags false type)])
-       (//module.with_module 0 module)))
-
-(def: (check_variant module tags expectedT variantT tag analysis)
-  (-> Text (List //module.Tag) Type Type Tag (Operation Analysis) Bit)
-  (|> analysis
-      (with_tags module tags variantT)
-      (//type.with_type expectedT)
-      (phase.result _primitive.state)
-      (case> (^ {try.#Success [_ (////analysis.variant variant)]})
-             (check_sum' tag (list.size tags) variant)
-
-             _
-             false)))
-
-(def: (correct_size? size)
-  (-> Nat (-> Analysis Bit))
-  (|>> (case> (^ (////analysis.tuple elems))
-              (|> elems
-                  list.size
-                  (n.= size))
-              
-              _
-              false)))
-
-(def: (check_record module tags expectedT recordT size analysis)
-  (-> Text (List //module.Tag) Type Type Nat (Operation Analysis) Bit)
-  (|> analysis
-      (with_tags module tags recordT)
-      (//type.with_type expectedT)
-      (phase.result _primitive.state)
-      (case> {try.#Success [_ productA]}
-             (correct_size? size productA)
-
-             _
-             false)))
-
-(def: sum
-  (do [! r.monad]
-    [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2))))
-     choice (|> r.nat (# ! each (n.% size)))
-     primitives (r.list size _primitive.primitive)
-     +choice (|> r.nat (# ! each (n.% (++ size))))
-     [_ +valueC] _primitive.primitive
-     .let [variantT (type.variant (list#each product.left primitives))
-           [valueT valueC] (maybe.trusted (list.item choice primitives))
-           +size (++ size)
-           +primitives (list.together (list (list.first choice primitives)
-                                            (list [{.#Parameter 1} +valueC])
-                                            (list.after choice primitives)))
-           [+valueT +valueC] (maybe.trusted (list.item +choice +primitives))
-           +variantT (type.variant (list#each product.left +primitives))]]
-    (<| (_.context (%.symbol (symbol /.sum)))
-        ($_ _.and
-            (_.test "Can analyse."
-                    (check_sum variantT choice size
-                               (/.sum _primitive.phase choice archive.empty valueC)))
-            (_.test "Can analyse through bound type-vars."
-                    (|> (do phase.monad
-                          [[_ varT] (//type.with_env check.var)
-                           _ (//type.with_env
-                               (check.check varT variantT))]
-                          (//type.with_type varT
-                            (/.sum _primitive.phase choice archive.empty valueC)))
-                        (phase.result _primitive.state)
-                        (case> (^ {try.#Success (////analysis.variant variant)})
-                               (check_sum' choice size variant)
-
-                               _
-                               false)))
-            (_.test "Cannot analyse through unbound type-vars."
-                    (|> (do phase.monad
-                          [[_ varT] (//type.with_env check.var)]
-                          (//type.with_type varT
-                            (/.sum _primitive.phase choice archive.empty valueC)))
-                        check_fails))
-            (_.test "Can analyse through existential quantification."
-                    (|> (//type.with_type (type.ex_q 1 +variantT)
-                          (/.sum _primitive.phase +choice archive.empty +valueC))
-                        check_succeeds))
-            (_.test "Can analyse through universal quantification."
-                    (let [check_outcome (if (not (n.= choice +choice))
-                                          check_succeeds
-                                          check_fails)]
-                      (|> (//type.with_type (type.univ_q 1 +variantT)
-                            (/.sum _primitive.phase +choice archive.empty +valueC))
-                          check_outcome)))
-            ))))
-
-(def: product
-  (do [! r.monad]
-    [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2))))
-     primitives (r.list size _primitive.primitive)
-     choice (|> r.nat (# ! each (n.% size)))
-     [_ +valueC] _primitive.primitive
-     .let [tupleT (type.tuple (list#each product.left primitives))
-           [singletonT singletonC] (|> primitives (list.item choice) maybe.trusted)
-           +primitives (list.together (list (list.first choice primitives)
-                                            (list [{.#Parameter 1} +valueC])
-                                            (list.after choice primitives)))
-           +tupleT (type.tuple (list#each product.left +primitives))]]
-    (<| (_.context (%.symbol (symbol /.product)))
-        ($_ _.and
-            (_.test "Can analyse."
-                    (|> (//type.with_type tupleT
-                          (/.product archive.empty _primitive.phase (list#each product.right primitives)))
-                        (phase.result _primitive.state)
-                        (case> {try.#Success tupleA}
-                               (correct_size? size tupleA)
-
-                               _
-                               false)))
-            (_.test "Can infer."
-                    (|> (//type.with_inference
-                          (/.product archive.empty _primitive.phase (list#each product.right primitives)))
-                        (phase.result _primitive.state)
-                        (case> {try.#Success [_type tupleA]}
-                               (and (check.subsumes? tupleT _type)
-                                    (correct_size? size tupleA))
-
-                               _
-                               false)))
-            (_.test "Can analyse singleton."
-                    (|> (//type.with_type singletonT
-                          (_primitive.phase archive.empty (` [(~ singletonC)])))
-                        check_succeeds))
-            (_.test "Can analyse through bound type-vars."
-                    (|> (do phase.monad
-                          [[_ varT] (//type.with_env check.var)
-                           _ (//type.with_env
-                               (check.check varT (type.tuple (list#each product.left primitives))))]
-                          (//type.with_type varT
-                            (/.product archive.empty _primitive.phase (list#each product.right primitives))))
-                        (phase.result _primitive.state)
-                        (case> {try.#Success tupleA}
-                               (correct_size? size tupleA)
-
-                               _
-                               false)))
-            (_.test "Can analyse through existential quantification."
-                    (|> (//type.with_type (type.ex_q 1 +tupleT)
-                          (/.product archive.empty _primitive.phase (list#each product.right +primitives)))
-                        check_succeeds))
-            (_.test "Cannot analyse through universal quantification."
-                    (|> (//type.with_type (type.univ_q 1 +tupleT)
-                          (/.product archive.empty _primitive.phase (list#each product.right +primitives)))
-                        check_fails))
-            ))))
-
-(def: variant
-  (do [! r.monad]
-    [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2))))
-     tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list))
-     choice (|> r.nat (# ! each (n.% size)))
-     other_choice (|> r.nat (# ! each (n.% size)) (r.only (|>> (n.= choice) not)))
-     primitives (r.list size _primitive.primitive)
-     module_name (r.unicode 5)
-     type_name (r.unicode 5)
-     .let [with_name (|>> {.#Named [module_name type_name]})
-           varT {.#Parameter 1}
-           primitivesT (list#each product.left primitives)
-           [choiceT choiceC] (maybe.trusted (list.item choice primitives))
-           [other_choiceT other_choiceC] (maybe.trusted (list.item other_choice primitives))
-           monoT (type.variant primitivesT)
-           polyT (|> (type.variant (list.together (list (list.first choice primitivesT)
-                                                        (list varT)
-                                                        (list.after (++ choice) primitivesT))))
-                     (type.univ_q 1))
-           choice_tag (maybe.trusted (list.item choice tags))
-           other_choice_tag (maybe.trusted (list.item other_choice tags))]]
-    (<| (_.context (%.symbol (symbol /.tagged_sum)))
-        ($_ _.and
-            (_.test "Can infer."
-                    (|> (/.tagged_sum _primitive.phase [module_name choice_tag] archive.empty choiceC)
-                        (check_variant module_name tags
-                                       monoT (with_name monoT)
-                                       choice)))
-            (_.test "Inference retains universal quantification when type-vars are not bound."
-                    (|> (/.tagged_sum _primitive.phase [module_name other_choice_tag] archive.empty other_choiceC)
-                        (check_variant module_name tags
-                                       polyT (with_name polyT)
-                                       other_choice)))
-            (_.test "Can specialize."
-                    (|> (//type.with_type monoT
-                          (/.tagged_sum _primitive.phase [module_name other_choice_tag] archive.empty other_choiceC))
-                        (check_variant module_name tags
-                                       monoT (with_name polyT)
-                                       other_choice)))
-            (_.test "Specialization when type-vars get bound."
-                    (|> (/.tagged_sum _primitive.phase [module_name choice_tag] archive.empty choiceC)
-                        (check_variant module_name tags
-                                       monoT (with_name polyT)
-                                       choice)))
-            ))))
-
-(def: record
-  (do [! r.monad]
-    [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2))))
-     tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list))
-     primitives (r.list size _primitive.primitive)
-     module_name (r.unicode 5)
-     type_name (r.unicode 5)
-     choice (|> r.nat (# ! each (n.% size)))
-     .let [varT {.#Parameter 1}
-           tagsC (list#each (|>> [module_name] code.tag) tags)
-           primitivesT (list#each product.left primitives)
-           primitivesC (list#each product.right primitives)
-           monoT {.#Named [module_name type_name] (type.tuple primitivesT)}
-           recordC (list.zipped/2 tagsC primitivesC)
-           polyT (|> (type.tuple (list.together (list (list.first choice primitivesT)
-                                                      (list varT)
-                                                      (list.after (++ choice) primitivesT))))
-                     (type.univ_q 1)
-                     {.#Named [module_name type_name]})]]
-    (<| (_.context (%.symbol (symbol /.record)))
-        (_.test "Can infer."
-                (|> (/.record archive.empty _primitive.phase recordC)
-                    (check_record module_name tags monoT monoT size))))))
-
-(def: .public test
-  Test
-  (<| (_.context (symbol.module (symbol /._)))
-      ($_ _.and
-          ..sum
-          ..product
-          ..variant
-          ..record
-          )))