diff options
Diffstat (limited to '')
5 files changed, 287 insertions, 61 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 56be46610..7fc1c428d 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -20,6 +20,7 @@ ["#." try] ["#." io] ["#." parser + ["#/." analysis] ["#/." text] ["#/." cli]] ["#." pipe] @@ -57,6 +58,7 @@ Test ($_ _.and /parser.test + /parser/analysis.test /parser/text.test /parser/cli.test )) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux new file mode 100644 index 000000000..397b2c779 --- /dev/null +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -0,0 +1,146 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)] + ["." try] + ["." exception] + ["<>" parser]] + [data + ["." name ("#@." equivalence)] + ["." bit ("#@." equivalence)] + ["." text ("#@." equivalence)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["r" rev]] + [collection + ["." list]]] + [math + ["." random (#+ Random)]] + [tool + [compiler + [reference (#+ Constant)] + [language + [lux + ["." analysis]]]]]] + {1 + ["." /]}) + +(template: (!expect <expectation> <computation>) + (case <computation> + <expectation> + true + + _ + false)) + +(def: constant + (Random Constant) + (random.and (random.unicode 10) + (random.unicode 10))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + (do {@ random.monad} + [] + (`` ($_ _.and + (do {@ random.monad} + [expected (:: @ map (|>> analysis.bit) random.bit)] + (_.cover [/.run /.any] + (|> (list expected) + (/.run /.any) + (case> (#try.Success actual) + (:: analysis.equivalence = expected actual) + + (#try.Failure _) + false)))) + (~~ (template [<query> <check> <random> <analysis> <=>] + [(do {@ random.monad} + [expected <random>] + (_.cover [<query>] + (|> (list (<analysis> expected)) + (/.run <query>) + (case> (#try.Success actual) + (<=> expected actual) + + (#try.Failure _) + false)))) + (do {@ random.monad} + [expected <random>] + (_.cover [<check>] + (|> (list (<analysis> expected)) + (/.run (<check> expected)) + (!expect (#try.Success _)))))] + + [/.bit /.bit! random.bit analysis.bit bit@=] + [/.nat /.nat! random.nat analysis.nat n.=] + [/.int /.int! random.int analysis.int i.=] + [/.frac /.frac! random.frac analysis.frac f.=] + [/.rev /.rev! random.rev analysis.rev r.=] + [/.text /.text! (random.unicode 10) analysis.text text@=] + [/.local /.local! random.nat analysis.variable/local n.=] + [/.foreign /.foreign! random.nat analysis.variable/foreign n.=] + [/.constant /.constant! ..constant analysis.constant name@=] + )) + (do {@ random.monad} + [expected random.bit] + (_.cover [/.tuple] + (|> (list (analysis.tuple (list (analysis.bit expected)))) + (/.run (/.tuple /.bit)) + (case> (#try.Success actual) + (bit@= expected actual) + + (#try.Failure _) + false)))) + (do {@ random.monad} + [dummy random.bit] + (_.cover [/.end?] + (and (|> (/.run /.end? (list)) + (!expect (#try.Success #1))) + (|> (/.run (do <>.monad + [verdict /.end? + _ /.bit] + (wrap verdict)) + (list (analysis.bit dummy))) + (!expect (#try.Success #0)))))) + (do {@ random.monad} + [dummy random.bit] + (_.cover [/.end!] + (and (|> (/.run /.end! (list)) + (!expect (#try.Success _))) + (|> (/.run /.end! (list (analysis.bit dummy))) + (!expect (#try.Failure _)))))) + (do {@ random.monad} + [expected random.bit] + (_.cover [/.cannot-parse] + (and (|> (list (analysis.bit expected)) + (/.run /.nat) + (case> (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot-parse error))) + (|> (list) + (/.run /.bit) + (case> (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot-parse error)))))) + (do {@ random.monad} + [expected random.bit] + (_.cover [/.unconsumed-input] + (|> (list (analysis.bit expected) (analysis.bit expected)) + (/.run /.bit) + (case> (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.unconsumed-input error))))) + ))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 5f9f14321..d084e0210 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -1,15 +1,19 @@ (.module: [lux #* - [abstract ["." monad (#+ do)]] - [data - ["." name] - [number - ["n" nat]]] - ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] [control pipe - ["." try ("#@." functor)]]] + ["." try ("#@." functor)]] + [data + ["." sum] + [number + ["n" nat]] + [collection + ["." list ("#@." fold monoid)]]] + [math + ["." random (#+ Random) ("#@." monad)]]] ["." // #_ ["#." primitive]] {1 @@ -22,32 +26,33 @@ ["#." analysis (#+ Branch Analysis)] ["#." synthesis (#+ Synthesis)] [/// - ["#." reference] + ["#." reference + [variable (#+ Register)]] ["." phase] [meta ["." archive]]]]]]]}) -(def: dummy-vars +(def: masking-test Test - (do {@ r.monad} + (do {@ random.monad} [maskedA //primitive.primitive - temp (|> r.nat (:: @ map (n.% 100))) + temp (|> random.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 archive.empty) - (phase.run [///bundle.empty ////synthesis.init]) - (try@map (//primitive.corresponds? maskedA)) - (try.default false))))) + (_.cover [/.synthesize-masking] + (|> maskA + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) + (try@map (//primitive.corresponds? maskedA)) + (try.default false))))) -(def: let-expr +(def: let-test Test - (do r.monad - [registerA r.nat + (do random.monad + [registerA random.nat inputA //primitive.primitive outputA //primitive.primitive #let [letA (////analysis.control/case @@ -55,22 +60,22 @@ [[(#////analysis.Bind registerA) outputA] (list)]])]] - (_.test "Can detect and reify simple 'let' expressions." - (|> letA - (//.phase archive.empty) - (phase.run [///bundle.empty ////synthesis.init]) - (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS]))) - (and (n.= registerA registerS) - (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? outputA outputS)) + (_.cover [/.synthesize-let] + (|> letA + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) + (case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS]))) + (and (n.= registerA registerS) + (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? outputA outputS)) - _ - false))))) + _ + false))))) -(def: if-expr +(def: if-test Test - (do r.monad - [then|else r.bit + (do random.monad + [then|else random.bit inputA //primitive.primitive thenA //primitive.primitive elseA //primitive.primitive @@ -83,23 +88,83 @@ 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 archive.empty) - (phase.run [///bundle.empty ////synthesis.init]) - (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS]))) - (and (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? thenA thenS) - (//primitive.corresponds? elseA elseS)) + (_.cover [/.synthesize-if] + (|> ifA + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) + (case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS]))) + (and (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? thenA thenS) + (//primitive.corresponds? elseA elseS)) + + _ + false))))) + +(def: random-member + (Random ////synthesis.Member) + (do {@ random.monad} + [lefts (|> random.nat (:: @ map (n.% 10))) + right? random.bit] + (wrap (if right? + (#.Right lefts) + (#.Left lefts))))) + +(def: random-path + (Random (////analysis.Tuple ////synthesis.Member)) + (do {@ random.monad} + [size-1 (|> random.nat (:: @ map (|>> (n.% 10) inc)))] + (random.list size-1 ..random-member))) + +(def: (get-pattern path) + (-> (////analysis.Tuple ////synthesis.Member) + (Random [////analysis.Pattern Register])) + (do random.monad + [@member random.nat] + (wrap [(list@fold (function (_ member inner) + (case member + (#.Left lefts) + (////analysis.pattern/tuple + (list@compose (list.repeat lefts (////analysis.pattern/unit)) + (list inner (////analysis.pattern/unit)))) + + (#.Right lefts) + (////analysis.pattern/tuple + (list@compose (list.repeat (inc lefts) (////analysis.pattern/unit)) + (list inner))))) + (#////analysis.Bind @member) + (list.reverse path)) + @member]))) + +(def: get-test + Test + (do {@ random.monad} + [recordA (|> random.nat + (:: @ map (|>> ////analysis.nat)) + (random.list 10) + (:: @ map (|>> ////analysis.tuple))) + pathA ..random-path + [pattern @member] (get-pattern pathA) + #let [getA (////analysis.control/case [recordA [[pattern + (#////analysis.Reference (////reference.local @member))] + (list)]])]] + (_.cover [/.synthesize-get] + (|> getA + (//.phase archive.empty) + (phase.run [///bundle.empty ////synthesis.init]) + (case> (^ (#try.Success (////synthesis.branch/get [pathS recordS]))) + (and (:: (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS) + (//primitive.corresponds? recordA recordS)) - _ - false))))) + _ + false))))) (def: #export test Test - (<| (_.context (name.module (name-of /._))) + (<| (_.covering /._) + (_.with-cover [/.synthesize]) ($_ _.and - ..dummy-vars - ..let-expr - ..if-expr + ..masking-test + ..let-test + ..if-test + ..get-test ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 799a8a526..7350881b1 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -16,7 +16,7 @@ ["n" nat]] [collection ["." list ("#@." functor fold)] - ["dict" dictionary (#+ Dictionary)] + ["." dictionary (#+ Dictionary)] ["." set]]]] ["." // #_ ["#." primitive]] @@ -31,7 +31,8 @@ ["#." synthesis (#+ Synthesis)] [/// [arity (#+ Arity)] - ["#." reference (#+ Variable) ("variable@." equivalence)] + ["#." reference + ["." variable (#+ Variable) ("#@." equivalence)]] ["." phase] [meta ["." archive]]]]]]]}) @@ -61,16 +62,16 @@ (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)] + local-env (list@map (|>> #variable.Local) indices) + foreign-env (list@map (|>> #variable.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.put idx var resolver)) (: (Dictionary Nat Variable) - (dict.new n.hash)) + (dictionary.new n.hash)) (list.enumerate current-env))] (do @ [nest? r.bit] @@ -83,7 +84,7 @@ (list@map (function (_ pick) (maybe.assume (list.nth pick current-env))) picks)) - #let [picked-env (list@map (|>> #////reference.Foreign) picks)]] + #let [picked-env (list@map (|>> #variable.Foreign) picks)]] (wrap [arity (#////analysis.Function picked-env bodyA) predictionA])) @@ -91,7 +92,7 @@ [chosen (pick (list.size current-env))] (wrap [arity (#////analysis.Reference (////reference.foreign chosen)) - (maybe.assume (dict.get chosen resolver))])))))))] + (maybe.assume (dictionary.get chosen resolver))])))))))] (wrap [arity (#////analysis.Function local-env bodyA) predictionA]))) @@ -111,7 +112,7 @@ [chosen (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2))))] (wrap [arity (#////analysis.Reference (////reference.local chosen)) - (|> chosen (n.+ (dec arity)) #////reference.Local)]))))) + (|> chosen (n.+ (dec arity)) #variable.Local)]))))) (def: abstraction Test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index cd7fe54eb..40f9efad4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -1,14 +1,18 @@ (.module: [lux (#- primitive) [abstract ["." monad (#+ do)]] + [control + [pipe (#+ case>)] + ["." try]] [data ["%" text/format (#+ format)] - ["." name]] + ["." name] + [number + ["n" nat]] + [collection + ["." list]]] ["r" math/random (#+ Random) ("#@." monad)] - ["_" test (#+ Test)] - [control - pipe - ["." try]]] + ["_" test (#+ Test)]] {1 ["." / #_ ["/#" // @@ -54,6 +58,14 @@ [#////analysis.Frac (|>) #////synthesis.F64 (|>)] [#////analysis.Text (|>) #////synthesis.Text (|>)] )) + + (^ [(////analysis.tuple expected) + (////synthesis.tuple actual)]) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (corresponds? expected actual)) + (list.zip2 expected actual))) _ false))) |