From 971c90ca9bcaa656f2e5682d61ca8054a59a8fea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 22 Jan 2022 03:55:22 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 10] --- stdlib/source/test/lux/target/jvm.lux | 12 +- stdlib/source/test/lux/target/ruby.lux | 157 ++++++++++++++------- .../lux/tool/compiler/language/lux/analysis.lux | 2 + .../tool/compiler/language/lux/analysis/macro.lux | 106 ++++++++++++++ 4 files changed, 221 insertions(+), 56 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 62ef895da..616f3f1f5 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -110,7 +110,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -854,7 +854,7 @@ static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list (/field.field /field.static class_field /type.long (sequence.sequence)) @@ -1332,7 +1332,7 @@ (in (case (do try.monad [class (/class.class /version.v6_0 /class.public (/name.internal class_name) - (/type.declaration class_name (list)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1632,7 +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)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1643,7 +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)) + {.#None} (/name.internal "java.lang.Object") (list) (list) @@ -1669,7 +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)) + {.#None} (/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 516037ea9..7ec415b16 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -35,7 +35,7 @@ [world ["[0]" file]]]] [\\library - ["[0]" /]]) + ["[0]" / ("[1]#[0]" equivalence)]]) (ffi.import: (eval [Text] "try" "?" Any)) @@ -238,7 +238,7 @@ random.nat) $method/1 (|> random.nat (# ! each (|>> %.nat (format "method_") /.local)) - (random.only (|>> (# /.equivalence = $method/0) not))) + (random.only (|>> (/#= $method/0) not))) $arg/0 (# ! each (|>> %.nat (format "arg_") /.local) random.nat) $state (# ! each (|>> %.nat (format "instance_") /.instance) @@ -341,6 +341,46 @@ ..test|computation) )))) +(def: test|global + Test + (do [! random.monad] + [float/0 random.safe_frac + $global (# ! each /.global (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.global] + (expression (|>> (:as Text) (text#= "global-variable")) + (|> ($_ /.then + (/.set (list $global) (/.float float/0)) + (/.return (/.defined?/1 $global))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.script_name] + (expression (let [file (format (# file.default separator) packager.main_file)] + (|>> (:as Text) + (text.ends_with? file))) + /.script_name)) + (_.cover [/.script_name] + (expression (let [file (format (# file.default separator) packager.main_file)] + (|>> (:as Text) + (text.ends_with? file))) + /.script_name)) + (_.cover [/.input_record_separator] + (expression (|>> (:as Text) + (text#= text.\n)) + /.input_record_separator)) + (_.cover [/.output_record_separator] + (..nil /.output_record_separator)) + (_.cover [/.process_id] + (expression (|>> (:as Nat) (n.= 0) not) + /.process_id)) + (_.cover [/.case_insensitivity_flag] + (expression (|>> (:as Bit) (bit#= false)) + /.case_insensitivity_flag)) + (_.cover [/.command_line_arguments] + (expression (|>> (:as Int) (i.= +0)) + (/.the "length" /.command_line_arguments))) + ))) + (def: test|local_var Test (do [! random.monad] @@ -433,13 +473,36 @@ (/.apply_lambda/* (list))))) ))) -(def: test|var +(def: test|static_var Test (do [! random.monad] - [float/0 random.safe_frac - $foreign (# ! each /.local (random.ascii/lower 10)) + [int/0 (# ! each (|>> (n.% 10) ++ .int) + random.nat) + $static (# ! each (|>> %.nat (format "static_") /.static) + random.nat) + $arg (# ! each (|>> %.nat /.local) + random.nat) + $method (# ! each (|>> %.nat (format "method_") /.local) + random.nat) + $class (# ! each (|>> %.nat (format "class_") /.local) + random.nat)] + ($_ _.and + (_.cover [/.static /.class_variable_set /.class_variable_get] + (expression (|>> (:as Int) (i.= int/0)) + (|> ($_ /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.function $method (list) + (/.return (/.int +0)))])) + (/.statement (/.class_variable_set $static (/.int int/0) $class)) + (/.return (/.class_variable_get $static $class))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) - $inputs (# ! each /.local (random.ascii/lower 10)) +(def: test|variadic + Test + (do [! random.monad] + [$inputs (# ! each /.local (random.ascii/lower 10)) arity (# ! each (n.% 10) random.nat) vals (|> random.int (# ! each /.int) @@ -448,20 +511,6 @@ (random.set text.hash arity) (# ! each (|>> set.list (list#each /.string))))] ($_ _.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)))))) - (_.for [/.LVar] - ..test|local_var) - (_.for [/.IVar] - ..test|instance_var) (<| (_.for [/.LVar*]) ($_ _.and (_.cover [/.variadic] @@ -482,6 +531,43 @@ (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals))))))))) ))) +(def: test|var + Test + (do [! random.monad] + [float/0 random.safe_frac + $foreign (# ! each /.local (random.ascii/lower 10)) + + $constant (# ! each /.constant (random.ascii/lower 10))] + ($_ _.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)))))) + (_.for [/.CVar] + (_.cover [/.constant] + (expression (|>> (:as Text) (text#= "constant")) + (|> ($_ /.then + (/.set (list $constant) (/.float float/0)) + (/.return (/.defined?/1 $constant))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.GVar] + ..test|global) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (_.for [/.SVar] + ..test|static_var) + ..test|variadic + ))) + (def: test|location Test (do [! random.monad] @@ -828,33 +914,6 @@ ..test|location) ))) -(def: test|global - Test - (do random.monad - [_ (in [])] - ($_ _.and - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (:as Text) - (text.ends_with? file))) - /.script_name)) - (_.cover [/.input_record_separator] - (expression (|>> (:as Text) - (text#= text.\n)) - /.input_record_separator)) - (_.cover [/.output_record_separator] - (..nil /.output_record_separator)) - (_.cover [/.process_id] - (expression (|>> (:as Nat) (n.= 0) not) - /.process_id)) - (_.cover [/.case_insensitivity_flag] - (expression (|>> (:as Bit) (bit#= false)) - /.case_insensitivity_flag)) - (_.cover [/.command_line_arguments] - (expression (|>> (:as Int) (i.= +0)) - (/.the "length" /.command_line_arguments))) - ))) - (def: random_expression (Random /.Expression) (let [literal (: (Random /.Literal) @@ -881,11 +940,9 @@ (_.cover [/.code /.manual] (|> (/.manual (/.code expected)) (: /.Expression) - (# /.equivalence = expected))) + (/#= expected))) (_.for [/.Expression] ..test|expression) (_.for [/.Statement] ..test|statement) - (_.for [/.GVar] - ..test|global) )))) 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 69c608fda..c1bc9d62e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -27,6 +27,7 @@ ["[1][0]" simple] ["[1][0]" complex] ["[1][0]" pattern] + ["[1][0]" macro] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -436,4 +437,5 @@ /simple.test /complex.test /pattern.test + /macro.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux new file mode 100644 index 000000000..b976dab87 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux @@ -0,0 +1,106 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" monad)]]] + [macro + ["[0]" code ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat]]]]] + ["$" /////// "_" + [macro + ["[1][0]" code]] + [meta + ["[1][0]" symbol]]] + [\\library + ["[0]" / + ["/[1]" //]]]) + +(def: random_state + (Random Lux) + (do random.monad + [version random.nat + host (random.ascii/lower 1)] + (in (//.state (//.info version host))))) + +(def: (expander macro inputs state) + /.Expander + {try.#Success ((.macro macro) inputs state)}) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Expander]) + (do [! random.monad] + [multiplicity (# ! each (|>> (n.% 8) (n.+ 2)) + random.nat) + choice (# ! each (n.% multiplicity) + random.nat) + expected_error (random.ascii/upper 5) + + name ($symbol.random 2 2) + mono $code.random + poly (random.list multiplicity $code.random) + + lux ..random_state + .let [singular (<| (:as Macro) + (: Macro') + (function (_ inputs state) + (case (list.item choice inputs) + {.#Some it} + {try.#Success [state (list it)]} + + {.#None} + {try.#Failure expected_error}))) + multiple (<| (:as Macro) + (: Macro') + (function (_ inputs state) + {try.#Success [state (|> inputs + (list.repeated multiplicity) + list#conjoint)]}))]]) + ($_ _.and + (_.cover [/.expansion] + (|> (/.expansion ..expander name multiple (list mono)) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list.repeated multiplicity mono))) + (try.else false))) + (_.cover [/.expansion_failed] + (|> (/.expansion ..expander name singular (list)) + (meta.result lux) + (case> {try.#Failure it} + (and (text.contains? expected_error it) + (text.contains? (value@ exception.#label /.expansion_failed) it)) + + _ + false))) + (_.cover [/.single_expansion] + (|> (/.single_expansion ..expander name singular poly) + (meta.result lux) + (try#each (code#= (|> poly (list.item choice) maybe.trusted))) + (try.else false))) + (_.cover [/.must_have_single_expansion] + (|> (/.single_expansion ..expander name multiple (list mono)) + (meta.result lux) + (case> {try.#Failure it} + (text.contains? (value@ exception.#label /.must_have_single_expansion) it) + + _ + false))) + ))) -- cgit v1.2.3