Ported the analysis tests to the new format.

21 files changed, 1162 insertions, 1111 deletions

diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 59e004ea7..bd4b80c69 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -5,13 +5,11 @@
     [codec (#+ Codec)]
     hash]
    [data
-    ["." text ("#;." monoid hash)]]])
+    ["." text ("#@." monoid hash)]]])
 
-## [Types]
 ## (type: Name
 ##   [Text Text])
 
-## [Functions]
 (template [<name> <side>]
   [(def: #export (<name> [module short])
      (-> Name Text)
@@ -21,21 +19,20 @@
   [short  short]
   )
 
-## [Structures]
 (structure: #export equivalence (Equivalence Name)
   (def: (= [xmodule xname] [ymodule yname])
-    (and (text;= xmodule ymodule)
-         (text;= xname yname))))
+    (and (text@= xmodule ymodule)
+         (text@= xname yname))))
 
 (structure: #export codec (Codec Text Name)
   (def: (encode [module short])
     (case module
       "" short
-      _ ($_ text;compose module "." short)))
+      _ ($_ text@compose module "." short)))
   
   (def: (decode input)
-    (if (text;= "" input)
-      (#.Left (text;compose "Invalid format for Name: " input))
+    (if (text@= "" input)
+      (#.Left (text@compose "Invalid format for Name: " input))
       (case (text.split-all-with "." input)
         (^ (list short))
         (#.Right ["" short])
@@ -44,10 +41,10 @@
         (#.Right [module short])
 
         _
-        (#.Left (text;compose "Invalid format for Name: " input))))))
+        (#.Left (text@compose "Invalid format for Name: " input))))))
 
 (structure: #export hash (Hash Name)
   (def: &equivalence ..equivalence)
   
   (def: (hash [module name])
-    (n/+ (text;hash module) (text;hash name))))
+    (n/+ (text@hash module) (text@hash name))))
diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux
index 06d8b6d72..b7197f3af 100644
--- a/stdlib/source/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/default/syntax.lux
@@ -46,11 +46,6 @@
    [macro
     ["." template]]])
 
-## TODO: Optimize how forms, tuples & records are parsed in the end.
-## There is repeated-work going on when parsing the white-space before the
-## closing parenthesis/bracket/brace.
-## That repeated-work should be avoided.
-
 ## TODO: Implement "lux syntax char case!" as a custom extension.
 ## That way, it should be possible to obtain the char without wrapping
 ## it into a java.lang.Long, thereby improving performance.
@@ -58,6 +53,12 @@
 ## TODO: Make an extension to take advantage of java/lang/String::indexOf<int,int>
 ## to get better performance than the current "lux text index" extension.
 
+## TODO: Instead of always keeping a "where" cursor variable, keep the
+## individual components (i.e. file, line and column) separate, so
+## that updated the "where" only involved updating the components, and
+## producing the cursors only involved building them, without any need
+## for pattern-matching and de-structuring.
+
 (type: Char Nat)
 
 (template [<name> <extension> <diff>]
@@ -454,14 +455,23 @@
                       [(~~ (static ..open-form))]
                       (parse-form <recur> <consume-1>)
 
+                      [(~~ (static ..close-form))]
+                      (!close ..close-form)
+
                       ## Tuple
                       [(~~ (static ..open-tuple))]
                       (parse-tuple <recur> <consume-1>)
 
+                      [(~~ (static ..close-tuple))]
+                      (!close ..close-tuple)
+
                       ## Record
                       [(~~ (static ..open-record))]
                       (parse-record <recur> <consume-1>)
 
+                      [(~~ (static ..close-record))]
+                      (!close ..close-record)
+
                       ## Text
                       [(~~ (static ..text-delimiter))]
                       (let [offset/1 (!inc offset/0)]
@@ -515,16 +525,7 @@
                       [(~~ (static ..positive-sign))
                        (~~ (static ..negative-sign))]
                       (!parse-signed source-code//size offset/0 where source-code
-                                     (!end-of-file where offset/0 source-code current-module))
-
-                      [(~~ (static ..close-form))]
-                      (!close ..close-form)
-                      
-                      [(~~ (static ..close-tuple))]
-                      (!close ..close-tuple)
-                      
-                      [(~~ (static ..close-record))]
-                      (!close ..close-record)]
+                                     (!end-of-file where offset/0 source-code current-module))]
 
                      ## else
                      (if (!digit? char/0)
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux
index 79d2c9ebd..da142fed8 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux
@@ -3,10 +3,10 @@
    [abstract
     monad]
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    ["." macro]
    [data
-    ["." text ("#;." equivalence)
+    ["." text ("#@." equivalence)
      format]]]
   ["." // #_
    ["#." scope]
@@ -18,11 +18,13 @@
      ["/" analysis (#+ Analysis Operation)]]]])
 
 (exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text})
-  (ex.report ["Current" current]
-             ["Foreign" foreign]))
+  (exception.report
+   ["Current" current]
+   ["Foreign" foreign]))
 
-(exception: #export (definition-has-not-been-expored {definition Name})
-  (ex.report ["Definition" (%name definition)]))
+(exception: #export (definition-has-not-been-exported {definition Name})
+  (exception.report
+   ["Definition" (%name definition)]))
 
 (def: (definition def-name)
   (-> Name (Operation Analysis))
@@ -38,7 +40,7 @@
           [_ (//type.infer actualT)
            (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name))
            current (///extension.lift macro.current-module-name)]
-          (if (text;= current ::module)
+          (if (text@= current ::module)
             <return>
             (if (macro.export? def-anns)
               (do @
@@ -46,7 +48,7 @@
                 (if imported!
                   <return>
                   (///.throw foreign-module-has-not-been-imported [current ::module])))
-              (///.throw definition-has-not-been-expored def-name))))))))
+              (///.throw definition-has-not-been-exported def-name))))))))
 
 (def: (variable var-name)
   (-> Text (Operation (Maybe Analysis)))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
index 71ecd5d8a..a62fee79f 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
@@ -25,7 +25,6 @@
       [evaluation (#+ Eval)]]
      ["#." analysis (#+ Analysis Handler Bundle)]]]])
 
-## [Utils]
 (def: (simple inputsT+ outputT)
   (-> (List Type) Type Handler)
   (let [num-expected (list.size inputsT+)]
@@ -58,7 +57,6 @@
   (-> Type Type Type Type Handler)
   (simple (list subjectT param0T param1T) outputT))
 
-## [Analysers]
 ## "lux is" represents reference/pointer equality.
 (def: lux::is
   Handler
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 031e5025d..31de534eb 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -4,16 +4,17 @@
     [equivalence (#+ Equivalence)]
     [monad (#+ Monad do)]]
    [control
-    ["p" parser]]
+    ["p" parser]
+    ["." function]]
    [data
-    ["." text ("#;." monoid equivalence)]
-    ["." name ("#;." equivalence codec)]
+    ["." text ("#@." monoid equivalence)]
+    ["." name ("#@." equivalence codec)]
     [number
-     ["." nat ("#;." decimal)]]
+     ["." nat ("#@." decimal)]]
     ["." maybe]
     [collection
      ["." array]
-     ["." list ("#;." functor monoid fold)]]]
+     ["." list ("#@." functor monoid fold)]]]
    ["." macro
     ["." code]
     ["s" syntax (#+ Syntax syntax:)]]])
@@ -22,7 +23,7 @@
   (-> (List Type) Type Type)
   (case type
     (#.Primitive name params)
-    (#.Primitive name (list;map (beta-reduce env) params))
+    (#.Primitive name (list@map (beta-reduce env) params))
     
     (^template [<tag>]
       (<tag> left right)
@@ -37,12 +38,12 @@
         (<tag> env def)
 
         _
-        (<tag> (list;map (beta-reduce env) old-env) def)))
+        (<tag> (list@map (beta-reduce env) old-env) def)))
     ([#.UnivQ]
      [#.ExQ])
     
     (#.Parameter idx)
-    (maybe.default (error! (text;compose "Unknown type var: " (nat;encode idx)))
+    (maybe.default (error! (text@compose "Unknown type var: " (nat@encode idx)))
                    (list.nth idx env))
     
     _
@@ -53,9 +54,9 @@
   (def: (= x y)
     (case [x y]
       [(#.Primitive xname xparams) (#.Primitive yname yparams)]
-      (and (text;= xname yname)
+      (and (text@= xname yname)
            (n/= (list.size yparams) (list.size xparams))
-           (list;fold (.function (_ [x y] prev) (and prev (= x y)))
+           (list@fold (.function (_ [x y] prev) (and prev (= x y)))
                       #1
                       (list.zip2 xparams yparams)))
 
@@ -70,7 +71,7 @@
            (= xright yright))
 
       [(#.Named xname xtype) (#.Named yname ytype)]
-      (and (name;= xname yname)
+      (and (name@= xname yname)
            (= xtype ytype))
 
       (^template [<tag>]
@@ -82,7 +83,7 @@
            [(#.ExQ xenv xbody) (#.ExQ yenv ybody)])
       (and (n/= (list.size yenv) (list.size xenv))
            (= xbody ybody)
-           (list;fold (.function (_ [x y] prev) (and prev (= x y)))
+           (list@fold (.function (_ [x y] prev) (and prev (= x y)))
                       #1
                       (list.zip2 xenv yenv)))
 
@@ -121,7 +122,7 @@
   (case type
     (#.Apply arg func')
     (let [[func args] (flatten-application func')]
-      [func (list;compose args (list arg))])
+      [func (list@compose args (list arg))])
 
     _
     [type (list)]))
@@ -169,7 +170,7 @@
   (case type
     (#.Primitive name params)
     (` (#.Primitive (~ (code.text name))
-                    (.list (~+ (list;map to-code params)))))
+                    (.list (~+ (list@map to-code params)))))
 
     (^template [<tag>]
       (<tag> idx)
@@ -187,7 +188,7 @@
 
     (^template [<tag>]
       (<tag> env body)
-      (` (<tag> (.list (~+ (list;map to-code env)))
+      (` (<tag> (.list (~+ (list@map to-code env)))
                 (~ (to-code body)))))
     ([#.UnivQ] [#.ExQ])
     ))
@@ -196,56 +197,57 @@
   (-> Type Text)
   (case type
     (#.Primitive name params)
-    (case params
-      #.Nil
-      ($_ text;compose "(primitive " name ")")
-
-      _
-      ($_ text;compose "(primitive " name " " (|> params (list;map to-text) list.reverse (list.interpose " ") (list;fold text;compose "")) ")"))
+    ($_ text@compose
+        "(primitive "
+        (text.enclose' text.double-quote name)
+        (|> params
+            (list@map (|>> to-text (text@compose " ")))
+            (list@fold (function.flip text@compose) ""))
+        ")")
 
     (^template [<tag> <open> <close> <flatten>]
       (<tag> _)
-      ($_ text;compose <open>
+      ($_ text@compose <open>
           (|> (<flatten> type)
-              (list;map to-text)
+              (list@map to-text)
               list.reverse
               (list.interpose " ")
-              (list;fold text;compose ""))
+              (list@fold text@compose ""))
           <close>))
     ([#.Sum  "(| " ")" flatten-variant]
      [#.Product "["   "]" flatten-tuple])
 
     (#.Function input output)
     (let [[ins out] (flatten-function type)]
-      ($_ text;compose  "(-> "
+      ($_ text@compose  "(-> "
           (|> ins
-              (list;map to-text)
+              (list@map to-text)
               list.reverse
               (list.interpose " ")
-              (list;fold text;compose ""))
+              (list@fold text@compose ""))
           " " (to-text out) ")"))
 
     (#.Parameter idx)
-    (nat;encode idx)
+    (nat@encode idx)
 
     (#.Var id)
-    ($_ text;compose "⌈v:" (nat;encode id) "⌋")
+    ($_ text@compose "⌈v:" (nat@encode id) "⌋")
 
     (#.Ex id)
-    ($_ text;compose "⟨e:" (nat;encode id) "⟩")
+    ($_ text@compose "⟨e:" (nat@encode id) "⟩")
 
     (#.Apply param fun)
     (let [[type-func type-args] (flatten-application type)]
-      ($_ text;compose  "(" (to-text type-func) " " (|> type-args (list;map to-text) list.reverse (list.interpose " ") (list;fold text;compose "")) ")"))
+      ($_ text@compose  "(" (to-text type-func) " " (|> type-args (list@map to-text) list.reverse (list.interpose " ") (list@fold text@compose "")) ")"))
 
     (^template [<tag> <desc>]
       (<tag> env body)
-      ($_ text;compose "(" <desc> " {" (|> env (list;map to-text) (text.join-with " ")) "} " (to-text body) ")"))
+      ($_ text@compose "(" <desc> " {" (|> env (list@map to-text) (text.join-with " ")) "} " (to-text body) ")"))
     ([#.UnivQ "All"]
      [#.ExQ "Ex"])
 
     (#.Named [module name] type)
-    ($_ text;compose module "." name)
+    ($_ text@compose module "." name)
     ))
 
 (def: #export (un-alias type)
@@ -343,9 +345,9 @@
     (do @
       [cursor macro.cursor
        valueT (macro.find-type valueN)
-       #let [_ (log! ($_ text;compose
+       #let [_ (log! ($_ text@compose
                          ":log!" " @ " (.cursor-description cursor) text.new-line
-                         (name;encode valueN) " : " (..to-text valueT) text.new-line))]]
+                         (name@encode valueN) " : " (..to-text valueT) text.new-line))]]
       (wrap (list (code.identifier valueN))))
 
     (#.Right valueC)
@@ -361,7 +363,7 @@
                         input
                         output
                         {value (p.maybe s.any)})
-  (let [casterC (` (: (All [(~+ (list;map code.local-identifier type-vars))]
+  (let [casterC (` (: (All [(~+ (list@map code.local-identifier type-vars))]
                         (-> (~ input) (~ output)))
                       (|>> :assume)))]
     (case value
@@ -384,7 +386,7 @@
                          {exemplar typed}
                          {computation typed})
   (macro.with-gensyms [g!_]
-    (let [shareC (` (: (All [(~+ (list;map code.local-identifier type-vars))]
+    (let [shareC (` (: (All [(~+ (list@map code.local-identifier type-vars))]
                          (-> (~ (get@ #type exemplar))
                              (~ (get@ #type computation))))
                        (.function ((~ g!_) (~ g!_))
@@ -395,7 +397,7 @@
 (syntax: #export (:by-example {type-vars type-parameters}
                               {exemplar typed}
                               {extraction s.any})
-  (wrap (list (` (:of (:share [(~+ (list;map code.local-identifier type-vars))]
+  (wrap (list (` (:of (:share [(~+ (list@map code.local-identifier type-vars))]
                               {(~ (get@ #type exemplar))
                                (~ (get@ #expression exemplar))}
                               {(~ extraction)
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 77f0e1bbd..bad2e5500 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -18,6 +18,7 @@
       ["." io (#+ io)]
       ["." function]]
      [data
+      ["." name]
       [number
        ["." i64]]]
      ["." math]
@@ -296,7 +297,7 @@
                           on-default))))))
 
 (def: test
-  (<| (_.context (%name (name-of /._)))
+  (<| (_.context (name.module (name-of /._)))
       ($_ _.and
           (<| (_.context "Identity.")
               ..identity)
@@ -348,8 +349,7 @@
           /math.test
           (<| (_.context "/time")
               /time.test)
-          (<| (_.context "/tool")
-              /tool.test)
+          /tool.test
           /type.test
           /world.test
           (<| (_.context "/host")
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux
deleted file mode 100644
index 5c47960c1..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux
+++ /dev/null
@@ -1,198 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    pipe]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." text ("#;." equivalence)]
-    [collection
-     ["." list ("#;." monad)]
-     ["." set]]]
-   [math
-    ["r" random ("#;." monad)]]
-   ["." type
-    ["." check]]
-   [macro
-    ["." code]]
-   [compiler
-    [default
-     ["." phase
-      ["." analysis
-       ["." module]
-       [".A" type]
-       ["/" case]]]]]
-   test]
-  [//
-   ["_." primitive]
-   ["_." structure]])
-
-(def: (exhaustive-weaving branchings)
-  (-> (List (List Code)) (List (List Code)))
-  (case branchings
-    #.Nil
-    #.Nil
-
-    (#.Cons head+ #.Nil)
-    (list;map (|>> list) head+)
-
-    (#.Cons head+ tail++)
-    (do list.monad
-      [tail+ (exhaustive-weaving tail++)
-       head head+]
-      (wrap (#.Cons head tail+)))))
-
-(def: #export (exhaustive-branches allow-literals? variantTC inputC)
-  (-> Bit (List [Code Code]) Code (r.Random (List Code)))
-  (case inputC
-    [_ (#.Bit _)]
-    (r;wrap (list (' #1) (' #0)))
-
-    (^template [<tag> <gen> <wrapper>]
-      [_ (<tag> _)]
-      (if allow-literals?
-        (do r.monad
-          [?sample (r.maybe <gen>)]
-          (case ?sample
-            (#.Some sample)
-            (do @
-              [else (exhaustive-branches allow-literals? variantTC inputC)]
-              (wrap (list& (<wrapper> sample) else)))
-
-            #.None
-            (wrap (list (' _)))))
-        (r;wrap (list (' _)))))
-    ([#.Nat  r.nat          code.nat]
-     [#.Int  r.int          code.int]
-     [#.Rev  r.rev          code.rev]
-     [#.Frac r.frac         code.frac]
-     [#.Text (r.unicode 5) code.text])
-    
-    (^ [_ (#.Tuple (list))])
-    (r;wrap (list (' [])))
-
-    (^ [_ (#.Record (list))])
-    (r;wrap (list (' {})))
-
-    [_ (#.Tuple members)]
-    (do r.monad
-      [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
-      (wrap (|> member-wise-patterns
-                exhaustive-weaving
-                (list;map code.tuple))))
-
-    [_ (#.Record kvs)]
-    (do r.monad
-      [#let [ks (list;map product.left kvs)
-             vs (list;map product.right kvs)]
-       member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
-      (wrap (|> member-wise-patterns
-                exhaustive-weaving
-                (list;map (|>> (list.zip2 ks) code.record)))))
-
-    (^ [_ (#.Form (list [_ (#.Tag _)] _))])
-    (do r.monad
-      [bundles (monad.map @
-                          (function (_ [_tag _code])
-                            (do @
-                              [v-branches (exhaustive-branches allow-literals? variantTC _code)]
-                              (wrap (list;map (function (_ pattern) (` ((~ _tag) (~ pattern))))
-                                              v-branches))))
-                          variantTC)]
-      (wrap (list;join bundles)))
-
-    _
-    (r;wrap (list))
-    ))
-
-(def: #export (input variant-tags record-tags primitivesC)
-  (-> (List Code) (List Code) (List Code) (r.Random Code))
-  (r.rec
-   (function (_ input)
-     ($_ r.either
-         (r;map product.right _primitive.primitive)
-         (do r.monad
-           [choice (|> r.nat (:: @ map (n/% (list.size variant-tags))))
-            #let [choiceT (maybe.assume (list.nth choice variant-tags))
-                  choiceC (maybe.assume (list.nth choice primitivesC))]]
-           (wrap (` ((~ choiceT) (~ choiceC)))))
-         (do r.monad
-           [size (|> r.nat (:: @ map (n/% 3)))
-            elems (r.list size input)]
-           (wrap (code.tuple elems)))
-         (r;wrap (code.record (list.zip2 record-tags primitivesC)))
-         ))))
-
-(def: (branch body pattern)
-  (-> Code Code [Code Code])
-  [pattern body])
-
-(context: "Pattern-matching."
-  ## #seed 9253409297339902486
-  ## #seed 3793366152923578600
-  (<| (seed 5004137551292836565)
-      ## (times 100)
-      (do @
-        [module-name (r.unicode 5)
-         variant-name (r.unicode 5)
-         record-name (|> (r.unicode 5) (r.filter (|>> (text;= variant-name) not)))
-         size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
-         record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
-         primitivesTC (r.list size _primitive.primitive)
-         #let [primitivesT (list;map product.left primitivesTC)
-               primitivesC (list;map product.right primitivesTC)
-               code-tag (|>> [module-name] code.tag)
-               variant-tags+ (list;map code-tag variant-tags)
-               record-tags+ (list;map code-tag record-tags)
-               variantTC (list.zip2 variant-tags+ primitivesC)]
-         inputC (input variant-tags+ record-tags+ primitivesC)
-         [outputT outputC] _primitive.primitive
-         [heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not)
-                                                   _primitive.primitive)
-         exhaustive-patterns (exhaustive-branches #1 variantTC inputC)
-         redundant-patterns (exhaustive-branches #0 variantTC inputC)
-         redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns))))
-         heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns))))
-         #let [exhaustive-branchesC (list;map (branch outputC)
-                                              exhaustive-patterns)
-               non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC))
-                                                   exhaustive-branchesC)
-               redundant-branchesC (<| (list;map (branch outputC))
-                                       list.concat
-                                       (list (list.take redundancy-idx redundant-patterns)
-                                             (list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
-                                             (list.drop redundancy-idx redundant-patterns)))
-               heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
-                                                          (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
-                                                                  [_pattern heterogeneousC]))
-                                                          (list.drop (inc heterogeneous-idx) exhaustive-branchesC)))
-               analyse-pm (|>> (/.case _primitive.phase inputC)
-                               (typeA.with-type outputT)
-                               analysis.with-scope
-                               (do phase.monad
-                                 [_ (module.declare-tags variant-tags #0
-                                                         (#.Named [module-name variant-name]
-                                                                  (type.variant primitivesT)))
-                                  _ (module.declare-tags record-tags #0
-                                                         (#.Named [module-name record-name]
-                                                                  (type.tuple primitivesT)))])
-                               (module.with-module 0 module-name))]]
-        ($_ seq
-            (test "Will reject empty pattern-matching (no branches)."
-                  (|> (analyse-pm (list))
-                      _structure.check-fails))
-            (test "Can analyse exhaustive pattern-matching."
-                  (|> (analyse-pm exhaustive-branchesC)
-                      _structure.check-succeeds))
-            (test "Will reject non-exhaustive pattern-matching."
-                  (|> (analyse-pm non-exhaustive-branchesC)
-                      _structure.check-fails))
-            (test "Will reject redundant pattern-matching."
-                  (|> (analyse-pm redundant-branchesC)
-                      _structure.check-fails))
-            (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
-                  (|> (analyse-pm heterogeneous-branchesC)
-                      _structure.check-fails)))
-        )))
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/function.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/function.lux
deleted file mode 100644
index acdb9e7ff..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/function.lux
+++ /dev/null
@@ -1,118 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error]
-    ["." maybe]
-    ["." product]
-    ["." text ("#;." equivalence)
-     format]
-    [collection
-     ["." list ("#;." functor)]]]
-   [math
-    ["r" random]]
-   ["." type]
-   ["." macro
-    ["." code]]
-   [compiler
-    [default
-     ["." reference]
-     ["." init]
-     ["." phase
-      ["." analysis (#+ Analysis Operation)
-       [".A" type]
-       ["." expression]
-       ["/" function]]
-      [extension
-       [".E" analysis]]]]]
-   test]
-  [//
-   ["_." primitive]
-   ["_." structure]])
-
-(def: (check-apply expectedT num-args analysis)
-  (-> Type Nat (Operation Analysis) Bit)
-  (|> analysis
-      (typeA.with-type expectedT)
-      (phase.run _primitive.state)
-      (case> (#error.Success applyA)
-             (let [[funcA argsA] (analysis.application applyA)]
-               (n/= num-args (list.size argsA)))
-
-             (#error.Failure error)
-             #0)))
-
-(context: "Function definition."
-  (<| (times 100)
-      (do @
-        [func-name (r.unicode 5)
-         arg-name (|> (r.unicode 5) (r.filter (|>> (text;= func-name) not)))
-         [outputT outputC] _primitive.primitive
-         [inputT _] _primitive.primitive
-         #let [g!arg (code.local-identifier arg-name)]]
-        ($_ seq
-            (test "Can analyse function."
-                  (and (|> (typeA.with-type (All [a] (-> a outputT))
-                             (/.function _primitive.phase func-name arg-name outputC))
-                           _structure.check-succeeds)
-                       (|> (typeA.with-type (All [a] (-> a a))
-                             (/.function _primitive.phase func-name arg-name g!arg))
-                           _structure.check-succeeds)))
-            (test "Generic functions can always be specialized."
-                  (and (|> (typeA.with-type (-> inputT outputT)
-                             (/.function _primitive.phase func-name arg-name outputC))
-                           _structure.check-succeeds)
-                       (|> (typeA.with-type (-> inputT inputT)
-                             (/.function _primitive.phase func-name arg-name g!arg))
-                           _structure.check-succeeds)))
-            (test "The function's name is bound to the function's type."
-                  (|> (typeA.with-type (Rec self (-> inputT self))
-                        (/.function _primitive.phase func-name arg-name (code.local-identifier func-name)))
-                      _structure.check-succeeds))
-            ))))
-
-(context: "Function application."
-  (<| (times 100)
-      (do @
-        [full-args (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         partial-args (|> r.nat (:: @ map (n/% full-args)))
-         var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max 1))))
-         inputsTC (r.list full-args _primitive.primitive)
-         #let [inputsT (list;map product.left inputsTC)
-               inputsC (list;map product.right inputsTC)]
-         [outputT outputC] _primitive.primitive
-         #let [funcT (type.function inputsT outputT)
-               partialT (type.function (list.drop partial-args inputsT) outputT)
-               varT (#.Parameter 1)
-               polyT (<| (type.univ-q 1)
-                         (type.function (list.concat (list (list.take var-idx inputsT)
-                                                           (list varT)
-                                                           (list.drop (inc var-idx) inputsT))))
-                         varT)
-               poly-inputT (maybe.assume (list.nth var-idx inputsT))
-               partial-poly-inputsT (list.drop (inc var-idx) inputsT)
-               partial-polyT1 (<| (type.function partial-poly-inputsT)
-                                  poly-inputT)
-               partial-polyT2 (<| (type.univ-q 1)
-                                  (type.function (#.Cons varT partial-poly-inputsT))
-                                  varT)
-               dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local 1)))]]
-        ($_ seq
-            (test "Can analyse monomorphic type application."
-                  (|> (/.apply _primitive.phase funcT dummy-function inputsC)
-                      (check-apply outputT full-args)))
-            (test "Can partially apply functions."
-                  (|> (/.apply _primitive.phase funcT dummy-function (list.take partial-args inputsC))
-                      (check-apply partialT partial-args)))
-            (test "Can apply polymorphic functions."
-                  (|> (/.apply _primitive.phase polyT dummy-function inputsC)
-                      (check-apply poly-inputT full-args)))
-            (test "Polymorphic partial application propagates found type-vars."
-                  (|> (/.apply _primitive.phase polyT dummy-function (list.take (inc var-idx) inputsC))
-                      (check-apply partial-polyT1 (inc var-idx))))
-            (test "Polymorphic partial application preserves quantification for type-vars."
-                  (|> (/.apply _primitive.phase polyT dummy-function (list.take var-idx inputsC))
-                      (check-apply partial-polyT2 var-idx)))
-            ))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/primitive.lux
deleted file mode 100644
index e60a7c40c..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/primitive.lux
+++ /dev/null
@@ -1,100 +0,0 @@
-(.module:
-  [lux (#- primitive)
-   [control
-    [monad (#+ do)]
-    pipe
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." error (#+ Error)]
-    [text
-     format]]
-   [math
-    ["r" random ("#;." monad)]]
-   ["." type ("#;." equivalence)]
-   [macro
-    ["." code]]
-   [compiler
-    [default
-     ["." init]
-     [evaluation (#+ Eval)]
-     ["." phase
-      ["." analysis (#+ Analysis Operation)
-       [".A" type]
-       ["." expression]]
-      [extension
-       [".E" analysis]]]]]
-   test])
-
-(def: #export phase
-  analysis.Phase
-  expression.compile)
-
-(def: #export state
-  analysis.State+
-  [(analysisE.bundle (:coerce Eval [])) (init.compiler [])])
-
-(def: unit
-  (r.Random Code)
-  (r;wrap (' [])))
-
-(def: #export primitive
-  (r.Random [Type Code])
-  (`` ($_ r.either
-          (~~ (template [<type> <code-wrapper> <value-gen>]
-                [(r.and (r;wrap <type>) (r;map <code-wrapper> <value-gen>))]
-
-                [Any  code.tuple (r.list 0 ..unit)]
-                [Bit  code.bit   r.bit]
-                [Nat  code.nat   r.nat]
-                [Int  code.int   r.int]
-                [Rev  code.rev   r.rev]
-                [Frac code.frac  r.frac]
-                [Text code.text  (r.unicode 5)]
-                )))))
-
-(exception: (wrong-inference {expected Type} {inferred Type})
-  (ex.report ["Expected" (%type expected)]
-             ["Inferred" (%type inferred)]))
-
-(def: (infer-primitive expected-type analysis)
-  (-> Type (Operation Analysis) (Error Analysis))
-  (|> analysis
-      typeA.with-inference
-      (phase.run ..state)
-      (case> (#error.Success [inferred-type output])
-             (if (is? expected-type inferred-type)
-               (#error.Success output)
-               (ex.throw wrong-inference [expected-type inferred-type]))
-
-             (#error.Failure error)
-             (#error.Failure error))))
-
-(context: "Primitives"
-  ($_ seq
-      (test "Can analyse unit."
-            (|> (infer-primitive Any (..phase (' [])))
-                (case> (^ (#error.Success (#analysis.Primitive (#analysis.Unit output))))
-                       (is? [] output)
-
-                       _
-                       #0)))
-      (<| (times 100)
-          (`` ($_ seq
-                  (~~ (template [<desc> <type> <tag> <random> <constructor>]
-                        [(do @
-                           [sample <random>]
-                           (test (format "Can analyse " <desc> ".")
-                                 (|> (infer-primitive <type> (..phase (<constructor> sample)))
-                                     (case> (#error.Success (#analysis.Primitive (<tag> output)))
-                                            (is? sample output)
-
-                                            _
-                                            #0))))]
-
-                        ["bit"  Bit  #analysis.Bit  r.bit  code.bit]
-                        ["nat"  Nat  #analysis.Nat  r.nat  code.nat]
-                        ["int"  Int  #analysis.Int  r.int  code.int]
-                        ["rev"  Rev  #analysis.Rev  r.rev  code.rev]
-                        ["frac" Frac #analysis.Frac r.frac code.frac]
-                        ["text" Text #analysis.Text (r.unicode 5) code.text]
-                        )))))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux
deleted file mode 100644
index bf7de5cec..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux
+++ /dev/null
@@ -1,187 +0,0 @@
-(.module:
-  [lux #*
-   [io]
-   [control
-    [monad (#+ do)]
-    pipe]
-   [concurrency
-    ["." atom]]
-   [data
-    ["." error]
-    ["." product]
-    [text
-     format]]
-   [math
-    ["r" random]]
-   ["." type ("#;." equivalence)]
-   [macro
-    ["." code]]
-   [compiler
-    [default
-     ["." init]
-     ["." phase
-      [analysis
-       ["." scope]
-       [".A" type]]
-      [extension
-       [".E" analysis]]]]]
-   test]
-  [///
-   ["_." primitive]])
-
-(template [<name> <success> <failure>]
-  [(def: (<name> procedure params output-type)
-     (-> Text (List Code) Type Bit)
-     (|> (scope.with-scope ""
-           (typeA.with-type output-type
-             (_primitive.phase (` ((~ (code.text procedure)) (~+ params))))))
-         (phase.run _primitive.state)
-         (case> (#error.Success _)
-                <success>
-
-                (#error.Failure error)
-                <failure>)))]
-
-  [check-success+ #1 #0]
-  [check-failure+ #0 #1]
-  )
-
-(context: "Lux procedures"
-  (<| (times 100)
-      (do @
-        [[primT primC] _primitive.primitive
-         [antiT antiC] (|> _primitive.primitive
-                           (r.filter (|>> product.left (type;= primT) not)))]
-        ($_ seq
-            (test "Can test for reference equality."
-                  (check-success+ "lux is" (list primC primC) Bit))
-            (test "Reference equality must be done with elements of the same type."
-                  (check-failure+ "lux is" (list primC antiC) Bit))
-            (test "Can 'try' risky IO computations."
-                  (check-success+ "lux try"
-                                  (list (` ([(~' _) (~' _)] (~ primC))))
-                                  (type (Either Text primT))))
-            ))))
-
-(context: "Bit procedures"
-  (<| (times 100)
-      (do @
-        [subjectC (|> r.nat (:: @ map code.nat))
-         signedC (|> r.int (:: @ map code.int))
-         paramC (|> r.nat (:: @ map code.nat))]
-        ($_ seq
-            (test "Can perform bit 'and'."
-                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
-            (test "Can perform bit 'or'."
-                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
-            (test "Can perform bit 'xor'."
-                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
-            (test "Can shift bit pattern to the left."
-                  (check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
-            (test "Can shift bit pattern to the right."
-                  (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
-            (test "Can shift signed bit pattern to the right."
-                  (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
-            ))))
-
-(context: "Int procedures"
-  (<| (times 100)
-      (do @
-        [subjectC (|> r.int (:: @ map code.int))
-         paramC (|> r.int (:: @ map code.int))]
-        ($_ seq
-            (test "Can add integers."
-                  (check-success+ "lux int +" (list paramC subjectC) Int))
-            (test "Can subtract integers."
-                  (check-success+ "lux int -" (list paramC subjectC) Int))
-            (test "Can multiply integers."
-                  (check-success+ "lux int *" (list paramC subjectC) Int))
-            (test "Can divide integers."
-                  (check-success+ "lux int /" (list paramC subjectC) Int))
-            (test "Can calculate remainder of integers."
-                  (check-success+ "lux int %" (list paramC subjectC) Int))
-            (test "Can test equivalence of integers."
-                  (check-success+ "lux int =" (list paramC subjectC) Bit))
-            (test "Can compare integers."
-                  (check-success+ "lux int <" (list paramC subjectC) Bit))
-            (test "Can convert integer to fraction."
-                  (check-success+ "lux int to-frac" (list subjectC) Frac))
-            (test "Can convert integer to text."
-                  (check-success+ "lux int char" (list subjectC) Text))
-            ))))
-
-(context: "Frac procedures"
-  (<| (times 100)
-      (do @
-        [subjectC (|> r.frac (:: @ map code.frac))
-         paramC (|> r.frac (:: @ map code.frac))
-         encodedC (|> (r.unicode 5) (:: @ map code.text))]
-        ($_ seq
-            (test "Can add frac numbers."
-                  (check-success+ "lux frac +" (list paramC subjectC) Frac))
-            (test "Can subtract frac numbers."
-                  (check-success+ "lux frac -" (list paramC subjectC) Frac))
-            (test "Can multiply frac numbers."
-                  (check-success+ "lux frac *" (list paramC subjectC) Frac))
-            (test "Can divide frac numbers."
-                  (check-success+ "lux frac /" (list paramC subjectC) Frac))
-            (test "Can calculate remainder of frac numbers."
-                  (check-success+ "lux frac %" (list paramC subjectC) Frac))
-            (test "Can test equivalence of frac numbers."
-                  (check-success+ "lux frac =" (list paramC subjectC) Bit))
-            (test "Can compare frac numbers."
-                  (check-success+ "lux frac <" (list paramC subjectC) Bit))
-            (test "Can obtain minimum frac number."
-                  (check-success+ "lux frac min" (list) Frac))
-            (test "Can obtain maximum frac number."
-                  (check-success+ "lux frac max" (list) Frac))
-            (test "Can obtain smallest frac number."
-                  (check-success+ "lux frac smallest" (list) Frac))
-            (test "Can convert frac number to integer."
-                  (check-success+ "lux frac to-int" (list subjectC) Int))
-            (test "Can convert frac number to text."
-                  (check-success+ "lux frac encode" (list subjectC) Text))
-            (test "Can convert text to frac number."
-                  (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
-            ))))
-
-(context: "Text procedures"
-  (<| (times 100)
-      (do @
-        [subjectC (|> (r.unicode 5) (:: @ map code.text))
-         paramC (|> (r.unicode 5) (:: @ map code.text))
-         replacementC (|> (r.unicode 5) (:: @ map code.text))
-         fromC (|> r.nat (:: @ map code.nat))
-         toC (|> r.nat (:: @ map code.nat))]
-        ($_ seq
-            (test "Can test text equivalence."
-                  (check-success+ "lux text =" (list paramC subjectC) Bit))
-            (test "Compare texts in lexicographical order."
-                  (check-success+ "lux text <" (list paramC subjectC) Bit))
-            (test "Can concatenate one text to another."
-                  (check-success+ "lux text concat" (list subjectC paramC) Text))
-            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
-                  (check-success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat))))
-            (test "Can query the size/length of a text."
-                  (check-success+ "lux text size" (list subjectC) Nat))
-            (test "Can obtain the character code of a text at a given index."
-                  (check-success+ "lux text char" (list fromC subjectC) Nat))
-            (test "Can clip a piece of text between 2 indices."
-                  (check-success+ "lux text clip" (list fromC toC subjectC) Text))
-            ))))
-
-(context: "IO procedures"
-  (<| (times 100)
-      (do @
-        [logC (|> (r.unicode 5) (:: @ map code.text))
-         exitC (|> r.int (:: @ map code.int))]
-        ($_ seq
-            (test "Can log messages to standard output."
-                  (check-success+ "lux io log" (list logC) Any))
-            (test "Can throw a run-time error."
-                  (check-success+ "lux io error" (list logC) Nothing))
-            (test "Can exit the program."
-                  (check-success+ "lux io exit" (list exitC) Nothing))
-            (test "Can query the current time (as milliseconds since epoch)."
-                  (check-success+ "lux io current-time" (list) Int))
-            ))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/reference.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/reference.lux
deleted file mode 100644
index a73e6c3cb..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/reference.lux
+++ /dev/null
@@ -1,107 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error (#+ Error)]
-    ["." name ("#;." equivalence)]
-    ["." text ("#;." equivalence)]]
-   [math
-    ["r" random]]
-   ["." type ("#;." equivalence)]
-   [macro
-    ["." code]]
-   [compiler
-    [default
-     ["." reference]
-     ["." init]
-     ["." phase
-      ["." analysis
-       ["." scope]
-       ["." module]
-       [".A" type]
-       ["." expression]]
-      [extension
-       [".E" analysis]]]]]
-   test]
-  [//
-   ["_." primitive]])
-
-(type: Check (-> (Error Any) Bit))
-
-(template [<name> <on-success> <on-failure>]
-  [(def: <name>
-     Check
-     (|>> (case> (#error.Success _)
-                 <on-success>
-
-                 (#error.Failure _)
-                 <on-failure>)))]
-
-  [success? #1 #0]
-  [failure? #0 #1]
-  )
-
-(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
-  (-> Text [Bit Text] [Bit Text] Check Bit)
-  (|> (do phase.monad
-        [_ (module.with-module 0 def-module
-             (module.define var-name [Any
-                                      (if export?
-                                        (' {#.export? #1})
-                                        (' {}))
-                                      []]))]
-        (module.with-module 0 dependent-module
-          (do @
-            [_ (if import?
-                 (module.import def-module)
-                 (wrap []))]
-            (typeA.with-inference
-              (_primitive.phase (code.identifier [def-module var-name]))))))
-      (phase.run _primitive.state)
-      check!))
-
-(context: "References"
-  (<| (times 100)
-      (do @
-        [[expectedT _] _primitive.primitive
-         def-module (r.unicode 5)
-         scope-name (r.unicode 5)
-         var-name (r.unicode 5)
-         dependent-module (|> (r.unicode 5)
-                              (r.filter (|>> (text;= def-module) not)))]
-        ($_ seq
-            (test "Can analyse variable."
-                  (|> (scope.with-scope scope-name
-                        (scope.with-local [var-name expectedT]
-                          (typeA.with-inference
-                            (_primitive.phase (code.local-identifier var-name)))))
-                      (phase.run _primitive.state)
-                      (case> (^ (#error.Success [inferredT (#analysis.Reference (reference.local var))]))
-                             (and (type;= expectedT inferredT)
-                                  (n/= 0 var))
-
-                             _
-                             #0)))
-            (test "Can analyse definition (in the same module)."
-                  (let [def-name [def-module var-name]]
-                    (|> (do phase.monad
-                          [_ (module.define var-name [expectedT (' {}) []])]
-                          (typeA.with-inference
-                            (_primitive.phase (code.identifier def-name))))
-                        (module.with-module 0 def-module)
-                        (phase.run _primitive.state)
-                        (case> (^ (#error.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))]))
-                               (and (type;= expectedT inferredT)
-                                    (name;= def-name constant-name))
-
-                               _
-                               #0))))
-            (test "Can analyse definition (if exported from imported module)."
-                  (reach-test var-name [#1 def-module] [#1 dependent-module] success?))
-            (test "Cannot analyse definition (if not exported from imported module)."
-                  (reach-test var-name [#0 def-module] [#1 dependent-module] failure?))
-            (test "Cannot analyse definition (if exported from non-imported module)."
-                  (reach-test var-name [#1 def-module] [#0 dependent-module] failure?))
-            ))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/structure.lux
deleted file mode 100644
index 186c961e9..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/analysis/structure.lux
+++ /dev/null
@@ -1,297 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." bit ("#;." equivalence)]
-    ["e" error]
-    ["." product]
-    ["." maybe]
-    ["." text]
-    [collection
-     ["." list ("#;." functor)]
-     ["." set]]]
-   [math
-    ["r" random]]
-   ["." type ("#;." equivalence)
-    ["." check]]
-   [macro
-    ["." code]]
-   [compiler
-    [default
-     ["." init]
-     ["." phase
-      ["." analysis (#+ Analysis Variant Tag Operation)
-       ["." module]
-       [".A" type]
-       ["/" structure]
-       ["." expression]]
-      [extension
-       [".E" analysis]]]]]
-   test]
-  [//
-   ["_." primitive]])
-
-(template [<name> <on-success> <on-error>]
-  [(def: #export <name>
-     (All [a] (-> (Operation a) Bit))
-     (|>> (phase.run _primitive.state)
-          (case> (#e.Success _)
-                 <on-success>
-
-                 _
-                 <on-error>)))]
-
-  [check-succeeds #1 #0]
-  [check-fails    #0 #1]
-  )
-
-(def: (check-sum' size tag variant)
-  (-> Nat Tag (Variant Analysis) Bit)
-  (let [variant-tag (if (get@ #analysis.right? variant)
-                      (inc (get@ #analysis.lefts variant))
-                      (get@ #analysis.lefts variant))]
-    (|> size dec (n/= tag)
-        (bit;= (get@ #analysis.right? variant))
-        (and (n/= tag variant-tag)))))
-
-(def: (check-sum type size tag analysis)
-  (-> Type Nat Tag (Operation Analysis) Bit)
-  (|> analysis
-      (typeA.with-type type)
-      (phase.run _primitive.state)
-      (case> (^ (#e.Success (analysis.variant variant)))
-             (check-sum' size tag variant)
-
-             _
-             #0)))
-
-(def: (tagged module tags type)
-  (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a])))
-  (|>> (do phase.monad
-         [_ (module.declare-tags tags #0 type)])
-       (module.with-module 0 module)))
-
-(def: (check-variant module tags type size tag analysis)
-  (-> Text (List module.Tag) Type Nat Tag (Operation Analysis) Bit)
-  (|> analysis
-      (tagged module tags type)
-      (typeA.with-type type)
-      (phase.run _primitive.state)
-      (case> (^ (#e.Success [_ (analysis.variant variant)]))
-             (check-sum' size tag variant)
-
-             _
-             #0)))
-
-(def: (right-size? size)
-  (-> Nat (-> Analysis Bit))
-  (|>> (case> (^ (analysis.tuple elems))
-              (|> elems
-                  list.size
-                  (n/= size))
-              
-              _
-              false)))
-
-(def: (check-record-inference module tags type size analysis)
-  (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit)
-  (|> analysis
-      (tagged module tags type)
-      (phase.run _primitive.state)
-      (case> (#e.Success [_ productT productA])
-             (and (type;= type productT)
-                  (right-size? size productA))
-
-             _
-             #0)))
-
-(context: "Sums"
-  (<| (times 100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         choice (|> r.nat (:: @ map (n/% size)))
-         primitives (r.list size _primitive.primitive)
-         +choice (|> r.nat (:: @ map (n/% (inc size))))
-         [_ +valueC] _primitive.primitive
-         #let [variantT (type.variant (list;map product.left primitives))
-               [valueT valueC] (maybe.assume (list.nth choice primitives))
-               +size (inc size)
-               +primitives (list.concat (list (list.take choice primitives)
-                                              (list [(#.Parameter 1) +valueC])
-                                              (list.drop choice primitives)))
-               [+valueT +valueC] (maybe.assume (list.nth +choice +primitives))
-               +variantT (type.variant (list;map product.left +primitives))]]
-        ($_ seq
-            (test "Can analyse sum."
-                  (check-sum variantT size choice
-                             (/.sum _primitive.phase choice valueC)))
-            (test "Can analyse sum through bound type-vars."
-                  (|> (do phase.monad
-                        [[_ varT] (typeA.with-env check.var)
-                         _ (typeA.with-env
-                             (check.check varT variantT))]
-                        (typeA.with-type varT
-                          (/.sum _primitive.phase choice valueC)))
-                      (phase.run _primitive.state)
-                      (case> (^ (#e.Success (analysis.variant variant)))
-                             (check-sum' size choice variant)
-
-                             _
-                             #0)))
-            (test "Cannot analyse sum through unbound type-vars."
-                  (|> (do phase.monad
-                        [[_ varT] (typeA.with-env check.var)]
-                        (typeA.with-type varT
-                          (/.sum _primitive.phase choice valueC)))
-                      check-fails))
-            (test "Can analyse sum through existential quantification."
-                  (|> (typeA.with-type (type.ex-q 1 +variantT)
-                        (/.sum _primitive.phase +choice +valueC))
-                      check-succeeds))
-            (test "Can analyse sum through universal quantification."
-                  (let [check-outcome (if (not (n/= choice +choice))
-                                        check-succeeds
-                                        check-fails)]
-                    (|> (typeA.with-type (type.univ-q 1 +variantT)
-                          (/.sum _primitive.phase +choice +valueC))
-                        check-outcome)))
-            ))))
-
-(context: "Products"
-  (<| (times 100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         primitives (r.list size _primitive.primitive)
-         choice (|> r.nat (:: @ map (n/% size)))
-         [_ +valueC] _primitive.primitive
-         #let [tupleT (type.tuple (list;map product.left primitives))
-               [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume)
-               +primitives (list.concat (list (list.take choice primitives)
-                                              (list [(#.Parameter 1) +valueC])
-                                              (list.drop choice primitives)))
-               +tupleT (type.tuple (list;map product.left +primitives))]]
-        ($_ seq
-            (test "Can analyse product."
-                  (|> (typeA.with-type tupleT
-                        (/.product _primitive.phase (list;map product.right primitives)))
-                      (phase.run _primitive.state)
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             #0)))
-            (test "Can infer product."
-                  (|> (typeA.with-inference
-                        (/.product _primitive.phase (list;map product.right primitives)))
-                      (phase.run _primitive.state)
-                      (case> (#e.Success [_type tupleA])
-                             (and (type;= tupleT _type)
-                                  (right-size? size tupleA))
-
-                             _
-                             #0)))
-            (test "Can analyse pseudo-product (singleton tuple)"
-                  (|> (typeA.with-type singletonT
-                        (_primitive.phase (` [(~ singletonC)])))
-                      check-succeeds))
-            (test "Can analyse product through bound type-vars."
-                  (|> (do phase.monad
-                        [[_ varT] (typeA.with-env check.var)
-                         _ (typeA.with-env
-                             (check.check varT (type.tuple (list;map product.left primitives))))]
-                        (typeA.with-type varT
-                          (/.product _primitive.phase (list;map product.right primitives))))
-                      (phase.run _primitive.state)
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             #0)))
-            (test "Can analyse product through existential quantification."
-                  (|> (typeA.with-type (type.ex-q 1 +tupleT)
-                        (/.product _primitive.phase (list;map product.right +primitives)))
-                      check-succeeds))
-            (test "Cannot analyse product through universal quantification."
-                  (|> (typeA.with-type (type.univ-q 1 +tupleT)
-                        (/.product _primitive.phase (list;map product.right +primitives)))
-                      check-fails))
-            ))))
-
-(context: "Tagged Sums"
-  (<| (times 100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
-         choice (|> r.nat (:: @ map (n/% size)))
-         other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not)))
-         primitives (r.list size _primitive.primitive)
-         module-name (r.unicode 5)
-         type-name (r.unicode 5)
-         #let [varT (#.Parameter 1)
-               primitivesT (list;map product.left primitives)
-               [choiceT choiceC] (maybe.assume (list.nth choice primitives))
-               [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives))
-               variantT (type.variant primitivesT)
-               namedT (#.Named [module-name type-name] variantT)
-               named-polyT (|> (type.variant (list.concat (list (list.take choice primitivesT)
-                                                                (list varT)
-                                                                (list.drop (inc choice) primitivesT))))
-                               (type.univ-q 1)
-                               (#.Named [module-name type-name]))
-               choice-tag (maybe.assume (list.nth choice tags))
-               other-choice-tag (maybe.assume (list.nth other-choice tags))]]
-        ($_ seq
-            (test "Can infer tagged sum."
-                  (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC)
-                      (check-variant module-name tags namedT choice size)))
-            (test "Tagged sums specialize when type-vars get bound."
-                  (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC)
-                      (check-variant module-name tags named-polyT choice size)))
-            (test "Tagged sum inference retains universal quantification when type-vars are not bound."
-                  (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC)
-                      (check-variant module-name tags named-polyT other-choice size)))
-            (test "Can specialize generic tagged sums."
-                  (|> (typeA.with-type variantT
-                        (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC))
-                      (check-variant module-name tags named-polyT other-choice size)))
-            ))))
-
-(context: "Records"
-  (<| (times 100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-         tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
-         primitives (r.list size _primitive.primitive)
-         module-name (r.unicode 5)
-         type-name (r.unicode 5)
-         choice (|> r.nat (:: @ map (n/% size)))
-         #let [varT (#.Parameter 1)
-               tagsC (list;map (|>> [module-name] code.tag) tags)
-               primitivesT (list;map product.left primitives)
-               primitivesC (list;map product.right primitives)
-               tupleT (type.tuple primitivesT)
-               namedT (#.Named [module-name type-name] tupleT)
-               recordC (list.zip2 tagsC primitivesC)
-               named-polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT)
-                                                              (list varT)
-                                                              (list.drop (inc choice) primitivesT))))
-                               (type.univ-q 1)
-                               (#.Named [module-name type-name]))]]
-        ($_ seq
-            (test "Can infer record."
-                  (|> (typeA.with-inference
-                        (/.record _primitive.phase recordC))
-                      (check-record-inference module-name tags namedT size)))
-            (test "Records specialize when type-vars get bound."
-                  (|> (typeA.with-inference
-                        (/.record _primitive.phase recordC))
-                      (check-record-inference module-name tags named-polyT size)))
-            (test "Can specialize generic records."
-                  (|> (do phase.monad
-                        [recordA (typeA.with-type tupleT
-                                   (/.record _primitive.phase recordC))]
-                        (wrap [tupleT recordA]))
-                      (check-record-inference module-name tags named-polyT size)))
-            ))))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 340e24642..91c8d385b 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -3,14 +3,6 @@
    ["_" test (#+ Test)]]
   ## [compiler
   ##  [phase
-  ##   [analysis
-  ##    ["_.A" primitive]
-  ##    ["_.A" structure]
-  ##    ["_.A" reference]
-  ##    ["_.A" case]
-  ##    ["_.A" function]
-  ##    [procedure
-  ##     ["_.A" common]]]
   ##   [synthesis
   ##    ["_.S" primitive]
   ##    ["_.S" structure]
@@ -19,10 +11,13 @@
   ["." / #_
    [compiler
     [default
-     ["#." syntax]]]])
+     ["#." syntax]]
+    [phase
+     ["#." analysis]]]])
 
 (def: #export test
   Test
   ($_ _.and
       /syntax.test
+      /analysis.test
       ))
diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux
index 632e97023..9f36c551f 100644
--- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux
@@ -1,7 +1,9 @@
 (.module:
   [lux #*
-   data/text/format
    [abstract/monad (#+ do)]
+   [data
+    text/format
+    ["." name]]
    ["r" math/random (#+ Random) ("#@." monad)]
    ["_" test (#+ Test)]
    [data
@@ -25,17 +27,8 @@
 (def: name-part^
   (Random Text)
   (do r.monad
-    [#let [digits "0123456789"
-           delimiters (format "()[]{}#." /.text-delimiter)
-           space (format " " text.new-line)
-           invalid-range (format digits delimiters space)
-           char-gen (|> r.nat
-                        (:: @ map (|>> (n/% 256) (n/max 1)))
-                        (r.filter (function (_ sample)
-                                    (not (text.contains? (text.from-code sample)
-                                                         invalid-range)))))]
-     size (|> r.nat (:: @ map (|>> (n/% 20) (n/max 1))))]
-    (r.text char-gen size)))
+    [size (|> r.nat (:: @ map (|>> (n/% 20) (n/max 1))))]
+    (r.ascii/lower-alpha size)))
 
 (def: name^
   (Random Name)
@@ -49,12 +42,12 @@
                         (|> r.nat (r@map code.nat))
                         (|> r.int (r@map code.int))
                         (|> r.rev (r@map code.rev))
-                        (|> r.frac (r@map code.frac))))
+                        (|> r.safe-frac (r@map code.frac))))
         textual^ (: (Random Code)
                     ($_ r.either
                         (do r.monad
                           [size (|> r.nat (r@map (n/% 20)))]
-                          (|> (r.unicode size) (r@map code.text)))
+                          (|> (r.ascii/upper-alpha size) (r@map code.text)))
                         (|> name^ (r@map code.identifier))
                         (|> name^ (r@map code.tag))))
         simple^ (: (Random Code)
@@ -146,7 +139,8 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ..code
-      ..comments
-      ))
+  (<| (_.context (name.module (name-of /._)))
+      ($_ _.and
+          ..code
+          ..comments
+          )))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis.lux
new file mode 100644
index 000000000..d24feb8be
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis.lux
@@ -0,0 +1,24 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]]
+  ["." / #_
+   ["#." primitive]
+   ["#." structure]
+   ["#." reference]
+   ["#." case]
+   ["#." function]
+   ["/#" // #_
+    [extension
+     [analysis
+      ["#." common]]]]])
+
+(def: #export test
+  Test
+  ($_ _.and
+      /primitive.test
+      /structure.test
+      /reference.test
+      /case.test
+      /function.test
+      //common.test
+      ))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux
new file mode 100644
index 000000000..6f5a324cd
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux
@@ -0,0 +1,201 @@
+(.module:
+  [lux #*
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name ("#@." equivalence)]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." text ("#@." equivalence)]
+    [collection
+     ["." list ("#@." monad)]
+     ["." set]]]
+   ["." type
+    ["." check]]
+   [macro
+    ["." code]]]
+  [//
+   ["_." primitive]
+   ["_." structure]]
+  {1
+   ["." /
+    ["/#" //
+     ["#." module]
+     ["#." type]
+     ["/#" //
+      ["/#" //
+       ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+
+(def: (exhaustive-weaving branchings)
+  (-> (List (List Code)) (List (List Code)))
+  (case branchings
+    #.Nil
+    #.Nil
+
+    (#.Cons head+ #.Nil)
+    (list@map (|>> list) head+)
+
+    (#.Cons head+ tail++)
+    (do list.monad
+      [tail+ (exhaustive-weaving tail++)
+       head head+]
+      (wrap (#.Cons head tail+)))))
+
+(def: #export (exhaustive-branches allow-literals? variantTC inputC)
+  (-> Bit (List [Code Code]) Code (Random (List Code)))
+  (case inputC
+    [_ (#.Bit _)]
+    (r@wrap (list (' #0) (' #1)))
+
+    (^template [<tag> <gen> <wrapper>]
+      [_ (<tag> _)]
+      (if allow-literals?
+        (do r.monad
+          [?sample (r.maybe <gen>)]
+          (case ?sample
+            (#.Some sample)
+            (do @
+              [else (exhaustive-branches allow-literals? variantTC inputC)]
+              (wrap (list& (<wrapper> sample) else)))
+
+            #.None
+            (wrap (list (' _)))))
+        (r@wrap (list (' _)))))
+    ([#.Nat  r.nat         code.nat]
+     [#.Int  r.int         code.int]
+     [#.Rev  r.rev         code.rev]
+     [#.Frac r.frac        code.frac]
+     [#.Text (r.unicode 5) code.text])
+    
+    (^ [_ (#.Tuple (list))])
+    (r@wrap (list (' [])))
+
+    [_ (#.Tuple members)]
+    (do r.monad
+      [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
+      (wrap (|> member-wise-patterns
+                exhaustive-weaving
+                (list@map code.tuple))))
+
+    (^ [_ (#.Record (list))])
+    (r@wrap (list (' {})))
+
+    [_ (#.Record kvs)]
+    (do r.monad
+      [#let [ks (list@map product.left kvs)
+             vs (list@map product.right kvs)]
+       member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
+      (wrap (|> member-wise-patterns
+                exhaustive-weaving
+                (list@map (|>> (list.zip2 ks) code.record)))))
+
+    (^ [_ (#.Form (list [_ (#.Tag _)] _))])
+    (do r.monad
+      [bundles (monad.map @
+                          (function (_ [_tag _code])
+                            (do @
+                              [v-branches (exhaustive-branches allow-literals? variantTC _code)]
+                              (wrap (list@map (function (_ pattern) (` ((~ _tag) (~ pattern))))
+                                              v-branches))))
+                          variantTC)]
+      (wrap (list@join bundles)))
+
+    _
+    (r@wrap (list))
+    ))
+
+(def: #export (input variant-tags record-tags primitivesC)
+  (-> (List Code) (List Code) (List Code) (Random Code))
+  (r.rec
+   (function (_ input)
+     ($_ r.either
+         (r@map product.right _primitive.primitive)
+         (do r.monad
+           [choice (|> r.nat (:: @ map (n/% (list.size variant-tags))))
+            #let [choiceT (maybe.assume (list.nth choice variant-tags))
+                  choiceC (maybe.assume (list.nth choice primitivesC))]]
+           (wrap (` ((~ choiceT) (~ choiceC)))))
+         (do r.monad
+           [size (|> r.nat (:: @ map (n/% 3)))
+            elems (r.list size input)]
+           (wrap (code.tuple elems)))
+         (r@wrap (code.record (list.zip2 record-tags primitivesC)))
+         ))))
+
+(def: (branch body pattern)
+  (-> Code Code [Code Code])
+  [pattern body])
+
+(def: #export test
+  (<| (_.context (name.module (name-of /._)))
+      (do r.monad
+        [module-name (r.unicode 5)
+         variant-name (r.unicode 5)
+         record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not)))
+         size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+         variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+         record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+         primitivesTC (r.list size _primitive.primitive)
+         #let [primitivesT (list@map product.left primitivesTC)
+               primitivesC (list@map product.right primitivesTC)
+               code-tag (|>> [module-name] code.tag)
+               variant-tags+ (list@map code-tag variant-tags)
+               record-tags+ (list@map code-tag record-tags)
+               variantTC (list.zip2 variant-tags+ primitivesC)]
+         inputC (input variant-tags+ record-tags+ primitivesC)
+         [outputT outputC] (r.filter (|>> product.left (is? Any) not)
+                                     _primitive.primitive)
+         #let [analyse-pm (|>> (/.case _primitive.phase inputC)
+                               (//type.with-type outputT)
+                               ////analysis.with-scope
+                               (do ///.monad
+                                 [_ (//module.declare-tags variant-tags false
+                                                           (#.Named [module-name variant-name]
+                                                                    (type.variant primitivesT)))
+                                  _ (//module.declare-tags record-tags false
+                                                           (#.Named [module-name record-name]
+                                                                    (type.tuple primitivesT)))])
+                               (//module.with-module 0 module-name))]
+         exhaustive-patterns (exhaustive-branches true variantTC inputC)
+         #let [exhaustive-branchesC (list@map (branch outputC)
+                                              exhaustive-patterns)]]
+        ($_ _.and
+            (_.test "Will reject empty pattern-matching (no branches)."
+                    (|> (analyse-pm (list))
+                        _structure.check-fails))
+            (_.test "Can analyse exhaustive pattern-matching."
+                    (|> (analyse-pm exhaustive-branchesC)
+                        _structure.check-succeeds))
+            (let [non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC))
+                                                      exhaustive-branchesC)]
+              (_.test "Will reject non-exhaustive pattern-matching."
+                      (|> (analyse-pm non-exhaustive-branchesC)
+                          _structure.check-fails)))
+            (do @
+              [redundant-patterns (exhaustive-branches false variantTC inputC)
+               redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns))))
+               #let [redundant-branchesC (<| (list@map (branch outputC))
+                                             list.concat
+                                             (list (list.take redundancy-idx redundant-patterns)
+                                                   (list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
+                                                   (list.drop redundancy-idx redundant-patterns)))]]
+              (_.test "Will reject redundant pattern-matching."
+                      (|> (analyse-pm redundant-branchesC)
+                          _structure.check-fails)))
+            (do @
+              [[heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not)
+                                                         _primitive.primitive)
+               heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns))))
+               #let [heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
+                                                                (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
+                                                                        [_pattern heterogeneousC]))
+                                                                (list.drop (inc heterogeneous-idx) exhaustive-branchesC)))]]
+              (_.test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
+                      (|> (analyse-pm heterogeneous-branchesC)
+                          _structure.check-fails)))
+            ))))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux
new file mode 100644
index 000000000..8d345dae2
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux
@@ -0,0 +1,125 @@
+(.module:
+  [lux #*
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name ("#@." equivalence)]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe]
+   [data
+    ["." error]
+    ["." maybe]
+    ["." product]
+    ["." text ("#@." equivalence)]
+    [collection
+     ["." list ("#@." functor)]]]
+   ["." type]
+   ["." macro
+    ["." code]]]
+  [//
+   ["_." primitive]
+   ["_." structure]]
+  {1
+   ["." /
+    ["/#" //
+     ["#." module]
+     ["#." type]
+     ["/#" //
+      ["/#" //
+       ["#." reference]
+       ["#." analysis (#+ Analysis Operation)]]]]]})
+
+(def: (check-apply expectedT num-args analysis)
+  (-> Type Nat (Operation Analysis) Bit)
+  (|> analysis
+      (//type.with-type expectedT)
+      (///.run _primitive.state)
+      (case> (#error.Success applyA)
+             (let [[funcA argsA] (////analysis.application applyA)]
+               (n/= num-args (list.size argsA)))
+
+             (#error.Failure error)
+             false)))
+
+(def: abstraction
+  (do r.monad
+    [func-name (r.unicode 5)
+     arg-name (|> (r.unicode 5) (r.filter (|>> (text@= func-name) not)))
+     [outputT outputC] _primitive.primitive
+     [inputT _] _primitive.primitive
+     #let [g!arg (code.local-identifier arg-name)]]
+    (<| (_.context (%name (name-of /.function)))
+        ($_ _.and
+            (_.test "Can analyse function."
+                    (and (|> (//type.with-type (All [a] (-> a outputT))
+                               (/.function _primitive.phase func-name arg-name outputC))
+                             _structure.check-succeeds)
+                         (|> (//type.with-type (All [a] (-> a a))
+                               (/.function _primitive.phase func-name arg-name g!arg))
+                             _structure.check-succeeds)))
+            (_.test "Generic functions can always be specialized."
+                    (and (|> (//type.with-type (-> inputT outputT)
+                               (/.function _primitive.phase func-name arg-name outputC))
+                             _structure.check-succeeds)
+                         (|> (//type.with-type (-> inputT inputT)
+                               (/.function _primitive.phase func-name arg-name g!arg))
+                             _structure.check-succeeds)))
+            (_.test "The function's name is bound to the function's type."
+                    (|> (//type.with-type (Rec self (-> inputT self))
+                          (/.function _primitive.phase func-name arg-name (code.local-identifier func-name)))
+                        _structure.check-succeeds))
+            ))))
+
+(def: apply
+  (do r.monad
+    [full-args (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     partial-args (|> r.nat (:: @ map (n/% full-args)))
+     var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max 1))))
+     inputsTC (r.list full-args _primitive.primitive)
+     #let [inputsT (list@map product.left inputsTC)
+           inputsC (list@map product.right inputsTC)]
+     [outputT outputC] _primitive.primitive
+     #let [funcT (type.function inputsT outputT)
+           partialT (type.function (list.drop partial-args inputsT) outputT)
+           varT (#.Parameter 1)
+           polyT (<| (type.univ-q 1)
+                     (type.function (list.concat (list (list.take var-idx inputsT)
+                                                       (list varT)
+                                                       (list.drop (inc var-idx) inputsT))))
+                     varT)
+           poly-inputT (maybe.assume (list.nth var-idx inputsT))
+           partial-poly-inputsT (list.drop (inc var-idx) inputsT)
+           partial-polyT1 (<| (type.function partial-poly-inputsT)
+                              poly-inputT)
+           partial-polyT2 (<| (type.univ-q 1)
+                              (type.function (#.Cons varT partial-poly-inputsT))
+                              varT)
+           dummy-function (#////analysis.Function (list) (#////analysis.Reference (////reference.local 1)))]]
+    (<| (_.context (%name (name-of /.apply)))
+        ($_ _.and
+            (_.test "Can analyse monomorphic type application."
+                    (|> (/.apply _primitive.phase funcT dummy-function inputsC)
+                        (check-apply outputT full-args)))
+            (_.test "Can partially apply functions."
+                    (|> (/.apply _primitive.phase funcT dummy-function (list.take partial-args inputsC))
+                        (check-apply partialT partial-args)))
+            (_.test "Can apply polymorphic functions."
+                    (|> (/.apply _primitive.phase polyT dummy-function inputsC)
+                        (check-apply poly-inputT full-args)))
+            (_.test "Polymorphic partial application propagates found type-vars."
+                    (|> (/.apply _primitive.phase polyT dummy-function (list.take (inc var-idx) inputsC))
+                        (check-apply partial-polyT1 (inc var-idx))))
+            (_.test "Polymorphic partial application preserves quantification for type-vars."
+                    (|> (/.apply _primitive.phase polyT dummy-function (list.take var-idx inputsC))
+                        (check-apply partial-polyT2 var-idx)))
+            ))))
+
+(def: #export test
+  Test
+  (<| (_.context (name.module (name-of /._)))
+      ($_ _.and
+          ..abstraction
+          ..apply
+          )))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux
new file mode 100644
index 000000000..2ed135058
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux
@@ -0,0 +1,108 @@
+(.module:
+  [lux (#- primitive)
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe
+    ["." exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]]
+   ["." type ("#@." equivalence)]
+   [macro
+    ["." code]]]
+  {1
+   ["." /
+    ["/#" //
+     ["#." type]
+     ["/#" //
+      [macro (#+ Expander)]
+      [extension
+       ["#." analysis]]
+      ["/#" //
+       ["#." analysis (#+ Analysis Operation)]
+       [default
+        [evaluation (#+ Eval)]
+        ["." init]]]]]]})
+
+(def: #export (expander macro inputs state)
+  Expander
+  (#error.Failure "NOPE"))
+
+(def: #export (eval count type expression)
+  Eval
+  (function (_ state)
+    (#error.Failure "NO!")))
+
+(def: #export phase
+  ////analysis.Phase
+  (//.phase ..expander))
+
+(def: #export state
+  ////analysis.State+
+  [(///analysis.bundle ..eval) (////analysis.state init.info [])])
+
+(def: #export primitive
+  (Random [Type Code])
+  (`` ($_ r.either
+          (~~ (template [<type> <code-wrapper> <value-gen>]
+                [(r.and (r@wrap <type>) (r@map <code-wrapper> <value-gen>))]
+
+                [Any  code.tuple (r.list 0 (r@wrap (' [])))]
+                [Bit  code.bit   r.bit]
+                [Nat  code.nat   r.nat]
+                [Int  code.int   r.int]
+                [Rev  code.rev   r.rev]
+                [Frac code.frac  r.frac]
+                [Text code.text  (r.unicode 5)]
+                )))))
+
+(exception: (wrong-inference {expected Type} {inferred Type})
+  (exception.report
+   ["Expected" (%type expected)]
+   ["Inferred" (%type inferred)]))
+
+(def: (infer expected-type analysis)
+  (-> Type (Operation Analysis) (Error Analysis))
+  (|> analysis
+      //type.with-inference
+      (///.run ..state)
+      (case> (#error.Success [inferred-type output])
+             (if (is? expected-type inferred-type)
+               (#error.Success output)
+               (exception.throw wrong-inference [expected-type inferred-type]))
+
+             (#error.Failure error)
+             (#error.Failure error))))
+
+(def: #export test
+  (<| (_.context (name.module (name-of /._)))
+      (`` ($_ _.and
+              (_.test (%name (name-of #////analysis.Unit))
+                      (|> (infer Any (..phase (' [])))
+                          (case> (^ (#error.Success (#////analysis.Primitive (#////analysis.Unit output))))
+                                 (is? [] output)
+
+                                 _
+                                 false)))
+              (~~ (template [<type> <tag> <random> <constructor>]
+                    [(do r.monad
+                       [sample <random>]
+                       (_.test (%name (name-of <tag>))
+                               (|> (infer <type> (..phase (<constructor> sample)))
+                                   (case> (#error.Success (#////analysis.Primitive (<tag> output)))
+                                          (is? sample output)
+
+                                          _
+                                          false))))]
+
+                    [Bit  #////analysis.Bit  r.bit         code.bit]
+                    [Nat  #////analysis.Nat  r.nat         code.nat]
+                    [Int  #////analysis.Int  r.int         code.int]
+                    [Rev  #////analysis.Rev  r.rev         code.rev]
+                    [Frac #////analysis.Frac r.frac        code.frac]
+                    [Text #////analysis.Text (r.unicode 5) code.text]
+                    ))))))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux
new file mode 100644
index 000000000..7356b9fad
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux
@@ -0,0 +1,106 @@
+(.module:
+  [lux #*
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name ("#@." equivalence)]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe]
+   [data
+    ["." error (#+ Error)]
+    ["." text ("#@." equivalence)]]
+   ["." type ("#@." equivalence)]
+   [macro
+    ["." code]]]
+  [//
+   ["_." primitive]]
+  {1
+   ["." /
+    ["/#" //
+     ["#." scope]
+     ["#." module]
+     ["#." type]
+     ["/#" //
+      ["/#" //
+       ["#." reference]
+       ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+
+(type: Check (-> (Error Any) Bit))
+
+(template [<name> <on-success> <on-failure>]
+  [(def: <name>
+     Check
+     (|>> (case> (#error.Success _)
+                 <on-success>
+
+                 (#error.Failure error)
+                 <on-failure>)))]
+
+  [success? true false]
+  [failure? false true]
+  )
+
+(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
+  (-> Text [Bit Text] [Bit Text] Check Bit)
+  (|> (do ///.monad
+        [_ (//module.with-module 0 def-module
+             (//module.define var-name [Any
+                                        (if export?
+                                          (' {#.export? #1})
+                                          (' {}))
+                                        []]))]
+        (//module.with-module 0 dependent-module
+          (do @
+            [_ (if import?
+                 (//module.import def-module)
+                 (wrap []))]
+            (//type.with-inference
+              (_primitive.phase (code.identifier [def-module var-name]))))))
+      (///.run _primitive.state)
+      check!))
+
+(def: #export test
+  (<| (_.context (name.module (name-of /._)))
+      (do r.monad
+        [[expectedT _] _primitive.primitive
+         def-module (r.unicode 5)
+         scope-name (r.unicode 5)
+         var-name (r.unicode 5)
+         dependent-module (|> (r.unicode 5)
+                              (r.filter (|>> (text@= def-module) not)))]
+        ($_ _.and
+            (_.test "Can analyse variable."
+                    (|> (//scope.with-scope scope-name
+                          (//scope.with-local [var-name expectedT]
+                            (//type.with-inference
+                              (_primitive.phase (code.local-identifier var-name)))))
+                        (///.run _primitive.state)
+                        (case> (^ (#error.Success [inferredT (#////analysis.Reference (////reference.local var))]))
+                               (and (type@= expectedT inferredT)
+                                    (n/= 0 var))
+
+                               _
+                               false)))
+            (_.test "Can analyse definition (in the same module)."
+                    (let [def-name [def-module var-name]]
+                      (|> (do ///.monad
+                            [_ (//module.define var-name [expectedT (' {}) []])]
+                            (//type.with-inference
+                              (_primitive.phase (code.identifier def-name))))
+                          (//module.with-module 0 def-module)
+                          (///.run _primitive.state)
+                          (case> (^ (#error.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))]))
+                                 (and (type@= expectedT inferredT)
+                                      (name@= def-name constant-name))
+
+                                 _
+                                 false))))
+            (_.test "Can analyse definition (if exported from imported module)."
+                    (reach-test var-name [true def-module] [true dependent-module] success?))
+            (_.test "Cannot analyse definition (if not exported from imported module)."
+                    (reach-test var-name [false def-module] [true dependent-module] failure?))
+            (_.test "Cannot analyse definition (if exported from non-imported module)."
+                    (reach-test var-name [true def-module] [false dependent-module] failure?))
+            ))))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux
new file mode 100644
index 000000000..7c7e9e52c
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux
@@ -0,0 +1,303 @@
+(.module:
+  [lux #*
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe]
+   [data
+    ["." bit ("#@." equivalence)]
+    ["." error]
+    ["." product]
+    ["." maybe]
+    ["." text]
+    [collection
+     ["." list ("#@." functor)]
+     ["." set]]]
+   ["." type
+    ["." check]]
+   [macro
+    ["." code]]]
+  [//
+   ["_." primitive]]
+  {1
+   ["." /
+    ["/#" //
+     ["#." module]
+     ["#." type]
+     ["/#" //
+      ["/#" //
+       ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+
+(template [<name> <on-success> <on-error>]
+  [(def: #export <name>
+     (All [a] (-> (Operation a) Bit))
+     (|>> (///.run _primitive.state)
+          (case> (#error.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/= (dec size) tag)
+        expected//lefts (if expected//right?
+                          (dec tag)
+                          tag)
+        actual//right? (get@ #////analysis.right? variant)
+        actual//lefts (get@ #////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)
+      (///.run _primitive.state)
+      (case> (^ (#error.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 ///.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)
+      (///.run _primitive.state)
+      (case> (^ (#error.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)
+      (///.run _primitive.state)
+      (case> (#error.Success [_ productA])
+             (correct-size? size productA)
+
+             _
+             false)))
+
+(def: sum
+  (do r.monad
+    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     choice (|> r.nat (:: @ map (n/% size)))
+     primitives (r.list size _primitive.primitive)
+     +choice (|> r.nat (:: @ map (n/% (inc size))))
+     [_ +valueC] _primitive.primitive
+     #let [variantT (type.variant (list@map product.left primitives))
+           [valueT valueC] (maybe.assume (list.nth choice primitives))
+           +size (inc size)
+           +primitives (list.concat (list (list.take choice primitives)
+                                          (list [(#.Parameter 1) +valueC])
+                                          (list.drop choice primitives)))
+           [+valueT +valueC] (maybe.assume (list.nth +choice +primitives))
+           +variantT (type.variant (list@map product.left +primitives))]]
+    (<| (_.context (%name (name-of /.sum)))
+        ($_ _.and
+            (_.test "Can analyse."
+                    (check-sum variantT choice size
+                               (/.sum _primitive.phase choice valueC)))
+            (_.test "Can analyse through bound type-vars."
+                    (|> (do ///.monad
+                          [[_ varT] (//type.with-env check.var)
+                           _ (//type.with-env
+                               (check.check varT variantT))]
+                          (//type.with-type varT
+                            (/.sum _primitive.phase choice valueC)))
+                        (///.run _primitive.state)
+                        (case> (^ (#error.Success (////analysis.variant variant)))
+                               (check-sum' choice size variant)
+
+                               _
+                               false)))
+            (_.test "Cannot analyse through unbound type-vars."
+                    (|> (do ///.monad
+                          [[_ varT] (//type.with-env check.var)]
+                          (//type.with-type varT
+                            (/.sum _primitive.phase choice valueC)))
+                        check-fails))
+            (_.test "Can analyse through existential quantification."
+                    (|> (//type.with-type (type.ex-q 1 +variantT)
+                          (/.sum _primitive.phase +choice +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 +valueC))
+                          check-outcome)))
+            ))))
+
+(def: product
+  (do r.monad
+    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     primitives (r.list size _primitive.primitive)
+     choice (|> r.nat (:: @ map (n/% size)))
+     [_ +valueC] _primitive.primitive
+     #let [tupleT (type.tuple (list@map product.left primitives))
+           [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume)
+           +primitives (list.concat (list (list.take choice primitives)
+                                          (list [(#.Parameter 1) +valueC])
+                                          (list.drop choice primitives)))
+           +tupleT (type.tuple (list@map product.left +primitives))]]
+    (<| (_.context (%name (name-of /.product)))
+        ($_ _.and
+            (_.test "Can analyse."
+                    (|> (//type.with-type tupleT
+                          (/.product _primitive.phase (list@map product.right primitives)))
+                        (///.run _primitive.state)
+                        (case> (#error.Success tupleA)
+                               (correct-size? size tupleA)
+
+                               _
+                               false)))
+            (_.test "Can infer."
+                    (|> (//type.with-inference
+                          (/.product _primitive.phase (list@map product.right primitives)))
+                        (///.run _primitive.state)
+                        (case> (#error.Success [_type tupleA])
+                               (and (check.checks? tupleT _type)
+                                    (correct-size? size tupleA))
+
+                               _
+                               false)))
+            (_.test "Can analyse singleton."
+                    (|> (//type.with-type singletonT
+                          (_primitive.phase (` [(~ singletonC)])))
+                        check-succeeds))
+            (_.test "Can analyse through bound type-vars."
+                    (|> (do ///.monad
+                          [[_ varT] (//type.with-env check.var)
+                           _ (//type.with-env
+                               (check.check varT (type.tuple (list@map product.left primitives))))]
+                          (//type.with-type varT
+                            (/.product _primitive.phase (list@map product.right primitives))))
+                        (///.run _primitive.state)
+                        (case> (#error.Success tupleA)
+                               (correct-size? size tupleA)
+
+                               _
+                               false)))
+            (_.test "Can analyse through existential quantification."
+                    (|> (//type.with-type (type.ex-q 1 +tupleT)
+                          (/.product _primitive.phase (list@map product.right +primitives)))
+                        check-succeeds))
+            (_.test "Cannot analyse through universal quantification."
+                    (|> (//type.with-type (type.univ-q 1 +tupleT)
+                          (/.product _primitive.phase (list@map product.right +primitives)))
+                        check-fails))
+            ))))
+
+(def: variant
+  (do r.monad
+    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+     choice (|> r.nat (:: @ map (n/% size)))
+     other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (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@map product.left primitives)
+           [choiceT choiceC] (maybe.assume (list.nth choice primitives))
+           [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives))
+           monoT (type.variant primitivesT)
+           polyT (|> (type.variant (list.concat (list (list.take choice primitivesT)
+                                                      (list varT)
+                                                      (list.drop (inc choice) primitivesT))))
+                     (type.univ-q 1))
+           choice-tag (maybe.assume (list.nth choice tags))
+           other-choice-tag (maybe.assume (list.nth other-choice tags))]]
+    (<| (_.context (%name (name-of /.tagged-sum)))
+        ($_ _.and
+            (_.test "Can infer."
+                    (|> (/.tagged-sum _primitive.phase [module-name choice-tag] 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] 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] 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] choiceC)
+                        (check-variant module-name tags
+                                       monoT (with-name polyT)
+                                       choice)))
+            ))))
+
+(def: record
+  (do r.monad
+    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list))
+     primitives (r.list size _primitive.primitive)
+     module-name (r.unicode 5)
+     type-name (r.unicode 5)
+     choice (|> r.nat (:: @ map (n/% size)))
+     #let [varT (#.Parameter 1)
+           tagsC (list@map (|>> [module-name] code.tag) tags)
+           primitivesT (list@map product.left primitives)
+           primitivesC (list@map product.right primitives)
+           monoT (#.Named [module-name type-name] (type.tuple primitivesT))
+           recordC (list.zip2 tagsC primitivesC)
+           polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT)
+                                                    (list varT)
+                                                    (list.drop (inc choice) primitivesT))))
+                     (type.univ-q 1)
+                     (#.Named [module-name type-name]))]]
+    (<| (_.context (%name (name-of /.record)))
+        (_.test "Can infer."
+                (|> (/.record _primitive.phase recordC)
+                    (check-record module-name tags monoT monoT size))))))
+
+(def: #export test
+  Test
+  (<| (_.context (name.module (name-of /._)))
+      ($_ _.and
+          ..sum
+          ..product
+          ..variant
+          ..record
+          )))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux
new file mode 100644
index 000000000..9c9d675fd
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux
@@ -0,0 +1,202 @@
+(.module:
+  [lux (#- i64 int primitive)
+   [abstract ["." monad (#+ do)]]
+   [data
+    text/format
+    ["." name]]
+   ["r" math/random (#+ Random) ("#@." monad)]
+   ["_" test (#+ Test)]
+   [control
+    pipe
+    [io (#+ IO)]
+    [concurrency
+     ["." atom]]]
+   [data
+    ["." error]
+    ["." product]]
+   ["." type ("#@." equivalence)]
+   [macro
+    ["." code]]]
+  [////
+   [analysis
+    ["_." primitive]]]
+  {1
+   ["." /
+    ["///#" ////
+     [analysis
+      ["#." scope]
+      ["#." type]]]]})
+
+(template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bit)
+     (|> (////scope.with-scope ""
+           (////type.with-type output-type
+             (_primitive.phase (` ((~ (code.text procedure)) (~+ params))))))
+         (////.run _primitive.state)
+         (case> (#error.Success _)
+                <success>
+
+                (#error.Failure error)
+                <failure>)))]
+
+  [check-success+ true false]
+  [check-failure+ false true]
+  )
+
+(def: primitive
+  (Random [Type Code])
+  (r.filter (|>> product.left (is? Any) not) _primitive.primitive))
+
+(def: lux
+  Test
+  (do r.monad
+    [[primT primC] ..primitive
+     [antiT antiC] (|> ..primitive
+                       (r.filter (|>> product.left (type@= primT) not)))]
+    ($_ _.and
+        (_.test "Can test for reference equality."
+                (check-success+ "lux is" (list primC primC) Bit))
+        (_.test "Reference equality must be done with elements of the same type."
+                (check-failure+ "lux is" (list primC antiC) Bit))
+        (_.test "Can 'try' risky IO computations."
+                (check-success+ "lux try"
+                                (list (` ("lux coerce" (~ (type.to-code (type (IO primT))))
+                                          ([(~' _) (~' _)] (~ primC)))))
+                                (type (Either Text primT))))
+        )))
+
+(def: i64
+  Test
+  (do r.monad
+    [subjectC (|> r.nat (:: @ map code.nat))
+     signedC (|> r.int (:: @ map code.int))
+     paramC (|> r.nat (:: @ map code.nat))]
+    ($_ _.and
+        (_.test "i64 'and'."
+                (check-success+ "lux i64 and" (list paramC subjectC) Nat))
+        (_.test "i64 'or'."
+                (check-success+ "lux i64 or" (list paramC subjectC) Nat))
+        (_.test "i64 'xor'."
+                (check-success+ "lux i64 xor" (list paramC subjectC) Nat))
+        (_.test "i64 left-shift."
+                (check-success+ "lux i64 left-shift" (list paramC subjectC) Nat))
+        (_.test "i64 logical-right-shift."
+                (check-success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat))
+        (_.test "i64 arithmetic-right-shift."
+                (check-success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int))
+        (_.test "i64 equivalence."
+                (check-success+ "lux i64 =" (list paramC subjectC) Bit))
+        (_.test "i64 addition."
+                (check-success+ "lux i64 +" (list paramC subjectC) Int))
+        (_.test "i64 subtraction."
+                (check-success+ "lux i64 -" (list paramC subjectC) Int))
+        )))
+
+(def: int
+  Test
+  (do r.monad
+    [subjectC (|> r.int (:: @ map code.int))
+     paramC (|> r.int (:: @ map code.int))]
+    ($_ _.and
+        (_.test "Can multiply integers."
+                (check-success+ "lux int *" (list paramC subjectC) Int))
+        (_.test "Can divide integers."
+                (check-success+ "lux int /" (list paramC subjectC) Int))
+        (_.test "Can calculate remainder of integers."
+                (check-success+ "lux int %" (list paramC subjectC) Int))
+        (_.test "Can compare integers."
+                (check-success+ "lux int <" (list paramC subjectC) Bit))
+        (_.test "Can convert integer to text."
+                (check-success+ "lux int char" (list subjectC) Text))
+        (_.test "Can convert integer to fraction."
+                (check-success+ "lux int frac" (list subjectC) Frac))
+        )))
+
+(def: frac
+  Test
+  (do r.monad
+    [subjectC (|> r.safe-frac (:: @ map code.frac))
+     paramC (|> r.safe-frac (:: @ map code.frac))
+     encodedC (|> r.safe-frac (:: @ map (|>> %f code.text)))]
+    ($_ _.and
+        (_.test "Can add frac numbers."
+                (check-success+ "lux frac +" (list paramC subjectC) Frac))
+        (_.test "Can subtract frac numbers."
+                (check-success+ "lux frac -" (list paramC subjectC) Frac))
+        (_.test "Can multiply frac numbers."
+                (check-success+ "lux frac *" (list paramC subjectC) Frac))
+        (_.test "Can divide frac numbers."
+                (check-success+ "lux frac /" (list paramC subjectC) Frac))
+        (_.test "Can calculate remainder of frac numbers."
+                (check-success+ "lux frac %" (list paramC subjectC) Frac))
+        (_.test "Can test equivalence of frac numbers."
+                (check-success+ "lux frac =" (list paramC subjectC) Bit))
+        (_.test "Can compare frac numbers."
+                (check-success+ "lux frac <" (list paramC subjectC) Bit))
+        (_.test "Can obtain minimum frac number."
+                (check-success+ "lux frac min" (list) Frac))
+        (_.test "Can obtain maximum frac number."
+                (check-success+ "lux frac max" (list) Frac))
+        (_.test "Can obtain smallest frac number."
+                (check-success+ "lux frac smallest" (list) Frac))
+        (_.test "Can convert frac number to integer."
+                (check-success+ "lux frac int" (list subjectC) Int))
+        (_.test "Can convert frac number to text."
+                (check-success+ "lux frac encode" (list subjectC) Text))
+        (_.test "Can convert text to frac number."
+                (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
+        )))
+
+(def: text
+  Test
+  (do r.monad
+    [subjectC (|> (r.unicode 5) (:: @ map code.text))
+     paramC (|> (r.unicode 5) (:: @ map code.text))
+     replacementC (|> (r.unicode 5) (:: @ map code.text))
+     fromC (|> r.nat (:: @ map code.nat))
+     toC (|> r.nat (:: @ map code.nat))]
+    ($_ _.and
+        (_.test "Can test text equivalence."
+                (check-success+ "lux text =" (list paramC subjectC) Bit))
+        (_.test "Compare texts in lexicographical order."
+                (check-success+ "lux text <" (list paramC subjectC) Bit))
+        (_.test "Can concatenate one text to another."
+                (check-success+ "lux text concat" (list subjectC paramC) Text))
+        (_.test "Can find the index of a piece of text inside a larger one that (may) contain it."
+                (check-success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat))))
+        (_.test "Can query the size/length of a text."
+                (check-success+ "lux text size" (list subjectC) Nat))
+        (_.test "Can obtain the character code of a text at a given index."
+                (check-success+ "lux text char" (list fromC subjectC) Nat))
+        (_.test "Can clip a piece of text between 2 indices."
+                (check-success+ "lux text clip" (list fromC toC subjectC) Text))
+        )))
+
+(def: io
+  Test
+  (do r.monad
+    [logC (|> (r.unicode 5) (:: @ map code.text))
+     exitC (|> r.int (:: @ map code.int))]
+    ($_ _.and
+        (_.test "Can log messages to standard output."
+                (check-success+ "lux io log" (list logC) Any))
+        (_.test "Can throw a run-time error."
+                (check-success+ "lux io error" (list logC) Nothing))
+        (_.test "Can exit the program."
+                (check-success+ "lux io exit" (list exitC) Nothing))
+        (_.test "Can query the current time (as milliseconds since epoch)."
+                (check-success+ "lux io current-time" (list) Int))
+        )))
+
+(def: #export test
+  Test
+  (<| (_.context (name.module (name-of /._)))
+      ($_ _.and
+          ..lux
+          ..i64
+          ..int
+          ..frac
+          ..text
+          ..io
+          )))