From 0797dfc9ebb32e5eb324eec58e1e4b1c99895ce7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 14 Sep 2021 01:26:29 -0400 Subject: Re-named "Name" to "Symbol". --- stdlib/source/library/lux.lux | 114 ++++++++++----------- .../source/library/lux/abstract/monad/indexed.lux | 4 +- .../library/lux/control/concurrency/actor.lux | 2 +- .../source/library/lux/control/parser/analysis.lux | 5 +- .../source/library/lux/control/parser/binary.lux | 8 +- stdlib/source/library/lux/control/parser/code.lux | 19 ++-- .../library/lux/control/parser/synthesis.lux | 5 +- stdlib/source/library/lux/control/parser/type.lux | 2 +- stdlib/source/library/lux/control/parser/xml.lux | 7 +- .../library/lux/control/security/capability.lux | 2 +- stdlib/source/library/lux/control/try.lux | 2 +- stdlib/source/library/lux/data/format/binary.lux | 8 +- stdlib/source/library/lux/data/format/tar.lux | 2 +- stdlib/source/library/lux/data/format/xml.lux | 23 +++-- stdlib/source/library/lux/data/name.lux | 62 ----------- stdlib/source/library/lux/data/text/format.lux | 6 +- stdlib/source/library/lux/data/text/regex.lux | 34 +++--- stdlib/source/library/lux/debug.lux | 2 +- stdlib/source/library/lux/documentation.lux | 14 +-- stdlib/source/library/lux/ffi.jvm.lux | 2 +- stdlib/source/library/lux/ffi.old.lux | 2 +- stdlib/source/library/lux/macro.lux | 10 +- stdlib/source/library/lux/macro/code.lux | 12 +-- stdlib/source/library/lux/macro/local.lux | 11 +- .../source/library/lux/macro/syntax/definition.lux | 1 - stdlib/source/library/lux/macro/template.lux | 6 +- stdlib/source/library/lux/meta.lux | 55 +++++----- stdlib/source/library/lux/meta/symbol.lux | 62 +++++++++++ stdlib/source/library/lux/target/jvm/bytecode.lux | 4 +- .../library/lux/target/jvm/encoding/unsigned.lux | 8 +- stdlib/source/library/lux/test.lux | 52 +++++----- .../library/lux/tool/compiler/language/lux.lux | 4 - .../tool/compiler/language/lux/analysis/macro.lux | 12 +-- .../lux/tool/compiler/language/lux/generation.lux | 13 +-- .../language/lux/phase/analysis/module.lux | 14 +-- .../language/lux/phase/analysis/reference.lux | 12 +-- .../language/lux/phase/analysis/structure.lux | 21 ++-- .../tool/compiler/language/lux/phase/directive.lux | 4 +- .../tool/compiler/language/lux/phase/extension.lux | 2 +- .../language/lux/phase/extension/analysis/lux.lux | 4 +- .../language/lux/phase/extension/directive/lux.lux | 18 ++-- .../language/lux/phase/generation/jvm/host.lux | 2 +- .../lux/phase/generation/jvm/reference.lux | 2 +- .../lux/tool/compiler/language/lux/syntax.lux | 108 +++++++++---------- .../library/lux/tool/compiler/meta/archive.lux | 1 - .../lux/tool/compiler/meta/archive/signature.lux | 11 +- stdlib/source/library/lux/tool/compiler/phase.lux | 4 +- .../source/library/lux/tool/compiler/reference.lux | 13 +-- stdlib/source/library/lux/type.lux | 10 +- stdlib/source/library/lux/type/abstract.lux | 15 +-- stdlib/source/library/lux/type/implicit.lux | 30 +++--- stdlib/source/library/lux/type/unit.lux | 4 +- 52 files changed, 428 insertions(+), 422 deletions(-) delete mode 100644 stdlib/source/library/lux/data/name.lux create mode 100644 stdlib/source/library/lux/meta/symbol.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9aed7e4de..f3f3601d3 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -108,10 +108,10 @@ {0 #0 "#Text" {#End}}}) #1) -("lux def" Name +("lux def" Symbol ("lux type check type" {9 #1 - [..prelude_module "Name"] + [..prelude_module "Symbol"] {2 #0 Text Text}}) #1) @@ -144,7 +144,7 @@ ... {#UnivQ (List Type) Type} ... {#ExQ (List Type) Type} ... {#Apply Type Type} -... {#Named Name Type}))) +... {#Named Symbol Type}))) ("lux def type tagged" Type {9 #1 [..prelude_module "Type"] ({Type @@ -185,7 +185,7 @@ ... Apply Type_Pair ... Named - {2 #0 Name Type}}}}}}}}}}}}}} + {2 #0 Symbol Type}}}}}}}}}}}}}} ("lux type check type" {2 #0 Type Type}))} ("lux type check type" {9 #0 Type List}))} ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))} @@ -224,7 +224,7 @@ ... {#Rev Rev} ... {#Frac Frac} ... {#Text Text} -... {#Identifier Name} +... {#Identifier Symbol} ... {#Form (List (w (Code' w)))} ... {#Variant (List (w (Code' w)))} ... {#Tuple (List (w (Code' w)))}) @@ -253,7 +253,7 @@ Text {#Sum ... Identifier - Name + Symbol {#Sum ... Form Code_List @@ -336,7 +336,7 @@ #0) ("lux def" identifier$ - ("lux type check" {#Function Name Code} + ("lux type check" {#Function Symbol Code} ([_ name] (_ann {#Identifier name}))) #0) @@ -369,11 +369,11 @@ .public) ... (type: .public Alias -... Name) +... Symbol) ("lux def" Alias ("lux type check type" {#Named [..prelude_module "Alias"] - Name}) + Symbol}) .public) ... (type: .public Label @@ -1489,15 +1489,15 @@ (-> Text Text Text) ("lux text concat" x y)) -(def:''' .private (name#encoded full_name) - (-> Name Text) +(def:''' .private (symbol#encoded full_name) + (-> Symbol Text) (let' [[module name] full_name] ({"" name _ ($_ text#composite module "." name)} module))) (def:''' .private (global_identifier full_name state) - (-> Name ($' Meta Name)) + (-> Symbol ($' Meta Symbol)) (let' [[module name] full_name [#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host @@ -1515,11 +1515,11 @@ constant) {#None} - {#Left ($_ text#composite "Unknown definition: " (name#encoded full_name))}} + {#Left ($_ text#composite "Unknown definition: " (symbol#encoded full_name))}} (plist#value name definitions)) {#None} - {#Left ($_ text#composite "Unknown module: " module " @ " (name#encoded full_name))}} + {#Left ($_ text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} (plist#value module modules)))) (def:''' .private (:List expression) @@ -1752,7 +1752,7 @@ (function' [x] (f (g x)))) (def:''' .private (identifier_name x) - (-> Code ($' Maybe Name)) + (-> Code ($' Maybe Symbol)) ({[_ {#Identifier sname}] {#Some sname} @@ -1993,7 +1993,7 @@ ("lux type check" Global gdef)))) (def:''' .private (normal name) - (-> Name ($' Meta Name)) + (-> Symbol ($' Meta Symbol)) ({["" name] (do meta_monad [module_name current_module_name] @@ -2004,7 +2004,7 @@ name)) (def:''' .private (macro' full_name) - (-> Name ($' Meta ($' Maybe Macro))) + (-> Symbol ($' Meta ($' Maybe Macro))) (do meta_monad [current_module current_module_name] (let' [[module name] full_name] @@ -2018,7 +2018,7 @@ state))))) (def:''' .private (macro? name) - (-> Name ($' Meta Bit)) + (-> Symbol ($' Meta Bit)) (do meta_monad [name (normal name) output (macro' name)] @@ -2843,7 +2843,7 @@ {#Left ($_ text#composite "Unknown module: " name)})))) (def: (type_slot [module name]) - (-> Name (Meta [Nat (List Name) Bit Type])) + (-> Symbol (Meta [Nat (List Symbol) Bit Type])) (do meta_monad [=module (..module module) .let [[#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_state _] =module]] @@ -2857,10 +2857,10 @@ type]) _ - (failure (text#composite "Unknown slot: " (name#encoded [module name])))))) + (failure (text#composite "Unknown slot: " (symbol#encoded [module name])))))) (def: (record_slots type) - (-> Type (Meta (Maybe [(List Name) (List Type)]))) + (-> Type (Meta (Maybe [(List Symbol) (List Type)]))) (case type {#Apply arg func} (record_slots func) @@ -2949,7 +2949,7 @@ ")")) {#Named name _} - (name#encoded name) + (symbol#encoded name) )) (macro: .public (implementation tokens) @@ -2957,7 +2957,7 @@ [tokens' (monad#each meta_monad expansion tokens) struct_type ..expected_type tags+type (record_slots struct_type) - tags (: (Meta (List Name)) + tags (: (Meta (List Symbol)) (case tags+type {#Some [tags _]} (in_meta tags) @@ -3595,7 +3595,7 @@ scopes))) (def: (definition_type name state) - (-> Name Lux (Maybe Type)) + (-> Symbol Lux (Maybe Type)) (let [[v_module v_name] name [#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host @@ -3628,7 +3628,7 @@ {#None}))))) (def: (definition_value name state) - (-> Name (Meta [Type Any])) + (-> Symbol (Meta [Type Any])) (let [[v_module v_name] name [#info info #source source #current_module _ #modules modules #scopes scopes #type_context types #host host @@ -3636,12 +3636,12 @@ #scope_type_vars scope_type_vars #eval _eval] state] (case (plist#value v_module modules) {#None} - {#Left (text#composite "Unknown definition: " (name#encoded name))} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Some [#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_state _]} (case (plist#value v_name definitions) {#None} - {#Left (text#composite "Unknown definition: " (name#encoded name))} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Some definition} (case definition @@ -3655,10 +3655,10 @@ {#Right [state [..Type type]]} {#Tag _} - {#Left (text#composite "Unknown definition: " (name#encoded name))} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Slot _} - {#Left (text#composite "Unknown definition: " (name#encoded name))}))))) + {#Left (text#composite "Unknown definition: " (symbol#encoded name))}))))) (def: (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) @@ -3672,7 +3672,7 @@ (type_variable idx bindings')))) (def: (type_definition full_name) - (-> Name (Meta Type)) + (-> Symbol (Meta Type)) (do meta_monad [.let [[module name] full_name] current_module current_module_name] @@ -3688,13 +3688,13 @@ {#Right [compiler struct_type]} _ - {#Left ($_ text#composite "Unknown var: " (name#encoded full_name))})) + {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})) (case (definition_type full_name compiler) {#Some struct_type} {#Right [compiler struct_type]} _ - {#Left ($_ text#composite "Unknown var: " (name#encoded full_name))}))] + {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))] (case temp {#Right [compiler {#Var type_id}]} (let [[#info _ #source _ #current_module _ #modules _ @@ -3745,7 +3745,7 @@ {#Some tags&members} (do meta_monad - [full_body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) + [full_body ((: (-> Symbol [(List Symbol) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) (let [locals (list#each (function (_ [t_module t_name]) [[t_module t_name] @@ -3821,7 +3821,7 @@ (case (interface_methods type) {#Some members} (let [pattern (|> (zipped/2 tags (enumeration members)) - (list#each (: (-> [Name [Nat Type]] (List Code)) + (list#each (: (-> [Symbol [Nat Type]] (List Code)) (function (_ [[r_module r_name] [r_idx r_type]]) (list (identifier$ [r_module r_name]) (if ("lux i64 =" idx r_idx) @@ -3851,7 +3851,7 @@ (failure "Wrong syntax for value@"))) (def: (open_declaration alias tags my_tag_index [module short] source type) - (-> Text (List Name) Nat Name Code Type (Meta (List Code))) + (-> Text (List Symbol) Nat Symbol Code Type (Meta (List Code))) (do meta_monad [output (record_slots type) g!_ (..identifier "g!_") @@ -3868,7 +3868,7 @@ {#Some [tags' members']} (do meta_monad [decls' (monad#each meta_monad - (: (-> [Nat Name Type] (Meta (List Code))) + (: (-> [Nat Symbol Type] (Meta (List Code))) (function (_ [sub_tag_index sname stype]) (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] @@ -3891,7 +3891,7 @@ (case output {#Some [tags members]} (do meta_monad - [decls' (monad#each meta_monad (: (-> [Nat Name Type] (Meta (List Code))) + [decls' (monad#each meta_monad (: (-> [Nat Symbol Type] (Meta (List Code))) (function (_ [tag_index sname stype]) (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] @@ -3944,9 +3944,9 @@ _ (failure ($_ text#composite "Wrong syntax for refer @ " current_module \n (|> options - (list#each code#encoded) - (list#interposed " ") - (list#mix text#composite ""))))))) + (list#each code#encoded) + (list#interposed " ") + (list#mix text#composite ""))))))) (def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) @@ -4071,21 +4071,21 @@ {#Some members} (do meta_monad [pattern' (monad#each meta_monad - (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (..identifier "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' - (list#each (: (-> [Name Nat Code] (List Code)) + (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (identifier$ r_slot_name) r_var)))) list#conjoint tuple$) output (|> pattern' - (list#each (: (-> [Name Nat Code] (List Code)) + (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (identifier$ r_slot_name) (if ("lux i64 =" idx r_idx) @@ -4154,21 +4154,21 @@ {#Some members} (do meta_monad [pattern' (monad#each meta_monad - (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (..identifier "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' - (list#each (: (-> [Name Nat Code] (List Code)) + (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (identifier$ r_slot_name) r_var)))) list#conjoint tuple$) output (|> pattern' - (list#each (: (-> [Name Nat Code] (List Code)) + (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (identifier$ r_slot_name) (if ("lux i64 =" idx r_idx) @@ -4314,7 +4314,7 @@ inits (list#each product#right pairs)] (if (every? identifier? inits) (do meta_monad - [inits' (: (Meta (List Name)) + [inits' (: (Meta (List Symbol)) (case (monad#each maybe_monad identifier_name inits) {#Some inits'} (in_meta inits') {#None} (failure "Wrong syntax for loop"))) @@ -4343,8 +4343,8 @@ (case tokens (^ (list& [_ {#Form (list [_ {#Tuple (list& hslot' tslots')}])}] body branches)) (do meta_monad - [slots (: (Meta [Name (List Name)]) - (case (: (Maybe [Name (List Name)]) + [slots (: (Meta [Symbol (List Symbol)]) + (case (: (Maybe [Symbol (List Symbol)]) (do maybe_monad [hslot (..identifier_name hslot') tslots (monad#each maybe_monad ..identifier_name tslots')] @@ -4360,12 +4360,12 @@ output (..type_slot hslot) g!_ (..identifier "_") .let [[idx tags exported? type] output - slot_pairings (list#each (: (-> Name [Text Code]) + slot_pairings (list#each (: (-> Symbol [Text Code]) (function (_ [module name]) [name (local_identifier$ name)])) (list& hslot tslots)) pattern (|> tags - (list#each (: (-> Name (List Code)) + (list#each (: (-> Symbol (List Code)) (function (_ [module name]) (let [tag (identifier$ [module name])] (case (plist#value name slot_pairings) @@ -4438,7 +4438,7 @@ type)) (def: (static_simple_literal name) - (-> Name (Meta Code)) + (-> Symbol (Meta Code)) (do meta_monad [type+value (definition_value name) .let [[type value] type+value]] @@ -4454,7 +4454,7 @@ ["Text" Text text$]) _ - (failure (text#composite "Cannot anti-quote type: " (name#encoded name)))))) + (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name)))))) (def: (static_literal token) (-> Code (Meta Code)) @@ -4571,8 +4571,8 @@ ... currently being defined. That name can then be fed into ... 'wrong_syntax_error' for easier maintenance of the error_messages. (def: wrong_syntax_error - (-> Name Text) - (|>> name#encoded + (-> Symbol Text) + (|>> symbol#encoded (text#composite "Wrong syntax for "))) (macro: .public (name_of tokens) @@ -4762,7 +4762,7 @@ _ (failure ($_ text#composite - "Invalid target platform (must be a value of type Text): " (name#encoded identifier) + "Invalid target platform (must be a value of type Text): " (symbol#encoded identifier) " : " (..code#encoded (..type_code type)))))) _ @@ -4856,7 +4856,7 @@ (failure (..wrong_syntax_error (name_of ..``))))) (def: (name$ [module name]) - (-> Name Code) + (-> Symbol Code) (` [(~ (text$ module)) (~ (text$ name))])) (def: (untemplated_list& last inits) diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index 1382f764d..0d05fa951 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -33,11 +33,11 @@ (type: Context (Variant - {#Macro Name Code} + {#Macro Symbol Code} {#Binding Binding})) (def: global_identifier - (Parser Name) + (Parser Symbol) (//.do <>.monad [[module short] .identifier _ (<>.assertion "" (case module "" false _ true))] diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 49e785923..7bbc5f158 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -303,7 +303,7 @@ .local_identifier))) (def: reference^ - (Parser [Name (List Text)]) + (Parser [Symbol (List Text)]) (<>.either (.form (<>.and .identifier (<>.some .local_identifier))) (<>.and .identifier (# <>.monad in (list))))) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index 61e512c56..b39b7c01d 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -8,7 +8,6 @@ ["[0]" exception {"+" exception:}]] [data ["[0]" bit] - ["[0]" name] ["[0]" text ["%" format {"+" format}]] [collection @@ -22,6 +21,8 @@ ["[0]" int] ["[0]" rev] ["[0]" frac]]] + [meta + ["[0]" symbol]] [tool [compiler [arity {"+" Arity}] @@ -118,7 +119,7 @@ [text text! /.text Text text.equivalence] [local local! /.variable/local Nat nat.equivalence] [foreign foreign! /.variable/foreign Nat nat.equivalence] - [constant constant! /.constant Name name.equivalence] + [constant constant! /.constant Symbol symbol.equivalence] ) (def: .public (tuple parser) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 21f86eb84..2d52aaee3 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -235,8 +235,8 @@ (set.size output)))] (in output))) -(def: .public name - (Parser Name) +(def: .public symbol + (Parser Symbol) (//.and ..text ..text)) (def: .public type @@ -256,7 +256,7 @@ [7 [.#UnivQ] quantified] [8 [.#ExQ] quantified] [9 [.#Apply] pair] - [10 [.#Named] (//.and ..name type)]]))))) + [10 [.#Named] (//.and ..symbol type)]]))))) (def: .public location (Parser Location) @@ -274,7 +274,7 @@ [3 [.#Rev] ..rev] [4 [.#Frac] ..frac] [5 [.#Text] ..text] - [6 [.#Identifier] ..name] + [6 [.#Identifier] ..symbol] [7 [.#Form] sequence] [8 [.#Variant] sequence] [9 [.#Tuple] sequence]])))))) diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index 18953181b..c2ee27afd 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -8,7 +8,6 @@ [data ["[0]" bit] ["[0]" text ("[1]#[0]" monoid)] - ["[0]" name] [collection ["[0]" list ("[1]#[0]" functor)]]] [macro @@ -18,7 +17,9 @@ ["[0]" nat] ["[0]" int] ["[0]" rev] - ["[0]" frac]]]]] + ["[0]" frac]]] + [meta + ["[0]" symbol]]]] ["[0]" //]) (def: (un_paired pairs) @@ -80,13 +81,13 @@ _ ))))] - [bit bit! Bit .#Bit bit.equivalence "bit"] - [nat nat! Nat .#Nat nat.equivalence "nat"] - [int int! Int .#Int int.equivalence "int"] - [rev rev! Rev .#Rev rev.equivalence "rev"] - [frac frac! Frac .#Frac frac.equivalence "frac"] - [text text! Text .#Text text.equivalence "text"] - [identifier identifier! Name .#Identifier name.equivalence "identifier"] + [bit bit! Bit .#Bit bit.equivalence "bit"] + [nat nat! Nat .#Nat nat.equivalence "nat"] + [int int! Int .#Int int.equivalence "int"] + [rev rev! Rev .#Rev rev.equivalence "rev"] + [frac frac! Frac .#Frac frac.equivalence "frac"] + [text text! Text .#Text text.equivalence "text"] + [identifier identifier! Symbol .#Identifier symbol.equivalence "identifier"] ) (def: .public (this! code) diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux index 69e89986e..1e8dff8f2 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -8,7 +8,6 @@ ["[0]" exception {"+" exception:}]] [data ["[0]" bit] - ["[0]" name] ["[0]" text ["%" format {"+" format}]]] [math @@ -16,6 +15,8 @@ ["n" nat] ["[0]" i64] ["[0]" frac]]] + [meta + ["[0]" symbol]] [tool [compiler [reference {"+" } @@ -115,7 +116,7 @@ [text text! /.text Text text.equivalence] [local local! /.variable/local Nat n.equivalence] [foreign foreign! /.variable/foreign Nat n.equivalence] - [constant constant! /.constant Name name.equivalence] + [constant constant! /.constant Symbol symbol.equivalence] ) (def: .public (tuple parser) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 969acde94..11815338e 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -295,7 +295,7 @@ (//.failure (exception.error ..not_existential headT))))) (def: .public named - (Parser [Name Type]) + (Parser [Symbol Type]) (do //.monad [inputT any] (case inputT diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index fa4245354..0fc4ab793 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -7,14 +7,15 @@ ["[0]" try {"+" Try} ("[1]#[0]" functor)] ["[0]" exception {"+" exception:}]] [data - ["[0]" name ("[1]#[0]" equivalence codec)] ["[0]" text ["%" format {"+" format}]] [collection ["[0]" list] ["[0]" dictionary]] [format - ["/" xml {"+" Attribute Attrs Tag XML}]]]]] + ["/" xml {"+" Attribute Attrs Tag XML}]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence codec)]]]] ["[0]" //]) (type: .public (Parser a) @@ -107,7 +108,7 @@ (exception.except ..unexpected_input []) {/.#Node actual attrs' children} - (if (name#= expected actual) + (if (symbol#= expected actual) (|> children (..result' parser attrs') (try#each (|>> [[attrs tail]]))) diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index bcfecf187..f92ae3a75 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -49,7 +49,7 @@ [this_module meta.current_module_name .let [[name vars] declaration] g!brand (# ! each (|>> %.code code.text) - (macro.identifier (format (%.name [this_module name])))) + (macro.identifier (format (%.symbol [this_module name])))) .let [capability (` (..Capability (.Primitive (~ g!brand)) (~ input) (~ output)))]] (in (list (` (type: (~ export_policy) (~ (|declaration|.format declaration)) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index c3822c12e..9567a738e 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -128,7 +128,7 @@ {#Success value} {.#None} - {#Failure (`` (("lux in-module" (~~ (static .prelude_module)) .name#encoded) + {#Failure (`` (("lux in-module" (~~ (static .prelude_module)) .symbol#encoded) (name_of ..of_maybe)))})) (macro: .public (else tokens compiler) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index c794c5b3d..fa55d392e 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -219,8 +219,8 @@ (All (_ a) (-> (Writer a) (Writer (Set a)))) (|>> set.list (..list value))) -(def: .public name - (Writer Name) +(def: .public symbol + (Writer Symbol) (..and ..text ..text)) (def: .public type @@ -252,7 +252,7 @@ [7 .#UnivQ quantified] [8 .#ExQ quantified] [9 .#Apply pair] - [10 .#Named (..and ..name recur)]) + [10 .#Named (..and ..symbol recur)]) )))))) (def: .public location @@ -283,7 +283,7 @@ [3 .#Rev ..rev] [4 .#Frac ..frac] [5 .#Text ..text] - [6 .#Identifier ..name] + [6 .#Identifier ..symbol] [7 .#Form sequence] [8 .#Variant sequence] [9 .#Tuple sequence]) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 96448c214..fdc3c0022 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Mode Name and} + [lux {"-" Mode and} [abstract [monad {"+" do}]] [control diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index df6642565..1db81f6d7 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -11,7 +11,6 @@ ["<[0]>" text {"+" Parser}]]] [data ["[0]" product] - ["[0]" name ("[1]#[0]" equivalence codec)] ["[0]" text {"+" \n} ("[1]#[0]" equivalence monoid)] [collection ["[0]" list ("[1]#[0]" functor)] @@ -19,20 +18,22 @@ [math [number ["n" nat] - ["[0]" int]]]]]) + ["[0]" int]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence codec)]]]]) (type: .public Tag - Name) + Symbol) (type: .public Attribute - Name) + Symbol) (type: .public Attrs (Dictionary Attribute Text)) (def: .public attributes Attrs - (dictionary.empty name.hash)) + (dictionary.empty symbol.hash)) (type: .public XML (Rec XML @@ -87,7 +88,7 @@ (in ($_ text#composite head tail)))) (def: namespaced_symbol^ - (Parser Name) + (Parser Symbol) (do <>.monad [first_part xml_identifier ?second_part (<| <>.maybe (<>.after (.this ..namespace_separator)) xml_identifier)] @@ -115,7 +116,7 @@ (def: attrs^ (Parser Attrs) - (<| (# <>.monad each (dictionary.of_list name.hash)) + (<| (# <>.monad each (dictionary.of_list symbol.hash)) <>.some (<>.and (..spaced^ attr_name^)) (<>.after (.this "=")) @@ -129,9 +130,9 @@ (<>.after (.this "/")) (.enclosed ["<" ">"]))] (<>.assertion ($_ text#composite "Close tag does not match open tag." \n - "Expected: " (name#encoded expected) \n - " Actual: " (name#encoded actual) \n) - (name#= expected actual)))) + "Expected: " (symbol#encoded expected) \n + " Actual: " (symbol#encoded actual) \n) + (symbol#= expected actual)))) (def: comment^ (Parser Text) @@ -284,7 +285,7 @@ [{#Node reference/tag reference/attrs reference/children} {#Node sample/tag sample/attrs sample/children}] - (and (name#= reference/tag sample/tag) + (and (symbol#= reference/tag sample/tag) (# (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs) (n.= (list.size reference/children) (list.size sample/children)) diff --git a/stdlib/source/library/lux/data/name.lux b/stdlib/source/library/lux/data/name.lux deleted file mode 100644 index c0fc1cd86..000000000 --- a/stdlib/source/library/lux/data/name.lux +++ /dev/null @@ -1,62 +0,0 @@ -(.module: - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}] - [order {"+" Order}] - [codec {"+" Codec}]] - [data - ["[0]" text ("[1]#[0]" equivalence monoid)] - ["[0]" product]]]]) - -... (type: Name -... [Text Text]) - -(template [] - [(def: .public ( [module short]) - (-> Name Text) - )] - - [module] - [short] - ) - -(def: .public hash - (Hash Name) - (product.hash text.hash text.hash)) - -(def: .public equivalence - (Equivalence Name) - (# ..hash &equivalence)) - -(implementation: .public order - (Order Name) - - (def: &equivalence ..equivalence) - (def: (< [moduleP shortP] [moduleS shortS]) - (if (text#= moduleP moduleS) - (# text.order < shortP shortS) - (# text.order < moduleP moduleS)))) - -(def: separator - ".") - -(implementation: .public codec - (Codec Text Name) - - (def: (encoded [module short]) - (case module - "" short - _ ($_ text#composite module ..separator short))) - - (def: (decoded input) - (case (text.all_split_by ..separator input) - (^ (list short)) - {.#Right ["" short]} - - (^ (list module short)) - {.#Right [module short]} - - _ - {.#Left (text#composite "Invalid format for Name: " input)}))) diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index e94d613a7..8a5509a8f 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -10,7 +10,6 @@ ["<[0]>" code {"+" Parser}]]] [data ["[0]" bit] - ["[0]" name] ["[0]" text] [format ["[0]" xml] @@ -36,7 +35,8 @@ ["[0]" code] ["[0]" template]] [meta - ["[0]" location]] + ["[0]" location] + ["[0]" symbol]] ["[0]" type]]]) (type: .public (Format a) @@ -64,7 +64,7 @@ [text Text text.format] [ratio ratio.Ratio (# ratio.codec encoded)] - [name Name (# name.codec encoded)] + [symbol Symbol (# symbol.codec encoded)] [location Location location.format] [code Code code.format] [type Type type.format] diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 52fbed021..7a67e2a28 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -56,31 +56,31 @@ (-> (Parser (List Text)) (Parser Text)) (# <>.monad each //.together)) -(def: name_char^ +(def: symbol_char^ (Parser Text) - (.none_of (format "[]{}()s#.<>" //.double_quote))) + (.none_of (format "[]{}()s.<>" //.double_quote))) -(def: name_part^ +(def: symbol_part^ (Parser Text) (do <>.monad [head (refine^ (.not .decimal) - name_char^) - tail (.some name_char^)] + symbol_char^) + tail (.some symbol_char^)] (in (format head tail)))) -(def: (name^ current_module) - (-> Text (Parser Name)) +(def: (symbol^ current_module) + (-> Text (Parser Symbol)) ($_ <>.either - (<>.and (<>#in current_module) (<>.after (.this "..") name_part^)) - (<>.and name_part^ (<>.after (.this ".") name_part^)) - (<>.and (<>#in .prelude_module) (<>.after (.this ".") name_part^)) - (<>.and (<>#in "") name_part^))) + (<>.and (<>#in current_module) (<>.after (.this "..") symbol_part^)) + (<>.and symbol_part^ (<>.after (.this ".") symbol_part^)) + (<>.and (<>#in .prelude_module) (<>.after (.this ".") symbol_part^)) + (<>.and (<>#in "") symbol_part^))) (def: (re_var^ current_module) (-> Text (Parser Code)) (do <>.monad - [name (.enclosed ["\@<" ">"] (name^ current_module))] - (in (` (: ((~! .Parser) Text) (~ (code.identifier name))))))) + [symbol (.enclosed ["\@<" ">"] (symbol^ current_module))] + (in (` (: ((~! .Parser) Text) (~ (code.identifier symbol))))))) (def: re_range^ (Parser Code) @@ -199,9 +199,9 @@ (in (` ((~! ..copy) (~ (code.identifier ["" (n#encoded id)])))))) (do <>.monad [_ (.this "\k<") - captured_name name_part^ + captured_symbol symbol_part^ _ (.this ">")] - (in (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) + (in (` ((~! ..copy) (~ (code.identifier ["" captured_symbol])))))))) (def: (re_simple^ current_module) (-> Text (Parser Code)) @@ -398,11 +398,11 @@ (in [{#Non_Capturing} complex])) (do <>.monad [_ (.this "(?<") - captured_name name_part^ + captured_symbol symbol_part^ _ (.this ">") [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (.this ")")] - (in [{#Capturing [{.#Some captured_name} num_captures]} pattern])) + (in [{#Capturing [{.#Some captured_symbol} num_captures]} pattern])) (do <>.monad [_ (.this "(") [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 4e34cf604..5a35e3c62 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -412,7 +412,7 @@ (in (|>> (:as ) )))] [Ratio %.ratio] - [Name %.name] + [Symbol %.symbol] [Location %.location] [Type %.type] [Code %.code] diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 108bc1160..e37df17e9 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -95,7 +95,7 @@ (format "." short) ... else - (%.name [module short]))] + (%.symbol [module short]))] [(revised@ .#column (n.+ (text.size documentation)) new_location) (format (padding reference_column old_location new_location) documentation)]) @@ -293,7 +293,7 @@ (format "." _name) ... else - (%.name [_module _name])) + (%.symbol [_module _name])) )) (def: type @@ -431,7 +431,7 @@ (format "." _name) ... else - (%.name [_module _name])) + (%.symbol [_module _name])) ))) (def: (type_definition module [name parameters] tags type) @@ -449,12 +449,12 @@ (<>.or (.text! "") .any)) -(exception: .public (unqualified_identifier [name Name]) +(exception: .public (unqualified_identifier [name Symbol]) (exception.report - ["Name" (%.name name)])) + ["Name" (%.symbol name)])) (def: qualified_identifier - (Parser Name) + (Parser Symbol) (do <>.monad [name .identifier] (case name @@ -489,7 +489,7 @@ code.text)) (type: Declaration - [Name (List Text)]) + [Symbol (List Text)]) (def: declaration (Parser Declaration) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 0c7865049..fddde12e9 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -279,7 +279,7 @@ (type: Partial_Call (Record - [#pc_method Name + [#pc_method Symbol #pc_args (List Code)])) (type: ImportMethodKind diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index f7c40b59d..174e8e8d9 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -206,7 +206,7 @@ (type: Partial_Call (Record - [#pc_method Name + [#pc_method Symbol #pc_args (List Code)])) (type: ImportMethodKind diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index ecf9b134c..cb81d841b 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -5,7 +5,6 @@ ["[0]" monad {"+" do}]] [data ["[0]" text ("[1]#[0]" monoid)] - ["[0]" name ("[1]#[0]" codec)] [collection ["[0]" list ("[1]#[0]" monoid monad)]]] [macro @@ -16,7 +15,8 @@ ["[0]" int]]]]] ["[0]" // "_" ["[1]" meta - ["[0]" location]]]) + ["[0]" location] + ["[0]" symbol ("[1]#[0]" codec)]]]) (def: .public (single_expansion syntax) (-> Code (Meta (List Code))) @@ -110,8 +110,8 @@ (//.failure (text#composite "Code is not a local identifier: " (code.format ast))))) (def: .public wrong_syntax_error - (-> Name Text) - (|>> name#encoded + (-> Symbol Text) + (|>> symbol#encoded (text.prefix (text#composite "Wrong syntax for " text.\'')) (text.suffix (text#composite text.\'' ".")))) @@ -161,7 +161,7 @@ (do //.monad [location //.location output ( token) - .let [_ ("lux io log" ($_ text#composite (name#encoded macro_name) " " (location.format location))) + .let [_ ("lux io log" ($_ text#composite (symbol#encoded macro_name) " " (location.format location))) _ (list#each (|>> code.format "lux io log") output) _ ("lux io log" "")]] diff --git a/stdlib/source/library/lux/macro/code.lux b/stdlib/source/library/lux/macro/code.lux index 1b81cc910..60a3ee79c 100644 --- a/stdlib/source/library/lux/macro/code.lux +++ b/stdlib/source/library/lux/macro/code.lux @@ -6,7 +6,6 @@ [data ["[0]" product] ["[0]" bit] - ["[0]" name] ["[0]" text ("[1]#[0]" monoid equivalence)] [collection ["[0]" list ("[1]#[0]" functor mix)]]] @@ -17,7 +16,8 @@ ["[0]" rev] ["[0]" frac]]] [meta - ["[0]" location]]]]) + ["[0]" location] + ["[0]" symbol]]]]) ... (type: (Code' w) ... {.#Bit Bit} @@ -26,7 +26,7 @@ ... {.#Rev Rev} ... {.#Frac Frac} ... {.#Text Text} -... {.#Identifier Name} +... {.#Identifier Symbol} ... {.#Form (List (w (Code' w)))} ... {.#Variant (List (w (Code' w)))} ... {.#Tuple (List (w (Code' w)))}) @@ -45,7 +45,7 @@ [rev Rev .#Rev] [frac Frac .#Frac] [text Text .#Text] - [identifier Name .#Identifier] + [identifier Symbol .#Identifier] [form (List Code) .#Form] [variant (List Code) .#Variant] [tuple (List Code) .#Tuple] @@ -72,7 +72,7 @@ [.#Rev rev.equivalence] [.#Frac frac.equivalence] [.#Text text.equivalence] - [.#Identifier name.equivalence]) + [.#Identifier symbol.equivalence]) (^template [] [[[_ { xs'}] [_ { ys'}]] @@ -95,7 +95,7 @@ [.#Int int.decimal] [.#Rev rev.decimal] [.#Frac frac.decimal] - [.#Identifier name.codec]) + [.#Identifier symbol.codec]) [_ {.#Text value}] (text.format value) diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 88574b123..69b15e99b 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -49,7 +49,7 @@ (exception.except ..unknown_module [name])))) (def: (push_one [name macro]) - (-> [Name Macro] (Meta Any)) + (-> [Symbol Macro] (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) .let [definition (: Global {.#Definition [false .Macro macro]}) @@ -66,7 +66,7 @@ (exception.except ..cannot_shadow_definition [module_name definition_name])))))) (def: (pop_one name) - (-> Name (Meta Any)) + (-> Symbol (Meta Any)) (do meta.monad [[module_name definition_name] (meta.normal name) .let [lacks_macro! (: (-> (PList Global) (PList Global)) @@ -82,7 +82,7 @@ (exception.except ..unknown_definition [module_name definition_name])))))) (def: (pop_all macros self) - (-> (List Name) Name Macro) + (-> (List Symbol) Symbol Macro) ("lux macro" (function (_ _) (do [! meta.monad] @@ -97,11 +97,12 @@ (list))))))) (def: .public (push macros) - (-> (List [Name Macro]) (Meta Code)) + (-> (List [Symbol Macro]) (Meta Code)) (do meta.monad [_ (monad.each meta.monad ..push_one macros) seed meta.seed g!pop (//.identifier "pop") - _ (let [g!pop (: Name ["" (//code.format g!pop)])] + _ (let [g!pop (: Symbol + ["" (//code.format g!pop)])] (..push_one [g!pop (..pop_all (list#each product.left macros) g!pop)]))] (in (` ((~ g!pop)))))) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index 1549081e2..59b946503 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -12,7 +12,6 @@ ["[0]" sum] ["[0]" product] ["[0]" bit] - ["[0]" name] ["[0]" text ["%" format]] [collection diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index 19a9f6c01..d0355c4af 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -44,8 +44,8 @@ list#conjoint))] (~ body))))))) -(def: (name_side module_side? parser) - (-> Bit (Parser Name) (Parser Text)) +(def: (symbol_side module_side? parser) + (-> Bit (Parser Symbol) (Parser Text)) (do <>.monad [[module short] parser] (in (if module_side? @@ -56,7 +56,7 @@ (def: (snippet module_side?) (-> Bit (Parser Text)) - (.let [full_identifier (..name_side module_side? .identifier)] + (.let [full_identifier (..symbol_side module_side? .identifier)] ($_ <>.either .text (if module_side? diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 4e4c1a8d9..d9c84288d 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -11,7 +11,6 @@ [data ["[0]" product] ["[0]" text ("[1]#[0]" monoid order)] - ["[0]" name ("[1]#[0]" codec equivalence)] [collection ["[0]" list ("[1]#[0]" monoid monad)] [dictionary @@ -21,7 +20,9 @@ [math [number ["n" nat] - ["i" int]]]]] + ["i" int]]] + [meta + ["[0]" symbol ("[1]#[0]" codec equivalence)]]]] [/ ["[0]" location]]) @@ -150,7 +151,7 @@ false))) (def: .public (normal name) - (-> Name (Meta Name)) + (-> Symbol (Meta Symbol)) (case name ["" name] (do ..monad @@ -161,7 +162,7 @@ (# ..monad in name))) (def: .public (macro full_name) - (-> Name (Meta (Maybe Macro))) + (-> Symbol (Meta (Maybe Macro))) (do ..monad [[module name] (..normal full_name)] (: (Meta (Maybe Macro)) @@ -292,7 +293,7 @@ (text.interposed ..listing_separator))) (def: .public (definition name) - (-> Name (Meta Global)) + (-> Symbol (Meta Global)) (do ..monad [name (..normal name) .let [[normal_module normal_short] name]] @@ -313,7 +314,7 @@ (list#each product.left) ..module_listing)] {try.#Failure ($_ text#composite - "Unknown definition: " (name#encoded name) text.new_line + "Unknown definition: " (symbol#encoded name) text.new_line " Current module: " current_module text.new_line (case (plist.value current_module (value@ .#modules lux)) {.#Some this_module} @@ -328,7 +329,7 @@ {.#Type [exported? _]}) (if (and exported? (text#= normal_short def_name)) - {.#Some (name#encoded [module_name def_name])} + {.#Some (symbol#encoded [module_name def_name])} {.#None}) {.#Alias _} @@ -360,7 +361,7 @@ " All known modules: " all_known_modules text.new_line)}))))) (def: .public (export name) - (-> Name (Meta Definition)) + (-> Symbol (Meta Definition)) (do ..monad [definition (..definition name)] (case definition @@ -368,30 +369,30 @@ (let [[exported? def_type def_value] definition] (if exported? (in definition) - (failure ($_ text#composite "Definition is not an export: " (name#encoded name))))) + (failure ($_ text#composite "Definition is not an export: " (symbol#encoded name))))) {.#Type [exported? type labels]} (if exported? (in [exported? .Type type]) - (failure ($_ text#composite "Type is not an export: " (name#encoded name)))) + (failure ($_ text#composite "Type is not an export: " (symbol#encoded name)))) {.#Alias de_aliased} (failure ($_ text#composite "Aliases are not considered exports: " - (name#encoded name))) + (symbol#encoded name))) {.#Tag _} (failure ($_ text#composite "Tags are not considered exports: " - (name#encoded name))) + (symbol#encoded name))) {.#Slot _} (failure ($_ text#composite "Slots are not considered exports: " - (name#encoded name)))))) + (symbol#encoded name)))))) (def: .public (definition_type name) - (-> Name (Meta Type)) + (-> Symbol (Meta Type)) (do ..monad [definition (definition name)] (case definition @@ -407,15 +408,15 @@ {.#Tag _} (failure ($_ text#composite "Tags have no type: " - (name#encoded name))) + (symbol#encoded name))) {.#Slot _} (failure ($_ text#composite "Slots have no type: " - (name#encoded name)))))) + (symbol#encoded name)))))) (def: .public (type name) - (-> Name (Meta Type)) + (-> Symbol (Meta Type)) (case name ["" _name] (either (var_type _name) @@ -425,7 +426,7 @@ (definition_type name))) (def: .public (type_definition name) - (-> Name (Meta Type)) + (-> Symbol (Meta Type)) (do ..monad [definition (definition name)] (case definition @@ -439,16 +440,16 @@ (type_code .Type) (type_code def_type))) (in (:as Type def_value)) - (..failure ($_ text#composite "Definition is not a type: " (name#encoded name))))) + (..failure ($_ text#composite "Definition is not a type: " (symbol#encoded name))))) {.#Type [exported? type labels]} (in type) {.#Tag _} - (..failure ($_ text#composite "Tag is not a type: " (name#encoded name))) + (..failure ($_ text#composite "Tag is not a type: " (symbol#encoded name))) {.#Slot _} - (..failure ($_ text#composite "Slot is not a type: " (name#encoded name)))))) + (..failure ($_ text#composite "Slot is not a type: " (symbol#encoded name)))))) (def: .public (globals module) (-> Text (Meta (List [Text Global]))) @@ -500,7 +501,7 @@ {try.#Success}))) (def: .public (tags_of type_name) - (-> Name (Meta (Maybe (List Name)))) + (-> Symbol (Meta (Maybe (List Symbol)))) (do ..monad [.let [[module_name name] type_name] module (..module module_name)] @@ -550,7 +551,7 @@ (template [ ] [(def: .public ( tag_name) - (-> Name (Meta [Nat (List Name) Type])) + (-> Symbol (Meta [Nat (List Symbol) Type])) (do ..monad [.let [[module name] tag_name] =module (..module module) @@ -560,18 +561,18 @@ (if (or (text#= this_module_name module) exported?) (in [idx (list#each (|>> [module]) group) type]) - (..failure ($_ text#composite "Cannot access " ": " (name#encoded tag_name) " from module " this_module_name))) + (..failure ($_ text#composite "Cannot access " ": " (symbol#encoded tag_name) " from module " this_module_name))) _ (..failure ($_ text#composite - "Unknown " ": " (name#encoded tag_name))))))] + "Unknown " ": " (symbol#encoded tag_name))))))] [tag .#Tag "tag"] [slot .#Slot "slot"] ) (def: .public (tag_lists module) - (-> Text (Meta (List [(List Name) Type]))) + (-> Text (Meta (List [(List Symbol) Type]))) (do ..monad [=module (..module module) this_module_name ..current_module_name] @@ -609,7 +610,7 @@ scopes)]}))) (def: .public (de_aliased def_name) - (-> Name (Meta Name)) + (-> Symbol (Meta Symbol)) (do ..monad [constant (..definition def_name)] (in (case constant diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux new file mode 100644 index 000000000..8cab8c53c --- /dev/null +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -0,0 +1,62 @@ +(.module: + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}] + [order {"+" Order}] + [codec {"+" Codec}]] + [data + ["[0]" text ("[1]#[0]" equivalence monoid)] + ["[0]" product]]]]) + +... (type: Symbol +... [Text Text]) + +(template [] + [(def: .public ( [module short]) + (-> Symbol Text) + )] + + [module] + [short] + ) + +(def: .public hash + (Hash Symbol) + (product.hash text.hash text.hash)) + +(def: .public equivalence + (Equivalence Symbol) + (# ..hash &equivalence)) + +(implementation: .public order + (Order Symbol) + + (def: &equivalence ..equivalence) + (def: (< [moduleP shortP] [moduleS shortS]) + (if (text#= moduleP moduleS) + (# text.order < shortP shortS) + (# text.order < moduleP moduleS)))) + +(def: separator + ".") + +(implementation: .public codec + (Codec Text Symbol) + + (def: (encoded [module short]) + (case module + "" short + _ ($_ text#composite module ..separator short))) + + (def: (decoded input) + (case (text.all_split_by ..separator input) + (^ (list short)) + {.#Right ["" short]} + + (^ (list module short)) + {.#Right [module short]} + + _ + {.#Left (text#composite "Invalid format for Symbol: " input)}))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 1e49699c7..b269b69b7 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -116,13 +116,13 @@ (exception.report ["Label" (%.nat label)])) -(exception: .public (mismatched_environments [instruction Name +(exception: .public (mismatched_environments [instruction Symbol label Label address Address expected Stack actual Stack]) (exception.report - ["Instruction" (%.name instruction)] + ["Instruction" (%.symbol instruction)] ["Label" (%.nat label)] ["Address" (/address.format address)] ["Expected" (/stack.format expected)] diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index b43c060a4..bff5a4439 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -42,20 +42,20 @@ (n.< (:representation reference) (:representation sample)))) - (exception: .public (value_exceeds_the_maximum [type Name + (exception: .public (value_exceeds_the_maximum [type Symbol value Nat maximum (Unsigned Any)]) (exception.report - ["Type" (%.name type)] + ["Type" (%.symbol type)] ["Value" (%.nat value)] ["Maximum" (%.nat (:representation maximum))])) (exception: .public [brand] (subtraction_cannot_yield_negative_value - [type Name + [type Symbol parameter (Unsigned brand) subject (Unsigned brand)]) (exception.report - ["Type" (%.name type)] + ["Type" (%.symbol type)] ["Parameter" (%.nat (:representation parameter))] ["Subject" (%.nat (:representation subject))])) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index 03d06a2d2..92b90dcbb 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -1,7 +1,6 @@ (.module: [library [lux {"-" and for} - ["[0]" meta] ["[0]" debug] [abstract ["[0]" monad {"+" do}]] @@ -18,7 +17,6 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" name] ["[0]" text ["%" format {"+" format}]] [collection @@ -37,6 +35,8 @@ [macro [syntax {"+" syntax:}] ["[0]" code]] + ["[0]" meta + ["[0]" symbol]] [world ["[0]" program]]]]) @@ -44,8 +44,8 @@ (Record [#successes Nat #failures Nat - #expected_coverage (Set Name) - #actual_coverage (Set Name)])) + #expected_coverage (Set Symbol) + #actual_coverage (Set Symbol)])) (def: (total parameter subject) (-> Tally Tally Tally) @@ -60,8 +60,8 @@ Tally [#successes 0 #failures 0 - #expected_coverage (set.empty name.hash) - #actual_coverage (set.empty name.hash)]) + #expected_coverage (set.empty symbol.hash) + #actual_coverage (set.empty symbol.hash)]) (template [ ] [(def: @@ -190,10 +190,10 @@ (value@ #expected_coverage tally)) unexpected (set.difference (value@ #expected_coverage tally) (value@ #actual_coverage tally)) - report (: (-> (Set Name) Text) + report (: (-> (Set Symbol) Text) (|>> set.list - (list.sorted (# name.order <)) - (exception.listing %.name))) + (list.sorted (# symbol.order <)) + (exception.listing %.symbol))) expected_definitions_to_cover (set.size (value@ #expected_coverage tally)) unexpected_definitions_covered (set.size unexpected) actual_definitions_covered (n.- unexpected_definitions_covered @@ -253,41 +253,41 @@ _ ..failure_exit_code))))) (def: (|cover'| coverage condition) - (-> (List Name) Bit Assertion) + (-> (List Symbol) Bit Assertion) (let [message (|> coverage - (list#each %.name) + (list#each %.symbol) (text.interposed " & ")) - coverage (set.of_list name.hash coverage)] + coverage (set.of_list symbol.hash coverage)] (|> (..assertion message condition) (async#each (function (_ [tally documentation]) [(revised@ #actual_coverage (set.union coverage) tally) documentation]))))) (def: (|cover| coverage condition) - (-> (List Name) Bit Test) + (-> (List Symbol) Bit Test) (|> (..|cover'| coverage condition) random#in)) (def: (|for| coverage test) - (-> (List Name) Test Test) + (-> (List Symbol) Test Test) (let [context (|> coverage - (list#each %.name) + (list#each %.symbol) (text.interposed " & ")) - coverage (set.of_list name.hash coverage)] + coverage (set.of_list symbol.hash coverage)] (random#each (async#each (function (_ [tally documentation]) [(revised@ #actual_coverage (set.union coverage) tally) documentation])) (..context context test)))) -(def: (name_code name) - (-> Name Code) - (code.tuple (list (code.text (name.module name)) - (code.text (name.short name))))) +(def: (symbol_code symbol) + (-> Symbol Code) + (code.tuple (list (code.text (symbol.module symbol)) + (code.text (symbol.short symbol))))) (syntax: (reference [name .identifier]) (do meta.monad [_ (meta.export name)] - (in (list (name_code name))))) + (in (list (symbol_code name))))) (def: coverage_separator Text @@ -302,9 +302,9 @@ "")) (def: (coverage module encoding) - (-> Text Text (Set Name)) + (-> Text Text (Set Symbol)) (loop [remaining encoding - output (set.of_list name.hash (list))] + output (set.of_list symbol.hash (list))] (case (text.split_by ..coverage_separator remaining) {.#Some [head tail]} (recur tail (set.has [module head] output)) @@ -319,7 +319,7 @@ (` ((~! ..reference) (~ definition)))) coverage)] (in (list (` ((~! ) - (: (.List .Name) + (: (.List .Symbol) (.list (~+ coverage))) (~ condition)))))))] @@ -333,7 +333,7 @@ (` ((~! ..reference) (~ definition)))) coverage)] (in (list (` ((~! ..|for|) - (: (.List .Name) + (: (.List .Symbol) (.list (~+ coverage))) (~ test))))))) @@ -348,7 +348,7 @@ (syntax: .public (covering [module .identifier test .any]) (do meta.monad - [.let [module (name.module module)] + [.let [module (symbol.module module)] definitions (meta.definitions module) .let [coverage (|> definitions (list#mix (function (_ [short [exported? _]] aggregate) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index 3161bee88..06da2b69c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -31,8 +31,6 @@ ($_ _.and _.bit _.type (_.or labels labels))) global_label (: (Writer .Label) ($_ _.and _.bit _.type (_.list _.text) _.nat)) - name (: (Writer Name) - (_.and _.text _.text)) alias (: (Writer Alias) (_.and _.text _.text)) global (: (Writer Global) @@ -65,8 +63,6 @@ ($_ <>.and .bit .type (.or labels labels))) global_label (: (Parser .Label) ($_ <>.and .bit .type (.list .text) .nat)) - name (: (Parser Name) - (<>.and .text .text)) alias (: (Parser Alias) (<>.and .text .text)) global (: (Parser Global) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux index 95f1e980f..80fdf3173 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux @@ -13,19 +13,19 @@ [///// ["[0]" phase]]) -(exception: .public (expansion_failed [macro Name +(exception: .public (expansion_failed [macro Symbol inputs (List Code) error Text]) (exception.report - ["Macro" (%.name macro)] + ["Macro" (%.symbol macro)] ["Inputs" (exception.listing %.code inputs)] ["Error" error])) -(exception: .public (must_have_single_expansion [macro Name +(exception: .public (must_have_single_expansion [macro Symbol inputs (List Code) outputs (List Code)]) (exception.report - ["Macro" (%.name macro)] + ["Macro" (%.symbol macro)] ["Inputs" (exception.listing %.code inputs)] ["Outputs" (exception.listing %.code outputs)])) @@ -33,7 +33,7 @@ (-> Macro (List Code) Lux (Try (Try [Lux (List Code)])))) (def: .public (expand expander name macro inputs) - (-> Expander Name Macro (List Code) (Meta (List Code))) + (-> Expander Symbol Macro (List Code) (Meta (List Code))) (function (_ state) (do try.monad [output (expander macro inputs state)] @@ -45,7 +45,7 @@ ((meta.failure (exception.error ..expansion_failed [name inputs error])) state))))) (def: .public (expand_one expander name macro inputs) - (-> Expander Name Macro (List Code) (Meta Code)) + (-> Expander Symbol Macro (List Code) (Meta Code)) (do meta.monad [expansion (expand expander name macro inputs)] (case expansion diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 9c2d930ef..8133275b1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -10,7 +10,6 @@ [data [binary {"+" Binary}] ["[0]" product] - ["[0]" name] ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection @@ -18,7 +17,9 @@ ["[0]" list ("[1]#[0]" functor)]]] [math [number - ["n" nat]]]]] + ["n" nat]]] + [meta + ["[0]" symbol]]]] [// [synthesis {"+" Synthesis}] [phase @@ -257,16 +258,16 @@ [learn_directive artifact.directive] ) -(exception: .public (unknown_definition [name Name +(exception: .public (unknown_definition [name Symbol known_definitions (List Text)]) (exception.report - ["Definition" (name.short name)] - ["Module" (name.module name)] + ["Definition" (symbol.short name)] + ["Module" (symbol.module name)] ["Known Definitions" (exception.listing function.identity known_definitions)])) (def: .public (remember archive name) (All (_ anchor expression directive) - (-> Archive Name (Operation anchor expression directive Context))) + (-> Archive Symbol (Operation anchor expression directive Context))) (function (_ (^@ stateE [bundle state])) (let [[_module _name] name] (do try.monad diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index cd0004d31..fb7519932 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -39,25 +39,25 @@ [cannot_declare_tags_for_foreign_type] ) -(exception: .public (cannot_define_more_than_once [name Name +(exception: .public (cannot_define_more_than_once [name Symbol already_existing Global]) (exception.report - ["Definition" (%.name name)] + ["Definition" (%.symbol name)] ["Original" (case already_existing {.#Alias alias} - (format "alias " (%.name alias)) + (format "alias " (%.symbol alias)) {.#Definition definition} - (format "definition " (%.name name)) + (format "definition " (%.symbol name)) {.#Type _} - (format "type " (%.name name)) + (format "type " (%.symbol name)) {.#Tag _} - (format "tag " (%.name name)) + (format "tag " (%.symbol name)) {.#Slot _} - (format "slot " (%.name name)))])) + (format "slot " (%.symbol name)))])) (exception: .public (can_only_change_state_of_active_module [module Text state Module_State]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 90143d032..b9a600a0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -26,16 +26,16 @@ ["Current" current] ["Foreign" foreign])) -(exception: .public (definition_has_not_been_exported [definition Name]) +(exception: .public (definition_has_not_been_exported [definition Symbol]) (exception.report - ["Definition" (%.name definition)])) + ["Definition" (%.symbol definition)])) -(exception: .public (labels_are_not_definitions [definition Name]) +(exception: .public (labels_are_not_definitions [definition Symbol]) (exception.report - ["Label" (%.name definition)])) + ["Label" (%.symbol definition)])) (def: (definition def_name) - (-> Name (Operation Analysis)) + (-> Symbol (Operation Analysis)) (with_expansions [ (in (|> def_name ///reference.constant {/.#Reference}))] (do [! ///.monad] [constant (///extension.lifted (meta.definition def_name))] @@ -93,7 +93,7 @@ (in {.#None})))) (def: .public (reference reference) - (-> Name (Operation Analysis)) + (-> Symbol (Operation Analysis)) (case reference ["" simple_name] (do [! ///.monad] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index dc96cfd4d..8de445db6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -10,7 +10,6 @@ ["[0]" exception {"+" exception:}] ["[0]" state]] [data - ["[0]" name] ["[0]" product] [text ["%" format {"+" format}]] @@ -22,6 +21,8 @@ [math [number ["n" nat]]] + [meta + ["[0]" symbol]] ["[0]" type ["[0]" check]]]] ["[0]" // "_" @@ -73,8 +74,8 @@ ) (template [] - [(exception: .public ( [key Name - record (List [Name Code])]) + [(exception: .public ( [key Symbol + record (List [Symbol Code])]) (exception.report ["Tag" (%.code (code.identifier key))] ["Record" (%.code (code.tuple (|> record @@ -85,7 +86,7 @@ [cannot_repeat_slot] ) -(exception: .public (slot_does_not_belong_to_record [key Name +(exception: .public (slot_does_not_belong_to_record [key Symbol type Type]) (exception.report ["Tag" (%.code (code.identifier key))] @@ -94,7 +95,7 @@ (exception: .public (record_size_mismatch [expected Nat actual Nat type Type - record (List [Name Code])]) + record (List [Symbol Code])]) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)] @@ -283,7 +284,7 @@ )))) (def: .public (tagged_sum analyse tag archive valueC) - (-> Phase Name Phase) + (-> Phase Symbol Phase) (do [! ///.monad] [tag (///extension.lifted (meta.normal tag)) [idx group variantT] (///extension.lifted (meta.tag tag)) @@ -305,9 +306,9 @@ ... Normalization just means that all the tags get resolved to their ... canonical form (with their corresponding module identified). (def: .public (normal record) - (-> (List Code) (Operation (Maybe (List [Name Code])))) + (-> (List Code) (Operation (Maybe (List [Symbol Code])))) (loop [input record - output (: (List [Name Code]) + output (: (List [Symbol Code]) {.#End})] (case input (^ (list& [_ {.#Identifier slotH}] valueH tail)) @@ -325,7 +326,7 @@ ... re-implementing the same functionality for records makes no sense. ... Records, thus, get transformed into tuples by ordering the elements. (def: .public (order record) - (-> (List [Name Code]) (Operation (Maybe [Nat (List Code) Type]))) + (-> (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) (case record ... empty_record = empty_tuple = unit/any = [] {.#End} @@ -346,7 +347,7 @@ (in []) (/.except ..record_size_mismatch [size_ts size_record recordT record])) .let [tuple_range (list.indices size_ts) - tag->idx (dictionary.of_list name.hash (list.zipped/2 slot_set tuple_range))] + tag->idx (dictionary.of_list symbol.hash (list.zipped/2 slot_set tuple_range))] idx->val (monad.mix ! (function (_ [key val] idx->val) (do ! 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 5dda23a74..918d1d504 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 @@ -36,9 +36,9 @@ (exception.report ["Code" (%.code code)])) -(exception: .public (macro_was_not_found [name Name]) +(exception: .public (macro_was_not_found [name Symbol]) (exception.report - ["Name" (%.name name)])) + ["Name" (%.symbol name)])) (type: Eval (-> Type Code (Meta Any))) 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 02d8b32de..6b7006a0b 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 @@ -1,6 +1,6 @@ (.module: [library - [lux {"-" Name} + [lux "*" [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index bbac7e452..88bef0ffd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -199,9 +199,9 @@ (typeA.with_type input (phase archive valueC))))])) -(exception: .public (not_a_type [symbol Name]) +(exception: .public (not_a_type [symbol Symbol]) (exception.report - ["Symbol" (%.name symbol)])) + ["Symbol" (%.symbol symbol)])) (def: lux::macro Handler diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 14d9b7e31..5a0abb14d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -104,7 +104,7 @@ (All (_ anchor expression directive) (-> Archive (/////generation.Phase anchor expression directive) - Name + Symbol Type Synthesis (Operation anchor expression directive [Type expression Any]))) @@ -119,7 +119,7 @@ (def: (definition archive name expected codeC) (All (_ anchor expression directive) - (-> Archive Name (Maybe Type) Code + (-> Archive Symbol (Maybe Type) Code (Operation anchor expression directive [Type expression Any]))) (do [! phase.monad] [state (///.lifted phase.get_state) @@ -307,20 +307,20 @@ (exception: .public (cannot_alias_an_alias [local Alias foreign Alias - target Name]) + target Symbol]) (exception.report - ["Local alias" (%.name local)] - ["Foreign alias" (%.name foreign)] - ["Target definition" (%.name target)])) + ["Local alias" (%.symbol local)] + ["Foreign alias" (%.symbol foreign)] + ["Target definition" (%.symbol target)])) (exception: .public (cannot_alias_a_label [local Alias foreign Alias]) (exception.report - ["Alias" (%.name local)] - ["Label" (%.name foreign)])) + ["Alias" (%.symbol local)] + ["Label" (%.symbol foreign)])) (def: (define_alias alias original) - (-> Text Name (/////analysis.Operation Any)) + (-> Text Symbol (/////analysis.Operation Any)) (do phase.monad [current_module (///.lifted meta.current_module_name) constant (///.lifted (meta.definition original))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index e9b49fa1e..2684da183 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -139,7 +139,7 @@ (loader.load class_name loader)))) (def: (define! library loader [module name] valueG) - (-> Library java/lang/ClassLoader Name (Bytecode Any) (Try [Text Any Definition])) + (-> Library java/lang/ClassLoader Symbol (Bytecode Any) (Try [Text Any Definition])) (let [class_name (format (text.replaced .module_separator class_path_separator module) class_path_separator (name.normal name) "___" (%.nat (text#hash name)))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index 03cb18916..0ead1ae71 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -60,7 +60,7 @@ (..foreign archive variable))) (def: .public (constant archive name) - (-> Archive Name (Operation (Bytecode Any))) + (-> Archive Symbol (Operation (Bytecode Any))) (do [! ////.monad] [bytecode_name (# ! each //runtime.class_name (generation.remember archive name))] 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 d9e8a1c99..d64167384 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -141,7 +141,7 @@ ... mark], and the short [after the mark]). ... There are also some extra rules regarding name syntax, ... encoded in the parser. - ["." name_separator] + ["." symbol_separator] ) (exception: .public (end_of_file [module Text]) @@ -172,7 +172,7 @@ (template: (!failure parser where offset source_code) [{.#Left [[where offset source_code] - (exception.error ..unrecognized_input [where (%.name (name_of parser)) source_code offset])]}]) + (exception.error ..unrecognized_input [where (%.symbol (name_of parser)) source_code offset])]}]) (template: (!end_of_file where offset source_code current_module) [{.#Left [[where offset source_code] @@ -286,16 +286,16 @@ (!failure ..text_parser where offset source_code))) (with_expansions [ (as_is "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") - (template [] - [(~~ (static ))] - - [text.space] - [text.new_line] [text.carriage_return] - [..name_separator] - [..open_form] [..close_form] - [..open_variant] [..close_variant] - [..open_tuple] [..close_tuple] - [..text_delimiter]) + (template [] + [(~~ (static ))] + + [text.space] + [text.new_line] [text.carriage_return] + [..symbol_separator] + [..open_form] [..close_form] + [..open_variant] [..close_variant] + [..open_tuple] [..close_tuple] + [..text_delimiter]) (static ..digit_separator)] (template: (!if_digit? @char @then @else) [("lux syntax char case!" @char @@ -315,17 +315,17 @@ ... else @else))]) - (`` (template: (!if_name_char?|tail @char @then @else) + (`` (template: (!if_symbol_char?|tail @char @then @else) [("lux syntax char case!" @char - [[] + [[] @else] ... else @then)])) - (`` (template: (!if_name_char?|head @char @then @else) + (`` (template: (!if_symbol_char?|head @char @then @else) [("lux syntax char case!" @char - [[ ] + [[ ] @else] ... else @@ -420,65 +420,65 @@ (!with_char+ source_code//size source_code g!offset/1 g!char/1 @end) (!if_digit? g!char/1 (signed_parser source_code//size offset where (!++/2 offset) source_code) - (!full_name_parser offset [where (!++ offset) source_code] where @aliases .#Identifier)))]) + (!full_symbol_parser offset [where (!++ offset) source_code] where @aliases .#Identifier)))]) (with_expansions [ {.#Right [[(revised@ .#column (|>> (!n/+ (!n/- start end))) where) end source_code] (!clip start end source_code)]}] - (inline: (name_part_parser start where offset source_code) + (inline: (symbol_part_parser start where offset source_code) (-> Nat Location Offset Text (Either [Source Text] [Source Text])) (let [source_code//size ("lux text size" source_code)] (loop [end offset] (<| (!with_char+ source_code//size source_code end char ) - (!if_name_char?|tail char - (recur (!++ end)) - )))))) - -(template: (!half_name_parser @offset @char @module) - [(!if_name_char?|head @char - (!letE [source' name] (..name_part_parser @offset (!forward 1 where) (!++ @offset) source_code) - {.#Right [source' [@module name]]}) - (!failure ..!half_name_parser where @offset source_code))]) - -(`` (def: (short_name_parser source_code//size current_module [where offset/0 source_code]) - (-> Nat Text (Parser Name)) + (!if_symbol_char?|tail char + (recur (!++ end)) + )))))) + +(template: (!half_symbol_parser @offset @char @module) + [(!if_symbol_char?|head @char + (!letE [source' symbol] (..symbol_part_parser @offset (!forward 1 where) (!++ @offset) source_code) + {.#Right [source' [@module symbol]]}) + (!failure ..!half_symbol_parser where @offset source_code))]) + +(`` (def: (short_symbol_parser source_code//size current_module [where offset/0 source_code]) + (-> Nat Text (Parser Symbol)) (<| (!with_char+ source_code//size source_code offset/0 char/0 (!end_of_file where offset/0 source_code current_module)) - (if (!n/= (char (~~ (static ..name_separator))) char/0) + (if (!n/= (char (~~ (static ..symbol_separator))) char/0) (<| (let [offset/1 (!++ offset/0)]) (!with_char+ source_code//size source_code offset/1 char/1 (!end_of_file where offset/1 source_code current_module)) - (!half_name_parser offset/1 char/1 current_module)) - (!half_name_parser offset/0 char/0 (static ..prelude)))))) + (!half_symbol_parser offset/1 char/1 current_module)) + (!half_symbol_parser offset/0 char/0 (static ..prelude)))))) -(template: (!short_name_parser source_code//size @current_module @source @where @tag) - [(!letE [source' name] (..short_name_parser source_code//size @current_module @source) - {.#Right [source' [@where {@tag name}]]})]) +(template: (!short_symbol_parser source_code//size @current_module @source @where @tag) + [(!letE [source' symbol] (..short_symbol_parser source_code//size @current_module @source) + {.#Right [source' [@where {@tag symbol}]]})]) (with_expansions [ (as_is {.#Right [source' ["" simple]]})] - (`` (def: (full_name_parser aliases start source) - (-> Aliases Offset (Parser Name)) + (`` (def: (full_symbol_parser aliases start source) + (-> Aliases Offset (Parser Symbol)) (<| (!letE [source' simple] (let [[where offset source_code] source] - (..name_part_parser start where offset source_code))) + (..symbol_part_parser start where offset source_code))) (let [[where' offset' source_code'] source']) (!with_char source_code' offset' char/separator ) - (if (!n/= (char (~~ (static ..name_separator))) char/separator) + (if (!n/= (char (~~ (static ..symbol_separator))) char/separator) (<| (let [offset'' (!++ offset')]) - (!letE [source'' complex] (..name_part_parser offset'' (!forward 1 where') offset'' source_code')) + (!letE [source'' complex] (..symbol_part_parser offset'' (!forward 1 where') offset'' source_code')) (if ("lux text =" "" complex) (let [[where offset source_code] source] - (!failure ..full_name_parser where offset source_code)) + (!failure ..full_symbol_parser where offset source_code)) {.#Right [source'' [(|> aliases (dictionary.value simple) (maybe.else simple)) complex]]})) ))))) -(template: (!full_name_parser @offset @source @where @aliases @tag) - [(!letE [source' full_name] (..full_name_parser @aliases @offset @source) - {.#Right [source' [@where {@tag full_name}]]})]) +(template: (!full_symbol_parser @offset @source @where @aliases @tag) + [(!letE [source' full_symbol] (..full_symbol_parser @aliases @offset @source) + {.#Right [source' [@where {@tag full_symbol}]]})]) ... TODO: Grammar macro for specifying syntax. ... (grammar: lux_grammar @@ -535,13 +535,13 @@ [(~~ (static ..text_delimiter))] (text_parser where (!++ offset/0) source_code) - ... Coincidentally (= ..name_separator ..frac_separator) - [(~~ (static ..name_separator)) + ... Coincidentally (= ..symbol_separator ..frac_separator) + [(~~ (static ..symbol_separator)) ... (~~ (static ..frac_separator)) ] ... It's either a Rev, an identifier, or a comment. (with_expansions [ (rev_parser source_code//size offset/0 where (!++ offset/1) source_code) - (!short_name_parser source_code//size current_module [where offset/1 source_code] where .#Identifier) + (!short_symbol_parser source_code//size current_module [where offset/1 source_code] where .#Identifier) (case ("lux text index" (!++ offset/1) (static text.new_line) source_code) {.#Some end} (recur (!vertical where end source_code)) @@ -556,19 +556,19 @@ ... It's either an identifier, or a comment. ("lux syntax char case!" char/1 - [[(~~ (static ..name_separator))] + [[(~~ (static ..symbol_separator))] ... It's either an identifier, or a comment. (<| (let [offset/2 (!++ offset/1)]) (!with_char+ source_code//size source_code offset/2 char/2 (!end_of_file where offset/2 source_code current_module)) ("lux syntax char case!" char/2 - [[(~~ (static ..name_separator))] + [[(~~ (static ..symbol_separator))] ... It's a comment. ] ... It's an identifier. - ))] + ))] ... It's an identifier. - )))) + )))) [(~~ (static ..positive_sign)) (~~ (static ..negative_sign))] @@ -588,14 +588,14 @@ ["1" #1]))] ... else - (!full_name_parser offset/0 [] where aliases .#Identifier)))] + (!full_symbol_parser offset/0 [] where aliases .#Identifier)))] ... else (!if_digit? char/0 ... Natural number (nat_parser source_code//size offset/0 where (!++ offset/0) source_code) ... Identifier - (!full_name_parser offset/0 [] where aliases .#Identifier)) + (!full_symbol_parser offset/0 [] where aliases .#Identifier)) ))) ))) )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 1d9a35692..fd5753492 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -14,7 +14,6 @@ [binary {"+" Binary}] ["[0]" bit] ["[0]" product] - ["[0]" name] ["[0]" text ["%" format {"+" format}]] [format diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux index ccc605ef2..19c03d236 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux @@ -8,29 +8,30 @@ ["" binary {"+" Parser}]]] [data ["[0]" product] - ["[0]" name] ["[0]" text ["%" format {"+" format}]] [format ["[0]" binary {"+" Writer}]]] [math [number - ["[0]" nat]]]]] + ["[0]" nat]]] + [meta + ["[0]" symbol]]]] [//// [version {"+" Version}]]) (type: .public Signature (Record - [#name Name + [#name Symbol #version Version])) (def: .public equivalence (Equivalence Signature) - (product.equivalence name.equivalence nat.equivalence)) + (product.equivalence symbol.equivalence nat.equivalence)) (def: .public (description signature) (-> Signature Text) - (format (%.name (value@ #name signature)) " " (%.nat (value@ #version signature)))) + (format (%.symbol (value@ #name signature)) " " (%.nat (value@ #version signature)))) (def: .public writer (Writer Signature) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index fc4851b5d..407317fe2 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -109,7 +109,7 @@ (def: .public (timed definition description operation) (All (_ s a) - (-> Name Text (Operation s a) (Operation s a))) + (-> Symbol Text (Operation s a) (Operation s a))) (do ..monad [_ (in []) .let [pre (io.run! instant.now)] @@ -119,6 +119,6 @@ instant.relative (duration.difference (instant.relative pre)) %.duration - (format (%.name definition) " [" description "]: ") + (format (%.symbol definition) " [" description "]: ") debug.log!)]] (in output))) diff --git a/stdlib/source/library/lux/tool/compiler/reference.lux b/stdlib/source/library/lux/tool/compiler/reference.lux index c5adb07f3..6942f4968 100644 --- a/stdlib/source/library/lux/tool/compiler/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/reference.lux @@ -7,17 +7,18 @@ [control [pipe {"+" case>}]] [data - ["[0]" name] [text ["%" format {"+" Format}]]] [math [number - ["n" nat]]]]] + ["n" nat]]] + [meta + ["[0]" symbol]]]] ["[0]" / "_" ["[1][0]" variable {"+" Variable}]]) (type: .public Constant - Name) + Symbol) (type: .public Reference (Variant @@ -33,7 +34,7 @@ [[{ reference} { sample}] (# = reference sample)]) ([#Variable /variable.equivalence] - [#Constant name.equivalence]) + [#Constant symbol.equivalence]) _ false))) @@ -52,7 +53,7 @@ (# hash) (n.* ))]) ([2 #Variable /variable.hash] - [3 #Constant name.hash]) + [3 #Constant symbol.hash]) ))) (template [ ] @@ -84,4 +85,4 @@ (/variable.format variable) {#Constant constant} - (%.name constant)))) + (%.symbol constant)))) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index c8f2668f2..98a966e31 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -14,7 +14,6 @@ [data ["[0]" product] ["[0]" text ("[1]#[0]" monoid equivalence)] - ["[0]" name ("[1]#[0]" equivalence codec)] [collection ["[0]" array] ["[0]" list ("[1]#[0]" functor monoid mix)]]] @@ -25,7 +24,8 @@ [number ["n" nat ("[1]#[0]" decimal)]]] ["[0]" meta - ["[0]" location]]]]) + ["[0]" location] + ["[0]" symbol ("[1]#[0]" equivalence codec)]]]]) (template [ ] [(def: .public ( type) @@ -201,7 +201,7 @@ (= xright yright)) [{.#Named xname xtype} {.#Named yname ytype}] - (and (name#= xname yname) + (and (symbol#= xname yname) (= xtype ytype)) (^template [] @@ -397,13 +397,13 @@ valueT (meta.type valueN) .let [_ ("lux io log" ($_ text#composite - (name#encoded (name_of ..:log!)) " " (location.format location) text.new_line + (symbol#encoded (name_of ..:log!)) " " (location.format location) text.new_line "Expression: " (case valueC {.#Some valueC} (code.format valueC) {.#None} - (name#encoded valueN)) + (symbol#encoded valueN)) text.new_line " Type: " (..format valueT)))]] (in (list (code.identifier valueN)))) diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 6ebbe7719..915c035c3 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -9,14 +9,15 @@ ["<>" parser ("[1]#[0]" monad) ["<[0]>" code {"+" Parser}]]] [data - ["[0]" name ("[1]#[0]" codec)] ["[0]" text ("[1]#[0]" equivalence monoid)] [collection ["[0]" list ("[1]#[0]" functor monoid)]]] [macro ["[0]" code] [syntax {"+" syntax:} - ["|[0]|" export]]]]] + ["|[0]|" export]]] + [meta + ["[0]" symbol ("[1]#[0]" codec)]]]] ["[0]" //]) (type: Stack @@ -132,7 +133,7 @@ (undefined)))) (def: (push_frame [module_reference definition_reference] frame source) - (-> Name Frame (List [Text Module]) (List [Text Module])) + (-> Symbol Frame (List [Text Module]) (List [Text Module])) (!push source module_reference (revised@ .#definitions (push_frame_definition definition_reference frame) head))) @@ -166,7 +167,7 @@ (undefined)))) (def: (pop_frame [module_reference definition_reference] source) - (-> Name (List [Text Module]) (List [Text Module])) + (-> Symbol (List [Text Module]) (List [Text Module])) (!push source module_reference (|> head (revised@ .#definitions (pop_frame_definition definition_reference))))) @@ -194,13 +195,13 @@ ) (def: abstraction_type_name - (-> Name Text) - name#encoded) + (-> Symbol Text) + symbol#encoded) (def: representation_definition_name (-> Text Text) (|>> ($_ text#composite - (name#encoded (name_of ..#Representation)) + (symbol#encoded (name_of ..#Representation)) " "))) (def: declaration diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 97f14222f..c3b9983f4 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -46,7 +46,7 @@ )) (def: (implicit_type var_name) - (-> Name (Meta Type)) + (-> Symbol (Meta Type)) (do meta.monad [raw_type (meta.type var_name) compiler meta.compiler_state] @@ -82,7 +82,7 @@ (check.failure (format "Cannot find member type " (%.nat idx) " for " (%.type sig_type)))))) (def: (member_name member) - (-> Name (Meta Name)) + (-> Symbol (Meta Symbol)) (case member ["" simple_name] (meta.either (do meta.monad @@ -98,19 +98,19 @@ tag_lists)]] (case candidates {.#End} - (meta.failure (format "Unknown tag: " (%.name member))) + (meta.failure (format "Unknown tag: " (%.symbol member))) {.#Item winner {.#End}} (in winner) _ - (meta.failure (format "Too many candidate tags: " (%.list %.name candidates)))))) + (meta.failure (format "Too many candidate tags: " (%.list %.symbol candidates)))))) _ (# meta.monad in member))) (def: (implicit_member member) - (-> Name (Meta [Nat Type])) + (-> Symbol (Meta [Nat Type])) (do meta.monad [member (member_name member) [idx tag_list sig_type] (meta.slot member)] @@ -134,7 +134,7 @@ ))) (def: (available_definitions sig_type source_module target_module constants aggregate) - (-> Type Text Text (List [Text Definition]) (-> (List [Name Type]) (List [Name Type]))) + (-> Type Text Text (List [Text Definition]) (-> (List [Symbol Type]) (List [Symbol Type]))) (list#mix (function (_ [name [exported? def_type def_value]] aggregate) (if (and (or (text#= target_module source_module) exported?) @@ -145,7 +145,7 @@ constants)) (def: (local_env sig_type) - (-> Type (Meta (List [Name Type]))) + (-> Type (Meta (List [Symbol Type]))) (do meta.monad [local_batches meta.locals .let [total_locals (list#mix (function (_ [name type] table) @@ -161,14 +161,14 @@ {.#None}))))))) (def: (local_structs sig_type) - (-> Type (Meta (List [Name Type]))) + (-> Type (Meta (List [Symbol Type]))) (do [! meta.monad] [this_module_name meta.current_module_name definitions (meta.definitions this_module_name)] (in (available_definitions sig_type this_module_name this_module_name definitions {.#End})))) (def: (imported_structs sig_type) - (-> Type (Meta (List [Name Type]))) + (-> Type (Meta (List [Symbol Type]))) (do [! meta.monad] [this_module_name meta.current_module_name imported_modules (meta.imported_modules this_module_name) @@ -222,12 +222,12 @@ (type: Instance (Rec Instance (Record - [#constructor Name + [#constructor Symbol #dependencies (List Instance)]))) (def: (candidate_provision provision context dep alts) (-> (-> Lux Type_Context Type (Check Instance)) - Type_Context Type (List [Name Type]) + Type_Context Type (List [Symbol Type]) (Meta (List Instance))) (do meta.monad [compiler meta.compiler_state] @@ -272,11 +272,11 @@ (# check.monad in winner) _ - (check.failure (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) + (check.failure (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.symbol) candidates)))) )) (def: (candidate_alternatives sig_type member_idx input_types output_type alts) - (-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance))) + (-> Type Nat (List Type) Type (List [Symbol Type]) (Meta (List Instance))) (do meta.monad [compiler meta.compiler_state context meta.type_context] @@ -346,7 +346,7 @@ chosen_ones (alternatives sig_type member_idx input_types output_type)] (case chosen_ones {.#End} - (meta.failure (format "No implementation could be found for member: " (%.name member))) + (meta.failure (format "No implementation could be found for member: " (%.symbol member))) {.#Item chosen {.#End}} (in (list (` (# (~ (instance$ chosen)) @@ -356,7 +356,7 @@ _ (meta.failure (format "Too many implementations available: " (|> chosen_ones - (list#each (|>> product.left %.name)) + (list#each (|>> product.left %.symbol)) (text.interposed ", ")) " --- for type: " (%.type sig_type))))) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index d1a00e489..605867277 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -94,7 +94,7 @@ [@ meta.current_module_name .let [g!type (code.local_identifier type_name)]] (in (list (` (type: (~ export_policy) (~ g!type) - (Primitive (~ (code.text (%.name [@ type_name])))))) + (Primitive (~ (code.text (%.symbol [@ type_name])))))) (` (implementation: (~ export_policy) (~ (code.local_identifier unit_name)) (..Unit (~ g!type)) @@ -125,7 +125,7 @@ @ meta.current_module_name .let [g!scale (code.local_identifier type_name)]] (in (list (` (type: (~ export_policy) ((~ g!scale) (~' u)) - (Primitive (~ (code.text (%.name [@ type_name]))) [(~' u)]))) + (Primitive (~ (code.text (%.symbol [@ type_name]))) [(~' u)]))) (` (implementation: (~ export_policy) (~ (code.local_identifier scale_name)) (..Scale (~ g!scale)) -- cgit v1.2.3