Integrated tests into normal source code.

10 files changed, 1433 insertions, 0 deletions

diff --git a/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux
new file mode 100644
index 000000000..2bf02bb0e
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/case.lux
@@ -0,0 +1,198 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." text ("text/." equivalence)]
+    [collection
+     ["." list ("list/." monad)]
+     ["." set]]]
+   [math
+    ["r" random ("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 _)]
+    (random/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 (' _)))))
+        (random/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))])
+    (random/wrap (list (' [])))
+
+    (^ [_ (#.Record (list))])
+    (random/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)))
+
+    _
+    (random/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
+         (random/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)))
+         (random/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
new file mode 100644
index 000000000..0ec5d4766
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/function.lux
@@ -0,0 +1,118 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error]
+    ["." maybe]
+    ["." product]
+    [text ("text/." equivalence)
+     format]
+    [collection
+     ["." list ("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
new file mode 100644
index 000000000..de079094b
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/primitive.lux
@@ -0,0 +1,100 @@
+(.module:
+  [lux (#- primitive)
+   [control
+    [monad (#+ do)]
+    pipe
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    [text
+     format]]
+   [math
+    ["r" random ("random/." monad)]]
+   [".L" type ("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)
+  (random/wrap (' [])))
+
+(def: #export primitive
+  (r.Random [Type Code])
+  (`` ($_ r.either
+          (~~ (do-template [<type> <code-wrapper> <value-gen>]
+                [(r.and (random/wrap <type>) (random/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
+                  (~~ (do-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
new file mode 100644
index 000000000..6576ae90d
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/procedure/common.lux
@@ -0,0 +1,187 @@
+(.module:
+  [lux #*
+   [io]
+   [control
+    [monad (#+ do)]
+    pipe]
+   [concurrency
+    ["." atom]]
+   [data
+    ["." error]
+    ["." product]
+    [text
+     format]]
+   [math
+    ["r" random]]
+   [type ("type/." equivalence)]
+   [macro
+    ["." code]]
+   [compiler
+    [default
+     ["." init]
+     ["." phase
+      [analysis
+       ["." scope]
+       [".A" type]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [///
+   ["_." primitive]])
+
+(do-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 subjectC paramC) Int))
+            (test "Can subtract integers."
+                  (check-success+ "lux int -" (list subjectC paramC) Int))
+            (test "Can multiply integers."
+                  (check-success+ "lux int *" (list subjectC paramC) Int))
+            (test "Can divide integers."
+                  (check-success+ "lux int /" (list subjectC paramC) Int))
+            (test "Can calculate remainder of integers."
+                  (check-success+ "lux int %" (list subjectC paramC) Int))
+            (test "Can test equivalence of integers."
+                  (check-success+ "lux int =" (list subjectC paramC) Bit))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) 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 subjectC paramC) Frac))
+            (test "Can subtract frac numbers."
+                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
+            (test "Can multiply frac numbers."
+                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
+            (test "Can divide frac numbers."
+                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
+            (test "Can calculate remainder of frac numbers."
+                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
+            (test "Can test equivalence of frac numbers."
+                  (check-success+ "lux frac =" (list subjectC paramC) Bit))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) 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 subjectC paramC) Bit))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) 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 subjectC paramC fromC) (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 subjectC fromC) Nat))
+            (test "Can clip a piece of text between 2 indices."
+                  (check-success+ "lux text clip" (list subjectC fromC toC) 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
new file mode 100644
index 000000000..18ab58fa9
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/reference.lux
@@ -0,0 +1,107 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error (#+ Error)]
+    [name ("name/." equivalence)]
+    [text ("text/." equivalence)]]
+   [math
+    ["r" random]]
+   [type ("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))
+
+(do-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
new file mode 100644
index 000000000..63c6da493
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/analysis/structure.lux
@@ -0,0 +1,297 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    [bit ("bit/." equivalence)]
+    ["e" error]
+    ["." product]
+    ["." maybe]
+    ["." text]
+    [collection
+     ["." list ("list/." functor)]
+     ["." set]]]
+   [math
+    ["r" random]]
+   ["." type ("type/." equivalence)
+    ["." check]]
+   [macro
+    ["." code]]
+   [compiler
+    [default
+     ["." init]
+     ["." phase
+      ["." analysis (#+ Analysis Variant Tag Operation)
+       ["." module]
+       [".A" type]
+       ["/" structure]
+       ["." expression]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [//
+   ["_." primitive]])
+
+(do-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/compiler/default/phase/synthesis/case.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux
new file mode 100644
index 000000000..319d4ab57
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux
@@ -0,0 +1,88 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error ("error/." functor)]]
+   [compiler
+    [default
+     ["." reference]
+     ["." phase
+      ["." analysis (#+ Branch Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(context: "Dummy variables."
+  (<| (times 100)
+      (do @
+        [maskedA //primitive.primitive
+         temp (|> r.nat (:: @ map (n/% 100)))
+         #let [maskA (analysis.control/case
+                      [maskedA
+                       [[(#analysis.Bind temp)
+                         (#analysis.Reference (reference.local temp))]
+                        (list)]])]]
+        (test "Dummy variables created to mask expressions get eliminated during synthesis."
+              (|> maskA
+                  expression.phase
+                  (phase.run [bundle.empty //.init])
+                  (error/map (//primitive.corresponds? maskedA))
+                  (error.default #0))))))
+
+(context: "Let expressions."
+  (<| (times 100)
+      (do @
+        [registerA r.nat
+         inputA //primitive.primitive
+         outputA //primitive.primitive
+         #let [letA (analysis.control/case
+                     [inputA
+                      [[(#analysis.Bind registerA)
+                        outputA]
+                       (list)]])]]
+        (test "Can detect and reify simple 'let' expressions."
+              (|> letA
+                  expression.phase
+                  (phase.run [bundle.empty //.init])
+                  (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
+                         (and (n/= registerA registerS)
+                              (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? outputA outputS))
+
+                         _
+                         #0))))))
+
+(context: "If expressions."
+  (<| (times 100)
+      (do @
+        [then|else r.bit
+         inputA //primitive.primitive
+         thenA //primitive.primitive
+         elseA //primitive.primitive
+         #let [thenB (: Branch
+                        [(#analysis.Simple (#analysis.Bit #1))
+                         thenA])
+               elseB (: Branch
+                        [(#analysis.Simple (#analysis.Bit #0))
+                         elseA])
+               ifA (if then|else
+                     (analysis.control/case [inputA [thenB (list elseB)]])
+                     (analysis.control/case [inputA [elseB (list thenB)]]))]]
+        (test "Can detect and reify simple 'if' expressions."
+              (|> ifA
+                  expression.phase
+                  (phase.run [bundle.empty //.init])
+                  (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
+                         (and (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? thenA thenS)
+                              (//primitive.corresponds? elseA elseS))
+
+                         _
+                         #0))))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux
new file mode 100644
index 000000000..f2565dfa0
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux
@@ -0,0 +1,174 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." error]
+    ["." number]
+    [text
+     format]
+    [collection
+     ["." list ("list/." functor fold)]
+     ["dict" dictionary (#+ Dictionary)]
+     ["." set]]]
+   [compiler
+    [default
+     ["." reference (#+ Variable) ("variable/." equivalence)]
+     ["." phase
+      ["." analysis (#+ Arity Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(def: constant-function
+  (r.Random [Arity Analysis Analysis])
+  (r.rec
+   (function (_ constant-function)
+     (do r.monad
+       [function? r.bit]
+       (if function?
+         (do @
+           [[arity bodyA predictionA] constant-function]
+           (wrap [(inc arity)
+                  (#analysis.Function (list) bodyA)
+                  predictionA]))
+         (do @
+           [predictionA //primitive.primitive]
+           (wrap [0 predictionA predictionA])))))))
+
+(def: (pick scope-size)
+  (-> Nat (r.Random Nat))
+  (|> r.nat (:: r.monad map (n/% scope-size))))
+
+(def: function-with-environment
+  (r.Random [Arity Analysis Variable])
+  (do r.monad
+    [num-locals (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
+     #let [indices (list.n/range 0 (dec num-locals))
+           local-env (list/map (|>> #reference.Local) indices)
+           foreign-env (list/map (|>> #reference.Foreign) indices)]
+     [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
+                                  (loop [arity 1
+                                         current-env foreign-env]
+                                    (let [current-env/size (list.size current-env)
+                                          resolver (list/fold (function (_ [idx var] resolver)
+                                                                (dict.put idx var resolver))
+                                                              (: (Dictionary Nat Variable)
+                                                                 (dict.new number.hash))
+                                                              (list.enumerate current-env))]
+                                      (do @
+                                        [nest? r.bit]
+                                        (if nest?
+                                          (do @
+                                            [num-picks (:: @ map (n/max 1) (pick (inc current-env/size)))
+                                             picks (|> (r.set number.hash num-picks (pick current-env/size))
+                                                       (:: @ map set.to-list))
+                                             [arity bodyA predictionA] (recur (inc arity)
+                                                                              (list/map (function (_ pick)
+                                                                                          (maybe.assume (list.nth pick current-env)))
+                                                                                        picks))
+                                             #let [picked-env (list/map (|>> #reference.Foreign) picks)]]
+                                            (wrap [arity
+                                                   (#analysis.Function picked-env bodyA)
+                                                   predictionA]))
+                                          (do @
+                                            [chosen (pick (list.size current-env))]
+                                            (wrap [arity
+                                                   (#analysis.Reference (reference.foreign chosen))
+                                                   (maybe.assume (dict.get chosen resolver))])))))))]
+    (wrap [arity
+           (#analysis.Function local-env bodyA)
+           predictionA])))
+
+(def: local-function
+  (r.Random [Arity Analysis Variable])
+  (loop [arity 0
+         nest? #1]
+    (if nest?
+      (do r.monad
+        [nest?' r.bit
+         [arity' bodyA predictionA] (recur (inc arity) nest?')]
+        (wrap [arity'
+               (#analysis.Function (list) bodyA)
+               predictionA]))
+      (do r.monad
+        [chosen (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))]
+        (wrap [arity
+               (#analysis.Reference (reference.local chosen))
+               (|> chosen (n/+ (dec arity)) #reference.Local)])))))
+
+(context: "Abstraction."
+  (<| (times 100)
+      (do @
+        [[arity//constant function//constant prediction//constant] constant-function
+         [arity//environment function//environment prediction//environment] function-with-environment
+         [arity//local function//local prediction//local] local-function]
+        ($_ seq
+            (test "Nested functions will get folded together."
+                  (|> function//constant
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity output])))
+                             (and (n/= arity//constant arity)
+                                  (//primitive.corresponds? prediction//constant output))
+                             
+                             _
+                             (n/= 0 arity//constant))))
+            (test "Folded functions provide direct access to environment variables."
+                  (|> function//environment
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
+                             (and (n/= arity//environment arity)
+                                  (variable/= prediction//environment output))
+                             
+                             _
+                             #0)))
+            (test "Folded functions properly offset local variables."
+                  (|> function//local
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
+                             (and (n/= arity//local arity)
+                                  (variable/= prediction//local output))
+                             
+                             _
+                             #0)))
+            ))))
+
+(context: "Application."
+  (<| (times 100)
+      (do @
+        [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+         funcA //primitive.primitive
+         argsA (r.list arity //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize function application."
+                  (|> (analysis.apply [funcA argsA])
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
+                             (and (//primitive.corresponds? funcA funcS)
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 argsA argsS)))
+                             
+                             _
+                             #0)))
+            (test "Function application on no arguments just synthesizes to the function itself."
+                  (|> (analysis.apply [funcA (list)])
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (#error.Success funcS)
+                             (//primitive.corresponds? funcA funcS)
+
+                             _
+                             #0)))
+            ))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux
new file mode 100644
index 000000000..87dccc9f5
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux
@@ -0,0 +1,97 @@
+(.module:
+  [lux (#- primitive)
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error]
+    [text
+     format]]
+   [compiler
+    [default
+     ["." phase
+      ["." analysis (#+ Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test])
+
+(def: #export primitive
+  (r.Random Analysis)
+  (do r.monad
+    [primitive (: (r.Random analysis.Primitive)
+                  ($_ r.or
+                      (wrap [])
+                      r.bit
+                      r.nat
+                      r.int
+                      r.rev
+                      r.frac
+                      (r.unicode 5)))]
+    (wrap (#analysis.Primitive primitive))))
+
+(def: #export (corresponds? analysis synthesis)
+  (-> Analysis Synthesis Bit)
+  (case [synthesis analysis]
+    [(#//.Primitive (#//.Text valueS))
+     (#analysis.Primitive (#analysis.Unit valueA))]
+    (is? valueS (:coerce Text valueA))
+    
+    [(#//.Primitive (#//.Bit valueS))
+     (#analysis.Primitive (#analysis.Bit valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Nat valueA))]
+    (is? (.i64 valueS) (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Int valueA))]
+    (is? (.i64 valueS) (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Rev valueA))]
+    (is? (.i64 valueS) (.i64 valueA))
+    
+    [(#//.Primitive (#//.F64 valueS))
+     (#analysis.Primitive (#analysis.Frac valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.Text valueS))
+     (#analysis.Primitive (#analysis.Text valueA))]
+    (is? valueS valueA)
+    
+    _
+    #0))
+
+(context: "Primitives."
+  (<| (times 100)
+      (do @
+        [|bit| r.bit
+         |nat| r.nat
+         |int| r.int
+         |rev| r.rev
+         |frac| r.frac
+         |text| (r.unicode 5)]
+        (`` ($_ seq
+                (~~ (do-template [<desc> <analysis> <synthesis> <sample>]
+                      [(test (format "Can synthesize " <desc> ".")
+                             (|> (#analysis.Primitive (<analysis> <sample>))
+                                 expression.phase
+                                 (phase.run [bundle.empty //.init])
+                                 (case> (#error.Success (#//.Primitive (<synthesis> value)))
+                                        (is? <sample> value)
+
+                                        _
+                                        #0)))]
+
+                      ["unit" #analysis.Unit #//.Text //.unit]
+                      ["bit"  #analysis.Bit  #//.Bit  |bit|]
+                      ["nat"  #analysis.Nat  #//.I64  (.i64 |nat|)]
+                      ["int"  #analysis.Int  #//.I64  (.i64 |int|)]
+                      ["rev"  #analysis.Rev  #//.I64  (.i64 |rev|)]
+                      ["frac" #analysis.Frac #//.F64  |frac|]
+                      ["text" #analysis.Text #//.Text |text|])))))))
diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux
new file mode 100644
index 000000000..7f9eae209
--- /dev/null
+++ b/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux
@@ -0,0 +1,67 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    [bit ("bit/." equivalence)]
+    ["." product]
+    ["." error]
+    [collection
+     ["." list]]]
+   [compiler
+    [default
+     ["." phase
+      ["." analysis]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(context: "Variants"
+  (<| (times 100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2))))
+         tagA (|> r.nat (:: @ map (n/% size)))
+         #let [right? (n/= (dec size) tagA)
+               lefts (if right?
+                       (dec tagA)
+                       tagA)]
+         memberA //primitive.primitive]
+        ($_ seq
+            (test "Can synthesize variants."
+                  (|> (analysis.variant [lefts right? memberA])
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.variant [leftsS right?S valueS])))
+                             (let [tagS (if right?S (inc leftsS) leftsS)]
+                               (and (n/= tagA tagS)
+                                    (|> tagS (n/= (dec size)) (bit/= right?S))
+                                    (//primitive.corresponds? memberA valueS)))
+                             
+                             _
+                             #0)))
+            ))))
+
+(context: "Tuples"
+  (<| (times 100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+         membersA (r.list size //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize tuple."
+                  (|> (analysis.tuple membersA)
+                      expression.phase
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.tuple membersS)))
+                             (and (n/= size (list.size membersS))
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 membersA membersS)))
+
+                             _
+                             #0)))
+            ))))