From bf53ee92fc3c33a4885aa227e55d24f7ba3cb2c4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 Mar 2022 08:37:23 -0400 Subject: De-sigil-ification: prefix : --- stdlib/source/library/lux.lux | 789 +++++++++++++++++++++--------------------- 1 file changed, 386 insertions(+), 403 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index aa5e5c476..7a80d68e7 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1365,10 +1365,10 @@ ... (type: (Monad m) ... (Interface -... (: (All (_ a) (-> a (m a))) -... #in) -... (: (All (_ a b) (-> (-> a (m b)) (m a) (m b))) -... #then))) +... (is (All (_ a) (-> a (m a))) +... #in) +... (is (All (_ a b) (-> (-> a (m b)) (m a) (m b))) +... #then))) ("lux def type tagged" Monad {#Named [..prelude_module "Monad"] (All (_ !) @@ -2261,7 +2261,7 @@ {#End}}}}}] (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) - [_ {#Form {#Item [_ {#Symbol ["" ":~"]}] {#Item expression {#End}}}}] + [_ {#Form {#Item [_ {#Symbol ["" "~"]}] {#Item expression {#End}}}}] expression [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] @@ -2311,7 +2311,7 @@ (failure "Wrong syntax for type")} tokens)) -(macro:' .public (: tokens) +(macro:' .public (is tokens) ({{#Item type {#Item value {#End}}} (meta#in (list (` ("lux type check" (..type (~ type)) @@ -2321,14 +2321,14 @@ (failure "Wrong syntax for :")} tokens)) -(macro:' .public (:as tokens) +(macro:' .public (as tokens) ({{#Item type {#Item value {#End}}} (meta#in (list (` ("lux type as" (..type (~ type)) (~ value))))) _ - (failure "Wrong syntax for :as")} + (failure "Wrong syntax for as")} tokens)) (def:''' .private (empty? xs) @@ -2377,22 +2377,22 @@ (list#reversed tokens))) (macro:' .private (def:' tokens) - (let' [parts (: (Maybe [Code Code (List Code) (Maybe Code) Code]) - ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} - {#Some [export_policy name args {#Some type} body]} - - {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} - {#Some [export_policy name {#End} {#Some type} body]} - - {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} - {#Some [export_policy name args {#None} body]} - - {#Item export_policy {#Item name {#Item body {#End}}}} - {#Some [export_policy name {#End} {#None} body]} - - _ - {#None}} - tokens))] + (let' [parts (is (Maybe [Code Code (List Code) (Maybe Code) Code]) + ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} + {#Some [export_policy name args {#Some type} body]} + + {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} + {#Some [export_policy name {#End} {#Some type} body]} + + {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} + {#Some [export_policy name args {#None} body]} + + {#Item export_policy {#Item name {#Item body {#End}}}} + {#Some [export_policy name {#End} {#None} body]} + + _ + {#None}} + tokens))] ({{#Some [export_policy name args ?type body]} (let' [body' ({{#End} body @@ -2401,7 +2401,7 @@ (` (function' (~ name) [(~+ args)] (~ body)))} args) body'' ({{#Some type} - (` (: (~ type) (~ body'))) + (` (is (~ type) (~ body'))) {#None} body'} @@ -2503,12 +2503,12 @@ {#Some bindings} (|> bindings list#reversed - (list#mix (: (-> [Code Code] Code Code) - (function' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` ({(~ l) (~ body')} (~ r))) - (` (case (~ r) (~ l) (~ body'))))))) + (list#mix (is (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` ({(~ l) (~ body')} (~ r))) + (` (case (~ r) (~ l) (~ body'))))))) body) list meta#in) @@ -2520,22 +2520,22 @@ (failure "Wrong syntax for let"))) (macro:' .public (function tokens) - (case (: (Maybe [Text Code (List Code) Code]) - (case tokens - (pattern (list [_ {#Form (list& [_ {#Symbol ["" name]}] head tail)}] body)) - {#Some name head tail body} - - _ - {#None})) + (case (is (Maybe [Text Code (List Code) Code]) + (case tokens + (pattern (list [_ {#Form (list& [_ {#Symbol ["" name]}] head tail)}] body)) + {#Some name head tail body} + + _ + {#None})) {#Some g!name head tail body} (let [g!blank (local_symbol$ "") - nest (: (-> Code (-> Code Code Code)) - (function' [g!name] - (function' [arg body'] - (if (symbol? arg) - (` ([(~ g!name) (~ arg)] (~ body'))) - (` ([(~ g!name) (~ g!blank)] - (.case (~ g!blank) (~ arg) (~ body'))))))))] + nest (is (-> Code (-> Code Code Code)) + (function' [g!name] + (function' [arg body'] + (if (symbol? arg) + (` ([(~ g!name) (~ arg)] (~ body'))) + (` ([(~ g!name) (~ g!blank)] + (.case (~ g!blank) (~ arg) (~ body'))))))))] (meta#in (list (nest (..local_symbol$ g!name) head (list#mix (nest g!blank) body (list#reversed tail)))))) @@ -2750,8 +2750,8 @@ (~ body)))) body (case ?type {#Some type} - (` (: (~ type) - (~ body))) + (` (is (~ type) + (~ body))) {#None} body)] @@ -2809,8 +2809,8 @@ [(macro: .public ( tokens) (case (list#reversed tokens) (pattern (list& last init)) - (meta#in (list (list#mix (: (-> Code Code Code) - (function (_ pre post) (`
))) + (meta#in (list (list#mix (is (-> Code Code Code) + (function (_ pre post) (` ))) last init))) @@ -2831,7 +2831,7 @@ (macro: (maybe#else tokens state) (case tokens (pattern (list else maybe)) - (let [g!temp (: Code [dummy_location {#Symbol ["" ""]}]) + (let [g!temp (is Code [dummy_location {#Symbol ["" ""]}]) code (` (case (~ maybe) {.#Some (~ g!temp)} (~ g!temp) @@ -3125,34 +3125,34 @@ [tokens' (monad#each meta_monad expansion tokens) struct_type ..expected_type tags+type (record_slots struct_type) - tags (: (Meta (List Symbol)) - (case tags+type - {#Some [tags _]} - (meta#in tags) + tags (is (Meta (List Symbol)) + (case tags+type + {#Some [tags _]} + (meta#in tags) - _ - (failure ($_ text#composite - "No tags available for type: " - (type#encoded struct_type))))) - .let [tag_mappings (: (List [Text Code]) - (list#each (function (_ tag) - [(product#right tag) - (symbol$ tag)]) - tags))] + _ + (failure ($_ text#composite + "No tags available for type: " + (type#encoded struct_type))))) + .let [tag_mappings (is (List [Text Code]) + (list#each (function (_ tag) + [(product#right tag) + (symbol$ tag)]) + tags))] members (monad#each meta_monad - (: (-> Code (Meta (List Code))) - (function (_ token) - (case token - (pattern [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) - (case (plist#value slot_name tag_mappings) - {#Some tag} - (in (list tag value)) + (is (-> Code (Meta (List Code))) + (function (_ token) + (case token + (pattern [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) + (case (plist#value slot_name tag_mappings) + {#Some tag} + (in (list tag value)) - _ - (failure (text#composite "Unknown implementation member: " slot_name))) + _ + (failure (text#composite "Unknown implementation member: " slot_name))) - _ - (failure "Invalid implementation member.")))) + _ + (failure "Invalid implementation member.")))) (list#conjoint tokens'))] (in (list (tuple$ (list#conjoint members)))))) @@ -3336,14 +3336,14 @@ module_name current_module_name .let' [type_name (local_symbol$ name) [type labels??] type+labels?? - type' (: (Maybe Code) - (case args - {#End} - {#Some type} + type' (is (Maybe Code) + (case args + {#End} + {#Some type} - _ - {#Some (` (.All ((~ type_name) (~+ (list#each local_symbol$ args))) - (~ type)))}))]] + _ + {#Some (` (.All ((~ type_name) (~+ (list#each local_symbol$ args))) + (~ type)))}))]] (case type' {#Some type''} (let [typeC (` {.#Named [(~ (text$ module_name)) @@ -3398,14 +3398,14 @@ (def: (referral_references defs) (-> (List Code) (Meta (List Text))) (monad#each meta_monad - (: (-> Code (Meta Text)) - (function (_ def) - (case def - [_ {#Symbol ["" name]}] - (meta#in name) + (is (-> Code (Meta Text)) + (function (_ def) + (case def + [_ {#Symbol ["" name]}] + (meta#in name) - _ - (failure "only/+ and exclude/- require symbols.")))) + _ + (failure "only/+ and exclude/- require symbols.")))) defs)) (def: (referrals_parser tokens) @@ -3474,14 +3474,14 @@ (def: (replaced pattern replacement template) (-> Text Text Text Text) - ((: (-> Text Text Text) - (function (again left right) - (case (..text#split_by pattern right) - {#Some [pre post]} - (again ($_ "lux text concat" left pre replacement) post) + ((is (-> Text Text Text) + (function (again left right) + (case (..text#split_by pattern right) + {#Some [pre post]} + (again ($_ "lux text concat" left pre replacement) post) - {#None} - ("lux text concat" left right)))) + {#None} + ("lux text concat" left right)))) "" template)) (def: (alias_stand_in index) @@ -3576,75 +3576,75 @@ (-> Bit Text (List Text) (List Code) (Meta (List Importation))) (do meta_monad [imports' (monad#each meta_monad - (: (-> Code (Meta (List Importation))) - (function (_ token) - (case token - ... Simple - [_ {#Symbol ["" module_name]}] - (do meta_monad - [absolute_module_name (..absolute_module_name nested? relative_root module_name)] - (in (list [#import_name absolute_module_name - #import_alias {#None} - #import_refer [#refer_defs {#All} - #refer_open (list)]]))) - - ... Nested - (pattern [_ {#Tuple (list& [_ {#Symbol ["" module_name]}] extra)}]) - (do meta_monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) - {#Some parallel_path} - (in parallel_path) - - {#None} - (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra] - sub_imports (imports_parser #1 absolute_module_name context extra)] - (in (case [referral openings] - [{#Nothing} {#End}] - sub_imports - - _ - (list& [#import_name absolute_module_name - #import_alias {#None} - #import_refer [#refer_defs referral - #refer_open openings]] - sub_imports)))) - - (pattern [_ {#Tuple (list& [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}]) - (do meta_monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) - {#Some parallel_path} - (in parallel_path) - - {#None} - (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra - module_alias (..module_alias {#Item module_name context} alias)] - sub_imports (imports_parser #1 absolute_module_name {#Item module_alias context} extra)] - (in (case [referral openings] - [{#Ignore} {#End}] - sub_imports - - _ - (list& [#import_name absolute_module_name - #import_alias {#Some module_alias} - #import_refer [#refer_defs referral - #refer_open openings]] - sub_imports)))) - - ... Unrecognized syntax. - _ - (do meta_monad - [current_module current_module_name] - (failure ($_ text#composite - "Wrong syntax for import @ " current_module - \n (code#encoded token))))))) + (is (-> Code (Meta (List Importation))) + (function (_ token) + (case token + ... Simple + [_ {#Symbol ["" module_name]}] + (do meta_monad + [absolute_module_name (..absolute_module_name nested? relative_root module_name)] + (in (list [#import_name absolute_module_name + #import_alias {#None} + #import_refer [#refer_defs {#All} + #refer_open (list)]]))) + + ... Nested + (pattern [_ {#Tuple (list& [_ {#Symbol ["" module_name]}] extra)}]) + (do meta_monad + [absolute_module_name (case (normal_parallel_path relative_root module_name) + {#Some parallel_path} + (in parallel_path) + + {#None} + (..absolute_module_name nested? relative_root module_name)) + referral+extra (referrals_parser extra) + .let [[referral extra] referral+extra] + openings+extra (openings_parser extra) + .let [[openings extra] openings+extra] + sub_imports (imports_parser #1 absolute_module_name context extra)] + (in (case [referral openings] + [{#Nothing} {#End}] + sub_imports + + _ + (list& [#import_name absolute_module_name + #import_alias {#None} + #import_refer [#refer_defs referral + #refer_open openings]] + sub_imports)))) + + (pattern [_ {#Tuple (list& [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}]) + (do meta_monad + [absolute_module_name (case (normal_parallel_path relative_root module_name) + {#Some parallel_path} + (in parallel_path) + + {#None} + (..absolute_module_name nested? relative_root module_name)) + referral+extra (referrals_parser extra) + .let [[referral extra] referral+extra] + openings+extra (openings_parser extra) + .let [[openings extra] openings+extra + module_alias (..module_alias {#Item module_name context} alias)] + sub_imports (imports_parser #1 absolute_module_name {#Item module_alias context} extra)] + (in (case [referral openings] + [{#Ignore} {#End}] + sub_imports + + _ + (list& [#import_name absolute_module_name + #import_alias {#Some module_alias} + #import_refer [#refer_defs referral + #refer_open openings]] + sub_imports)))) + + ... Unrecognized syntax. + _ + (do meta_monad + [current_module current_module_name] + (failure ($_ text#composite + "Wrong syntax for import @ " current_module + \n (code#encoded token))))))) imports)] (in (list#conjoint imports')))) @@ -3658,28 +3658,28 @@ [current_module modules])] (case (plist#value module modules) {#Some =module} - (let [to_alias (list#each (: (-> [Text Global] - (List Text)) - (function (_ [name definition]) - (case definition - {#Alias _} - (list) - - {#Definition [exported? def_type def_value]} - (if exported? - (list name) - (list)) - - {#Type [exported? type labels]} - (if exported? - (list name) - (list)) - - {#Tag _} - (list) - - {#Slot _} - (list)))) + (let [to_alias (list#each (is (-> [Text Global] + (List Text)) + (function (_ [name definition]) + (case definition + {#Alias _} + (list) + + {#Definition [exported? def_type def_value]} + (if exported? + (list name) + (list)) + + {#Type [exported? type labels]} + (if exported? + (list name) + (list)) + + {#Tag _} + (list) + + {#Slot _} + (list)))) (let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module] definitions))] {#Right state (list#conjoint to_alias)}) @@ -3728,19 +3728,19 @@ ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] - (list#one (: (-> Scope (Maybe Type)) - (function (_ env) - (case env - [..#name _ - ..#inner _ - ..#locals [..#counter _ ..#mappings locals] - ..#captured _] - (list#one (: (-> [Text [Type Any]] (Maybe Type)) - (function (_ [bname [type _]]) - (if (text#= name bname) - {#Some type} - {#None}))) - locals)))) + (list#one (is (-> Scope (Maybe Type)) + (function (_ env) + (case env + [..#name _ + ..#inner _ + ..#locals [..#counter _ ..#mappings locals] + ..#captured _] + (list#one (is (-> [Text [Type Any]] (Maybe Type)) + (function (_ [bname [type _]]) + (if (text#= name bname) + {#Some type} + {#None}))) + locals)))) scopes))) (def: (definition_type name state) @@ -3834,25 +3834,25 @@ [.let [[module name] full_name] current_module current_module_name] (function (_ compiler) - (let [temp (: (Either Text [Lux Type]) - (if (text#= "" module) - (case (in_env name compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + (let [temp (is (Either Text [Lux Type]) + (if (text#= "" module) + (case (in_env name compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - (case (definition_type [current_module name] compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + _ + (case (definition_type [current_module name] compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - {#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: " (symbol#encoded full_name))})) + (case (definition_type full_name compiler) + {#Some struct_type} + {#Right [compiler struct_type]} - _ - {#Left ($_ text#composite "Unknown var: " (symbol#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 _ @@ -3903,39 +3903,39 @@ {#Some tags&members} (do meta_monad - [full_body ((: (-> Symbol [(List Symbol) (List Type)] Code (Meta Code)) - (function (again source [tags members] target) - (let [locals (list#each (function (_ [t_module t_name]) - [[t_module t_name] - ["" (..module_alias (list t_name) alias)]]) - tags) - pattern (case locals - (pattern (list [slot binding])) - (symbol$ binding) - - _ - (|> locals - (list#each (function (_ [slot binding]) - (list (symbol$ slot) - (symbol$ binding)))) - list#conjoint - tuple$))] - (do meta_monad - [enhanced_target (monad#mix meta_monad - (function (_ [[_ m_local] m_type] enhanced_target) - (do meta_monad - [m_implementation (record_slots m_type)] - (case m_implementation - {#Some m_tags&members} - (again m_local - m_tags&members - enhanced_target) - - {#None} - (in enhanced_target)))) - target - (zipped/2 locals members))] - (in (` ({(~ pattern) (~ enhanced_target)} (~ (symbol$ source))))))))) + [full_body ((is (-> Symbol [(List Symbol) (List Type)] Code (Meta Code)) + (function (again source [tags members] target) + (let [locals (list#each (function (_ [t_module t_name]) + [[t_module t_name] + ["" (..module_alias (list t_name) alias)]]) + tags) + pattern (case locals + (pattern (list [slot binding])) + (symbol$ binding) + + _ + (|> locals + (list#each (function (_ [slot binding]) + (list (symbol$ slot) + (symbol$ binding)))) + list#conjoint + tuple$))] + (do meta_monad + [enhanced_target (monad#mix meta_monad + (function (_ [[_ m_local] m_type] enhanced_target) + (do meta_monad + [m_implementation (record_slots m_type)] + (case m_implementation + {#Some m_tags&members} + (again m_local + m_tags&members + enhanced_target) + + {#None} + (in enhanced_target)))) + target + (zipped/2 locals members))] + (in (` ({(~ pattern) (~ enhanced_target)} (~ (symbol$ source))))))))) name tags&members body)] (in (list full_body))))) @@ -3947,10 +3947,10 @@ (pattern (list& else branches')) (case (pairs branches') {#Some branches'} - (meta#in (list (list#mix (: (-> [Code Code] Code Code) - (function (_ branch else) - (let [[then ?] branch] - (` (if (~ ?) (~ then) (~ else)))))) + (meta#in (list (list#mix (is (-> [Code Code] Code Code) + (function (_ branch else) + (let [[then ?] branch] + (` (if (~ ?) (~ then) (~ else)))))) else branches'))) @@ -3987,12 +3987,12 @@ (case (interface_methods type) {#Some members} (let [pattern (|> (zipped/2 tags (enumeration members)) - (list#each (: (-> [Symbol [Nat Type]] (List Code)) - (function (_ [[r_module r_name] [r_idx r_type]]) - (list (symbol$ [r_module r_name]) - (if ("lux i64 =" idx r_idx) - g!output - g!_))))) + (list#each (is (-> [Symbol [Nat Type]] (List Code)) + (function (_ [[r_module r_name] [r_idx r_type]]) + (list (symbol$ [r_module r_name]) + (if ("lux i64 =" idx r_idx) + g!output + g!_))))) list#conjoint tuple$)] (meta#in (list (` ({(~ pattern) (~ g!output)} (~ record)))))) @@ -4001,9 +4001,9 @@ (failure "the can only use records."))) (pattern (list [_ {#Tuple slots}] record)) - (meta#in (list (list#mix (: (-> Code Code Code) - (function (_ slot inner) - (` (..the (~ slot) (~ inner))))) + (meta#in (list (list#mix (is (-> Code Code Code) + (function (_ slot inner) + (` (..the (~ slot) (~ inner))))) record slots))) @@ -4034,9 +4034,9 @@ {#Some [tags' members']} (do meta_monad [decls' (monad#each meta_monad - (: (-> [Nat Symbol Type] (Meta (List Code))) - (function (_ [sub_tag_index sname stype]) - (open_declaration alias tags' sub_tag_index sname source+ stype))) + (is (-> [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')))] (meta#in (list#conjoint decls'))) @@ -4057,9 +4057,9 @@ (case output {#Some [tags members]} (do meta_monad - [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))) + [decls' (monad#each meta_monad (is (-> [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)))] (meta#in (list#conjoint decls'))) @@ -4118,15 +4118,15 @@ (-> Text Refer (Meta (List Code))) (do meta_monad [current_module ..current_module_name - .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) - (function (_ module_name all_defs referred_defs) - (monad#each meta_monad - (: (-> Text (Meta Any)) - (function (_ _def) - (if (is_member? all_defs _def) - (meta#in []) - (failure ($_ text#composite _def " is not defined in module " module_name " @ " current_module))))) - referred_defs)))] + .let [test_referrals (is (-> Text (List Text) (List Text) (Meta (List Any))) + (function (_ module_name all_defs referred_defs) + (monad#each meta_monad + (is (-> Text (Meta Any)) + (function (_ _def) + (if (is_member? all_defs _def) + (meta#in []) + (failure ($_ text#composite _def " is not defined in module " module_name " @ " current_module))))) + referred_defs)))] defs' (case r_defs {#All} (exported_definitions module_name) @@ -4148,16 +4148,16 @@ {#Nothing} (in (list))) - .let [defs (list#each (: (-> Text Code) - (function (_ def) - (` ("lux def alias" (~ (local_symbol$ def)) (~ (symbol$ [module_name def])))))) + .let [defs (list#each (is (-> Text Code) + (function (_ def) + (` ("lux def alias" (~ (local_symbol$ def)) (~ (symbol$ [module_name def])))))) defs') openings (|> r_opens - (list#each (: (-> Openings (List Code)) - (function (_ [alias structs]) - (list#each (function (_ name) - (` (open: (~ (text$ alias)) (~ (symbol$ [module_name name]))))) - structs)))) + (list#each (is (-> Openings (List Code)) + (function (_ [alias structs]) + (list#each (function (_ name) + (` (open: (~ (text$ alias)) (~ (symbol$ [module_name name]))))) + structs)))) list#conjoint)]] (in (list#composite defs openings)))) @@ -4174,22 +4174,22 @@ (def: (refer_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) (let [module_alias (..maybe#else module_name module_alias') - localizations (: (List Code) - (case r_defs - {#All} - (list (' "*")) - - {#Only defs} - (list (variant$ (list& (' "+") (list#each local_symbol$ defs)))) - - {#Exclude defs} - (list (variant$ (list& (' "-") (list#each local_symbol$ defs)))) - - {#Ignore} - (list) - - {#Nothing} - (list))) + localizations (is (List Code) + (case r_defs + {#All} + (list (' "*")) + + {#Only defs} + (list (variant$ (list& (' "+") (list#each local_symbol$ defs)))) + + {#Exclude defs} + (list (variant$ (list& (' "-") (list#each local_symbol$ defs)))) + + {#Ignore} + (list) + + {#Nothing} + (list))) openings (list#each (function (_ [alias structs]) (form$ (list& (text$ (..module_alias (list (alias_stand_in 0) module_alias) alias)) (list#each local_symbol$ structs)))) @@ -4221,26 +4221,26 @@ {#Some members} (do meta_monad [pattern' (monad#each meta_monad - (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) - (function (_ [r_slot_name [r_idx r_type]]) - (do meta_monad - [g!slot (..generated_symbol "")] - (meta#in [r_slot_name r_idx g!slot])))) + (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (..generated_symbol "")] + (meta#in [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' - (list#each (: (-> [Symbol Nat Code] (List Code)) - (function (_ [r_slot_name r_idx r_var]) - (list (symbol$ r_slot_name) - r_var)))) + (list#each (is (-> [Symbol Nat Code] (List Code)) + (function (_ [r_slot_name r_idx r_var]) + (list (symbol$ r_slot_name) + r_var)))) list#conjoint tuple$) output (|> pattern' - (list#each (: (-> [Symbol Nat Code] (List Code)) - (function (_ [r_slot_name r_idx r_var]) - (list (symbol$ r_slot_name) - (if ("lux i64 =" idx r_idx) - value - r_var))))) + (list#each (is (-> [Symbol Nat Code] (List Code)) + (function (_ [r_slot_name r_idx r_var]) + (list (symbol$ r_slot_name) + (if ("lux i64 =" idx r_idx) + value + r_var))))) list#conjoint tuple$)] (meta#in (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4256,20 +4256,20 @@ _ (do meta_monad [bindings (monad#each meta_monad - (: (-> Code (Meta Code)) - (function (_ _) (..generated_symbol "temp"))) + (is (-> Code (Meta Code)) + (function (_ _) (..generated_symbol "temp"))) slots) .let [pairs (zipped/2 slots bindings) - update_expr (list#mix (: (-> [Code Code] Code Code) - (function (_ [s b] v) - (` (..has (~ s) (~ v) (~ b))))) + update_expr (list#mix (is (-> [Code Code] Code Code) + (function (_ [s b] v) + (` (..has (~ s) (~ v) (~ b))))) value (list#reversed pairs)) - [_ accesses'] (list#mix (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) - (function (_ [new_slot new_binding] [old_record accesses']) - [(` (the (~ new_slot) (~ new_binding))) - {#Item (list new_binding old_record) accesses'}])) - [record (: (List (List Code)) {#End})] + [_ accesses'] (list#mix (is (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) + (function (_ [new_slot new_binding] [old_record accesses']) + [(` (the (~ new_slot) (~ new_binding))) + {#Item (list new_binding old_record) accesses'}])) + [record (is (List (List Code)) {#End})] pairs) accesses (list#conjoint (list#reversed accesses'))]] (in (list (` (let [(~+ accesses)] @@ -4304,26 +4304,26 @@ {#Some members} (do meta_monad [pattern' (monad#each meta_monad - (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) - (function (_ [r_slot_name [r_idx r_type]]) - (do meta_monad - [g!slot (..generated_symbol "")] - (meta#in [r_slot_name r_idx g!slot])))) + (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (..generated_symbol "")] + (meta#in [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' - (list#each (: (-> [Symbol Nat Code] (List Code)) - (function (_ [r_slot_name r_idx r_var]) - (list (symbol$ r_slot_name) - r_var)))) + (list#each (is (-> [Symbol Nat Code] (List Code)) + (function (_ [r_slot_name r_idx r_var]) + (list (symbol$ r_slot_name) + r_var)))) list#conjoint tuple$) output (|> pattern' - (list#each (: (-> [Symbol Nat Code] (List Code)) - (function (_ [r_slot_name r_idx r_var]) - (list (symbol$ r_slot_name) - (if ("lux i64 =" idx r_idx) - (` ((~ fun) (~ r_var))) - r_var))))) + (list#each (is (-> [Symbol Nat Code] (List Code)) + (function (_ [r_slot_name r_idx r_var]) + (list (symbol$ r_slot_name) + (if ("lux i64 =" idx r_idx) + (` ((~ fun) (~ r_var))) + r_var))))) list#conjoint tuple$)] (meta#in (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4368,20 +4368,20 @@ [_ {#Tuple templates}])}] [_ {#Form data}] branches)) - (case (: (Maybe (List Code)) - (do maybe_monad - [bindings' (monad#each maybe_monad symbol_short bindings) - data' (monad#each maybe_monad tuple_list data)] - (let [num_bindings (list#size bindings')] - (if (every? (|>> ("lux i64 =" num_bindings)) - (list#each list#size data')) - (let [apply (: (-> Replacement_Environment (List Code)) - (function (_ env) (list#each (realized_template env) templates)))] - (|> data' - (list#each (function#composite apply (replacement_environment bindings'))) - list#conjoint - in)) - {#None})))) + (case (is (Maybe (List Code)) + (do maybe_monad + [bindings' (monad#each maybe_monad symbol_short bindings) + data' (monad#each maybe_monad tuple_list data)] + (let [num_bindings (list#size bindings')] + (if (every? (|>> ("lux i64 =" num_bindings)) + (list#each list#size data')) + (let [apply (is (-> Replacement_Environment (List Code)) + (function (_ env) (list#each (realized_template env) templates)))] + (|> data' + (list#each (function#composite apply (replacement_environment bindings'))) + list#conjoint + in)) + {#None})))) {#Some output} (meta#in (list#composite output branches)) @@ -4465,10 +4465,10 @@ inits (list#each product#right pairs)] (if (every? symbol? inits) (do meta_monad - [inits' (: (Meta (List Symbol)) - (case (monad#each maybe_monad symbol_name inits) - {#Some inits'} (meta#in inits') - {#None} (failure "Wrong syntax for loop"))) + [inits' (is (Meta (List Symbol)) + (case (monad#each maybe_monad symbol_name inits) + {#Some inits'} (meta#in inits') + {#None} (failure "Wrong syntax for loop"))) init_types (monad#each meta_monad type_definition inits') expected ..expected_type] (meta#in (list (` (("lux type check" @@ -4479,8 +4479,8 @@ (~+ inits)))))) (do meta_monad [aliases (monad#each meta_monad - (: (-> Code (Meta Code)) - (function (_ _) (..generated_symbol ""))) + (is (-> Code (Meta Code)) + (function (_ _) (..generated_symbol ""))) inits)] (meta#in (list (` (let [(~+ (..interleaved aliases inits))] (.loop (~ name) @@ -4516,14 +4516,14 @@ (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} (loop [bindings bindings - map (: (PList (List Code)) - (list))] - (let [normal (: (-> Code (List Code)) - (function (_ it) - (list#mix (function (_ [binding expansion] it) - (list#conjoint (list#each (with_expansions' binding expansion) it))) - (list it) - map)))] + map (is (PList (List Code)) + (list))] + (let [normal (is (-> Code (List Code)) + (function (_ it) + (list#mix (function (_ [binding expansion] it) + (list#conjoint (list#each (with_expansions' binding expansion) it))) + (list it) + map)))] (case bindings {#Item [var_name expr] &rest} (do meta_monad @@ -4571,7 +4571,7 @@ (case (flat_alias type) (pattern#template [ ] [{#Named ["library/lux" ] _} - (in ( (:as value)))]) + (in ( (as value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] @@ -4658,7 +4658,7 @@ (list) (list g!_ (` {.#None})))))))) (` {.#Some (~ body)}) - (: (List [Code Code]) (list#reversed levels)))] + (is (List [Code Code]) (list#reversed levels)))] (list init_pattern inner_pattern_body))) (macro: (pattern#multi tokens) @@ -4713,7 +4713,7 @@ (-> a a Bit)) ("lux is" reference sample)) -(macro: .public (:expected tokens) +(macro: .public (as_expected tokens) (case tokens (pattern (list expr)) (do meta_monad @@ -4721,7 +4721,7 @@ (in (list (` ("lux type as" (~ (type_code type)) (~ expr)))))) _ - (failure (..wrong_syntax_error (symbol ..:expected))))) + (failure (..wrong_syntax_error (symbol ..as_expected))))) (def: location (Meta Location) @@ -4741,7 +4741,7 @@ _ (failure (..wrong_syntax_error (symbol ..undefined))))) -(macro: .public (:of tokens) +(macro: .public (type_of tokens) (case tokens (pattern (list [_ {#Symbol var_name}])) (do meta_monad @@ -4752,10 +4752,10 @@ (do meta_monad [g!temp (..generated_symbol "g!temp")] (in (list (` (let [(~ g!temp) (~ expression)] - (..:of (~ g!temp))))))) + (..type_of (~ g!temp))))))) _ - (failure (..wrong_syntax_error (symbol ..:of))))) + (failure (..wrong_syntax_error (symbol ..type_of))))) (def: (templateP tokens) (-> (List Code) (Maybe [Code Text (List Text) (List Code)])) @@ -4796,7 +4796,7 @@ (template [ ] [(template: .public ( it) - [(..|> it (..: (..I64 ..Any)) (..:as ))])] + [(..|> it (..is (..I64 ..Any)) (..as ))])] [i64 ..I64] [nat ..Nat] @@ -4837,7 +4837,7 @@ (case (..flat_alias type) (pattern#or {#Primitive "#Text" {#End}} {#Named ["library/lux" "Text"] {#Primitive "#Text" {#End}}}) - (in (:as ..Text value)) + (in (as ..Text value)) _ (failure ($_ text#composite @@ -4879,7 +4879,7 @@ {.#None} (failure (..wrong_syntax_error (symbol ..for))))) -... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and ":parameter" ASAP. +... TODO: Delete "scope_type_vars" (including the #scope_type_vars Lux state) and "parameter" ASAP. (for "{old}" (as_is (def: (scope_type_vars state) (Meta (List Nat)) (case state @@ -4889,7 +4889,7 @@ ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right [state scope_type_vars]})) - (macro: .public (:parameter tokens) + (macro: .public (parameter tokens) (case tokens (pattern (list [_ {#Nat idx}])) (do meta_monad @@ -4910,13 +4910,13 @@ [current_module ..current_module_name imports (imports_parser #0 current_module {#End} _imports) .let [=imports (|> imports - (list#each (: (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (` [(~ (text$ module_name)) (~ (text$ (..maybe#else "" m_alias)))])))) + (list#each (is (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (` [(~ (text$ module_name)) (~ (text$ (..maybe#else "" m_alias)))])))) tuple$) - =refers (list#each (: (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (refer_code module_name m_alias =refer))) + =refers (list#each (is (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (refer_code module_name m_alias =refer))) imports) =module (` ("lux def module" (~ =imports)))] g!_ (..generated_symbol "")] @@ -4974,23 +4974,6 @@ Bit #1) -(macro: .public (:let tokens) - (case tokens - (pattern (list [_ {#Tuple bindings}] bodyT)) - (case (..pairs bindings) - {#Some bindings} - (meta#in (list (` (..with_expansions [(~+ (|> bindings - (list#each (function (_ [localT valueT]) - (list localT (` (..as_is (~ valueT)))))) - (list#mix list#composite (list))))] - (~ bodyT))))) - - {#None} - (..failure ":let requires an even number of parts")) - - _ - (..failure (..wrong_syntax_error (symbol ..:let))))) - (macro: .public (try tokens) (case tokens (pattern (list expression)) @@ -5055,4 +5038,4 @@ (def: .public macro (-> Macro Macro') - (|>> (:as Macro'))) + (|>> (as Macro'))) -- cgit v1.2.3