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/test/lux/control/concatenative.lux | 1 - stdlib/source/test/lux/control/parser/analysis.lux | 5 +- stdlib/source/test/lux/control/parser/binary.lux | 13 ++-- stdlib/source/test/lux/control/parser/code.lux | 11 ++-- .../source/test/lux/control/parser/synthesis.lux | 7 ++- stdlib/source/test/lux/control/parser/type.lux | 5 +- stdlib/source/test/lux/control/parser/xml.lux | 29 ++++----- stdlib/source/test/lux/control/remember.lux | 2 +- stdlib/source/test/lux/data.lux | 4 +- stdlib/source/test/lux/data/format/xml.lux | 9 +-- stdlib/source/test/lux/data/name.lux | 69 ---------------------- stdlib/source/test/lux/data/text/format.lux | 11 ++-- stdlib/source/test/lux/debug.lux | 10 ++-- stdlib/source/test/lux/macro.lux | 8 +-- stdlib/source/test/lux/macro/code.lux | 10 ++-- stdlib/source/test/lux/meta.lux | 18 +++--- stdlib/source/test/lux/meta/symbol.lux | 69 ++++++++++++++++++++++ stdlib/source/test/lux/target/jvm.lux | 2 +- .../compiler/language/lux/phase/analysis/case.lux | 9 +-- .../language/lux/phase/analysis/function.lux | 13 ++-- .../language/lux/phase/analysis/primitive.lux | 13 ++-- .../language/lux/phase/analysis/reference.lux | 10 ++-- .../language/lux/phase/analysis/structure.lux | 17 +++--- .../language/lux/phase/extension/analysis/lux.lux | 9 +-- .../language/lux/phase/synthesis/primitive.lux | 9 +-- .../language/lux/phase/synthesis/structure.lux | 9 +-- .../test/lux/tool/compiler/language/lux/syntax.lux | 18 +++--- stdlib/source/test/lux/type.lux | 12 ++-- stdlib/source/test/lux/type/check.lux | 12 ++-- 29 files changed, 214 insertions(+), 200 deletions(-) delete mode 100644 stdlib/source/test/lux/data/name.lux create mode 100644 stdlib/source/test/lux/meta/symbol.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 4bdf801d8..704fdf68c 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -6,7 +6,6 @@ [monad {"+" do}]] [data ["[0]" sum] - ["[0]" name] ["[0]" bit ("[1]#[0]" equivalence)]] [macro ["[0]" template]] diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 57f6c1a77..730fd4cc3 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -10,7 +10,6 @@ ["[0]" exception] ["<>" parser]] [data - ["[0]" name ("[1]#[0]" equivalence)] ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" text ("[1]#[0]" equivalence)] [collection @@ -22,6 +21,8 @@ ["i" int] ["f" frac] ["r" rev]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]] [tool [compiler [reference {"+" Constant} @@ -88,7 +89,7 @@ [/.text /.text! (random.unicode 10) analysis.text text#=] [/.local /.local! random.nat analysis.variable/local n.=] [/.foreign /.foreign! random.nat analysis.variable/foreign n.=] - [/.constant /.constant! ..constant analysis.constant name#=] + [/.constant /.constant! ..constant analysis.constant symbol#=] )) (do [! random.monad] [expected random.bit] diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index f7809b34d..3bf3363c9 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -17,7 +17,6 @@ ["[0]" binary] ["[0]" sum] ["[0]" bit] - ["[0]" name] ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}] [encoding @@ -37,7 +36,9 @@ ["[0]" i64] ["[0]" int] ["[0]" rev] - ["[0]" frac]]]]] + ["[0]" frac]]] + [meta + ["[0]" symbol]]]] [\\library ["[0]" /]]) @@ -67,8 +68,8 @@ (random.only ..utf8_conversion_does_not_alter? (random.unicode ..segment_size))) -(def: random_name - (Random Name) +(def: random_symbol + (Random Symbol) (random.and ..random_text ..random_text)) (implementation: location_equivalence @@ -104,7 +105,7 @@ random.rev random.safe_frac ..random_text - ..random_name + ..random_symbol random_sequence random_sequence random_sequence @@ -265,7 +266,7 @@ [/.maybe (/.maybe /.nat) format.maybe (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)] [/.list (/.list /.nat) format.list (format.list format.nat) (random.list ..segment_size random.nat) (list.equivalence n.equivalence)] [/.set (/.set n.hash /.nat) format.set (format.set format.nat) (random.set n.hash ..segment_size random.nat) set.equivalence] - [/.name /.name format.name format.name ..random_name name.equivalence])) + [/.symbol /.symbol format.symbol format.symbol ..random_symbol symbol.equivalence])) (do [! random.monad] [expected (# ! each (list.repeated ..segment_size) random.nat)] (_.cover [/.set_elements_are_not_unique] diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 70afee9b7..aee053104 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -10,7 +10,6 @@ ["<>" parser]] [data ["[0]" bit] - ["[0]" name] ["[0]" text] [collection ["[0]" list]]] @@ -22,7 +21,9 @@ ["[0]" nat] ["[0]" int] ["[0]" rev] - ["[0]" frac]]]]] + ["[0]" frac]]] + [meta + ["[0]" symbol]]]] [\\library ["[0]" /]]) @@ -34,8 +35,8 @@ _ false)]) -(def: random_name - (Random Name) +(def: random_symbol + (Random Symbol) (random.and (random.unicode 1) (random.unicode 1))) @@ -74,7 +75,7 @@ [/.rev /.rev! random.rev code.rev rev.equivalence] [/.frac /.frac! random.safe_frac code.frac frac.equivalence] [/.text /.text! (random.unicode 1) code.text text.equivalence] - [/.identifier /.identifier! ..random_name code.identifier name.equivalence] + [/.identifier /.identifier! ..random_symbol code.identifier symbol.equivalence] [/.local_identifier /.local_identifier! (random.unicode 1) code.local_identifier text.equivalence] )) (~~ (template [ ] diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index f82b020a9..aa7cc05ef 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -11,7 +11,6 @@ ["[0]" exception]] [data ["[0]" bit] - ["[0]" name] ["[0]" text] [collection ["[0]" list ("[1]#[0]" functor)]]] @@ -21,6 +20,8 @@ ["n" nat] ["[0]" i64] ["[0]" frac]]] + [meta + ["[0]" symbol]] [tool [compiler [reference {"+" } @@ -41,7 +42,7 @@ false)]) (def: random_constant - (Random Name) + (Random Symbol) (random.and (random.unicode 1) (random.unicode 1))) @@ -84,7 +85,7 @@ [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.constant! ..random_constant synthesis.constant name.equivalence] + [/.constant /.constant! ..random_constant synthesis.constant symbol.equivalence] )) ))) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 2fca448f8..9ab2fb674 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -8,13 +8,14 @@ ["[0]" try] ["[0]" exception]] [data - ["[0]" name ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math ["[0]" random {"+" Random}] [number ["n" nat]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]] ["[0]" type ("[1]#[0]" equivalence)]]] [\\library ["[0]" / @@ -260,7 +261,7 @@ (|> (/.result /.named {.#Named expected_name expected_type}) (!expect (^multi {try.#Success [actual_name actual_type]} - (and (name#= expected_name actual_name) + (and (symbol#= expected_name actual_name) (type#= expected_type actual_type))))))) ..aggregate ..matches diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 705b5cd27..0b246f995 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -10,7 +10,6 @@ ["[0]" exception]] [data ["[0]" text ("[1]#[0]" equivalence)] - ["[0]" name ("[1]#[0]" equivalence)] [format ["[0]" xml ("[1]#[0]" equivalence)]] [collection @@ -21,7 +20,9 @@ [math ["[0]" random {"+" Random}] [number - ["n" nat]]]]] + ["n" nat]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]]]] [\\library ["[0]" / ["/[1]" // ("[1]#[0]" monad)]]]) @@ -47,7 +48,7 @@ <>)))))))]) (def: random_label - (Random Name) + (Random Symbol) (random.and (random.ascii/alpha 1) (random.ascii/alpha 1))) @@ -80,18 +81,18 @@ (|> (/.result (do //.monad [actual /.tag _ /.any] - (in (name#= expected actual))) - (list {xml.#Node expected (dictionary.empty name.hash) (list)})) + (in (symbol#= expected actual))) + (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) (!expect {try.#Success #1})))) (do [! random.monad] [expected ..random_tag] (_.cover [/.node] (|> (/.result (/.node expected (//#in [])) - (list {xml.#Node expected (dictionary.empty name.hash) (list)})) + (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) (!expect {try.#Success []})))) (!failure /.wrong_tag [[(/.node ["" expected] (//#in [])) - {xml.#Node [expected ""] (dictionary.empty name.hash) (list)}]]) + {xml.#Node [expected ""] (dictionary.empty symbol.hash) (list)}]]) (do [! random.monad] [expected_tag ..random_tag expected_attribute ..random_attribute @@ -101,14 +102,14 @@ (//.after (/.attribute expected_attribute)) (//#in [])) (list {xml.#Node expected_tag - (|> (dictionary.empty name.hash) + (|> (dictionary.empty symbol.hash) (dictionary.has expected_attribute expected_value)) (list)})) (!expect {try.#Success []})))) (!failure /.unknown_attribute [[(/.attribute ["" expected]) {xml.#Node [expected expected] - (|> (dictionary.empty name.hash) + (|> (dictionary.empty symbol.hash) (dictionary.has [expected ""] expected)) (list)}]]) (!failure /.empty_input @@ -125,19 +126,19 @@ (/.node [expected expected] (//#in []))) {xml.#Node [expected expected] - (dictionary.empty name.hash) + (dictionary.empty symbol.hash) (list)}] [(do //.monad [_ /.any] (/.node [expected expected] (/.attribute [expected expected]))) {xml.#Node [expected expected] - (|> (dictionary.empty name.hash) + (|> (dictionary.empty symbol.hash) (dictionary.has [expected expected] expected)) (list)}]]) (!failure /.unexpected_input [[/.text - {xml.#Node [expected expected] (dictionary.empty name.hash) (list)}] + {xml.#Node [expected expected] (dictionary.empty symbol.hash) (list)}] [(/.node [expected expected] (//#in [])) {xml.#Text expected}] @@ -147,10 +148,10 @@ (do [! random.monad] [.let [node (: (-> xml.Tag (List xml.XML) xml.XML) (function (_ tag children) - {xml.#Node tag (dictionary.empty name.hash) children}))] + {xml.#Node tag (dictionary.empty symbol.hash) children}))] parent ..random_tag right ..random_tag - wrong (random.only (|>> (name#= right) not) + wrong (random.only (|>> (symbol#= right) not) ..random_tag) .let [parser (<| (/.node parent) (do //.monad diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 1d078daf2..a8eb15141 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -33,7 +33,7 @@ (def: focus (Random Code) (random#each code.bit random.bit)) (def: (memory macro deadline message focus) - (-> Name Date Text (Maybe Code) Code) + (-> Symbol Date Text (Maybe Code) Code) (` ((~ (code.identifier macro)) (~ (code.text (%.date deadline))) (~ (code.text message)) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 573697f2a..5b49d61b3 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -12,7 +12,6 @@ ["[1][0]" color ["[1]/[0]" named]] ["[1][0]" identity] - ["[1][0]" name] ["[1][0]" product] ["[1][0]" sum] ["[1][0]" text] @@ -50,8 +49,7 @@ (def: test/1 Test ($_ _.and - /identity.test - /name.test)) + /identity.test)) (def: test/2 Test diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 3f94d894f..840455f41 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -14,7 +14,6 @@ ["p" parser ["" xml]]] [data - ["[0]" name] ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection @@ -23,7 +22,9 @@ [math ["[0]" random {"+" Random} ("[1]#[0]" monad)] [number - ["n" nat]]]]] + ["n" nat]]] + [meta + ["[0]" symbol]]]] [\\library ["[0]" / {"+" XML}]]) @@ -51,7 +52,7 @@ (random.text ..char size))) (def: identifier - (Random Name) + (Random Symbol) (random.and (..text 0 10) (..text 1 10))) @@ -63,7 +64,7 @@ [size (..size 0 2)] ($_ random.and ..identifier - (random.dictionary name.hash size ..identifier (..text 0 10)) + (random.dictionary symbol.hash size ..identifier (..text 0 10)) (random.list size random))))))) (def: .public test diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux deleted file mode 100644 index a069d846e..000000000 --- a/stdlib/source/test/lux/data/name.lux +++ /dev/null @@ -1,69 +0,0 @@ -(.module: - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" codec]]] - [control - pipe] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) - -(def: .public (random module_size short_size) - (-> Nat Nat (Random Name)) - (random.and (random.ascii/alpha module_size) - (random.ascii/alpha short_size))) - -(def: .public test - Test - (<| (_.covering /._) - (do [! random.monad] - [... First Name - sizeM1 (|> random.nat (# ! each (n.% 100))) - sizeS1 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) - (^@ name1 [module1 short1]) (..random sizeM1 sizeS1) - ... Second Name - sizeM2 (|> random.nat (# ! each (n.% 100))) - sizeS2 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) - (^@ name2 [module2 short2]) (..random sizeM2 sizeS2)] - (_.for [.Name] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) - (_.for [/.hash] - (|> (random.ascii 1) - (# ! each (|>> [""])) - ($hash.spec /.hash))) - (_.for [/.order] - ($order.spec /.order (..random sizeM1 sizeS1))) - (_.for [/.codec] - (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) - (let [(^open "/#[0]") /.codec] - (_.test "Encoding an name without a module component results in text equal to the short of the name." - (if (text.empty? module1) - (text#= short1 (/#encoded name1)) - #1))))) - - (_.cover [/.module /.short] - (and (same? module1 (/.module name1)) - (same? short1 (/.short name1)))) - (_.for [.name_of] - (let [(^open "/#[0]") /.equivalence] - ($_ _.and - (_.test "Can obtain Name from identifier." - (and (/#= [.prelude_module "yolo"] (.name_of .yolo)) - (/#= ["test/lux/data/name" "yolo"] (.name_of ..yolo)) - (/#= ["" "yolo"] (.name_of yolo)) - (/#= ["library/lux/test" "yolo"] (.name_of library/lux/test.yolo))))))) - ))))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index aa3a6b2cd..0a5bab197 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -13,7 +13,6 @@ [data ["[0]" text ("[1]#[0]" equivalence)] ["[0]" bit] - ["[0]" name] [format ["[0]" xml] ["[0]" json]] @@ -38,17 +37,19 @@ [macro ["[0]" code]] [meta - ["[0]" location]] + ["[0]" location] + ["[0]" symbol]] ["[0]" type]]] ["$[0]" /// "_" [format ["[1][0]" xml] ["[1][0]" json]] - ["[1][0]" name] [// ["[1][0]" type] [macro - ["[1][0]" code]]]] + ["[1][0]" code]] + [meta + ["[1][0]" symbol]]]] [\\library ["[0]" /]]) @@ -85,7 +86,7 @@ [/.rev rev.decimal random.rev] [/.frac frac.decimal random.frac] [/.ratio ratio.codec random.ratio] - [/.name name.codec ($///name.random 5 5)] + [/.symbol symbol.codec ($///symbol.random 5 5)] [/.xml xml.codec $///xml.random] [/.json json.codec $///json.random] [/.day day.codec random.day] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index d422caa8d..3ad2747e8 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -36,7 +36,6 @@ ["$[0]" // "_" ["[1][0]" type] [data - ["[1][0]" name] [format ["[1][0]" json] ["[1][0]" xml]]] @@ -46,7 +45,8 @@ [number ["[1][0]" ratio]]] [meta - ["[1][0]" location]]]) + ["[1][0]" location] + ["[1][0]" symbol]]]) (def: can_represent_simple_types (Random Bit) @@ -107,7 +107,7 @@ (Random Bit) (do random.monad [sample_ratio $//ratio.random - sample_name ($//name.random 5 5) + sample_symbol ($//symbol.random 5 5) sample_location $//location.random sample_type ($//type.random 0) sample_code $//code.random @@ -119,7 +119,7 @@ (try.else false))] [Ratio %.ratio sample_ratio] - [Name %.name sample_name] + [Symbol %.symbol sample_symbol] [Location %.location sample_location] [Code %.code sample_code] [Type %.type sample_type] @@ -262,7 +262,7 @@ true)) (_.cover [/.log!] (exec - (/.log! (format (%.name (name_of /.log!)) + (/.log! (format (%.symbol (name_of /.log!)) " works: " (%.text message))) true)) )))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index cdd48544b..0b8fdced8 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -10,7 +10,6 @@ ["<[0]>" code]]] [data ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" name] ["[0]" text ["%" format {"+" format}]] [collection @@ -20,7 +19,8 @@ [number ["[0]" nat]]] ["[0]" meta - ["[0]" location]]]] + ["[0]" location] + ["[0]" symbol]]]] [\\library ["[0]" / [syntax {"+" syntax:}] @@ -61,8 +61,8 @@ (do [! random.monad] [seed random.nat identifier_prefix (random.ascii/upper 1) - .let [macro_module (name.module (name_of /._)) - current_module (name.module (name_of .._))]] + .let [macro_module (symbol.module (name_of /._)) + current_module (symbol.module (name_of .._))]] (in [seed identifier_prefix [.#info [.#target "" diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 99ff3103e..8a0ab7ef1 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -31,8 +31,8 @@ (Random Text) (random.ascii/alpha 10)) -(def: random_name - (Random Name) +(def: random_symbol + (Random Symbol) (random.and ..random_text ..random_text)) (def: (random_sequence random) @@ -52,7 +52,7 @@ (random#each /.rev random.rev) (random#each /.frac random.safe_frac) (random#each /.text ..random_text) - (random#each /.identifier ..random_name) + (random#each /.identifier ..random_symbol) (random#each /.form (..random_sequence random)) (random#each /.variant (..random_sequence random)) (random#each /.tuple (..random_sequence random)) @@ -93,7 +93,7 @@ (random#each /.rev random.rev) (random#each /.frac random.safe_frac) (random#each /.text ..random_text) - (random#each /.identifier ..random_name)))] + (random#each /.identifier ..random_symbol)))] (in [sample sample])) (for_sequence /.form) (for_sequence /.variant) @@ -125,7 +125,7 @@ [/.rev random.rev .#Rev] [/.frac random.safe_frac .#Frac] [/.text ..random_text .#Text] - [/.identifier ..random_name .#Identifier] + [/.identifier ..random_symbol .#Identifier] [/.form (..random_sequence ..random) .#Form] [/.variant (..random_sequence ..random) .#Variant] [/.tuple (..random_sequence ..random) .#Tuple])) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 66a22d81c..fdf066663 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -16,14 +16,14 @@ [data ["[0]" product] ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" name ("[1]#[0]" equivalence)] ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" format}]] [collection ["[0]" list ("[1]#[0]" functor monoid)] ["[0]" set]]] [meta - ["[0]" location]] + ["[0]" location] + ["[0]" symbol ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" Random}] [number @@ -31,7 +31,8 @@ [\\library ["[0]" /]] ["[0]" / "_" - ["[1][0]" location]]) + ["[1][0]" location] + ["[1][0]" symbol]]) (template: (!expect ) [(case @@ -560,11 +561,11 @@ (expected_lux true {.#Some .Macro})] (and (|> (/.de_aliased [expected_macro_module expected_short]) (/.result expected_lux) - (try#each (name#= [expected_macro_module expected_short])) + (try#each (symbol#= [expected_macro_module expected_short])) (try.else false)) (|> (/.de_aliased [expected_current_module expected_short]) (/.result expected_lux) - (try#each (name#= [expected_macro_module expected_short])) + (try#each (symbol#= [expected_macro_module expected_short])) (try.else false))))) (_.cover [/.definition] (let [[current_globals macro_globals expected_lux] @@ -696,7 +697,7 @@ (_.cover [/.tag_lists] (let [equivalence (list.equivalence (product.equivalence - (list.equivalence name.equivalence) + (list.equivalence symbol.equivalence) type.equivalence))] (|> (/.tag_lists tag_module) (/.result expected_lux) @@ -706,7 +707,7 @@ (_.cover [/.tags_of] (|> (/.tags_of [tag_module name_1]) (/.result expected_lux) - (try#each (# (maybe.equivalence (list.equivalence name.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})})) + (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})})) (try.else false))) (_.cover [/.slot] (|> {.#Item tags_1} @@ -721,7 +722,7 @@ actual_index) correct_tags! - (# (list.equivalence name.equivalence) = + (# (list.equivalence symbol.equivalence) = (list#each (|>> [tag_module]) {.#Item tags_1}) actual_tags) @@ -947,4 +948,5 @@ )) /location.test + /symbol.test ))) diff --git a/stdlib/source/test/lux/meta/symbol.lux b/stdlib/source/test/lux/meta/symbol.lux new file mode 100644 index 000000000..85598a159 --- /dev/null +++ b/stdlib/source/test/lux/meta/symbol.lux @@ -0,0 +1,69 @@ +(.module: + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" codec]]] + [control + pipe] + [data + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def: .public (random module_size short_size) + (-> Nat Nat (Random Symbol)) + (random.and (random.ascii/alpha module_size) + (random.ascii/alpha short_size))) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [... First Symbol + sizeM1 (|> random.nat (# ! each (n.% 100))) + sizeS1 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) + (^@ symbol1 [module1 short1]) (..random sizeM1 sizeS1) + ... Second Symbol + sizeM2 (|> random.nat (# ! each (n.% 100))) + sizeS2 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) + (^@ symbol2 [module2 short2]) (..random sizeM2 sizeS2)] + (_.for [.Symbol] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) + (_.for [/.hash] + (|> (random.ascii 1) + (# ! each (|>> [""])) + ($hash.spec /.hash))) + (_.for [/.order] + ($order.spec /.order (..random sizeM1 sizeS1))) + (_.for [/.codec] + (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) + (let [(^open "/#[0]") /.codec] + (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." + (if (text.empty? module1) + (text#= short1 (/#encoded symbol1)) + #1))))) + + (_.cover [/.module /.short] + (and (same? module1 (/.module symbol1)) + (same? short1 (/.short symbol1)))) + (_.for [.name_of] + (let [(^open "/#[0]") /.equivalence] + ($_ _.and + (_.test "Can obtain Symbol from identifier." + (and (/#= [.prelude_module "yolo"] (.name_of .yolo)) + (/#= ["test/lux/meta/symbol" "yolo"] (.name_of ..yolo)) + (/#= ["" "yolo"] (.name_of yolo)) + (/#= ["library/lux/test" "yolo"] (.name_of library/lux/test.yolo))))))) + ))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index ed3916588..7aaefe214 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -1722,7 +1722,7 @@ (def: .public test Test - (<| (_.context (%.name (name_of .._))) + (<| (_.context (%.symbol (name_of .._))) ($_ _.and (<| (_.context "instruction") ..instruction) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 76f904817..b75932d8d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -3,8 +3,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random} ("[1]#[0]" monad)] ["_" test {"+" Test}] [control @@ -21,7 +20,9 @@ ["[0]" type ["[0]" check]] [macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol]]] [// ["_[0]" primitive] ["_[0]" structure]] @@ -139,7 +140,7 @@ [pattern body]) (def: .public test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) (do [! r.monad] [module_name (r.unicode 5) variant_name (r.unicode 5) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index f86c8bcfe..66f8a82ab 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -3,8 +3,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random}] ["_" test {"+" Test}] [control @@ -20,7 +19,9 @@ ["[0]" list ("[1]#[0]" functor)]]] ["[0]" type] ["[0]" macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol]]] [// ["_[0]" primitive] ["_[0]" structure]] @@ -57,7 +58,7 @@ [outputT outputC] _primitive.primitive [inputT _] _primitive.primitive .let [g!arg (code.local_identifier arg_name)]] - (<| (_.context (%.name (name_of /.function))) + (<| (_.context (%.symbol (name_of /.function))) ($_ _.and (_.test "Can analyse function." (and (|> (//type.with_type (All (_ a) (-> a outputT)) @@ -104,7 +105,7 @@ (type.function {.#Item varT partial_poly_inputsT}) varT) dummy_function {////analysis.#Function (list) {////analysis.#Reference (////reference.local 1)}}]] - (<| (_.context (%.name (name_of /.apply))) + (<| (_.context (%.symbol (name_of /.apply))) ($_ _.and (_.test "Can analyse monomorphic type application." (|> (/.apply _primitive.phase inputsC funcT dummy_function archive.empty (' [])) @@ -125,7 +126,7 @@ (def: .public test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) ($_ _.and ..abstraction ..apply diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index 7dc11195c..8ce35da36 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -4,8 +4,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random} ("[1]#[0]" monad)] ["_" test {"+" Test}] [control @@ -13,7 +12,9 @@ ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}]] [macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol]]] [\\ ["[0]" / ["/[1]" // @@ -85,9 +86,9 @@ {try.#Failure error}))) (def: .public test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) (`` ($_ _.and - (_.test (%.name (name_of ////analysis.#Unit)) + (_.test (%.symbol (name_of ////analysis.#Unit)) (|> (infer Any (..phase archive.empty (' []))) (case> (^ {try.#Success {////analysis.#Primitive {////analysis.#Unit output}}}) (same? [] output) @@ -97,7 +98,7 @@ (~~ (template [ ] [(do r.monad [sample ] - (_.test (%.name (name_of )) + (_.test (%.symbol (name_of )) (|> (infer (..phase archive.empty ( sample))) (case> {try.#Success {////analysis.#Primitive { output}}} (same? sample output) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 61195abbd..a1683c75d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -2,8 +2,6 @@ [lux "*" [abstract ["[0]" monad {"+" do}]] - [data - ["[0]" name ("[1]#[0]" equivalence)]] ["r" math/random {"+" Random}] ["_" test {"+" Test}] [control @@ -15,7 +13,9 @@ ["n" nat]]] ["[0]" type ("[1]#[0]" equivalence)] [macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]]] [// ["_[0]" primitive]] [\\ @@ -64,7 +64,7 @@ check!)) (def: .public test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) (do r.monad [[expectedT _] _primitive.primitive def_module (r.unicode 5) @@ -95,7 +95,7 @@ (phase.result _primitive.state) (case> (^ {try.#Success [_ inferredT {////analysis.#Reference (////reference.constant constant_name)}]}) (and (type#= expectedT inferredT) - (name#= def_name constant_name)) + (symbol#= def_name constant_name)) _ false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 6f63bf89c..062ec96dc 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -3,8 +3,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random}] ["_" test {"+" Test}] [control @@ -23,7 +22,9 @@ ["[0]" type ["[0]" check]] [macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol]]] [// ["_[0]" primitive]] [\\ @@ -132,7 +133,7 @@ (list.after choice primitives))) [+valueT +valueC] (maybe.trusted (list.item +choice +primitives)) +variantT (type.variant (list#each product.left +primitives))]] - (<| (_.context (%.name (name_of /.sum))) + (<| (_.context (%.symbol (name_of /.sum))) ($_ _.and (_.test "Can analyse." (check_sum variantT choice size @@ -181,7 +182,7 @@ (list [{.#Parameter 1} +valueC]) (list.after choice primitives))) +tupleT (type.tuple (list#each product.left +primitives))]] - (<| (_.context (%.name (name_of /.product))) + (<| (_.context (%.symbol (name_of /.product))) ($_ _.and (_.test "Can analyse." (|> (//type.with_type tupleT @@ -250,7 +251,7 @@ (type.univ_q 1)) choice_tag (maybe.trusted (list.item choice tags)) other_choice_tag (maybe.trusted (list.item other_choice tags))]] - (<| (_.context (%.name (name_of /.tagged_sum))) + (<| (_.context (%.symbol (name_of /.tagged_sum))) ($_ _.and (_.test "Can infer." (|> (/.tagged_sum _primitive.phase [module_name choice_tag] archive.empty choiceC) @@ -294,14 +295,14 @@ (list.after (++ choice) primitivesT)))) (type.univ_q 1) {.#Named [module_name type_name]})]] - (<| (_.context (%.name (name_of /.record))) + (<| (_.context (%.symbol (name_of /.record))) (_.test "Can infer." (|> (/.record archive.empty _primitive.phase recordC) (check_record module_name tags monoT monoT size)))))) (def: .public test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) ($_ _.and ..sum ..product diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 5430e455c..17ce8036e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -3,8 +3,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random}] ["_" test {"+" Test}] [control @@ -17,7 +16,9 @@ ["[0]" product]] ["[0]" type ("[1]#[0]" equivalence)] [macro - ["[0]" code]]] + ["[0]" code]] + [meta + ["[0]" symbol]]] [//// [analysis ["_[0]" primitive]]] @@ -193,7 +194,7 @@ (def: .public test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) ($_ _.and ..lux ..i64 diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index ee21bb16c..136635e38 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -6,13 +6,14 @@ ["[0]" try]] [data ["%" text/format {"+" format}] - ["[0]" name] [number ["n" nat]] [collection ["[0]" list]]] ["r" math/random {"+" Random} ("[1]#[0]" monad)] - ["_" test {"+" Test}]] + ["_" test {"+" Test}] + [meta + ["[0]" symbol]]] [\\ ["[0]" / "_" ["/[1]" // @@ -72,12 +73,12 @@ (def: .public test Test - (<| (_.context (%.name (name_of ////synthesis.#Primitive))) + (<| (_.context (%.symbol (name_of ////synthesis.#Primitive))) (`` ($_ _.and (~~ (template [ ] [(do r.monad [expected ] - (_.test (%.name (name_of )) + (_.test (%.symbol (name_of )) (|> {////analysis.#Primitive { expected}} (//.phase archive.empty) (phase.result [///bundle.empty ////synthesis.init]) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index 02d079c4d..f08463d54 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -3,8 +3,7 @@ [abstract ["[0]" monad {"+" do}]] [data - ["%" text/format {"+" format}] - ["[0]" name]] + ["%" text/format {"+" format}]] ["r" math/random {"+" Random}] ["_" test {"+" Test}] [control @@ -16,7 +15,9 @@ [number ["n" nat]] [collection - ["[0]" list]]]] + ["[0]" list]]] + [meta + ["[0]" symbol]]] ["[0]" // "_" ["[1][0]" primitive]] [\\ @@ -75,7 +76,7 @@ (def: .public test Test - (<| (_.context (%.name (name_of ////synthesis.#Structure))) + (<| (_.context (%.symbol (name_of ////synthesis.#Structure))) ($_ _.and ..variant ..tuple diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 84d47becc..306ab931b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -3,7 +3,6 @@ [abstract/monad {"+" do}] [data ["%" text/format {"+" format}] - ["[0]" name] [number ["n" nat]]] ["r" math/random {"+" Random} ("[1]#[0]" monad)] @@ -20,19 +19,20 @@ [macro ["[0]" code]] [meta - ["[0]" location]]] + ["[0]" location] + ["[0]" symbol]]] [\\ ["[0]" /]]) -(def: name_part^ +(def: symbol_part^ (Random Text) (do [! r.monad] [size (|> r.nat (# ! each (|>> (n.% 20) (n.max 1))))] (r.ascii/lower_alpha size))) -(def: name^ - (Random Name) - (r.and name_part^ name_part^)) +(def: symbol^ + (Random Symbol) + (r.and symbol_part^ symbol_part^)) (def: code^ (Random Code) @@ -48,8 +48,8 @@ (do r.monad [size (|> r.nat (r#each (n.% 20)))] (|> (r.ascii/upper_alpha size) (r#each code.text))) - (|> name^ (r#each code.identifier)) - (|> name^ (r#each code.tag)))) + (|> symbol^ (r#each code.identifier)) + (|> symbol^ (r#each code.tag)))) simple^ (: (Random Code) ($_ r.either numeric^ @@ -139,7 +139,7 @@ (def: .public test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.context (symbol.module (name_of /._))) ($_ _.and ..code ..comments diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index ffd3671cb..774e95513 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -41,8 +41,8 @@ [size (|> random.nat (# ! each (n.% 10)))] (random.unicode size))) -(def: name - (Random Name) +(def: symbol + (Random Symbol) (random.and ..short ..short)) (def: (random' parameters) @@ -83,10 +83,10 @@ [anonymousT (random.only (|>> (case> {.#Named _ _} false _ true)) (..random 0)) - name/0 ..name - name/1 ..name - .let [namedT {.#Named name/0 anonymousT} - aliasedT {.#Named name/1 namedT}]] + symbol/0 ..symbol + symbol/1 ..symbol + .let [namedT {.#Named symbol/0 anonymousT} + aliasedT {.#Named symbol/1 namedT}]] ($_ _.and (_.cover [/.de_aliased] (# /.equivalence = namedT (/.de_aliased aliasedT))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index ce181e56b..c4d14054e 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -34,8 +34,8 @@ (Random Text) (random.unicode 10)) -(def: name - (Random Name) +(def: symbol + (Random Symbol) (random.and ..short ..short)) (def: (type' num_vars) @@ -61,7 +61,7 @@ random_pair random_id random_quantified - (random#each (|>> {.#Named}) (random.and ..name (type' 0))) + (random#each (|>> {.#Named}) (random.and ..symbol (type' 0))) ))))) (def: type @@ -577,7 +577,7 @@ ultimates_check_themselves!))) (def: (names_do_not_affect_types! left_name right_name nominal) - (-> Name Name Type Bit) + (-> Symbol Symbol Type Bit) (and (..succeeds? (/.check {.#Named left_name Any} nominal)) (..succeeds? (/.check Any {.#Named right_name nominal})) (..succeeds? (/.check {.#Named left_name Any} {.#Named right_name nominal})))) @@ -615,8 +615,8 @@ [nominal ..nominal [name/0 name/1] (..non_twins text#= (random.ascii/upper 10)) [parameter/0 parameter/1] (..non_twins type#= ..nominal) - left_name ..name - right_name ..name + left_name ..symbol + right_name ..symbol ring_tail_size (# ! each (n.% 10) random.nat)] (_.cover [/.check] (and (..handles_nominal_types! name/0 name/1 parameter/0 parameter/1) -- cgit v1.2.3