diff options
author | Eduardo Julian | 2022-01-18 00:20:50 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-01-18 00:20:50 -0400 |
commit | fc854233d2af07ed44a063a75a6900cc02616c74 (patch) | |
tree | a62ce49314d2101cd77112eee54081153448836e /stdlib/source | |
parent | e1af5374ba4d969f866867db47af7ecf60cc9933 (diff) |
Fixes for the pure-Lux JVM compiler machinery. [Part 7]
Diffstat (limited to '')
9 files changed, 398 insertions, 90 deletions
diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index 027174fd1..f4f664878 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -61,7 +61,7 @@ (def: .public <constructor> (-> Int (Try <name>)) (let [positive (:representation <maximum>) - negative (|> <bytes> (n.* i64.bits_per_byte) i64.mask i64.not)] + negative (i64.not positive)] (function (_ value) (if (i.= (if (i.< +0 value) (i64.or negative value) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 22cad3f00..eb3c30c2f 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -117,7 +117,8 @@ GVar (..global <ruby_name>))] - ["@" latest_error] + ["!" latest_error_message] + ["@" latest_error_location] ["_" last_string_read] ["." last_line_number_read] ["&" last_string_matched] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux index 84a4838b9..568e061a6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux @@ -94,14 +94,14 @@ (def: .public (install extender name handler) (All (_ s i o) - (-> (Extender s i o) Text (Handler s i o) (Operation s i o Any))) + (-> (Extender s i o) Name (Handler s i o) (Operation s i o Any))) (function (_ [bundle state]) - (case (dictionary.value name bundle) - {.#None} - {try.#Success [[(dictionary.has name (extender handler) bundle) state] + (case (dictionary.has' name (extender handler) bundle) + {try.#Success bundle'} + {try.#Success [[bundle' state] []]} - _ + {try.#Failure _} (exception.except ..cannot_overwrite name)))) (def: .public (with extender extensions) @@ -172,8 +172,7 @@ (def: .public (lifted action) (All (_ s i o v) - (-> (//.Operation s v) - (//.Operation [(Bundle s i o) s] v))) + (-> (//.Operation s v) (Operation s i o v))) (function (_ [bundle state]) (case (action state) {try.#Success [state' output]} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 25e88f063..aa59d8b01 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -118,7 +118,7 @@ ($_ _.composite (_.set_label @branch) branchG - (_.goto @end))]))) + (_.when_continuous (_.goto @end)))]))) conditionalsS)) .let [table (|> conditionalsG+ (list#each product.left) @@ -134,7 +134,8 @@ conditionalsG (_.set_label @else) elseG - (_.set_label @end) + (<| (_.when_acknowledged @end) + (_.set_label @end)) )))))])) (def: (lux::is [referenceG sampleG]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index e93e347e1..bd202b113 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -25,30 +25,30 @@ ... [file-name, line, column] to keep track of their provenance and ... location, which is helpful for documentation and debugging. (.using - [library - [lux "*" - ["@" target] - [abstract - monad] - [control - ["[0]" maybe] - ["[0]" exception {"+" exception:}] - [parser - [text {"+" Offset}]]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list] - ["[0]" dictionary {"+" Dictionary}]]] - [macro - ["[0]" template]] - [math - [number - ["n" nat] - ["[0]" int] - ["[0]" rev] - ["[0]" frac]]]]]) + [library + [lux "*" + ["@" target] + [abstract + monad] + [control + ["[0]" maybe] + ["[0]" exception {"+" exception:}] + [parser + [text {"+" Offset}]]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list] + ["[0]" dictionary {"+" Dictionary}]]] + [macro + ["[0]" template]] + [math + [number + ["n" nat] + ["[0]" int] + ["[0]" rev] + ["[0]" frac]]]]]) (template: (inline: <declaration> <type> <body>) [(for [@.python (def: <declaration> <type> <body>) @@ -583,5 +583,5 @@ ... Symbol (!full_symbol_parser offset/0 [<consume_1>] where aliases .#Symbol)) ))) - ))) - )) + )))) + ) diff --git a/stdlib/source/test/lux/math/number.lux b/stdlib/source/test/lux/math/number.lux index 94849f0c0..beaa84aa6 100644 --- a/stdlib/source/test/lux/math/number.lux +++ b/stdlib/source/test/lux/math/number.lux @@ -41,16 +41,14 @@ {try.#Failure error} false)] - [n.= n.binary "11001001"] [n.= n.binary "11,00,10,01"] - [i.= i.binary "+11001001"] + [i.= i.binary "+11,00,10,01"] [i.= i.binary "-11,00,10,01"] - [r.= r.binary ".11001001"] [r.= r.binary ".11,00,10,01"] - [f.= f.binary "+1100.1001"] + [f.= f.binary "+11,00.10,01"] [f.= f.binary "-11,00.10,01"] ))))) (_.cover [/.oct] @@ -62,16 +60,14 @@ {try.#Failure error} false)] - [n.= n.octal "615243"] [n.= n.octal "615,243"] - [i.= i.octal "+615243"] + [i.= i.octal "+615,243"] [i.= i.octal "-615,243"] - [r.= r.octal ".615243"] [r.= r.octal ".615,243"] - [f.= f.octal "+6152.43"] + [f.= f.octal "+61,52.43"] [f.= f.octal "-61,52.43"] ))))) (_.cover [/.hex] @@ -83,16 +79,14 @@ {try.#Failure error} false)] - [n.= n.hex "deadBEEF"] [n.= n.hex "dead,BEEF"] - [i.= i.hex "+deadBEEF"] + [i.= i.hex "+dead,BEEF"] [i.= i.hex "-dead,BEEF"] - [r.= r.hex ".deadBEEF"] [r.= r.hex ".dead,BEEF"] - [f.= f.hex "+dead.BEEF"] + [f.= f.hex "+dead,BE.EF"] [f.= f.hex "-dead,BE.EF"] ))))) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index d48e16ecb..5e2cecbde 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -9,6 +9,7 @@ [\\specification ["$[0]" equivalence]]] [control + [pipe {"+" case>}] ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try} ("[1]#[0]" functor)]] [data @@ -20,7 +21,7 @@ ["[0]" set]]] ["[0]" math ["[0]" random {"+" Random} ("[1]#[0]" monad)] - [number + [number {"+" hex} ["n" nat] ["i" int] ["f" frac] @@ -46,6 +47,14 @@ (maybe.else false))) (try.else false))) +(def: nil + (-> /.Expression Bit) + (|>> /.code + ..eval + (try#each (|>> (case> {.#None} true + {.#Some _} false))) + (try.else false))) + (def: test|literal Test (do [! random.monad] @@ -55,14 +64,7 @@ string (random.ascii/upper 5)] ($_ _.and (_.cover [/.nil] - (|> /.nil - /.code - ..eval - (try#each (function (_ it) - (case it - {.#None} true - {.#Some _} false))) - (try.else false))) + (..nil /.nil)) (_.cover [/.bool] (expression (|>> (:as Bit) (bit#= bool)) (/.bool bool))) @@ -398,6 +400,22 @@ (/.return $output)) [(list $input)] (/.lambda {.#None}) (/.apply_lambda/* (list (/.int input))))))) + (_.cover [/.redo] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (|> ($_ /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + ($_ /.then + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.redo) + (/.set (list $output) (/.+ $input $output)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input))))))) ))) (def: test|loop @@ -435,17 +453,23 @@ ..test|label ))) +(def: random_tag + (Random Int) + (random#each (i64.and (hex "FF,FF,FF,FF")) + random.int)) + (def: test|exception Test (do [! random.monad] [expected random.safe_frac dummy (random.only (|>> (f.= expected) not) random.safe_frac) + error (random.ascii/lower 10) $ex (# ! each /.local (random.ascii/lower 10)) - expected_tag random.int + expected_tag ..random_tag dummy_tag (random.only (|>> (i.= expected_tag) not) - random.int) + ..random_tag) .let [expected_tag (/.int expected_tag) dummy_tag (/.int dummy_tag)]] ($_ _.and @@ -458,7 +482,7 @@ (_.cover [/.Rescue /.throw/1] (expression (|>> (:as Frac) (f.= expected)) (|> (/.begin ($_ /.then - (/.throw/1 (/.string "")) + (/.throw/1 (/.string error)) (/.return (/.float dummy))) (list [(list) $ex (/.return (/.float expected))])) [(list)] (/.lambda {.#None}) @@ -466,7 +490,7 @@ (_.cover [/.raise] (expression (|>> (:as Frac) (f.= expected)) (|> (/.begin ($_ /.then - (/.statement (/.raise (/.string ""))) + (/.statement (/.raise (/.string error))) (/.return (/.float dummy))) (list [(list) $ex (/.return (/.float expected))])) [(list)] (/.lambda {.#None}) @@ -492,6 +516,28 @@ (/.catch dummy_tag) [(list)] /.statement (/.catch expected_tag) [(list)] (/.throw/2 expected_tag (/.float expected)))))) + (_.cover [/.latest_error_message] + (expression (|>> (:as Text) (text#= error)) + (|> (/.begin ($_ /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.the "message" /.latest_error_message))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.latest_error_location] + (and (|> (/.return /.latest_error_location) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)) + ..nil) + (expression (|>> (:as Bit) (bit#= true)) + (|> (/.begin ($_ /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return ($_ /.and + (/.do "kind_of?" (list (/.local "Array")) {.#None} /.latest_error_location) + (/.> (/.int +0) (/.the "length" /.latest_error_location))))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) ))) (def: test|function @@ -625,30 +671,30 @@ (def: test|global Test - ($_ _.and - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (:as Text) - (predicate.or (text.ends_with? file) - (text#= "<script>")))) - /.script_name)) - (_.cover [/.input_record_separator] - (expression (|>> (:as Text) - (text#= text.\n)) - /.input_record_separator)) - (_.cover [/.output_record_separator] - (|> /.output_record_separator - /.code - ..eval - (try#each (function (_ it) - (case it - {.#None} true - {.#Some _} false))) - (try.else false))) - (_.cover [/.process_id] - (expression (|>> (:as Nat) (n.= 0) not) - /.process_id)) - )) + (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) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 736c8757c..99db7ef1a 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -15,10 +15,11 @@ ["[1]/[0]" simple] ["[1]/[0]" composite] ["[1]/[0]" pattern]] - ... [phase - ... ["[1][0]" analysis] - ... ["[1][0]" synthesis]] - ]] + ["[1][0]" phase "_" + ["[1]/[0]" extension] + ... ["[1]/[0]" analysis] + ... ["[1]/[0]" synthesis] + ]]] ["[1][0]" meta "_" ["[1]/[0]" archive "_" ["[1]/[0]" signature] @@ -39,6 +40,7 @@ /meta/archive/signature.test /meta/archive/key.test /meta/archive/document.test + /phase/extension.test ... /syntax.test ... /analysis.test ... /synthesis.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux new file mode 100644 index 000000000..517d5eb57 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux @@ -0,0 +1,265 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash]]] + [control + [pipe {"+" case>}] + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" dictionary] + ["[0]" list ("[1]#[0]" mix)]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" / + [///// + ["[0]" phase] + [meta + ["[0]" archive]]]]]) + +(def: .public random + (Random (/.Extension Nat)) + ($_ random.and + (random.ascii/lower 5) + (random.list 2 random.nat) + )) + +(def: test|state + Test + (do [! random.monad] + [state random.int + dummy (random.only (|>> (i.= state) not) + random.int)] + ($_ _.and + (_.cover [/.read] + (|> (: (/.Operation Int Nat Nat Text) + (/.read %.int)) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.update] + (|> (: (/.Operation Int Nat Nat Text) + (do phase.monad + [_ (/.update ++)] + (/.read %.int))) + (# phase.functor each (text#= (%.int (++ state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.temporary] + (|> (: (/.Operation Int Nat Nat Text) + (do phase.monad + [|state'| (/.temporary ++ (/.read %.int)) + |state| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.with_state] + (|> (: (/.Operation Int Nat Nat Text) + (/.with_state state + (/.read %.int))) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state dummy]) + (try.else false))) + (_.cover [/.localized] + (|> (: (/.Operation Int Nat Nat Text) + (do phase.monad + [|state| (/.localized %.int + (function (_ _ old) (++ old)) + (text.enclosed ["<" ">"]) + (/.read %.int)) + |state'| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (i.+ +2 state)) + " " (%.int (i.+ +1 state))))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) + )) + +(def: extender + /.Extender + (|>> :expected)) + +(def: handler/0 + (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (# phase.monad in (list#mix n.+ 0 inputs)))) + +(def: handler/1 + (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (# phase.monad in (list#mix n.* 1 inputs)))) + +(def: test|name + Test + (do [! random.monad] + [state random.int + extension (random.ascii/lower 1) + left random.nat + right random.nat] + ($_ _.and + (_.cover [/.cannot_overwrite] + (|> (do phase.monad + [_ (/.install extender extension handler/0)] + (/.install extender extension handler/1)) + (phase.result [/.#bundle /.empty + /.#state state]) + (case> {try.#Failure error} + (exception.match? /.cannot_overwrite error) + + _ + false))) + (_.cover [/.unknown] + (|> (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)]) + (phase.result [/.#bundle /.empty + /.#state state]) + (case> {try.#Failure error} + (exception.match? /.unknown error) + + _ + false))) + ))) + +(def: test|bundle + Test + (let [phase (: (/.Phase Int Nat Nat) + (function (_ archive input) + (# phase.monad in (++ input))))] + (do [! random.monad] + [state random.int + + extension (random.ascii/lower 1) + left random.nat + right random.nat] + ($_ _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (<| (_.for [/.Extender /.Handler]) + ($_ _.and + (_.cover [/.install /.apply] + (|> (do phase.monad + [_ (/.install extender extension handler/0)] + (/.apply archive.empty phase [extension (list left right)])) + (# phase.functor each (n.= (n.+ left right))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.Phase] + (let [handler (: (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (let [! phase.monad] + (|> inputs + (monad.each ! (phase archive)) + (# ! each (list#mix n.+ 0))))))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (# phase.functor each (n.= (n.+ (++ left) (++ right)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) + (_.cover [/.with] + (|> (do phase.monad + [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))] + (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)])) + (# phase.functor each (n.= (n.* left right))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.incorrect_arity] + (let [handler (: (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (case> {try.#Failure error} + (exception.match? /.incorrect_arity error) + + _ + false)))) + (_.cover [/.invalid_syntax] + (let [handler (: (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.invalid_syntax [@self %.nat inputs])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (case> {try.#Failure error} + (exception.match? /.invalid_syntax error) + + _ + false)))) + (_.for [/.Name] + ..test|name) + )) + )))) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Extension]) + (do [! random.monad] + [state random.int + dummy (random.only (|>> (i.= state) not) + random.int) + expected random.nat + expected_error (random.ascii/lower 1)] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) ..random)) + (_.for [/.hash] + ($hash.spec (/.hash n.hash) ..random)) + + (<| (_.for [/.Operation]) + ($_ _.and + (_.cover [/.lifted] + (and (|> (: (/.Operation Int Nat Nat Nat) + (/.lifted (do phase.monad + [] + (in expected)))) + (# phase.functor each (same? expected)) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)) + (|> (: (/.Operation Int Nat Nat Nat) + (/.lifted (phase.lifted {try.#Failure expected_error}))) + (phase.result [/.#bundle /.empty + /.#state state]) + (case> {try.#Failure actual_error} + (same? expected_error actual_error) + + _ + false)))) + )) + (_.for [/.State] + ..test|state) + (_.for [/.Bundle] + ..test|bundle) + )))) |