aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/test')
-rw-r--r--stdlib/test/test/lux/control/state.lux2
-rw-r--r--stdlib/test/test/lux/lang/synthesis/case.lux72
-rw-r--r--stdlib/test/test/lux/lang/synthesis/function.lux161
-rw-r--r--stdlib/test/test/lux/lang/synthesis/primitive.lux90
-rw-r--r--stdlib/test/test/lux/lang/synthesis/structure.lux54
5 files changed, 378 insertions, 1 deletions
diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux
index 381a40b79..1194351e5 100644
--- a/stdlib/test/test/lux/control/state.lux
+++ b/stdlib/test/test/lux/control/state.lux
@@ -83,7 +83,7 @@
(let [(^open "io/") io.Monad<IO>]
(test "Can add state functionality to any monad."
(|> (: (&.State' io.IO Nat Nat)
- (do (&.StateT io.Monad<IO>)
+ (do (&.Monad<State'> io.Monad<IO>)
[a (&.lift io.Monad<IO> (io/wrap left))
b (wrap right)]
(wrap (n/+ a b))))
diff --git a/stdlib/test/test/lux/lang/synthesis/case.lux b/stdlib/test/test/lux/lang/synthesis/case.lux
new file mode 100644
index 000000000..3ae62badc
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/case.lux
@@ -0,0 +1,72 @@
+(.module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (macro [code])
+ ["r" math/random "r/" Monad<Random>]
+ test)
+ (luxc (lang ["la" analysis]
+ ["//" synthesis #+ Synthesis]
+ (synthesis [".S" expression])
+ [".L" extension]
+ [".L" variable #+ Variable]))
+ (/// common))
+
+(context: "Dummy variables."
+ (<| (times +100)
+ (do @
+ [maskedA gen-primitive
+ temp (|> r.nat (:: @ map (n/% +100)))
+ #let [maskA (` ("lux case" (~ maskedA)
+ {("lux case bind" (~ (code.nat temp)))
+ (~ (la.var (variableL.local temp)))}))]]
+ (test "Dummy variables created to mask expressions get eliminated during synthesis."
+ (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+ maskA))
+ (corresponds? maskedA))))))
+
+(context: "Let expressions."
+ (<| (times +100)
+ (do @
+ [registerA r.nat
+ inputA gen-primitive
+ outputA gen-primitive
+ #let [letA (` ("lux case" (~ inputA)
+ {("lux case bind" (~ (code.nat registerA)))
+ (~ outputA)}))]]
+ (test "Can detect and reify simple 'let' expressions."
+ (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+ letA))
+ (case> (^ [_ (#.Form (list [_ (#.Text "lux let")] [_ (#.Nat registerS)] inputS outputS))])
+ (and (n/= registerA registerS)
+ (corresponds? inputA inputS)
+ (corresponds? outputA outputS))
+
+ _
+ false))))))
+
+(context: "If expressions."
+ (<| (times +100)
+ (do @
+ [then|else r.bool
+ inputA gen-primitive
+ thenA gen-primitive
+ elseA gen-primitive
+ #let [ifA (if then|else
+ (` ("lux case" (~ inputA)
+ {true (~ thenA)
+ false (~ elseA)}))
+ (` ("lux case" (~ inputA)
+ {false (~ elseA)
+ true (~ thenA)})))]]
+ (test "Can detect and reify simple 'if' expressions."
+ (|> (//.run (expressionS.synthesizer extensionL.no-syntheses
+ ifA))
+ (case> (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
+ (and (corresponds? inputA inputS)
+ (corresponds? thenA thenS)
+ (corresponds? elseA elseS))
+
+ _
+ false))))))
diff --git a/stdlib/test/test/lux/lang/synthesis/function.lux b/stdlib/test/test/lux/lang/synthesis/function.lux
new file mode 100644
index 000000000..c469d8665
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/function.lux
@@ -0,0 +1,161 @@
+(.module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [product]
+ [maybe]
+ [error]
+ [number]
+ text/format
+ (coll [list "list/" Functor<List> Fold<List>]
+ (dictionary ["dict" unordered #+ Dict])
+ (set ["set" unordered])))
+ (lang [".L" analysis #+ Variable Analysis "variable/" Eq<Variable>]
+ ["//" synthesis #+ Arity Synthesis]
+ (synthesis [".S" expression])
+ [".L" extension])
+ ["r" math/random]
+ test)
+ [//primitive])
+
+(def: constant-function
+ (r.Random [Arity Analysis Analysis])
+ (r.rec
+ (function (_ constant-function)
+ (do r.Monad<Random>
+ [function? r.bool]
+ (if function?
+ (do @
+ [[arity bodyA predictionA] constant-function]
+ (wrap [(inc arity)
+ (#analysisL.Function (list) bodyA)
+ predictionA]))
+ (do @
+ [predictionA //primitive.primitive]
+ (wrap [+0 predictionA predictionA])))))))
+
+(def: (pick scope-size)
+ (-> Nat (r.Random Nat))
+ (|> r.nat (:: r.Monad<Random> map (n/% scope-size))))
+
+(def: function-with-environment
+ (r.Random [Arity Analysis Variable])
+ (do r.Monad<Random>
+ [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
+ #let [indices (list.n/range +0 (dec num-locals))
+ absolute-env (list/map (|>> #analysisL.Local) indices)
+ relative-env (list/map (|>> #analysisL.Foreign) indices)]
+ [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
+ (loop [arity +1
+ global-env relative-env]
+ (let [env-size (list.size global-env)
+ resolver (list/fold (function (_ [idx var] resolver)
+ (dict.put idx var resolver))
+ (: (Dict Nat Variable)
+ (dict.new number.Hash<Nat>))
+ (list.zip2 (list.n/range +0 (dec env-size))
+ global-env))]
+ (do @
+ [nest? r.bool]
+ (if nest?
+ (do @
+ [num-picks (:: @ map (n/max +1) (pick (inc env-size)))
+ picks (|> (r.set number.Hash<Nat> num-picks (pick env-size))
+ (:: @ map set.to-list))
+ [arity bodyA predictionA] (recur (inc arity)
+ (list/map (function (_ pick)
+ (maybe.assume (list.nth pick global-env)))
+ picks))]
+ (wrap [arity
+ (#analysisL.Function (list/map (|>> #analysisL.Foreign) picks)
+ bodyA)
+ predictionA]))
+ (do @
+ [chosen (pick (list.size global-env))]
+ (wrap [arity
+ (#analysisL.Variable (#analysisL.Foreign chosen))
+ (maybe.assume (dict.get chosen resolver))])))))))]
+ (wrap [arity
+ (#analysisL.Function absolute-env bodyA)
+ predictionA])))
+
+(def: local-function
+ (r.Random [Arity Analysis Variable])
+ (loop [arity +0
+ nest? true]
+ (if nest?
+ (do r.Monad<Random>
+ [nest?' r.bool
+ [arity' bodyA predictionA] (recur (inc arity) nest?')]
+ (wrap [arity'
+ (#analysisL.Function (list) bodyA)
+ predictionA]))
+ (do r.Monad<Random>
+ [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
+ (wrap [arity
+ (#analysisL.Variable (#analysisL.Local chosen))
+ (|> chosen (n/+ (dec arity)) #analysisL.Local)])))))
+
+(context: "Function definition."
+ (<| (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
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (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
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+ (and (n/= arity//environment arity)
+ (variable/= prediction//environment output))
+
+ _
+ false)))
+ (test "Folded functions properly offset local variables."
+ (|> function//local
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Variable output)])))
+ (and (n/= arity//local arity)
+ (variable/= prediction//local output))
+
+ _
+ false)))
+ ))))
+
+(context: "Function 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."
+ (|> (analysisL.apply [funcA argsA])
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (^ (#error.Success (//.function/apply [funcS argsS])))
+ (and (//primitive.corresponds? funcA funcS)
+ (list.every? (product.uncurry //primitive.corresponds?)
+ (list.zip2 argsA argsS)))
+
+ _
+ false)))
+ (test "Function application on no arguments just synthesizes to the function itself."
+ (|> (analysisL.apply [funcA (list)])
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (#error.Success funcS)
+ (//primitive.corresponds? funcA funcS)
+
+ _
+ false)))
+ ))))
diff --git a/stdlib/test/test/lux/lang/synthesis/primitive.lux b/stdlib/test/test/lux/lang/synthesis/primitive.lux
new file mode 100644
index 000000000..ffe0eb795
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/primitive.lux
@@ -0,0 +1,90 @@
+(.module:
+ [lux #- primitive]
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [error]
+ text/format)
+ [lang]
+ (lang [".L" extension]
+ [".L" analysis #+ Analysis]
+ ["//" synthesis #+ Synthesis]
+ (synthesis [".S" expression]))
+ ["r" math/random]
+ test))
+
+(def: #export primitive
+ (r.Random Analysis)
+ (do r.Monad<Random>
+ [primitive (: (r.Random analysisL.Primitive)
+ ($_ r.alt
+ (wrap [])
+ r.bool
+ r.nat
+ r.int
+ r.deg
+ r.frac
+ (r.unicode +5)))]
+ (wrap (#analysisL.Primitive primitive))))
+
+(def: #export (corresponds? analysis synthesis)
+ (-> Analysis Synthesis Bool)
+ (case [synthesis analysis]
+ [(#//.Primitive (#//.Text valueS))
+ (#analysisL.Primitive (#analysisL.Unit valueA))]
+ (is? valueS (:! Text valueA))
+
+ [(#//.Primitive (#//.Bool valueS))
+ (#analysisL.Primitive (#analysisL.Bool valueA))]
+ (is? valueS valueA)
+
+ [(#//.Primitive (#//.I64 valueS))
+ (#analysisL.Primitive (#analysisL.Nat valueA))]
+ (is? valueS (.i64 valueA))
+
+ [(#//.Primitive (#//.I64 valueS))
+ (#analysisL.Primitive (#analysisL.Int valueA))]
+ (is? valueS (.i64 valueA))
+
+ [(#//.Primitive (#//.I64 valueS))
+ (#analysisL.Primitive (#analysisL.Deg valueA))]
+ (is? valueS (.i64 valueA))
+
+ [(#//.Primitive (#//.F64 valueS))
+ (#analysisL.Primitive (#analysisL.Frac valueA))]
+ (is? valueS valueA)
+
+ [(#//.Primitive (#//.Text valueS))
+ (#analysisL.Primitive (#analysisL.Text valueA))]
+ (is? valueS valueA)
+
+ _
+ false))
+
+(context: "Primitives."
+ (<| (times +100)
+ (do @
+ [%bool% r.bool
+ %nat% r.nat
+ %int% r.int
+ %deg% r.deg
+ %frac% r.frac
+ %text% (r.unicode +5)]
+ (`` ($_ seq
+ (~~ (do-template [<desc> <analysis> <synthesis> <sample>]
+ [(test (format "Can synthesize " <desc> ".")
+ (|> (#analysisL.Primitive (<analysis> <sample>))
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (#error.Success (#//.Primitive (<synthesis> value)))
+ (is? <sample> value)
+
+ _
+ false)))]
+
+ ["unit" #analysisL.Unit #//.Text //.unit]
+ ["bool" #analysisL.Bool #//.Bool %bool%]
+ ["nat" #analysisL.Nat #//.I64 (.i64 %nat%)]
+ ["int" #analysisL.Int #//.I64 (.i64 %int%)]
+ ["deg" #analysisL.Deg #//.I64 (.i64 %deg%)]
+ ["frac" #analysisL.Frac #//.F64 %frac%]
+ ["text" #analysisL.Text #//.Text %text%])))))))
diff --git a/stdlib/test/test/lux/lang/synthesis/structure.lux b/stdlib/test/test/lux/lang/synthesis/structure.lux
new file mode 100644
index 000000000..a8e298bf5
--- /dev/null
+++ b/stdlib/test/test/lux/lang/synthesis/structure.lux
@@ -0,0 +1,54 @@
+(.module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data [bool "bool/" Eq<Bool>]
+ [product]
+ [error]
+ (coll [list]))
+ (lang [".L" analysis]
+ ["//" synthesis #+ Synthesis]
+ (synthesis [".S" expression])
+ [".L" extension])
+ ["r" math/random "r/" Monad<Random>]
+ test)
+ [//primitive])
+
+(context: "Variants"
+ (<| (times +100)
+ (do @
+ [size (|> r.nat (:: @ map (|>> (n/% +10) (n/+ +2))))
+ tagA (|> r.nat (:: @ map (n/% size)))
+ memberA //primitive.primitive]
+ ($_ seq
+ (test "Can synthesize variants."
+ (|> (analysisL.sum-analysis size tagA memberA)
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
+ (let [tagS (if right?S (inc leftsS) leftsS)]
+ (and (n/= tagA tagS)
+ (|> tagS (n/= (dec size)) (bool/= right?S))
+ (//primitive.corresponds? memberA valueS)))
+
+ _
+ false)))
+ ))))
+
+(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."
+ (|> (analysisL.product-analysis membersA)
+ (//.run (expressionS.synthesizer extensionL.empty))
+ (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
+ (and (n/= size (list.size membersS))
+ (list.every? (product.uncurry //primitive.corresponds?)
+ (list.zip2 membersA membersS)))
+
+ _
+ false)))
+ ))))