From 7d9ba962cbb5c93367df3a0d2cdf3aea3a62c47d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 11 Jan 2022 03:34:19 -0400 Subject: Fixed a bug that broke re-compilation of STDLIB tests in Lua. --- stdlib/source/library/lux.lux | 26 +--- stdlib/source/library/lux/meta.lux | 8 +- .../tool/compiler/language/lux/phase/directive.lux | 26 +++- .../lux/tool/compiler/meta/archive/document.lux | 45 +++---- .../library/lux/tool/compiler/meta/archive/key.lux | 14 +- stdlib/source/test/lux/meta.lux | 142 +++++++++++++-------- stdlib/source/test/lux/tool.lux | 4 +- .../test/lux/tool/compiler/meta/archive/key.lux | 27 ++++ 8 files changed, 183 insertions(+), 109 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/key.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index d65fa7bcb..3fafb38f5 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -825,19 +825,6 @@ (failure "Wrong syntax for $'")} tokens)) -... (def:'' .private (list#each f xs) -... {#UnivQ {#End} -... {#UnivQ {#End} -... {#Function {#Function {#Parameter 3} {#Parameter 1}} -... {#Function ($' List {#Parameter 3}) -... ($' List {#Parameter 1})}}}} -... ({{#End} -... {#End} - -... {#Item x xs'} -... {#Item (f x) (list#each f xs')}} -... xs)) - (def:'' .private (list#mix f init xs) ... (All (_ a b) (-> (-> b a a) a (List b) a)) {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} @@ -1320,12 +1307,9 @@ (def:''' .private (list#composite xs ys) (All (_ a) (-> ($' List a) ($' List a) ($' List a))) - ({{#Item x xs'} - {#Item x (list#composite xs' ys)} - - {#End} - ys} - xs)) + (list#mix (function' [head tail] {#Item head tail}) + ys + (list#reversed xs))) (def:''' .private (right_associativity op a1 a2) (-> Code Code Code Code) @@ -3993,7 +3977,7 @@ (def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) (do meta_monad - [current_module current_module_name + [current_module ..current_module_name .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module_name all_defs referred_defs) (monad#each meta_monad @@ -4804,7 +4788,7 @@ (macro: .public (using _imports) (do meta_monad - [current_module current_module_name + [current_module ..current_module_name imports (imports_parser #0 current_module {#End} _imports) .let [=imports (|> imports (list#each (: (-> Importation Code) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index a32be80ad..d16ca46b9 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -550,10 +550,10 @@ ..current_module)) (template [ ] - [(def: .public ( tag_name) + [(def: .public ( label_name) (-> Symbol (Meta [Nat (List Symbol) Type])) (do ..monad - [.let [[module name] tag_name] + [.let [[module name] label_name] =module (..module module) this_module_name ..current_module_name] (case (plist.value name (value@ .#definitions =module)) @@ -561,11 +561,11 @@ (if (or (text#= this_module_name module) exported?) (in [idx (list#each (|>> [module]) group) type]) - (..failure ($_ text#composite "Cannot access " ": " (symbol#encoded tag_name) " from module " this_module_name))) + (..failure ($_ text#composite "Cannot access " ": " (symbol#encoded label_name) " from module " this_module_name))) _ (..failure ($_ text#composite - "Unknown " ": " (symbol#encoded tag_name))))))] + "Unknown " ": " (symbol#encoded label_name))))))] [tag .#Tag "tag"] [slot .#Slot "slot"] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index 110b76a3d..23123a8c5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -17,7 +17,7 @@ ["[1][0]" analysis ["[1]/[0]" type]] ["/[1]" // "_" - ["/" directive {"+" Phase}] + ["/" directive {"+" Operation Phase}] ["[1][0]" analysis ["[0]" evaluation] ["[1]/[0]" macro {"+" Expander}]] @@ -54,6 +54,26 @@ {try.#Failure error} {try.#Failure error}))) +(def: (requiring phase archive expansion) + (All (_ anchor expression directive) + (-> (Phase anchor expression directive) Archive (List Code) + (Operation anchor expression directive /.Requirements))) + (function (_ state) + (loop [state state + input expansion + output /.no_requirements] + (case input + {.#End} + {try.#Success [state output]} + + {.#Item head tail} + (case (phase archive head state) + {try.#Success [state' head']} + (again state' tail (/.merge_requirements head' output)) + + {try.#Failure error} + {try.#Failure error}))))) + (with_expansions [ (as_is [|form_location| {.#Form (list& [|text_location| {.#Text "lux def module"}] annotations)}])] (def: .public (phase wrapper expander) (-> //.Wrapper Expander Phase) @@ -99,9 +119,7 @@ (# ! each (revised@ /.#referrals (list#composite referrals)))) _ - (|> expansion - (monad.each ! (again archive)) - (# ! each (list#mix /.merge_requirements /.no_requirements))))) + (..requiring again archive expansion))) _ (//.except ..not_a_directive code))))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux index b9b2ec192..1171852cb 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -1,24 +1,24 @@ (.using - [library - [lux {"-" Module} - [abstract - [monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["<>" parser - [binary {"+" Parser}]]] - [data - [collection - ["[0]" dictionary {"+" Dictionary}]] - [format - ["[0]" binary {"+" Writer}]]] - [type {"+" :sharing} - abstract]]] - [// - ["[0]" signature {"+" Signature}] - ["[0]" key {"+" Key}] - [descriptor {"+" Module}]]) + [library + [lux {"-" Module} + [abstract + [monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + [binary {"+" Parser}]]] + [data + [collection + ["[0]" dictionary {"+" Dictionary}]] + [format + ["[0]" binary {"+" Writer}]]] + [type {"+" :sharing} + abstract]]] + [// + ["[0]" signature {"+" Signature}] + ["[0]" key {"+" Key}] + [descriptor {"+" Module}]]) (exception: .public (invalid_signature [expected Signature actual Signature]) @@ -63,8 +63,9 @@ (def: .public (writer content) (All (_ d) (-> (Writer d) (Writer (Document d)))) - (let [writer (binary.and signature.writer - content)] + (let [writer ($_ binary.and + signature.writer + content)] (|>> :representation writer))) (def: .public parser diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux index 7c3be5e1b..a124fae6a 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux @@ -1,16 +1,16 @@ (.using - [library - [lux "*" - [type - abstract]]] - [// - [signature {"+" Signature}]]) + [library + [lux "*" + [type + abstract]]] + [// + [signature {"+" Signature}]]) (abstract: .public (Key k) Signature (def: .public signature - (-> (Key Any) Signature) + (All (_ ?) (-> (Key ?) Signature)) (|>> :representation)) (def: .public (key signature sample) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index f950abaa0..914e02d92 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -1,38 +1,38 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - ["[0]" type ("[1]#[0]" equivalence)] - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad]]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try} ("[1]#[0]" functor)]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor monoid)] - ["[0]" set]]] - [meta - ["[0]" location] - ["[0]" symbol ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]] - ["[0]" / "_" - ["[1][0]" location] - ["[1][0]" symbol]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + [equivalence {"+" Equivalence}] + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad]]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try} ("[1]#[0]" functor)]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor monoid)] + ["[0]" set]]] + [meta + ["[0]" location] + ["[0]" symbol ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" location] + ["[1][0]" symbol]]) (template: (!expect ) [(case @@ -159,6 +159,16 @@ (!expect (^multi {try.#Success actual} (n.= expected actual)))) )) + (_.cover [/.try] + (and (|> (/.try (/.failure expected_error)) + (/.result expected_lux) + (!expect (^multi {try.#Success {try.#Failure actual_error}} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.try (# /.monad in expected)) + (/.result expected_lux) + (!expect (^multi {try.#Success {try.#Success actual}} + (same? expected actual)))))) ))) (def: module_related @@ -310,6 +320,11 @@ .#eval (:as (-> Type Code (Meta Any)) []) .#host []]]] ($_ _.and + (_.cover [/.target] + (|> /.target + (/.result expected_lux) + (try#each (same? target)) + (try.else false))) (_.cover [/.seed] (|> (do /.monad [pre /.seed @@ -623,18 +638,18 @@ alias!))) ))) -(def: tags_related +(def: label_related Test (do [! random.monad] [current_module (random.ascii/upper 1) - tag_module (random.only (|>> (text#= current_module) not) - (random.ascii/upper 1)) + label_module (random.only (|>> (text#= current_module) not) + (random.ascii/upper 1)) name_0 (random.ascii/upper 1) name_1 (random.only (|>> (text#= name_0) not) (random.ascii/upper 1)) - .let [random_tag (# ! each (|>> [tag_module]) + .let [random_tag (# ! each (|>> [label_module]) (random.ascii/upper 1)) random_labels (: (Random [Text (List Text)]) (do ! @@ -665,18 +680,18 @@ [.#module_hash 0 .#module_aliases (list) .#definitions (list) - .#imports (list tag_module) + .#imports (list label_module) .#module_state {.#Active}]] - [tag_module + [label_module [.#module_hash 0 .#module_aliases (list) - .#definitions (list& [name_0 {.#Type [false type_0 {.#Left tags_0}]}] + .#definitions (list& [name_0 {.#Type [true type_0 {.#Left tags_0}]}] [name_1 {.#Type [true type_1 {.#Right tags_1}]}] ($_ list#composite (|> {.#Item tags_0} list.enumeration (list#each (function (_ [index short]) - [short {.#Tag [false type_0 {.#Item tags_0} index]}]))) + [short {.#Tag [true type_0 {.#Item tags_0} index]}]))) (|> {.#Item tags_1} list.enumeration (list#each (function (_ [index short]) @@ -699,21 +714,47 @@ (product.equivalence (list.equivalence symbol.equivalence) type.equivalence))] - (|> (/.tag_lists tag_module) + (|> (/.tag_lists label_module) (/.result expected_lux) - (try#each (# equivalence = (list [(list#each (|>> [tag_module]) {.#Item tags_1}) + (try#each (# equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0}) + type_0] + [(list#each (|>> [label_module]) {.#Item tags_1}) type_1]))) (try.else false)))) (_.cover [/.tags_of] - (|> (/.tags_of [tag_module name_1]) + (|> (/.tags_of [label_module name_1]) (/.result expected_lux) - (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})})) + (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})})) (try.else false))) + (_.cover [/.tag] + (|> {.#Item tags_0} + list.enumeration + (list.every? (function (_ [expected_index label]) + (|> [label_module label] + /.tag + (/.result expected_lux) + (!expect (^multi {try.#Success [actual_index actual_tags actual_type]} + (let [correct_index! + (n.= expected_index + actual_index) + + correct_tags! + (# (list.equivalence symbol.equivalence) = + (list#each (|>> [label_module]) {.#Item tags_0}) + actual_tags) + + correct_type! + (type#= type_0 + actual_type)] + (and correct_index! + correct_tags! + correct_type!)))) + ))))) (_.cover [/.slot] (|> {.#Item tags_1} list.enumeration - (list.every? (function (_ [expected_index tag]) - (|> [tag_module tag] + (list.every? (function (_ [expected_index label]) + (|> [label_module label] /.slot (/.result expected_lux) (!expect (^multi {try.#Success [actual_index actual_tags actual_type]} @@ -723,7 +764,7 @@ correct_tags! (# (list.equivalence symbol.equivalence) = - (list#each (|>> [tag_module]) {.#Item tags_1}) + (list#each (|>> [label_module]) {.#Item tags_1}) actual_tags) correct_type! @@ -943,8 +984,9 @@ ..context_related ..definition_related ..search_related - ..tags_related ..locals_related + (_.for [.Label] + ..label_related) )) /location.test diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 761192245..c60d3ba2d 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -20,7 +20,8 @@ ]] ["[1][0]" meta "_" ["[1]/[0]" archive "_" - ["[1]/[0]" signature]]] + ["[1]/[0]" signature] + ["[1]/[0]" key]]] ]]) (def: .public test @@ -33,6 +34,7 @@ /analysis/composite.test /analysis/pattern.test /meta/archive/signature.test + /meta/archive/key.test ... /syntax.test ... /analysis.test ... /synthesis.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux new file mode 100644 index 000000000..45d29931d --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux @@ -0,0 +1,27 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]] + ["[0]" // "_" + ["[1][0]" signature]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Key]) + (do random.monad + [expected //signature.random + document random.nat] + ($_ _.and + (_.cover [/.key /.signature] + (|> document + (/.key expected) + /.signature + (same? expected))) + )))) -- cgit v1.2.3