diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/target/ruby.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux | 106 |
3 files changed, 139 insertions, 3 deletions
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 7723cd776..61fb1197e 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -16,7 +16,8 @@ ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)] + ["[0]" set]]] ["[0]" math ["[0]" random {"+" Random} ("[1]#[0]" monad)] [number @@ -299,7 +300,16 @@ (do [! random.monad] [float/0 random.safe_frac $foreign (# ! each /.local (random.ascii/lower 10)) - field (# ! each /.string (random.ascii/upper 10))] + field (# ! each /.string (random.ascii/upper 10)) + + $inputs (# ! each /.local (random.ascii/lower 10)) + arity (# ! each (n.% 10) random.nat) + vals (|> random.int + (# ! each /.int) + (random.list arity)) + keys (|> (random.ascii/lower 1) + (random.set text.hash arity) + (# ! each (|>> set.list (list#each /.string))))] ($_ _.and (<| (_.for [/.Var]) ($_ _.and @@ -310,6 +320,24 @@ (/.return $foreign)) [(list $foreign)] (/.lambda {.#None}) (/.apply_lambda/* (list (/.float float/0)))))) + (<| (_.for [/.LVar*]) + ($_ _.and + (_.cover [/.variadic] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))) + (_.cover [/.splat] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))))) + (<| (_.for [/.LVar**]) + (_.cover [/.variadic_kv /.double_splat] + (expression (|>> (:as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals))))))))) )) (_.cover [/.Access] (and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index df128f232..761192245 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -12,7 +12,8 @@ ... ["[1][0]" syntax] ["[1][0]" analysis "_" ["[1]/[0]" primitive] - ["[1]/[0]" composite]] + ["[1]/[0]" composite] + ["[1]/[0]" pattern]] ... [phase ... ["[1][0]" analysis] ... ["[1][0]" synthesis]] @@ -30,6 +31,7 @@ /reference.test /analysis/primitive.test /analysis/composite.test + /analysis/pattern.test /meta/archive/signature.test ... /syntax.test ... /analysis.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux new file mode 100644 index 000000000..b4ee9e9c8 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -0,0 +1,106 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["f" frac]]]]] + [\\library + ["[0]" /]] + ["[0]" // "_" + ["[1][0]" primitive] + ["[1][0]" composite]]) + +(def: .public random + (Random /.Pattern) + (random.rec + (function (_ random) + ($_ random.or + //primitive.random + (//composite.random 4 random) + random.nat + )))) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Pattern]) + (do random.monad + [expected_register random.nat + expected_bit random.bit + expected_nat random.nat + expected_int random.int + expected_rev random.rev + expected_frac random.frac + expected_text (random.ascii/lower 2) + + expected_lefts random.nat + expected_right? random.bit]) + (`` ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.unit] + (case (/.unit) + (^ (/.unit)) + true + + _ + false)) + (~~ (template [<tag> <value>] + [(_.cover [<tag>] + (case (<tag> <value>) + (^ (<tag> actual)) + (same? <value> actual) + + _ + false))] + + [/.bind expected_register] + [/.bit expected_bit] + [/.nat expected_nat] + [/.int expected_int] + [/.rev expected_rev] + [/.frac expected_frac] + [/.text expected_text] + )) + (_.cover [/.variant] + (case (/.variant [expected_lefts expected_right? (/.text expected_text)]) + (^ (/.variant [actual_lefts actual_right? (/.text actual_text)])) + (and (same? expected_lefts actual_lefts) + (same? expected_right? actual_right?) + (same? expected_text actual_text)) + + _ + false)) + (_.cover [/.tuple] + (case (/.tuple (list (/.bit expected_bit) + (/.nat expected_nat) + (/.int expected_int) + (/.rev expected_rev) + (/.frac expected_frac) + (/.text expected_text))) + (^ (/.tuple (list (/.bit actual_bit) + (/.nat actual_nat) + (/.int actual_int) + (/.rev actual_rev) + (/.frac actual_frac) + (/.text actual_text)))) + (and (same? expected_bit actual_bit) + (same? expected_nat actual_nat) + (same? expected_int actual_int) + (same? expected_rev actual_rev) + (same? expected_frac actual_frac) + (same? expected_text actual_text)) + + _ + false)) + )))) |