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 +++---- 5 files changed, 61 insertions(+), 58 deletions(-) (limited to 'stdlib/source/library') 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) -- cgit v1.2.3