diff options
Diffstat (limited to 'stdlib/test')
| -rw-r--r-- | stdlib/test/test/lux/control/state.lux | 2 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/synthesis/case.lux | 72 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/synthesis/function.lux | 161 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/synthesis/primitive.lux | 90 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/synthesis/structure.lux | 54 |
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))) + )))) |