diff options
author | Eduardo Julian | 2022-01-19 22:30:05 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-01-19 22:30:05 -0400 |
commit | c98d05fcb43714dc7e2ce07ab3fa17b78f21b3bf (patch) | |
tree | 99704fb276b197d2b3295fc1304f3f493828556d /stdlib/source/test | |
parent | e3dc47dafccb1d21a5c162e4329afd72ddb00650 (diff) |
Fixes for the pure-Lux JVM compiler machinery. [Part 9]
Diffstat (limited to 'stdlib/source/test')
7 files changed, 245 insertions, 168 deletions
diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 7caae5fdd..a3f401643 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -87,8 +87,8 @@ [/.frac /.frac! random.safe_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.=] + [/.local /.local! random.nat analysis.local n.=] + [/.foreign /.foreign! random.nat analysis.foreign n.=] [/.constant /.constant! ..constant analysis.constant symbol#=] )) (do [! random.monad] diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 3a10b530d..62ef895da 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -110,6 +110,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list) @@ -853,6 +854,7 @@ static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list (/field.field /field.static class_field /type.long (sequence.sequence)) @@ -1330,6 +1332,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) + (/type.declaration class_name (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1629,6 +1632,7 @@ interface_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract /class.interface) (/name.internal interface_class) + (/type.declaration interface_class (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1639,6 +1643,7 @@ (format.result /class.writer)) abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract) (/name.internal abstract_class) + (/type.declaration abstract_class (list)) (/name.internal "java.lang.Object") (list) (list) @@ -1664,6 +1669,7 @@ (/.invokevirtual class method method::type)))) concrete_bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal concrete_class) + (/type.declaration concrete_class (list)) (/name.internal abstract_class) (list (/name.internal interface_class)) (list) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 2a2f9667d..516037ea9 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -3,6 +3,7 @@ [lux "*" ["_" test {"+" Test}] ["[0]" ffi] + ["[0]" debug] [abstract [monad {"+" do}] ["[0]" predicate] @@ -340,12 +341,103 @@ ..test|computation) )))) -(def: test/location +(def: test|local_var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.local] + (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) + (|> (/.return (/.+ $foreign $foreign)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + (_.cover [/.set] + (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) + (|> ($_ /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.+ $foreign $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) + +(def: test|instance_var + Test + (do [! random.monad] + [float/0 random.safe_frac + instance (# ! each (|>> %.nat (format "instance_")) + random.nat) + .let [$instance (/.instance instance)] + $method (# ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (# ! each (|>> %.nat (format "class_") /.local) + random.nat) + $object (# ! each (|>> %.nat (format "object_") /.local) + random.nat)] + ($_ _.and + (_.cover [/.instance] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + (/.function $method (list) + (/.return $instance)) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_reader/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.attr_reader/* (list instance)) + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.the instance)))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_writer/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body ($_ /.then + (/.attr_writer/* (list instance)) + (/.function $method (list) + (/.return $instance)) + )])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (|> $object + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_accessor/*] + (expression (|>> (:as Frac) (f.= float/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.attr_accessor/* (list instance))])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (/.the instance $object))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) + +(def: test|var Test (do [! random.monad] [float/0 random.safe_frac $foreign (# ! each /.local (random.ascii/lower 10)) - field (# ! each /.string (random.ascii/upper 10)) $inputs (# ! each /.local (random.ascii/lower 10)) arity (# ! each (n.% 10) random.nat) @@ -356,44 +448,49 @@ (random.set text.hash arity) (# ! each (|>> set.list (list#each /.string))))] ($_ _.and - (<| (_.for [/.Var]) + (_.cover [/.defined?/1] + (and (expression (|>> (:as Bit)) + (|> (/.defined?/1 $foreign) + (/.= /.nil))) + (expression (|>> (:as Text) (text#= "local-variable")) + (|> ($_ /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.defined?/1 $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (<| (_.for [/.LVar*]) ($_ _.and - (_.cover [/.defined?/1] - (and (expression (|>> (:as Bit)) - (|> (/.defined?/1 $foreign) - (/.= /.nil))) - (expression (|>> (:as Text) (text#= "local-variable")) - (|> ($_ /.then - (/.set (list $foreign) (/.float float/0)) - (/.return (/.defined?/1 $foreign))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))))) - (_.cover [/.LVar /.local /.set] - (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) - (|> ($_ /.then - (/.set (list $foreign) (/.+ $foreign $foreign)) - (/.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 [/.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))))))))) + ))) + +(def: test|location + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10)) + field (# ! each /.string (random.ascii/upper 10))] + ($_ _.and + (<| (_.for [/.Var]) + ..test|var) (_.cover [/.Access] (and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0))) (let [@ (/.item (/.int +0) $foreign)] @@ -483,7 +580,7 @@ (def: test|loop Test (do [! random.monad] - [input random.int + [input (# ! each (i.right_shifted 32) random.int) iterations (# ! each (n.% 10) random.nat) .let [$input (/.local "input") $output (/.local "output") @@ -728,7 +825,7 @@ (_.for [/.Block] ..test|function) (_.for [/.Location] - ..test/location) + ..test|location) ))) (def: test|global diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 635322a92..78aaee40e 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -14,7 +14,8 @@ ["[1][0]" analysis] ["[1][0]" phase "_" ["[1]/[0]" extension] - ... ["[1]/[0]" analysis] + ["[1]/[0]" analysis "_" + ["[1]/[0]" simple]] ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" @@ -38,7 +39,7 @@ /meta/archive/key.test /meta/archive/document.test /phase/extension.test + /phase/analysis/simple.test ... /syntax.test - ... /analysis.test ... /synthesis.test )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index 210d6d29a..69c608fda 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -169,8 +169,8 @@ _ false))] - [/.variable/local expected_register] - [/.variable/foreign expected_register] + [/.local expected_register] + [/.foreign expected_register] [/.constant expected_constant] [/.variable expected_variable] )) @@ -184,7 +184,7 @@ _ false)]) -(def: test|application +(def: test|reification Test (do random.monad [expected_abstraction (random.only (|>> (..tagged? /.#Apply) not) @@ -192,10 +192,10 @@ expected_parameter/0 (..random 2) expected_parameter/1 (..random 2)] ($_ _.and - (_.cover [/.apply /.application] + (_.cover [/.reified /.reification] (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] - /.apply - /.application) + /.reified + /.reification) (^ [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) (and (same? expected_abstraction actual_abstraction) (same? expected_parameter/0 actual_parameter/0) @@ -421,8 +421,8 @@ ..test|simple ..test|complex ..test|reference - (_.for [/.Application] - ..test|application) + (_.for [/.Reification] + ..test|reification) (_.for [/.Branch /.Branch' /.Match /.Match'] ..test|case) (_.for [/.Operation /.Phase /.Handler /.Bundle] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux deleted file mode 100644 index 252148fb5..000000000 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ /dev/null @@ -1,115 +0,0 @@ -(.using - [lux {"-" primitive} - ["@" target] - [abstract - ["[0]" monad {"+" do}]] - [data - ["%" text/format {"+" format}]] - ["r" math/random {"+" Random} ("[1]#[0]" monad)] - ["_" test {"+" Test}] - [control - pipe - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [macro - ["[0]" code]] - [meta - ["[0]" symbol]]] - [\\ - ["[0]" / - ["/[1]" // - ["[1][0]" type] - ["/[1]" // "_" - [extension - ["[0]" bundle] - ["[1][0]" analysis]] - ["/[1]" // "_" - ["[0]" version] - ["[1][0]" analysis {"+" Analysis Operation} - [macro {"+" Expander}] - [evaluation {"+" Eval}]] - [/// - ["[0]" phase] - [meta - ["[0]" archive]]]]]]]]) - -(def: .public (expander macro inputs state) - Expander - {try.#Failure "NOPE"}) - -(def: .public (eval archive count type expression) - Eval - (function (_ state) - {try.#Failure "NO!"})) - -(def: .public phase - ////analysis.Phase - (//.phase ..expander)) - -(def: .public state - ////analysis.State+ - [(///analysis.bundle ..eval bundle.empty) - (////analysis.state (////analysis.info version.version @.jvm))]) - -(def: .public primitive - (Random [Type Code]) - (`` ($_ r.either - (~~ (template [<type> <code_wrapper> <value_gen>] - [(r.and (r#in <type>) (r#each <code_wrapper> <value_gen>))] - - [Any code.tuple (r.list 0 (r#in (' [])))] - [Bit code.bit r.bit] - [Nat code.nat r.nat] - [Int code.int r.int] - [Rev code.rev r.rev] - [Frac code.frac r.frac] - [Text code.text (r.unicode 5)] - ))))) - -(exception: (wrong_inference [expected Type - inferred Type]) - (exception.report - ["Expected" (%.type expected)] - ["Inferred" (%.type inferred)])) - -(def: (infer expected_type analysis) - (-> Type (Operation Analysis) (Try Analysis)) - (|> analysis - //type.with_inference - (phase.result ..state) - (case> {try.#Success [inferred_type output]} - (if (same? expected_type inferred_type) - {try.#Success output} - (exception.except wrong_inference [expected_type inferred_type])) - - {try.#Failure error} - {try.#Failure error}))) - -(def: .public test - (<| (_.context (symbol.module (symbol /._))) - (`` ($_ _.and - (_.test (%.symbol (symbol ////analysis.#Unit)) - (|> (infer Any (..phase archive.empty (' []))) - (case> (^ {try.#Success {////analysis.#Primitive {////analysis.#Unit output}}}) - (same? [] output) - - _ - false))) - (~~ (template [<type> <tag> <random> <constructor>] - [(do r.monad - [sample <random>] - (_.test (%.symbol (symbol <tag>)) - (|> (infer <type> (..phase archive.empty (<constructor> sample))) - (case> {try.#Success {////analysis.#Primitive {<tag> output}}} - (same? sample output) - - _ - false))))] - - [Bit ////analysis.#Bit r.bit code.bit] - [Nat ////analysis.#Nat r.nat code.nat] - [Int ////analysis.#Int r.int code.int] - [Rev ////analysis.#Rev r.rev code.rev] - [Frac ////analysis.#Frac r.frac code.frac] - [Text ////analysis.#Text (r.unicode 5) code.text] - )))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux new file mode 100644 index 000000000..015c9d362 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -0,0 +1,88 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try]] + [math + ["[0]" random]]]] + [\\library + ["[0]" / + [// + ["[1][0]" type] + [// + ["[1][0]" extension] + [// + ["[1][0]" analysis {"+" Analysis Operation}] + [/// + ["[1][0]" phase]]]]]]]) + +(def: (analysis state type it ?) + (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit) + (and (|> (/type.with_type type + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Success analysis}) + (? analysis) + + _ + false)) + (|> (/type.with_type .Nothing + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Failure error}) + true + + _ + false)) + (|> (/type.with_inference + it) + (/phase.result [/extension.#bundle /extension.empty + /extension.#state state]) + (case> (^ {try.#Success [inferred analysis]}) + (and (type#= type inferred) + (? analysis)) + + _ + false)))) + +(template: (analysis? <type> <tag>) + [(: (-> <type> Analysis Bit) + (function (_ expected) + (|>> (case> (^ (<tag> actual)) + (same? expected actual) + + _ + false))))]) + +(def: .public test + (<| (_.covering /._) + (do [! random.monad] + [version random.nat + host (random.ascii/lower 5) + .let [state (/analysis.state (/analysis.info version host))]] + (`` ($_ _.and + (_.cover [/.unit] + (..analysis state .Any /.unit + (|>> (case> (^ (/analysis.unit)) true _ false)))) + (~~ (template [<analysis> <type> <random> <tag>] + [(do ! + [sample <random>] + (_.cover [<analysis>] + (..analysis state <type> (<analysis> sample) + ((..analysis? <type> <tag>) sample))))] + + [/.bit .Bit random.bit /analysis.bit] + [/.nat .Nat random.nat /analysis.nat] + [/.int .Int random.int /analysis.int] + [/.rev .Rev random.rev /analysis.rev] + [/.frac .Frac random.frac /analysis.frac] + [/.text .Text (random.unicode 1) /analysis.text] + )) + ))))) |