aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-04-15 18:30:37 -0400
committerEduardo Julian2019-04-15 18:30:37 -0400
commitd3444a45d289e75e64037d2b402dde18db6aa04f (patch)
tree72f8ccd771abc3f3f7e4155808fd7cd284088059 /stdlib
parentefde1a8f5d7cd94a921f3964dd504709791db75e (diff)
Ported the synthesis tests to the new format.
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux.lux33
-rw-r--r--stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux88
-rw-r--r--stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux174
-rw-r--r--stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux97
-rw-r--r--stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux67
-rw-r--r--stdlib/source/test/lux/tool.lux11
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux3
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis.lux17
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux101
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux185
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux81
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux75
12 files changed, 472 insertions, 460 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index bad2e5500..99276bcf1 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -81,9 +81,7 @@
## ["._" multi]]]
## [text
## ["._" buffer]]]
- ## ["._" macro
- ## [poly
- ## ["._" json]]]
+ ## ["._" macro]
## [type
## ["._" unit]
## ["._" refinement]
@@ -96,14 +94,7 @@
## ["._" default
## ["._" evaluation]
## [phase
- ## ["._" generation
- ## [scheme
- ## ["._scheme" function]
- ## ["._scheme" loop]
- ## ["._scheme" case]
- ## ["._scheme" extension]
- ## ["._scheme" extension/common]
- ## ["._scheme" expression]]]
+ ## ["._" generation]
## [extension
## ["._" statement]]]
## ["._default" cache]]
@@ -339,24 +330,18 @@
..templates)
(<| (_.context "Cross-platform support.")
..cross-platform-support)
- (<| (_.context "/abstract")
- /abstract.test)
- (<| (_.context "/control")
- /control.test)
- (<| (_.context "/data")
- /data.test)
+ /abstract.test
+ /control.test
+ /data.test
/macro.test
/math.test
- (<| (_.context "/time")
- /time.test)
+ /time.test
/tool.test
/type.test
/world.test
- (<| (_.context "/host")
- ($_ _.and
- /host.test
- (<| (_.context "/jvm")
- /host/jvm.test)))
+ ($_ _.and
+ /host.test
+ /host/jvm.test)
)))
(program: args
diff --git a/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux
deleted file mode 100644
index 9a635eb9e..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/synthesis/case.lux
+++ /dev/null
@@ -1,88 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." 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
deleted file mode 100644
index 9d7edb358..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/synthesis/function.lux
+++ /dev/null
@@ -1,174 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." product]
- ["." maybe]
- ["." error]
- ["." number]
- [text
- format]
- [collection
- ["." 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
deleted file mode 100644
index d6bb57789..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/synthesis/primitive.lux
+++ /dev/null
@@ -1,97 +0,0 @@
-(.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
- (~~ (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
deleted file mode 100644
index d24131f04..000000000
--- a/stdlib/source/test/lux/compiler/default/phase/synthesis/structure.lux
+++ /dev/null
@@ -1,67 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." 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)))
- ))))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 91c8d385b..7d1c2676e 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -1,23 +1,18 @@
(.module:
[lux #*
["_" test (#+ Test)]]
- ## [compiler
- ## [phase
- ## [synthesis
- ## ["_.S" primitive]
- ## ["_.S" structure]
- ## ["_.S" case]
- ## ["_.S" function]]]]
["." / #_
[compiler
[default
["#." syntax]]
[phase
- ["#." analysis]]]])
+ ["#." analysis]
+ ["#." synthesis]]]])
(def: #export test
Test
($_ _.and
/syntax.test
/analysis.test
+ /synthesis.test
))
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
index 9c9d675fd..7980118a0 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux
+++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/common.lux
@@ -61,8 +61,7 @@
(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)))))
+ (list (` ("lux io error" "YOLO")))
(type (Either Text primT))))
)))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux
new file mode 100644
index 000000000..da9937862
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ ["." / #_
+ ["#." primitive]
+ ["#." structure]
+ ["#." case]
+ ["#." function]])
+
+(def: #export test
+ Test
+ ($_ _.and
+ /primitive.test
+ /structure.test
+ /case.test
+ /function.test
+ ))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux
new file mode 100644
index 000000000..ea2114509
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux
@@ -0,0 +1,101 @@
+(.module:
+ [lux #*
+ [abstract ["." monad (#+ do)]]
+ [data
+ text/format
+ ["." name]]
+ ["r" math/random (#+ Random) ("#@." monad)]
+ ["_" test (#+ Test)]
+ [control
+ pipe]
+ [data
+ ["." error ("#@." functor)]]]
+ ["." // #_
+ ["#." primitive]]
+ {1
+ ["." /
+ ["/#" //
+ ["/#" //
+ [extension
+ ["#." bundle]]
+ ["/#" //
+ ["#." reference]
+ ["#." analysis (#+ Branch Analysis)]
+ ["#." synthesis (#+ Synthesis)]]]]]})
+
+(def: dummy-vars
+ Test
+ (do r.monad
+ [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
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (error@map (//primitive.corresponds? maskedA))
+ (error.default false)))))
+
+(def: let-expr
+ Test
+ (do r.monad
+ [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
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.branch/let [inputS registerS outputS])))
+ (and (n/= registerA registerS)
+ (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? outputA outputS))
+
+ _
+ false)))))
+
+(def: if-expr
+ Test
+ (do r.monad
+ [then|else r.bit
+ inputA //primitive.primitive
+ thenA //primitive.primitive
+ elseA //primitive.primitive
+ #let [thenB (: Branch
+ [(#////analysis.Simple (#////analysis.Bit true))
+ thenA])
+ elseB (: Branch
+ [(#////analysis.Simple (#////analysis.Bit false))
+ 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
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.branch/if [inputS thenS elseS])))
+ (and (//primitive.corresponds? inputA inputS)
+ (//primitive.corresponds? thenA thenS)
+ (//primitive.corresponds? elseA elseS))
+
+ _
+ false)))))
+
+(def: #export test
+ Test
+ (<| (_.context (name.module (name-of /._)))
+ ($_ _.and
+ ..dummy-vars
+ ..let-expr
+ ..if-expr
+ )))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
new file mode 100644
index 000000000..5c6c3f3af
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
@@ -0,0 +1,185 @@
+(.module:
+ [lux #*
+ [abstract ["." monad (#+ do)]]
+ [data
+ text/format
+ ["." name]]
+ ["r" math/random (#+ Random) ("#@." monad)]
+ ["_" test (#+ Test)]
+ [control
+ pipe]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." error]
+ [number
+ ["." nat]]
+ [collection
+ ["." list ("#@." functor fold)]
+ ["dict" dictionary (#+ Dictionary)]
+ ["." set]]]]
+ ["." // #_
+ ["#." primitive]]
+ {1
+ ["." /
+ ["/#" //
+ ["/#" //
+ [extension
+ ["#." bundle]]
+ ["/#" //
+ ["#." reference (#+ Variable) ("variable@." equivalence)]
+ ["#." analysis (#+ Arity Analysis)]
+ ["#." synthesis (#+ Synthesis)]]]]]})
+
+(def: constant-function
+ (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 (Random Nat))
+ (|> r.nat (:: r.monad map (n/% scope-size))))
+
+(def: function-with-environment
+ (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] (: (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 nat.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 nat.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
+ (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)])))))
+
+(def: abstraction
+ Test
+ (do r.monad
+ [[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]
+ ($_ _.and
+ (_.test "Nested functions will get folded together."
+ (|> function//constant
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.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
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))])))
+ (and (n/= arity//environment arity)
+ (variable@= prediction//environment output))
+
+ _
+ #0)))
+ (_.test "Folded functions properly offset local variables."
+ (|> function//local
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))])))
+ (and (n/= arity//local arity)
+ (variable@= prediction//local output))
+
+ _
+ #0)))
+ )))
+
+(def: application
+ Test
+ (do r.monad
+ [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+ funcA //primitive.primitive
+ argsA (r.list arity //primitive.primitive)]
+ ($_ _.and
+ (_.test "Can synthesize function application."
+ (|> (////analysis.apply [funcA argsA])
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.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)])
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (#error.Success funcS)
+ (//primitive.corresponds? funcA funcS)
+
+ _
+ #0)))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.context (name.module (name-of /._)))
+ ($_ _.and
+ ..abstraction
+ ..application
+ )))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux
new file mode 100644
index 000000000..d5683b14f
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux
@@ -0,0 +1,81 @@
+(.module:
+ [lux (#- primitive)
+ [abstract ["." monad (#+ do)]]
+ [data
+ text/format
+ ["." name]]
+ ["r" math/random (#+ Random) ("#@." monad)]
+ ["_" test (#+ Test)]
+ [control
+ pipe]
+ [data
+ ["." error]]]
+ {1
+ ["." / #_
+ ["/#" //
+ ["/#" //
+ [extension
+ ["#." bundle]]
+ ["/#" //
+ ["#." analysis (#+ Analysis)]
+ ["#." synthesis (#+ Synthesis)]]]]]})
+
+(def: #export primitive
+ (Random Analysis)
+ (do r.monad
+ [primitive (: (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 [analysis synthesis]
+ (~~ (template [<analysis> <post-analysis> <synthesis> <post-synthesis>]
+ [[(#////analysis.Primitive (<analysis> expected))
+ (#////synthesis.Primitive (<synthesis> actual))]
+ (is? (|> expected <post-analysis>)
+ (|> actual <post-synthesis>))]
+
+ [#////analysis.Unit (:coerce Text) #////synthesis.Text (|>)]
+ [#////analysis.Bit (|>) #////synthesis.Bit (|>)]
+ [#////analysis.Nat .i64 #////synthesis.I64 .i64]
+ [#////analysis.Int .i64 #////synthesis.I64 .i64]
+ [#////analysis.Rev .i64 #////synthesis.I64 .i64]
+ [#////analysis.Frac (|>) #////synthesis.F64 (|>)]
+ [#////analysis.Text (|>) #////synthesis.Text (|>)]
+ ))
+
+ _
+ false)))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of #////synthesis.Primitive)))
+ (`` ($_ _.and
+ (~~ (template [<analysis> <synthesis> <generator>]
+ [(do r.monad
+ [expected <generator>]
+ (_.test (%name (name-of <synthesis>))
+ (|> (#////analysis.Primitive (<analysis> expected))
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (#error.Success (#////synthesis.Primitive (<synthesis> actual)))
+ (is? expected actual)
+
+ _
+ false))))]
+
+ [#////analysis.Unit #////synthesis.Text (r@wrap ////synthesis.unit)]
+ [#////analysis.Bit #////synthesis.Bit r.bit]
+ [#////analysis.Nat #////synthesis.I64 (r@map .i64 r.nat)]
+ [#////analysis.Int #////synthesis.I64 (r@map .i64 r.int)]
+ [#////analysis.Rev #////synthesis.I64 (r@map .i64 r.rev)]
+ [#////analysis.Frac #////synthesis.F64 r.frac]
+ [#////analysis.Text #////synthesis.Text (r.unicode 5)]))))))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux
new file mode 100644
index 000000000..4e7f6c3b5
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux
@@ -0,0 +1,75 @@
+(.module:
+ [lux #*
+ [abstract ["." monad (#+ do)]]
+ [data
+ text/format
+ ["." name]]
+ ["r" math/random (#+ Random) ("#@." monad)]
+ ["_" test (#+ Test)]
+ [control
+ pipe]
+ [data
+ ["." bit ("#@." equivalence)]
+ ["." product]
+ ["." error]
+ [collection
+ ["." list]]]]
+ ["." // #_
+ ["#." primitive]]
+ {1
+ ["." / #_
+ ["/#" //
+ ["/#" //
+ [extension
+ ["#." bundle]]
+ ["/#" //
+ ["#." analysis (#+ Analysis)]
+ ["#." synthesis (#+ Synthesis)]]]]]})
+
+(def: variant
+ Test
+ (do r.monad
+ [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]
+ (_.test "Can synthesize variants."
+ (|> (////analysis.variant [lefts right? memberA])
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.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)))
+
+ _
+ false)))))
+
+(def: tuple
+ Test
+ (do r.monad
+ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+ membersA (r.list size //primitive.primitive)]
+ (_.test "Can synthesize tuple."
+ (|> (////analysis.tuple membersA)
+ //.phase
+ (///.run [///bundle.empty ////synthesis.init])
+ (case> (^ (#error.Success (////synthesis.tuple membersS)))
+ (and (n/= size (list.size membersS))
+ (list.every? (product.uncurry //primitive.corresponds?)
+ (list.zip2 membersA membersS)))
+
+ _
+ false)))))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of #////synthesis.Structure)))
+ ($_ _.and
+ ..variant
+ ..tuple
+ )))