From ef77466323f85a3d1b65b46a3deb93652ef22085 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 9 Sep 2021 00:29:12 -0400 Subject: The old record syntax has been re-purposed as variant syntax. --- stdlib/source/library/lux.lux | 479 ++++++++++++++++++------------------------ 1 file changed, 205 insertions(+), 274 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 0872e57c1..5f6f9342e 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -18,7 +18,7 @@ ... (Ex (_ a) a)) ("lux def" Any ("lux type check type" - (9 #1 ["library/lux" "Any"] + (9 #1 [..prelude_module "Any"] (8 #0 (0 #0) (4 #0 1)))) #1) @@ -26,7 +26,7 @@ ... (All (_ a) a)) ("lux def" Nothing ("lux type check type" - (9 #1 ["library/lux" "Nothing"] + (9 #1 [..prelude_module "Nothing"] (7 #0 (0 #0) (4 #0 1)))) #1) @@ -34,11 +34,12 @@ ... #End ... (#Item a (List a))) ("lux def type tagged" List - (9 #1 ["library/lux" "List"] + (9 #1 [..prelude_module "List"] (7 #0 (0 #0) - (1 #0 ... "lux.End" + (1 #0 + ... End Any - ... "lux.Item" + ... Item (2 #0 (4 #0 1) (9 #0 (4 #0 1) (4 #0 0)))))) ("End" "Item") @@ -46,50 +47,50 @@ ("lux def" Bit ("lux type check type" - (9 #1 ["library/lux" "Bit"] + (9 #1 [..prelude_module "Bit"] (0 #0 "#Bit" #End))) #1) ("lux def" I64 ("lux type check type" - (9 #1 ["library/lux" "I64"] + (9 #1 [..prelude_module "I64"] (7 #0 (0 #0) (0 #0 "#I64" (#Item (4 #0 1) #End))))) #1) ("lux def" Nat ("lux type check type" - (9 #1 ["library/lux" "Nat"] + (9 #1 [..prelude_module "Nat"] (0 #0 "#I64" (#Item (0 #0 "#Nat" #End) #End)))) #1) ("lux def" Int ("lux type check type" - (9 #1 ["library/lux" "Int"] + (9 #1 [..prelude_module "Int"] (0 #0 "#I64" (#Item (0 #0 "#Int" #End) #End)))) #1) ("lux def" Rev ("lux type check type" - (9 #1 ["library/lux" "Rev"] + (9 #1 [..prelude_module "Rev"] (0 #0 "#I64" (#Item (0 #0 "#Rev" #End) #End)))) #1) ("lux def" Frac ("lux type check type" - (9 #1 ["library/lux" "Frac"] + (9 #1 [..prelude_module "Frac"] (0 #0 "#Frac" #End))) #1) ("lux def" Text ("lux type check type" - (9 #1 ["library/lux" "Text"] + (9 #1 [..prelude_module "Text"] (0 #0 "#Text" #End))) #1) ("lux def" Name ("lux type check type" - (9 #1 ["library/lux" "Name"] + (9 #1 [..prelude_module "Name"] (2 #0 Text Text))) #1) @@ -97,11 +98,12 @@ ... #None ... (#Some a)) ("lux def type tagged" Maybe - (9 #1 ["library/lux" "Maybe"] + (9 #1 [..prelude_module "Maybe"] (7 #0 #End - (1 #0 ... "lux.None" + (1 #0 + ... None Any - ... "lux.Some" + ... Some (4 #0 1)))) ("None" "Some") #1) @@ -121,43 +123,43 @@ ... (#Apply Type Type) ... (#Named Name Type)))) ("lux def type tagged" Type - (9 #1 ["library/lux" "Type"] + (9 #1 [..prelude_module "Type"] ({Type ({Type_List ({Type_Pair (9 #0 (0 #0 ["" #End]) (7 #0 #End (1 #0 - ... "lux.Primitive" + ... Primitive (2 #0 Text Type_List) (1 #0 - ... "lux.Sum" + ... Sum Type_Pair (1 #0 - ... "lux.Product" + ... Product Type_Pair (1 #0 - ... "lux.Function" + ... Function Type_Pair (1 #0 - ... "lux.Parameter" + ... Parameter Nat (1 #0 - ... "lux.Var" + ... Var Nat (1 #0 - ... "lux.Ex" + ... Ex Nat (1 #0 - ... "lux.UnivQ" + ... UnivQ (2 #0 Type_List Type) (1 #0 - ... "lux.ExQ" + ... ExQ (2 #0 Type_List Type) (1 #0 - ... "lux.Apply" + ... Apply Type_Pair - ... "lux.Named" + ... Named (2 #0 Name Type)))))))))))))} ("lux type check type" (2 #0 Type Type)))} ("lux type check type" (9 #0 Type List)))} @@ -171,7 +173,7 @@ ... #line Nat ... #column Nat])) ("lux def type tagged" Location - (#Named ["library/lux" "Location"] + (#Named [..prelude_module "Location"] (#Product Text (#Product Nat Nat))) ["module" "line" "column"] #1) @@ -181,7 +183,7 @@ ... [#meta m ... #datum v])) ("lux def type tagged" Ann - (#Named ["library/lux" "Ann"] + (#Named [..prelude_module "Ann"] (#UnivQ #End (#UnivQ #End (#Product (#Parameter 3) @@ -199,49 +201,59 @@ ... (#Identifier Name) ... (#Tag Name) ... (#Form (List (w (Code' w)))) -... (#Tuple (List (w (Code' w)))) -... (#Record (List [(w (Code' w)) (w (Code' w))]))) +... (#Variant (List (w (Code' w)))) +... (#Tuple (List (w (Code' w))))) ("lux def type tagged" Code' - (#Named ["library/lux" "Code'"] + (#Named [..prelude_module "Code'"] ({Code ({Code_List (#UnivQ #End - (#Sum ... "lux.Bit" + (#Sum + ... Bit Bit - (#Sum ... "lux.Nat" + (#Sum + ... Nat Nat - (#Sum ... "lux.Int" + (#Sum + ... Int Int - (#Sum ... "lux.Rev" + (#Sum + ... Rev Rev - (#Sum ... "lux.Frac" + (#Sum + ... Frac Frac - (#Sum ... "lux.Text" + (#Sum + ... Text Text - (#Sum ... "lux.Identifier" + (#Sum + ... Identifier Name - (#Sum ... "lux.Tag" + (#Sum + ... Tag Name - (#Sum ... "lux.Form" + (#Sum + ... Form Code_List - (#Sum ... "lux.Tuple" + (#Sum + ... Variant + Code_List + ... Tuple Code_List - ... "lux.Record" - (#Apply (#Product Code Code) List) )))))))))) )} ("lux type check type" (#Apply Code List)))} ("lux type check type" (#Apply (#Apply (#Parameter 1) (#Parameter 0)) (#Parameter 1))))) - ("Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record") + ("Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Variant" "Tuple") #1) ... (type: .public Code ... (Ann Location (Code' (Ann Location)))) ("lux def" Code ("lux type check type" - (#Named ["library/lux" "Code"] + (#Named [..prelude_module "Code"] ({w (#Apply (#Apply w Code') w)} ("lux type check type" (#Apply Location Ann))))) @@ -327,21 +339,21 @@ ([_ tokens] (_ann (#Form tokens)))) #0) -("lux def" tuple$ +("lux def" variant$ ("lux type check" (#Function (#Apply Code List) Code) - ([_ tokens] (_ann (#Tuple tokens)))) + ([_ tokens] (_ann (#Variant tokens)))) #0) -("lux def" record$ - ("lux type check" (#Function (#Apply (#Product Code Code) List) Code) - ([_ tokens] (_ann (#Record tokens)))) +("lux def" tuple$ + ("lux type check" (#Function (#Apply Code List) Code) + ([_ tokens] (_ann (#Tuple tokens)))) #0) ... (type: .public Definition ... [Bit Type Any]) ("lux def" Definition ("lux type check type" - (#Named ["library/lux" "Definition"] + (#Named [..prelude_module "Definition"] (#Product Bit (#Product Type Any)))) .public) @@ -349,7 +361,7 @@ ... Name) ("lux def" Alias ("lux type check type" - (#Named ["library/lux" "Alias"] + (#Named [..prelude_module "Alias"] Name)) .public) @@ -357,7 +369,7 @@ ... [Bit Type (List Text) Nat]) ("lux def" Label ("lux type check type" - (#Named ["library/lux" "Label"] + (#Named [..prelude_module "Label"] (#Product Bit (#Product Type (#Product (#Apply Text List) Nat))))) .public) @@ -369,7 +381,7 @@ ... (#Slot Label) ... (#Alias Alias))) ("lux def type tagged" Global - (#Named ["library/lux" "Global"] + (#Named [..prelude_module "Global"] (#Sum Definition (#Sum ({labels (#Product Bit (#Product Type (#Sum labels labels)))} @@ -385,12 +397,13 @@ ... [#counter Nat ... #mappings (List [k v])])) ("lux def type tagged" Bindings - (#Named ["library/lux" "Bindings"] + (#Named [..prelude_module "Bindings"] (#UnivQ #End (#UnivQ #End - (#Product ... "lux.counter" + (#Product + ... counter Nat - ... "lux.mappings" + ... mappings (#Apply (#Product (#Parameter 3) (#Parameter 1)) List))))) @@ -401,7 +414,7 @@ ... (#Local Nat) ... (#Captured Nat)) ("lux def type tagged" Ref - (#Named ["library/lux" "Ref"] + (#Named [..prelude_module "Ref"] (#Sum ... Local Nat ... Captured @@ -416,7 +429,7 @@ ... #locals (Bindings Text [Type Nat]) ... #captured (Bindings Text [Type Ref])])) ("lux def type tagged" Scope - (#Named ["library/lux" "Scope"] + (#Named [..prelude_module "Scope"] (#Product ... name (#Apply Text List) (#Product ... inner @@ -437,12 +450,13 @@ ... (#Left l) ... (#Right r)) ("lux def type tagged" Either - (#Named ["library/lux" "Either"] + (#Named [..prelude_module "Either"] (#UnivQ #End (#UnivQ #End - (#Sum ... "lux.Left" + (#Sum + ... Left (#Parameter 3) - ... "lux.Right" + ... Right (#Parameter 1))))) ("Left" "Right") .public) @@ -451,7 +465,7 @@ ... [Location Nat Text]) ("lux def" Source ("lux type check type" - (#Named ["library/lux" "Source"] + (#Named [..prelude_module "Source"] (#Product Location (#Product Nat Text)))) .public) @@ -460,7 +474,7 @@ ... #Compiled ... #Cached) ("lux def type tagged" Module_State - (#Named ["library/lux" "Module_State"] + (#Named [..prelude_module "Module_State"] (#Sum ... #Active Any @@ -480,18 +494,18 @@ ... #imports (List Text) ... #module_state Module_State])) ("lux def type tagged" Module - (#Named ["library/lux" "Module"] + (#Named [..prelude_module "Module"] (#Product - ... "lux.module_hash" + ... module_hash Nat (#Product - ... "lux.module_aliases" + ... module_aliases (#Apply (#Product Text Text) List) (#Product - ... "lux.definitions" + ... definitions (#Apply (#Product Text Global) List) (#Product - ... "lux.imports" + ... imports (#Apply Text List) ... module_state Module_State @@ -505,7 +519,7 @@ ... #var_counter Nat ... #var_bindings (List [Nat (Maybe Type)])])) ("lux def type tagged" Type_Context - (#Named ["library/lux" "Type_Context"] + (#Named [..prelude_module "Type_Context"] (#Product ... ex_counter Nat (#Product ... var_counter @@ -521,7 +535,7 @@ ... #Eval ... #Interpreter) ("lux def type tagged" Mode - (#Named ["library/lux" "Mode"] + (#Named [..prelude_module "Mode"] (#Sum ... Build Any (#Sum ... Eval @@ -537,7 +551,7 @@ ... #version Text ... #mode Mode])) ("lux def type tagged" Info - (#Named ["library/lux" "Info"] + (#Named [..prelude_module "Info"] (#Product ... target Text @@ -565,7 +579,7 @@ ... #eval (-> Type Code (-> Lux (Either Text [Lux Any]))) ... #host Any])) ("lux def type tagged" Lux - (#Named ["library/lux" "Lux"] + (#Named [..prelude_module "Lux"] ({Lux (#Apply (0 #0 ["" #End]) (#UnivQ #End @@ -618,7 +632,7 @@ ... (-> Lux (Either Text [Lux a]))) ("lux def" Meta ("lux type check type" - (#Named ["library/lux" "Meta"] + (#Named [..prelude_module "Meta"] (#UnivQ #End (#Function Lux (#Apply (#Product Lux (#Parameter 1)) @@ -629,7 +643,7 @@ ... (-> (List Code) (Meta (List Code)))) ("lux def" Macro' ("lux type check type" - (#Named ["library/lux" "Macro'"] + (#Named [..prelude_module "Macro'"] (#Function Code_List (#Apply Code_List Meta)))) .public) @@ -637,7 +651,7 @@ ... (primitive "#Macro")) ("lux def" Macro ("lux type check type" - (#Named ["library/lux" "Macro"] + (#Named [..prelude_module "Macro"] (#Primitive "#Macro" #End))) .public) @@ -672,7 +686,8 @@ ("lux macro" ([_ tokens] ({(#Item lhs (#Item rhs (#Item body #End))) - (in_meta (#Item (form$ (#Item (record$ (#Item [lhs body] #End)) (#Item rhs #End))) + (in_meta (#Item (form$ (#Item (variant$ (#Item lhs (#Item body #End))) + (#Item rhs #End))) #End)) _ @@ -690,7 +705,7 @@ body _ - (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) + (_ann (#Form (#Item (_ann (#Identifier [..prelude_module "function''"])) (#Item (_ann (#Tuple args')) (#Item body #End)))))} args') @@ -704,7 +719,7 @@ body _ - (_ann (#Form (#Item (_ann (#Identifier ["library/lux" "function''"])) + (_ann (#Form (#Item (_ann (#Identifier [..prelude_module "function''"])) (#Item (_ann (#Tuple args')) (#Item body #End)))))} args') @@ -733,8 +748,8 @@ ("lux def" flag_meta ("lux type check" (#Function Text Code) ([_ tag] - (tuple$ (#Item [(meta_code ["library/lux" "Tag"] (tuple$ (#Item (text$ "library/lux") (#Item (text$ tag) #End)))) - (#Item [(meta_code ["library/lux" "Bit"] (bit$ #1)) + (tuple$ (#Item [(meta_code [..prelude_module "Tag"] (tuple$ (#Item (text$ ..prelude_module) (#Item (text$ tag) #End)))) + (#Item [(meta_code [..prelude_module "Bit"] (bit$ #1)) #End])])))) #0) @@ -753,7 +768,7 @@ ("lux def" as_function ("lux type check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) (function'' [self inputs output] - (form$ (#Item (identifier$ ["library/lux" "function''"]) + (form$ (#Item (identifier$ [..prelude_module "function''"]) (#Item self (#Item (tuple$ inputs) (#Item output #End))))))) @@ -809,8 +824,8 @@ (in_meta tokens) (#Item x (#Item y xs)) - (in_meta (#Item (form$ (#Item (identifier$ ["library/lux" "$'"]) - (#Item (form$ (#Item (tag$ ["library/lux" "Apply"]) + (in_meta (#Item (form$ (#Item (identifier$ [..prelude_module "$'"]) + (#Item (form$ (#Item (tag$ [..prelude_module "Apply"]) (#Item y (#Item x #End)))) xs))) #End)) @@ -876,16 +891,11 @@ [meta (#Form parts)] [meta (#Form (list\each (with_replacements reps) parts))] + [meta (#Variant members)] + [meta (#Variant (list\each (with_replacements reps) members))] + [meta (#Tuple members)] [meta (#Tuple (list\each (with_replacements reps) members))] - - [meta (#Record slots)] - [meta (#Record (list\each ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [slot] - ({[k v] - [(with_replacements reps k) (with_replacements reps v)]} - slot))) - slots))] _ syntax} @@ -920,16 +930,16 @@ (def:'' .private (let$ binding value body) (#Function Code (#Function Code (#Function Code Code))) - (form$ (#Item (record$ (#Item [binding body] #End)) + (form$ (#Item (variant$ (#Item binding (#Item body #End))) (#Item value #End)))) (def:'' .private (UnivQ$ body) (#Function Code Code) - (form$ (#Item (tag$ ["library/lux" "UnivQ"]) (#Item (tag$ ["library/lux" "End"]) (#Item body #End))))) + (form$ (#Item (tag$ [..prelude_module "UnivQ"]) (#Item (tag$ [..prelude_module "End"]) (#Item body #End))))) (def:'' .private (ExQ$ body) (#Function Code Code) - (form$ (#Item (tag$ ["library/lux" "ExQ"]) (#Item (tag$ ["library/lux" "End"]) (#Item body #End))))) + (form$ (#Item (tag$ [..prelude_module "ExQ"]) (#Item (tag$ [..prelude_module "End"]) (#Item body #End))))) (def:'' .private quantification_level Text @@ -943,7 +953,7 @@ (def:'' .private (quantified_type_parameter idx) (#Function Nat Code) - (form$ (#Item (tag$ ["library/lux" "Parameter"]) + (form$ (#Item (tag$ [..prelude_module "Parameter"]) (#Item (form$ (#Item (text$ "lux i64 +") (#Item (local_identifier$ ..quantification_level) (#Item (nat$ idx) @@ -1135,7 +1145,7 @@ (macro:' .public (-> tokens) ({(#Item output inputs) (in_meta (#Item (list\mix ("lux type check" (#Function Code (#Function Code Code)) - (function'' [i o] (form$ (#Item (tag$ ["library/lux" "Function"]) (#Item i (#Item o #End)))))) + (function'' [i o] (form$ (#Item (tag$ [..prelude_module "Function"]) (#Item i (#Item o #End)))))) output inputs) #End)) @@ -1146,17 +1156,17 @@ (macro:' .public (list xs) (in_meta (#Item (list\mix (function'' [head tail] - (form$ (#Item (tag$ ["library/lux" "Item"]) + (form$ (#Item (tag$ [..prelude_module "Item"]) (#Item (tuple$ (#Item [head (#Item [tail #End])])) #End)))) - (tag$ ["library/lux" "End"]) + (tag$ [..prelude_module "End"]) (list\reversed xs)) #End))) (macro:' .public (list& xs) ({(#Item last init) (in_meta (list (list\mix (function'' [head tail] - (form$ (list (tag$ ["library/lux" "Item"]) + (form$ (list (tag$ [..prelude_module "Item"]) (tuple$ (list head tail))))) last init))) @@ -1167,20 +1177,20 @@ (macro:' .public (Union tokens) ({#End - (in_meta (list (identifier$ ["library/lux" "Nothing"]))) + (in_meta (list (identifier$ [..prelude_module "Nothing"]))) (#Item last prevs) - (in_meta (list (list\mix (function'' [left right] (form$ (list (tag$ ["library/lux" "Sum"]) left right))) + (in_meta (list (list\mix (function'' [left right] (form$ (list (tag$ [..prelude_module "Sum"]) left right))) last prevs)))} (list\reversed tokens))) (macro:' .public (Tuple tokens) ({#End - (in_meta (list (identifier$ ["library/lux" "Any"]))) + (in_meta (list (identifier$ [..prelude_module "Any"]))) (#Item last prevs) - (in_meta (list (list\mix (function'' [left right] (form$ (list (tag$ ["library/lux" "Product"]) left right))) + (in_meta (list (list\mix (function'' [left right] (form$ (list (tag$ [..prelude_module "Product"]) left right))) last prevs)))} (list\reversed tokens))) @@ -1219,7 +1229,7 @@ name (form$ (list (text$ "lux type check") type - (form$ (list (identifier$ ["library/lux" "function'"]) + (form$ (list (identifier$ [..prelude_module "function'"]) name (tuple$ args) body)))) @@ -1260,7 +1270,7 @@ Code) (function' [binding body] ({[label value] - (form$ (list (record$ (list [label body])) value))} + (form$ (list (variant$ (list label body)) value))} binding))) body (list\reversed (pairs bindings))))) @@ -1289,10 +1299,10 @@ (def:''' .private (untemplated_list tokens) (-> ($' List Code) Code) ({#End - (_ann (#Tag ["library/lux" "End"])) + (_ann (#Tag [..prelude_module "End"])) (#Item [token tokens']) - (_ann (#Form (list (_ann (#Tag ["library/lux" "Item"])) token (untemplated_list tokens'))))} + (_ann (#Form (list (_ann (#Tag [..prelude_module "Item"])) token (untemplated_list tokens'))))} tokens)) (def:''' .private (list\composite xs ys) @@ -1352,7 +1362,7 @@ ... (: (All (_ a b) (-> (-> a (m b)) (m a) (m b))) ... then))) ("lux def type tagged" Monad - (#Named ["library/lux" "Monad"] + (#Named [..prelude_module "Monad"] (All (_ !) (Tuple (All (_ a) (-> a ($' ! a))) @@ -1416,9 +1426,9 @@ var)))) body (list\reversed (pairs bindings)))] - (in_meta (list (form$ (list (record$ (list [(tuple$ (list (tag$ ["library/lux" "in"]) g!in - (tag$ ["library/lux" "then"]) g!then)) - body'])) + (in_meta (list (form$ (list (variant$ (list (tuple$ (list (tag$ [..prelude_module "in"]) g!in + (tag$ [..prelude_module "then"]) g!then)) + body')) monad))))) _ @@ -1461,8 +1471,8 @@ (macro:' .public (if tokens) ({(#Item test (#Item then (#Item else #End))) - (in_meta (list (form$ (list (record$ (list [(bit$ #1) then] - [(bit$ #0) else])) + (in_meta (list (form$ (list (variant$ (list (bit$ #1) then + (bit$ #0) else)) test)))) _ @@ -1531,16 +1541,16 @@ (def:''' .private (code_list expression) (-> Code Code) - (let' [type (form$ (list (tag$ ["library/lux" "Apply"]) - (identifier$ ["library/lux" "Code"]) - (identifier$ ["library/lux" "List"])))] + (let' [type (form$ (list (tag$ [..prelude_module "Apply"]) + (identifier$ [..prelude_module "Code"]) + (identifier$ [..prelude_module "List"])))] (form$ (list (text$ "lux type check") type expression)))) (def:''' .private (spliced replace? untemplated elems) (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ({#1 ({#End - (in_meta (tag$ ["library/lux" "End"])) + (in_meta (tag$ [..prelude_module "End"])) (#Item lastI inits) (do meta_monad @@ -1550,21 +1560,21 @@ _ (do meta_monad [lastO (untemplated lastI)] - (in (code_list (form$ (list (tag$ ["library/lux" "Item"]) - (tuple$ (list lastO (tag$ ["library/lux" "End"]))))))))} + (in (code_list (form$ (list (tag$ [..prelude_module "Item"]) + (tuple$ (list lastO (tag$ [..prelude_module "End"]))))))))} lastI)] (monad\mix meta_monad (function' [leftI rightO] ({[_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] (let' [g!in-module (form$ (list (text$ "lux in-module") - (text$ "library/lux") - (identifier$ ["library/lux" "list\composite"])))] + (text$ ..prelude_module) + (identifier$ [..prelude_module "list\composite"])))] (in (form$ (list g!in-module (code_list spliced) rightO)))) _ (do meta_monad [leftO (untemplated leftI)] - (in (form$ (list (tag$ ["library/lux" "Item"]) (tuple$ (list leftO rightO))))))} + (in (form$ (list (tag$ [..prelude_module "Item"]) (tuple$ (list leftO rightO))))))} leftI)) lastO inits))} @@ -1577,30 +1587,30 @@ (def:''' .private (untemplated_text value) (-> Text Code) - (with_location (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) + (with_location (form$ (list (tag$ [..prelude_module "Text"]) (text$ value))))) (def:''' .private (untemplated replace? subst token) (-> Bit Text Code ($' Meta Code)) ({[_ [_ (#Bit value)]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Bit"]) (bit$ value))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Bit"]) (bit$ value))))) [_ [_ (#Nat value)]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Nat"]) (nat$ value))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Nat"]) (nat$ value))))) [_ [_ (#Int value)]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Int"]) (int$ value))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Int"]) (int$ value))))) [_ [_ (#Rev value)]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Rev"]) (rev$ value))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Rev"]) (rev$ value))))) [_ [_ (#Frac value)]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Frac"]) (frac$ value))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] (in_meta (untemplated_text value)) [#0 [_ (#Tag [module name])]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Tag [module name])]] (let' [module' ({"" @@ -1609,7 +1619,7 @@ _ module} module)] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) [#1 [_ (#Identifier [module name])]] (do meta_monad @@ -1622,20 +1632,20 @@ (in [module name])} module) .let' [[module name] real_name]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) [#0 [_ (#Identifier [module name])]] - (in_meta (with_location (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) + (in_meta (with_location (form$ (list (tag$ [..prelude_module "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~"])] (#Item [unquoted #End])]))]] (in_meta (form$ (list (text$ "lux type check") - (identifier$ ["library/lux" "Code"]) + (identifier$ [..prelude_module "Code"]) unquoted))) [#1 [_ (#Form (#Item [[_ (#Identifier ["" "~!"])] (#Item [dependent #End])]))]] (do meta_monad [independent (untemplated replace? subst dependent)] - (in (with_location (form$ (list (tag$ ["library/lux" "Form"]) + (in (with_location (form$ (list (tag$ [..prelude_module "Form"]) (untemplated_list (list (untemplated_text "lux in-module") (untemplated_text subst) independent))))))) @@ -1646,35 +1656,28 @@ [_ [meta (#Form elems)]] (do meta_monad [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Form"]) output)))]] + .let' [[_ output'] (with_location (form$ (list (tag$ [..prelude_module "Form"]) output)))]] (in [meta output'])) - [_ [meta (#Tuple elems)]] + [_ [meta (#Variant elems)]] (do meta_monad [output (spliced replace? (untemplated replace? subst) elems) - .let' [[_ output'] (with_location (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] + .let' [[_ output'] (with_location (form$ (list (tag$ [..prelude_module "Variant"]) output)))]] (in [meta output'])) - [_ [_ (#Record fields)]] + [_ [meta (#Tuple elems)]] (do meta_monad - [=fields (monad\each meta_monad - ("lux type check" (-> (Tuple Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do meta_monad - [=k (untemplated replace? subst k) - =v (untemplated replace? subst v)] - (in (tuple$ (list =k =v))))))) - fields)] - (in (with_location (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} + [output (spliced replace? (untemplated replace? subst) elems) + .let' [[_ output'] (with_location (form$ (list (tag$ [..prelude_module "Tuple"]) output)))]] + (in [meta output']))} [replace? token])) (macro:' .public (primitive tokens) ({(#Item [_ (#Text class_name)] #End) - (in_meta (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (tag$ ["library/lux" "End"]))))) + (in_meta (list (form$ (list (tag$ [..prelude_module "Primitive"]) (text$ class_name) (tag$ [..prelude_module "End"]))))) (#Item [_ (#Text class_name)] (#Item [_ (#Tuple params)] #End)) - (in_meta (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplated_list params))))) + (in_meta (list (form$ (list (tag$ [..prelude_module "Primitive"]) (text$ class_name) (untemplated_list params))))) _ (failure "Wrong syntax for primitive")} @@ -1700,7 +1703,7 @@ [current_module current_module_name =template (untemplated #1 current_module template)] (in (list (form$ (list (text$ "lux type check") - (identifier$ ["library/lux" "Code"]) + (identifier$ [..prelude_module "Code"]) =template))))) _ @@ -1711,7 +1714,7 @@ ({(#Item template #End) (do meta_monad [=template (untemplated #1 "" template)] - (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ [..prelude_module "Code"]) =template))))) _ (failure "Wrong syntax for `")} @@ -1721,7 +1724,7 @@ ({(#Item template #End) (do meta_monad [=template (untemplated #0 "" template)] - (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ [..prelude_module "Code"]) =template))))) _ (failure "Wrong syntax for '")} @@ -1818,18 +1821,14 @@ template} (..replacement sname env)) - [meta (#Tuple elems)] - [meta (#Tuple (list\each (realized_template env) elems))] - [meta (#Form elems)] [meta (#Form (list\each (realized_template env) elems))] - [meta (#Record members)] - [meta (#Record (list\each ("lux type check" (-> (Tuple Code Code) (Tuple Code Code)) - (function' [kv] - (let' [[slot value] kv] - [(realized_template env slot) (realized_template env value)]))) - members))] + [meta (#Tuple elems)] + [meta (#Tuple (list\each (realized_template env) elems))] + + [meta (#Variant elems)] + [meta (#Variant (list\each (realized_template env) elems))] _ template} @@ -2138,21 +2137,10 @@ [members' (monad\each meta_monad full_expansion members)] (in (list (tuple$ (list\conjoint members'))))) - [_ (#Record pairs)] + [_ (#Variant members)] (do meta_monad - [pairs' (monad\each meta_monad - (function' [kv] - (let' [[key val] kv] - (do meta_monad - [val' (full_expansion val)] - ({(#Item val'' #End) - (in_meta [key val'']) - - _ - (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} - val')))) - pairs)] - (in (list (record$ pairs')))) + [members' (monad\each meta_monad full_expansion members)] + (in (list (variant$ (list\conjoint members'))))) _ (in_meta (list syntax))} @@ -2206,10 +2194,9 @@ list\reversed (list\mix text\composite "")) "]") - [_ (#Record kvs)] - ($_ text\composite "{" (|> kvs - (list\each (function' [kv] ({[k v] ($_ text\composite (code\encoded k) " " (code\encoded v))} - kv))) + [_ (#Variant xs)] + ($_ text\composite "{" (|> xs + (list\each code\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) "}")} @@ -2220,6 +2207,9 @@ ({[_ (#Form (#Item [_ (#Tag tag)] parts))] (form$ (#Item (tag$ tag) (list\each normal_type parts))) + [_ (#Variant members)] + (` (Or (~+ (list\each normal_type members)))) + [_ (#Tuple members)] (` (Tuple (~+ (list\each normal_type members)))) @@ -2232,10 +2222,10 @@ [_ (#Form (#Item [_ (#Identifier ["" ":~"])] (#Item expression #End)))] expression - [_0 (#Form (#Item [_1 (#Record (#Item [binding body] #End))] + [_0 (#Form (#Item [_1 (#Variant (#Item binding (#Item body #End)))] (#Item value #End)))] - [_0 (#Form (#Item [_1 (#Record (#Item [binding (normal_type body)] #End))] + [_0 (#Form (#Item [_1 (#Variant (#Item binding (#Item (normal_type body) #End)))] (#Item value #End)))] @@ -2244,7 +2234,7 @@ (#Item _level (#Item body #End)))))] - [_0 (#Form (#Item [_1 (#Identifier ["library/lux" "__adjusted_quantified_type__"])] + [_0 (#Form (#Item [_1 (#Identifier [..prelude_module "__adjusted_quantified_type__"])] (#Item _permission (#Item _level (#Item (normal_type body) @@ -2419,7 +2409,7 @@ ({(#Item value branches) (do meta_monad [expansion (expander branches)] - (in (list (` ((~ (record$ (pairs expansion))) (~ value)))))) + (in (list (` ((~ (variant$ expansion)) (~ value)))))) _ (failure "Wrong syntax for case")} @@ -3306,14 +3296,14 @@ (def: (referrals_parser tokens) (-> (List Code) (Meta [Referrals (List Code)])) (case tokens - (^or (^ (list& [_ (#Record (list [[_ (#Text "+")] [_ (#Tuple defs)]]))] tokens')) - (^ (list& [_ (#Record (list [[_ (#Text "only")] [_ (#Tuple defs)]]))] tokens'))) + (^or (^ (list& [_ (#Variant (list [_ (#Text "+")] [_ (#Tuple defs)]))] tokens')) + (^ (list& [_ (#Variant (list [_ (#Text "only")] [_ (#Tuple defs)]))] tokens'))) (do meta_monad [defs' (..referral_references defs)] (in [(#Only defs') tokens'])) - (^or (^ (list& [_ (#Record (list [[_ (#Text "-")] [_ (#Tuple defs)]]))] tokens')) - (^ (list& [_ (#Record (list [[_ (#Text "exclude")] [_ (#Tuple defs)]]))] tokens'))) + (^or (^ (list& [_ (#Variant (list [_ (#Text "-")] [_ (#Tuple defs)]))] tokens')) + (^ (list& [_ (#Variant (list [_ (#Text "exclude")] [_ (#Tuple defs)]))] tokens'))) (do meta_monad [defs' (..referral_references defs)] (in [(#Exclude defs') tokens'])) @@ -4060,10 +4050,10 @@ (list (' "*")) (#Only defs) - (list (record$ (list [(' "+") (tuple$ (list\each local_identifier$ defs))]))) + (list (variant$ (list (' "+") (tuple$ (list\each local_identifier$ defs))))) (#Exclude defs) - (list (record$ (list [(' "-") (tuple$ (list\each local_identifier$ defs))]))) + (list (variant$ (list (' "-") (tuple$ (list\each local_identifier$ defs))))) #Ignore (list) @@ -4424,41 +4414,23 @@ (failure "Wrong syntax for ^slots"))) (def: (with_expansions' label tokens target) - (-> Text (List Code) Code (Maybe (List Code))) + (-> Text (List Code) Code (List Code)) (case target (^or [_ (#Bit _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) - (#Some (list target)) + (list target) [_ (#Identifier [module name])] (if (and (text\= "" module) (text\= label name)) - (#Some tokens) - (#Some (list target))) + tokens + (list target)) (^template [] [[location ( elems)] - (do maybe_monad - [placements (monad\each maybe_monad (with_expansions' label tokens) elems)] - (in (list [location ( (list\conjoint placements))])))]) - ([#Tuple] - [#Form]) - - [location (#Record pairs)] - (do maybe_monad - [=pairs (monad\each maybe_monad - (: (-> [Code Code] (Maybe [Code Code])) - (function (_ [slot value]) - (do maybe_monad - [slot' (with_expansions' label tokens slot) - value' (with_expansions' label tokens value)] - (case [slot' value'] - (^ [(list =slot) (list =value)]) - (in [=slot =value]) - - _ - #None)))) - pairs)] - (in (list [location (#Record =pairs)]))))) + (list [location ( (list\conjoint (list\each (with_expansions' label tokens) elems)))])]) + ([#Form] + [#Variant] + [#Tuple]))) (macro: .public (with_expansions tokens) (case tokens @@ -4467,15 +4439,10 @@ (^ (list& [_ (#Identifier ["" var_name])] expr bindings')) (do meta_monad [expansion (single_expansion expr)] - (case (with_expansions' var_name expansion - (` (.with_expansions - [(~+ bindings')] - (~+ bodies)))) - (#Some output) - (in output) - - _ - (failure "[with_expansions] Improper macro expansion."))) + (in (with_expansions' var_name expansion + (` (.with_expansions + [(~+ bindings')] + (~+ bodies)))))) #End (in_meta bodies) @@ -4540,18 +4507,8 @@ [=parts (monad\each meta_monad static_literal parts)] (in [meta ( =parts)]))]) ([#Form] + [#Variant] [#Tuple]) - - [meta (#Record pairs)] - (do meta_monad - [=pairs (monad\each meta_monad - (: (-> [Code Code] (Meta [Code Code])) - (function (_ [slot value]) - (do meta_monad - [=value (static_literal value)] - (in [slot =value])))) - pairs)] - (in [meta (#Record =pairs)])) _ (\ meta_monad in_meta token) @@ -4661,7 +4618,7 @@ ([#Identifier] [#Tag]) _ - (failure (..wrong_syntax_error ["library/lux" "name_of"])))) + (failure (..wrong_syntax_error [..prelude_module "name_of"])))) (def: (scope_type_vars state) (Meta (List Nat)) @@ -4914,21 +4871,9 @@ [=parts (monad\each meta_monad embedded_expansions parts)] (in [(list\mix list\composite (list) (list\each product\left =parts)) [ann ( (list\each product\right =parts))]]))]) - ([#Form] [#Tuple]) - - [ann (#Record kvs)] - (do meta_monad - [=kvs (monad\each meta_monad - (function (_ [key val]) - (do meta_monad - [=key (embedded_expansions key) - =val (embedded_expansions val) - .let [[key_labels key_labelled] =key - [val_labels val_labelled] =val]] - (in [(list\composite key_labels val_labels) [key_labelled val_labelled]]))) - kvs)] - (in [(list\mix list\composite (list) (list\each product\left =kvs)) - [ann (#Record (list\each product\right =kvs))]])) + ([#Form] + [#Variant] + [#Tuple]) _ (in_meta [(list) code]))) @@ -4960,19 +4905,6 @@ (#Item [init inits']) (` (#.Item (~ init) (~ (untemplated_list& last inits')))))) -(def: (untemplated_record g!meta untemplated_pattern fields) - (-> Code (-> Code (Meta Code)) - (-> (List [Code Code]) (Meta Code))) - (do meta_monad - [=fields (monad\each meta_monad - (function (_ [key value]) - (do meta_monad - [=key (untemplated_pattern key) - =value (untemplated_pattern value)] - (in (` [(~ =key) (~ =value)])))) - fields)] - (in (` [(~ g!meta) (#.Record (~ (untemplated_list =fields)))])))) - (template [ ] [(def: ( g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) @@ -4989,8 +4921,9 @@ [=elems (monad\each meta_monad untemplated_pattern elems)] (in (` [(~ g!meta) ( (~ (untemplated_list =elems)))])))))] - [#.Tuple untemplated_tuple] [#.Form untemplated_form] + [#.Tuple untemplated_tuple] + [#.Variant untemplated_variant] ) (def: (untemplated_pattern pattern) @@ -5019,11 +4952,9 @@ (^template [ ] [[_ ( elems)] ( g!meta untemplated_pattern elems)]) - ([#Tuple ..untemplated_tuple] - [#Form ..untemplated_form]) - - [_ (#Record fields)] - (..untemplated_record g!meta untemplated_pattern fields) + ([#Form ..untemplated_form] + [#Variant ..untemplated_variant] + [#Tuple ..untemplated_tuple]) ))) (macro: .public (^code tokens) -- cgit v1.2.3