diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux | 185 |
1 files changed, 185 insertions, 0 deletions
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 + ))) |