diff options
| author | Eduardo Julian | 2020-12-25 09:22:38 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2020-12-25 09:22:38 -0400 |
| commit | 4ca397765805eda5ddee393901ed3a02001a960a (patch) | |
| tree | 2ab184a1a4e244f3a69e86c8a7bb3ad49c22b4a3 /stdlib/source/lux.lux | |
| parent | d29e091e98dabb8dfcf816899ada480ecbf7e357 (diff) | |
Replaced kebab-case with snake_case for naming convention.
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 2734 |
1 files changed, 1367 insertions, 1367 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index f45bab179..4d0ac9c4d 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,21 +1,21 @@ -("lux def" dummy-location +("lux def" dummy_location ["" 0 0] [["" 0 0] (9 #1 (0 #0))] #0) -("lux def" double-quote +("lux def" double_quote ("lux i64 char" +34) - [dummy-location (9 #1 (0 #0))] + [dummy_location (9 #1 (0 #0))] #0) -("lux def" new-line +("lux def" new_line ("lux i64 char" +10) - [dummy-location (9 #1 (0 #0))] + [dummy_location (9 #1 (0 #0))] #0) ("lux def" __paragraph - ("lux text concat" new-line new-line) - [dummy-location (9 #1 (0 #0))] + ("lux text concat" new_line new_line) + [dummy_location (9 #1 (0 #0))] #0) ## (type: Any @@ -24,9 +24,9 @@ ("lux check type" (9 #1 ["lux" "Any"] (8 #0 (0 #0) (4 #0 1)))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "The type of things whose type is irrelevant." __paragraph) "It can be used to write functions or data-structures that can take, or return, anything."))]] (0 #0)))] @@ -38,9 +38,9 @@ ("lux check type" (9 #1 ["lux" "Nothing"] (7 #0 (0 #0) (4 #0 1)))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "The type of things whose type is undefined." __paragraph) "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] (0 #0)))] @@ -57,11 +57,11 @@ ## "lux.Cons" (2 #0 (4 #0 1) (9 #0 (4 #0 1) (4 #0 0)))))) - [dummy-location - (9 #1 (0 #1 [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (0 #1 [dummy-location (5 #0 "a")] (0 #0)))]] - (0 #1 [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A potentially empty list of values.")]] + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (0 #1 [dummy_location (5 #0 "a")] (0 #0)))]] + (0 #1 [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A potentially empty list of values.")]] (0 #0))))] ["Nil" "Cons"] #1) @@ -70,9 +70,9 @@ ("lux check type" (9 #1 ["lux" "Bit"] (0 #0 "#Bit" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] #Nil))] #1) @@ -81,9 +81,9 @@ (9 #1 ["lux" "I64"] (7 #0 (0 #0) (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "64-bit integers without any semantics.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "64-bit integers without any semantics.")]] #Nil))] #1) @@ -91,9 +91,9 @@ ("lux check type" (9 #1 ["lux" "Nat"] (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) "They start at zero (0) and extend in the positive direction."))]] #Nil))] @@ -103,9 +103,9 @@ ("lux check type" (9 #1 ["lux" "Int"] (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] #Nil))] #1) @@ -113,9 +113,9 @@ ("lux check type" (9 #1 ["lux" "Rev"] (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 ("lux text concat" + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 ("lux text concat" ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) "Useful for probability, and other domains that work within that interval."))]] #Nil))] @@ -125,9 +125,9 @@ ("lux check type" (9 #1 ["lux" "Frac"] (0 #0 "#Frac" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] #Nil))] #1) @@ -135,9 +135,9 @@ ("lux check type" (9 #1 ["lux" "Text"] (0 #0 "#Text" #Nil))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Your standard, run-of-the-mill string values.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill string values.")]] #Nil))] #1) @@ -145,9 +145,9 @@ ("lux check type" (9 #1 ["lux" "Name"] (2 #0 Text Text))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] #Nil))] #1) @@ -161,11 +161,11 @@ Any ## "lux.Some" (4 #0 1)))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "a")] #Nil))]] - (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "A potentially missing value.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "a")] #Nil))]] + (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "A potentially missing value.")]] #Nil)))] ["None" "Some"] #1) @@ -186,18 +186,18 @@ ("lux def type tagged" Type (9 #1 ["lux" "Type"] ({Type - ({Type-List - ({Type-Pair + ({Type_List + ({Type_Pair (9 #0 Nothing (7 #0 #Nil (1 #0 ## "lux.Primitive" - (2 #0 Text Type-List) + (2 #0 Text Type_List) (1 #0 ## "lux.Sum" - Type-Pair + Type_Pair (1 #0 ## "lux.Product" - Type-Pair + Type_Pair (1 #0 ## "lux.Function" - Type-Pair + Type_Pair (1 #0 ## "lux.Parameter" Nat (1 #0 ## "lux.Var" @@ -205,21 +205,21 @@ (1 #0 ## "lux.Ex" Nat (1 #0 ## "lux.UnivQ" - (2 #0 Type-List Type) + (2 #0 Type_List Type) (1 #0 ## "lux.ExQ" - (2 #0 Type-List Type) + (2 #0 Type_List Type) (1 #0 ## "lux.Apply" - Type-Pair + Type_Pair ## "lux.Named" (2 #0 Name Type)))))))))))))} ("lux check type" (2 #0 Type Type)))} ("lux check type" (9 #0 Type List)))} ("lux check type" (9 #0 (4 #0 1) (4 #0 0))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] - (#Cons [[dummy-location (7 #0 ["lux" "type-rec?"])] - [dummy-location (0 #0 #1)]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy_location (7 #0 ["lux" "type-rec?"])] + [dummy_location (0 #0 #1)]] #Nil)))] ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] #1) @@ -231,9 +231,9 @@ ("lux def type tagged" Location (#Named ["lux" "Location"] (#Product Text (#Product Nat Nat))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] #Nil))] ["module" "line" "column"] #1) @@ -247,11 +247,11 @@ (#UnivQ #Nil (#Product (#Parameter 3) (#Parameter 1))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "doc"])] - [dummy-location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] - (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "m")] (#Cons [dummy-location (5 #0 "v")] #Nil)))]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "doc"])] + [dummy_location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "m")] (#Cons [dummy_location (5 #0 "v")] #Nil)))]] #Nil)))] ["meta" "datum"] #1) @@ -271,7 +271,7 @@ ("lux def type tagged" Code' (#Named ["lux" "Code'"] ({Code - ({Code-List + ({Code_List (#UnivQ #Nil (#Sum ## "lux.Bit" Bit @@ -290,9 +290,9 @@ (#Sum ## "lux.Tag" Name (#Sum ## "lux.Form" - Code-List + Code_List (#Sum ## "lux.Tuple" - Code-List + Code_List ## "lux.Record" (#Apply (#Product Code Code) List) )))))))))) @@ -301,9 +301,9 @@ ("lux check type" (#Apply (#Apply (#Parameter 1) (#Parameter 0)) (#Parameter 1))))) - [dummy-location - (9 #1 (#Cons [[dummy-location (7 #0 ["lux" "type-args"])] - [dummy-location (9 #0 (#Cons [dummy-location (5 #0 "w")] #Nil))]] + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 ["lux" "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "w")] #Nil))]] #Nil))] ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] #1) @@ -315,9 +315,9 @@ ({w (#Apply (#Apply w Code') w)} ("lux check type" (#Apply Location Ann)))) - [dummy-location - (#Record (#Cons [[dummy-location (#Tag ["lux" "doc"])] - [dummy-location (#Text "The type of Code nodes for Lux syntax.")]] + [dummy_location + (#Record (#Cons [[dummy_location (#Tag ["lux" "doc"])] + [dummy_location (#Text "The type of Code nodes for Lux syntax.")]] #Nil))] #1) @@ -326,86 +326,86 @@ Code') Code) ([_ data] - [dummy-location data])) - [dummy-location (#Record #Nil)] + [dummy_location data])) + [dummy_location (#Record #Nil)] #0) ("lux def" bit$ ("lux check" (#Function Bit Code) ([_ value] (_ann (#Bit value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" nat$ ("lux check" (#Function Nat Code) ([_ value] (_ann (#Nat value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" int$ ("lux check" (#Function Int Code) ([_ value] (_ann (#Int value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" rev$ ("lux check" (#Function Rev Code) ([_ value] (_ann (#Rev value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" frac$ ("lux check" (#Function Frac Code) ([_ value] (_ann (#Frac value)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" text$ ("lux check" (#Function Text Code) ([_ text] (_ann (#Text text)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" identifier$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Identifier name)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) -("lux def" local-identifier$ +("lux def" local_identifier$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Identifier ["" name])))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" tag$ ("lux check" (#Function Name Code) ([_ name] (_ann (#Tag name)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) -("lux def" local-tag$ +("lux def" local_tag$ ("lux check" (#Function Text Code) ([_ name] (_ann (#Tag ["" name])))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" form$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Form tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" tuple$ ("lux check" (#Function (#Apply Code List) Code) ([_ tokens] (_ann (#Tuple tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ("lux def" record$ ("lux check" (#Function (#Apply (#Product Code Code) List) Code) ([_ tokens] (_ann (#Record tokens)))) - [dummy-location (#Record #Nil)] + [dummy_location (#Record #Nil)] #0) ## (type: Definition @@ -492,7 +492,7 @@ ["name" "inner" "locals" "captured"] #1) -("lux def" Code-List +("lux def" Code_List ("lux check type" (#Apply Code List)) (record$ #Nil) @@ -526,12 +526,12 @@ (record$ #Nil) #1) -## (type: Module-State +## (type: Module_State ## #Active ## #Compiled ## #Cached) -("lux def type tagged" Module-State - (#Named ["lux" "Module-State"] +("lux def type tagged" Module_State + (#Named ["lux" "Module_State"] (#Sum ## #Active Any @@ -545,19 +545,19 @@ #1) ## (type: Module -## {#module-hash Nat -## #module-aliases (List [Text Text]) +## {#module_hash Nat +## #module_aliases (List [Text Text]) ## #definitions (List [Text Global]) ## #imports (List Text) ## #tags (List [Text [Nat (List Name) Bit Type]]) ## #types (List [Text [(List Name) Bit Type]]) -## #module-annotations (Maybe Code) -## #module-state Module-State}) +## #module_annotations (Maybe Code) +## #module_state Module_State}) ("lux def type tagged" Module (#Named ["lux" "Module"] - (#Product ## "lux.module-hash" + (#Product ## "lux.module_hash" Nat - (#Product ## "lux.module-aliases" + (#Product ## "lux.module_aliases" (#Apply (#Product Text Text) List) (#Product ## "lux.definitions" (#Apply (#Product Text Global) List) @@ -576,31 +576,31 @@ (#Product Bit Type))) List) - (#Product ## "lux.module-annotations" + (#Product ## "lux.module_annotations" (#Apply Code Maybe) - Module-State)) + Module_State)) )))))) (record$ (#Cons [(tag$ ["lux" "doc"]) (text$ "All the information contained within a Lux module.")] #Nil)) - ["module-hash" "module-aliases" "definitions" "imports" "tags" "types" "module-annotations" "module-state"] + ["module_hash" "module_aliases" "definitions" "imports" "tags" "types" "module_annotations" "module_state"] #1) -## (type: Type-Context -## {#ex-counter Nat -## #var-counter Nat -## #var-bindings (List [Nat (Maybe Type)])}) -("lux def type tagged" Type-Context - (#Named ["lux" "Type-Context"] - (#Product ## ex-counter +## (type: Type_Context +## {#ex_counter Nat +## #var_counter Nat +## #var_bindings (List [Nat (Maybe Type)])}) +("lux def type tagged" Type_Context + (#Named ["lux" "Type_Context"] + (#Product ## ex_counter Nat - (#Product ## var-counter + (#Product ## var_counter Nat - ## var-bindings + ## var_bindings (#Apply (#Product Nat (#Apply Type Maybe)) List)))) (record$ #Nil) - ["ex-counter" "var-counter" "var-bindings"] + ["ex_counter" "var_counter" "var_bindings"] #1) ## (type: Mode @@ -645,13 +645,13 @@ ## {#info Info ## #source Source ## #location Location -## #current-module (Maybe Text) +## #current_module (Maybe Text) ## #modules (List [Text Module]) ## #scopes (List Scope) -## #type-context Type-Context +## #type_context Type_Context ## #expected (Maybe Type) ## #seed Nat -## #scope-type-vars (List Nat) +## #scope_type_vars (List Nat) ## #extensions Any ## #host Any}) ("lux def type tagged" Lux @@ -662,19 +662,19 @@ Source (#Product ## "lux.location" Location - (#Product ## "lux.current-module" + (#Product ## "lux.current_module" (#Apply Text Maybe) (#Product ## "lux.modules" (#Apply (#Product Text Module) List) (#Product ## "lux.scopes" (#Apply Scope List) - (#Product ## "lux.type-context" - Type-Context + (#Product ## "lux.type_context" + Type_Context (#Product ## "lux.expected" (#Apply Type Maybe) (#Product ## "lux.seed" Nat - (#Product ## scope-type-vars + (#Product ## scope_type_vars (#Apply Nat List) (#Product ## extensions Any @@ -687,7 +687,7 @@ ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] #Nil)) - ["info" "source" "location" "current-module" "modules" "scopes" "type-context" "expected" "seed" "scope-type-vars" "extensions" "host"] + ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] #1) ## (type: (Meta a) @@ -713,7 +713,7 @@ ("lux def" Macro' ("lux check type" (#Named ["lux" "Macro'"] - (#Function Code-List (#Apply Code-List Meta)))) + (#Function Code_List (#Apply Code_List Meta)))) (record$ #Nil) #1) @@ -805,52 +805,52 @@ (record$ #.Nil) #0) -("lux def" location-code +("lux def" location_code ("lux check" Code (tuple$ (#Cons (text$ "") (#Cons (nat$ 0) (#Cons (nat$ 0) #Nil))))) (record$ #Nil) #0) -("lux def" meta-code +("lux def" meta_code ("lux check" (#Function Name (#Function Code Code)) ([_ tag] ([_ value] - (tuple$ (#Cons location-code + (tuple$ (#Cons location_code (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) #Nil)))))) (record$ #Nil) #0) -("lux def" flag-meta +("lux def" flag_meta ("lux check" (#Function Text Code) ([_ tag] - (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) - (#Cons [(meta-code ["lux" "Bit"] (bit$ #1)) + (tuple$ (#Cons [(meta_code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) + (#Cons [(meta_code ["lux" "Bit"] (bit$ #1)) #Nil])])))) (record$ #Nil) #0) -("lux def" doc-meta +("lux def" doc_meta ("lux check" (#Function Text (#Product Code Code)) (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)])) (record$ #Nil) #0) -("lux def" as-def +("lux def" as_def ("lux check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) (function'' [name value annotations exported?] (form$ (#Cons (text$ "lux def") (#Cons name (#Cons value (#Cons annotations (#Cons (bit$ exported?) #Nil)))))))) (record$ #Nil) #0) -("lux def" as-checked +("lux def" as_checked ("lux check" (#Function Code (#Function Code Code)) (function'' [type value] (form$ (#Cons (text$ "lux check") (#Cons type (#Cons value #Nil)))))) (record$ #Nil) #0) -("lux def" as-function +("lux def" as_function ("lux check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) (function'' [self inputs output] (form$ (#Cons (identifier$ ["lux" "function''"]) @@ -860,7 +860,7 @@ (record$ #Nil) #0) -("lux def" as-macro +("lux def" as_macro ("lux check" (#Function Code Code) (function'' [expression] (form$ (#Cons (text$ "lux macro") @@ -875,7 +875,7 @@ ({(#Cons [[_ (#Tag ["" "export"])] (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -883,7 +883,7 @@ #Nil])) (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(as-def name (as-checked type body) + (return (#Cons [(as_def name (as_checked type body) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -892,7 +892,7 @@ (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -900,7 +900,7 @@ #Nil])) (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(as-def name (as-checked type body) + (return (#Cons [(as_def name (as_checked type body) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons meta #Nil))) @@ -917,7 +917,7 @@ ("lux macro" (function'' [tokens] ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons (tag$ ["lux" "Nil"]) #Nil))) @@ -925,17 +925,17 @@ #Nil)) (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) (#Cons (tag$ ["lux" "Nil"]) #Nil))) #1) #Nil)) - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (as-def name (as-macro (as-function name args body)) + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta_data (#Cons body #Nil)))) + (return (#Cons (as_def name (as_macro (as_function name args body)) (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons meta-data + (#Cons meta_data #Nil))) #1) #Nil)) @@ -990,11 +990,11 @@ Type ($' List (#Product Text Code))) -(def:'' (make-env xs ys) +(def:'' (make_env xs ys) #Nil (#Function ($' List Text) (#Function ($' List Code) RepEnv)) ({[(#Cons x xs') (#Cons y ys')] - (#Cons [x y] (make-env xs' ys')) + (#Cons [x y] (make_env xs' ys')) _ #Nil} @@ -1005,7 +1005,7 @@ (#Function Text (#Function Text Bit)) ("lux text =" reference sample)) -(def:'' (get-rep key env) +(def:'' (get_rep key env) #Nil (#Function Text (#Function RepEnv ($' Maybe Code))) ({#Nil @@ -1016,11 +1016,11 @@ (#Some v) #0 - (get-rep key env')} + (get_rep key env')} (text\= k key))} env)) -(def:'' (replace-syntax reps syntax) +(def:'' (replace_syntax reps syntax) #Nil (#Function RepEnv (#Function Code Code)) ({[_ (#Identifier "" name)] @@ -1029,19 +1029,19 @@ #None syntax} - (get-rep name reps)) + (get_rep name reps)) [meta (#Form parts)] - [meta (#Form (list\map (replace-syntax reps) parts))] + [meta (#Form (list\map (replace_syntax reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list\map (replace-syntax reps) members))] + [meta (#Tuple (list\map (replace_syntax reps) members))] [meta (#Record slots)] [meta (#Record (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [slot] ({[k v] - [(replace-syntax reps k) (replace-syntax reps v)]} + [(replace_syntax reps k) (replace_syntax reps v)]} slot))) slots))] @@ -1050,37 +1050,37 @@ syntax)) (def:'' (n/* param subject) - (#.Cons (doc-meta "Nat(ural) multiplication.") #.Nil) + (#.Cons (doc_meta "Nat(ural) multiplication.") #.Nil) (#Function Nat (#Function Nat Nat)) ("lux coerce" Nat ("lux i64 *" ("lux coerce" Int param) ("lux coerce" Int subject)))) -(def:'' (update-parameters code) +(def:'' (update_parameters code) #Nil (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list\map update-parameters members)) + (tuple$ (list\map update_parameters members)) [_ (#Record pairs)] (record$ (list\map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) (function'' [pair] (let'' [name val] pair - [name (update-parameters val)]))) + [name (update_parameters val)]))) pairs)) [_ (#Form (#Cons [_ (#Tag "lux" "Parameter")] (#Cons [_ (#Nat idx)] #Nil)))] (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ ("lux i64 +" 2 idx)) #Nil))) [_ (#Form members)] - (form$ (list\map update-parameters members)) + (form$ (list\map update_parameters members)) _ code} code)) -(def:'' (parse-quantified-args args next) +(def:'' (parse_quantified_args args next) #Nil ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) (#Function ($' List Code) @@ -1090,14 +1090,14 @@ ({#Nil (next #Nil) - (#Cons [_ (#Identifier "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + (#Cons [_ (#Identifier "" arg_name)] args') + (parse_quantified_args args' (function'' [names] (next (#Cons arg_name names)))) _ (fail "Expected identifier.")} args)) -(def:'' (make-parameter idx) +(def:'' (make_parameter idx) #Nil (#Function Nat Code) (form$ (#Cons (tag$ ["lux" "Parameter"]) (#Cons (nat$ idx) #Nil)))) @@ -1134,21 +1134,21 @@ ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(All List [a] (| Any [a (List a)]))"))))] #Nil) - (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) - [self-name tokens] + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] _ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args + (parse_quantified_args args (function'' [names] (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "UnivQ"]) (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-parameter 1)] #Nil) - (update-parameters body')) #Nil)))))) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) body names) (return (#Cons ({[#1 _] @@ -1158,10 +1158,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text\= "" self-name) names]) + [(text\= "" self_name) names]) #Nil))))) _ @@ -1178,21 +1178,21 @@ ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) "(Ex Self [a] [(Codec Text a) a (List (Self a))])"))))] #Nil) - (let'' [self-name tokens] ({(#Cons [_ (#Identifier "" self-name)] tokens) - [self-name tokens] + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] _ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args + (parse_quantified_args args (function'' [names] (let'' body' (list\fold ("lux check" (#Function Text (#Function Code Code)) (function'' [name' body'] (form$ (#Cons (tag$ ["lux" "ExQ"]) (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-parameter 1)] #Nil) - (update-parameters body')) #Nil)))))) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) body names) (return (#Cons ({[#1 _] @@ -1202,10 +1202,10 @@ body' [#0 _] - (replace-syntax (#Cons [self-name (make-parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] #Nil) body')} - [(text\= "" self-name) names]) + [(text\= "" self_name) names]) #Nil))))) _ @@ -1322,10 +1322,10 @@ (fail "function' requires a non-empty arguments tuple.") (#Cons [harg targs]) - (return (list (form$ (list (tuple$ (list (local-identifier$ name) + (return (list (form$ (list (tuple$ (list (local_identifier$ name) harg)) (list\fold (function'' [arg body'] - (form$ (list (tuple$ (list (local-identifier$ "") + (form$ (list (tuple$ (list (local_identifier$ "") arg)) body'))) body @@ -1392,11 +1392,11 @@ (fail "Wrong syntax for def:'''")} tokens)) -(def:''' (as-pairs xs) +(def:''' (as_pairs xs) #Nil (All [a] (-> ($' List a) ($' List (& a a)))) ({(#Cons x (#Cons y xs')) - (#Cons [x y] (as-pairs xs')) + (#Cons [x y] (as_pairs xs')) _ #Nil} @@ -1411,7 +1411,7 @@ (form$ (list (record$ (list [label body])) value))} binding))) body - (list\reverse (as-pairs bindings))))) + (list\reverse (as_pairs bindings))))) _ (fail "Wrong syntax for let'")} @@ -1430,20 +1430,20 @@ (p x))} xs)) -(def:''' (wrap-meta content) +(def:''' (wrap_meta content) #Nil (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) content))) -(def:''' (untemplate-list tokens) +(def:''' (untemplate_list tokens) #Nil (-> ($' List Code) Code) ({#Nil (_ann (#Tag ["lux" "Nil"])) (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens'))))} + (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate_list tokens'))))} tokens)) (def:''' (list\compose xs ys) @@ -1476,11 +1476,11 @@ (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..new_line) ("lux text concat" - ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) ("lux text concat" - ("lux text concat" "## =>" ..new-line) + ("lux text concat" "## =>" ..new_line) "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] #Nil) ({(#Cons op tokens') @@ -1498,11 +1498,11 @@ (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new-line) + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..new_line) ("lux text concat" - ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new-line) + ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..new_line) ("lux text concat" - ("lux text concat" "## =>" ..new-line) + ("lux text concat" "## =>" ..new_line) "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] #Nil) ({(#Cons op tokens') @@ -1533,7 +1533,7 @@ ["wrap" "bind"] #0) -(def:''' maybe-monad +(def:''' maybe_monad #Nil ($' Monad Maybe) {#wrap @@ -1545,7 +1545,7 @@ (#Some a) (f a)} ma))}) -(def:''' meta-monad +(def:''' meta_monad #Nil ($' Monad Meta) {#wrap @@ -1565,8 +1565,8 @@ (macro:' (do tokens) ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (local-identifier$ "wrap") - g!bind (local-identifier$ " bind ") + (let' [g!wrap (local_identifier$ "wrap") + g!bind (local_identifier$ " bind ") body' (list\fold ("lux check" (-> (& Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] @@ -1575,11 +1575,11 @@ _ (form$ (list g!bind - (form$ (list (tuple$ (list (local-identifier$ "") var)) body')) + (form$ (list (tuple$ (list (local_identifier$ "") var)) body')) value))} var)))) body - (list\reverse (as-pairs bindings)))] + (list\reverse (as_pairs bindings)))] (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) body'])) monad))))) @@ -1682,67 +1682,67 @@ (-> Text Text Text) ("lux text concat" x y)) -(def:''' (name\encode full-name) +(def:''' (name\encode full_name) #Nil (-> Name Text) - (let' [[module name] full-name] + (let' [[module name] full_name] ({"" name _ ($_ text\compose module "." name)} module))) -(def:''' (get-meta tag def-meta) +(def:''' (get_meta tag def_meta) #Nil (-> Name Code ($' Maybe Code)) (let' [[prefix name] tag] - ({[_ (#Record def-meta)] - ({(#Cons [key value] def-meta') + ({[_ (#Record def_meta)] + ({(#Cons [key value] def_meta') ({[_ (#Tag [prefix' name'])] ({[#1 #1] (#Some value) _ - (get-meta tag (record$ def-meta'))} + (get_meta tag (record$ def_meta'))} [(text\= prefix prefix') (text\= name name')]) _ - (get-meta tag (record$ def-meta'))} + (get_meta tag (record$ def_meta'))} key) #Nil #None} - def-meta) + def_meta) _ #None} - def-meta))) + def_meta))) -(def:''' (resolve-global-identifier full-name state) +(def:''' (resolve_global_identifier full_name state) #Nil (-> Name ($' Meta Name)) - (let' [[module name] full-name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let' [[module name] full_name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) + #scope_type_vars scope_type_vars} state] + ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _}) ({(#Some constant) - ({(#Left real-name) - (#Right [state real-name]) + ({(#Left real_name) + (#Right [state real_name]) - (#Right [exported? def-type def-meta def-value]) - (#Right [state full-name])} + (#Right [exported? def_type def_meta def_value]) + (#Right [state full_name])} constant) #None - (#Left ($_ text\compose "Unknown definition: " (name\encode full-name)))} + (#Left ($_ text\compose "Unknown definition: " (name\encode full_name)))} (get name definitions)) #None - (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full-name)))} + (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full_name)))} (get module modules)))) -(def:''' (as-code-list expression) +(def:''' (as_code_list expression) #Nil (-> Code Code) (let' [type (form$ (list (tag$ ["lux" "Apply"]) @@ -1758,26 +1758,26 @@ (return (tag$ ["lux" "Nil"])) (#Cons lastI inits) - (do meta-monad + (do meta_monad [lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (as-code-list spliced)) + (wrap (as_code_list spliced)) _ - (do meta-monad + (do meta_monad [lastO (untemplate lastI)] - (wrap (as-code-list (form$ (list (tag$ ["lux" "Cons"]) + (wrap (as_code_list (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"]))))))))} lastI)] - (monad\fold meta-monad + (monad\fold meta_monad (function' [leftI rightO] ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "lux") (identifier$ ["lux" "list\compose"])))] - (wrap (form$ (list g!in-module (as-code-list spliced) rightO)))) + (wrap (form$ (list g!in-module (as_code_list spliced) rightO)))) _ - (do meta-monad + (do meta_monad [leftO (untemplate leftI)] (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))} leftI)) @@ -1785,39 +1785,39 @@ inits))} (list\reverse elems)) #0 - (do meta-monad - [=elems (monad\map meta-monad untemplate elems)] - (wrap (untemplate-list =elems)))} + (do meta_monad + [=elems (monad\map meta_monad untemplate elems)] + (wrap (untemplate_list =elems)))} replace?)) -(def:''' (untemplate-text value) +(def:''' (untemplate_text value) #Nil (-> Text Code) - (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) + (wrap_meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) (def:''' (untemplate replace? subst token) #Nil (-> Bit Text Code ($' Meta Code)) ({[_ [_ (#Bit value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Bit"]) (bit$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Bit"]) (bit$ value))))) [_ [_ (#Nat value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) [_ [_ (#Rev value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Rev"]) (rev$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Rev"]) (rev$ value))))) [_ [_ (#Frac value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] - (return (untemplate-text value)) + (return (untemplate_text value)) [#0 [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Tag [module name])]] (let' [module' ({"" @@ -1826,23 +1826,23 @@ _ module} module)] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) [#1 [_ (#Identifier [module name])]] - (do meta-monad - [real-name ({"" + (do meta_monad + [real_name ({"" (if (text\= "" subst) (wrap [module name]) - (resolve-global-identifier [subst name])) + (resolve_global_identifier [subst name])) _ (wrap [module name])} module) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) + #let [[module name] real_name]] + (return (wrap_meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) [#0 [_ (#Identifier [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) + (return (wrap_meta (form$ (list (tag$ ["lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))]] (return (form$ (list (text$ "lux check") @@ -1850,40 +1850,40 @@ unquoted))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]] - (do meta-monad + (do meta_monad [independent (untemplate replace? subst dependent)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Form"]) - (untemplate-list (list (untemplate-text "lux in-module") - (untemplate-text subst) + (wrap (wrap_meta (form$ (list (tag$ ["lux" "Form"]) + (untemplate_list (list (untemplate_text "lux in-module") + (untemplate_text subst) independent))))))) - [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate #0 subst keep-quoted) + [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep_quoted #Nil])]))]] + (untemplate #0 subst keep_quoted) [_ [meta (#Form elems)]] - (do meta-monad + (do meta_monad [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] + #let [[_ output'] (wrap_meta (form$ (list (tag$ ["lux" "Form"]) output)))]] (wrap [meta output'])) [_ [meta (#Tuple elems)]] - (do meta-monad + (do meta_monad [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] + #let [[_ output'] (wrap_meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] (wrap [meta output'])) [_ [_ (#Record fields)]] - (do meta-monad - [=fields (monad\map meta-monad + (do meta_monad + [=fields (monad\map meta_monad ("lux check" (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] - (do meta-monad + (do meta_monad [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] (wrap (tuple$ (list =k =v))))))) fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} + (wrap (wrap_meta (form$ (list (tag$ ["lux" "Record"]) (untemplate_list =fields))))))} [replace? token])) (macro:' #export (primitive tokens) @@ -1892,29 +1892,29 @@ "## Macro to treat define new primitive types." __paragraph "(primitive ''java.lang.Object'')" __paragraph "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) - ({(#Cons [_ (#Text class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + ({(#Cons [_ (#Text class_name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class_name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Text class_name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class_name) (untemplate_list params))))) _ (fail "Wrong syntax for primitive")} tokens)) -(def:'' (current-module-name state) +(def:'' (current_module_name state) #Nil ($' Meta Text) - ({{#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - ({(#Some module-name) - (#Right [state module-name]) + #scope_type_vars scope_type_vars} + ({(#Some module_name) + (#Right [state module_name]) _ (#Left "Cannot get the module name without a module!")} - current-module)} + current_module)} state)) (macro:' #export (` tokens) @@ -1924,9 +1924,9 @@ "## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used." __paragraph "(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) - (do meta-monad - [current-module current-module-name - =template (untemplate #1 current-module template)] + (do meta_monad + [current_module current_module_name + =template (untemplate #1 current_module template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -1941,7 +1941,7 @@ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) ({(#Cons template #Nil) - (do meta-monad + (do meta_monad [=template (untemplate #1 "" template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -1955,7 +1955,7 @@ "## Quotation as a macro." __paragraph "(' YOLO)"))]) ({(#Cons template #Nil) - (do meta-monad + (do meta_monad [=template (untemplate #0 "" template)] (wrap (list (form$ (list (text$ "lux check") (identifier$ ["lux" "Code"]) =template))))) @@ -2022,7 +2022,7 @@ (-> (-> b c) (-> a b) (-> a c))) (function' [x] (f (g x)))) -(def:''' (get-name x) +(def:''' (get_name x) #Nil (-> Code ($' Maybe Name)) ({[_ (#Identifier sname)] @@ -2032,7 +2032,7 @@ #None} x)) -(def:''' (get-tag x) +(def:''' (get_tag x) #Nil (-> Code ($' Maybe Name)) ({[_ (#Tag sname)] @@ -2042,7 +2042,7 @@ #None} x)) -(def:''' (get-short x) +(def:''' (get_short x) #Nil (-> Code ($' Maybe Text)) ({[_ (#Identifier "" sname)] @@ -2062,7 +2062,7 @@ #None} tuple)) -(def:''' (apply-template env template) +(def:''' (apply_template env template) #Nil (-> RepEnv Code Code) ({[_ (#Identifier "" sname)] @@ -2071,19 +2071,19 @@ _ template} - (get-rep sname env)) + (get_rep sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list\map (apply-template env) elems))] + [meta (#Tuple (list\map (apply_template env) elems))] [meta (#Form elems)] - [meta (#Form (list\map (apply-template env) elems))] + [meta (#Form (list\map (apply_template env) elems))] [meta (#Record members)] [meta (#Record (list\map ("lux check" (-> (& Code Code) (& Code Code)) (function' [kv] (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) + [(apply_template env slot) (apply_template env value)]))) members))] _ @@ -2096,32 +2096,32 @@ (-> (-> a Bit) ($' List a) Bit)) (list\fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) -(def:''' (high-bits value) +(def:''' (high_bits value) (list) (-> ($' I64 Any) I64) ("lux i64 logical-right-shift" 32 value)) -(def:''' low-mask +(def:''' low_mask (list) I64 (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) -(def:''' (low-bits value) +(def:''' (low_bits value) (list) (-> ($' I64 Any) I64) - ("lux i64 and" low-mask value)) + ("lux i64 and" low_mask value)) (def:''' (n/< reference sample) (list) (-> Nat Nat Bit) - (let' [referenceH (high-bits reference) - sampleH (high-bits sample)] + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] (if ("lux i64 <" referenceH sampleH) #1 (if ("lux i64 =" referenceH sampleH) ("lux i64 <" - (low-bits reference) - (low-bits sample)) + (low_bits reference) + (low_bits sample)) #0)))) (def:''' (n/<= reference sample) @@ -2141,27 +2141,27 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph - "(template [<name> <diff>]" ..new-line + "(template [<name> <diff>]" ..new_line " " "[(def: #export <name> (-> Int Int) (+ <diff>))]" __paragraph - " " "[inc +1]" ..new-line + " " "[inc +1]" ..new_line " " "[dec -1]"))]) ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (list\map (apply-template env) templates))) - num-bindings (list\size bindings')] - (if (every? (function' [size] ("lux i64 =" num-bindings size)) + (function' [env] (list\map (apply_template env) templates))) + num_bindings (list\size bindings')] + (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) (|> data' - (list\map (compose apply (make-env bindings'))) + (list\map (compose apply (make_env bindings'))) list\join return) (fail "Irregular arguments tuples for template."))) _ (fail "Wrong syntax for template")} - [(monad\map maybe-monad get-short bindings) - (monad\map maybe-monad tuple->list data)]) + [(monad\map maybe_monad get_short bindings) + (monad\map maybe_monad tuple->list data)]) _ (fail "Wrong syntax for template")} @@ -2277,7 +2277,7 @@ (-> Bit Bit) (if x #0 #1)) -(def:''' (macro-type? type) +(def:''' (macro_type? type) (list) (-> Type Bit) ({(#Named ["lux" "Macro"] (#Primitive "#Macro" #Nil)) @@ -2287,24 +2287,24 @@ #0} type)) -(def:''' (find-macro' modules current-module module name) +(def:''' (find_macro' modules current_module module name) #Nil (-> ($' List (& Text Module)) Text Text Text ($' Maybe Macro)) - (do maybe-monad + (do maybe_monad [$module (get module modules) - gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] + gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux check" Module $module)] (get name bindings))] - ({(#Left [r-module r-name]) - (find-macro' modules current-module r-module r-name) + ({(#Left [r_module r_name]) + (find_macro' modules current_module r_module r_name) - (#Right [exported? def-type def-meta def-value]) - (if (macro-type? def-type) + (#Right [exported? def_type def_meta def_value]) + (if (macro_type? def_type) (if exported? - (#Some ("lux coerce" Macro def-value)) - (if (text\= module current-module) - (#Some ("lux coerce" Macro def-value)) + (#Some ("lux coerce" Macro def_value)) + (if (text\= module current_module) + (#Some ("lux coerce" Macro def_value)) #None)) #None)} ("lux check" Global gdef)))) @@ -2313,35 +2313,35 @@ #Nil (-> Name ($' Meta Name)) ({["" name] - (do meta-monad - [module-name current-module-name] - (wrap [module-name name])) + (do meta_monad + [module_name current_module_name] + (wrap [module_name name])) _ (return name)} name)) -(def:''' (find-macro full-name) +(def:''' (find_macro full_name) #Nil (-> Name ($' Meta ($' Maybe Macro))) - (do meta-monad - [current-module current-module-name] - (let' [[module name] full-name] + (do meta_monad + [current_module current_module_name] + (let' [[module name] full_name] (function' [state] - ({{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))} + #scope_type_vars scope_type_vars} + (#Right state (find_macro' modules current_module module name))} state))))) (def:''' (macro? name) #Nil (-> Name ($' Meta Bit)) - (do meta-monad + (do meta_monad [name (normalize name) - output (find-macro name)] + output (find_macro name)] (wrap ({(#Some _) #1 #None #0} output)))) @@ -2360,13 +2360,13 @@ (list& x sep (interpose sep xs'))} xs)) -(def:''' (macro-expand-once token) +(def:''' (macro_expand_once token) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) (("lux coerce" Macro' macro) args) @@ -2378,17 +2378,17 @@ (return (list token))} token)) -(def:''' (macro-expand token) +(def:''' (macro_expand token) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) - (do meta-monad + (do meta_monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad\map meta-monad macro-expand expansion)] + expansion' (monad\map meta_monad macro_expand expansion)] (wrap (list\join expansion'))) #None @@ -2399,42 +2399,42 @@ (return (list token))} token)) -(def:''' (macro-expand-all syntax) +(def:''' (macro_expand_all syntax) #Nil (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Cons [_ (#Identifier macro-name)] args))] - (do meta-monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] ({(#Some macro) - (do meta-monad + (do meta_monad [expansion (("lux coerce" Macro' macro) args) - expansion' (monad\map meta-monad macro-expand-all expansion)] + expansion' (monad\map meta_monad macro_expand_all expansion)] (wrap (list\join expansion'))) #None - (do meta-monad - [args' (monad\map meta-monad macro-expand-all args)] - (wrap (list (form$ (#Cons (identifier$ macro-name) (list\join args'))))))} + (do meta_monad + [args' (monad\map meta_monad macro_expand_all args)] + (wrap (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} ?macro)) [_ (#Form members)] - (do meta-monad - [members' (monad\map meta-monad macro-expand-all members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] (wrap (list (form$ (list\join members'))))) [_ (#Tuple members)] - (do meta-monad - [members' (monad\map meta-monad macro-expand-all members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] (wrap (list (tuple$ (list\join members'))))) [_ (#Record pairs)] - (do meta-monad - [pairs' (monad\map meta-monad + (do meta_monad + [pairs' (monad\map meta_monad (function' [kv] (let' [[key val] kv] - (do meta-monad - [val' (macro-expand-all val)] + (do meta_monad + [val' (macro_expand_all val)] ({(#Cons val'' #Nil) (return [key val'']) @@ -2448,29 +2448,29 @@ (return (list syntax))} syntax)) -(def:''' (walk-type type) +(def:''' (walk_type type) #Nil (-> Code Code) ({[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (list\map walk-type parts)])) + (form$ (#Cons [(tag$ tag) (list\map walk_type parts)])) [_ (#Tuple members)] - (` (& (~+ (list\map walk-type members)))) + (` (& (~+ (list\map walk_type members)))) [_ (#Form (#Cons [_ (#Text "lux in-module")] (#Cons [_ (#Text module)] (#Cons type' #Nil))))] - (` ("lux in-module" (~ (text$ module)) (~ (walk-type type')))) + (` ("lux in-module" (~ (text$ module)) (~ (walk_type type')))) [_ (#Form (#Cons [_ (#Identifier ["" ":~"])] (#Cons expression #Nil)))] expression - [_ (#Form (#Cons type-fn args))] + [_ (#Form (#Cons type_fn args))] (list\fold ("lux check" (-> Code Code Code) - (function' [arg type-fn] (` (#.Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (list\map walk-type args)) + (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) + (walk_type type_fn) + (list\map walk_type args)) _ type} @@ -2482,10 +2482,10 @@ "## Takes a type expression and returns it's representation as data-structure." __paragraph "(type (All [a] (Maybe (List a))))"))]) ({(#Cons type #Nil) - (do meta-monad - [type+ (macro-expand-all type)] + (do meta_monad + [type+ (macro_expand_all type)] ({(#Cons type' #Nil) - (wrap (list (walk-type type'))) + (wrap (list (walk_type type'))) _ (fail "The expansion of the type-syntax had to yield a single element.")} @@ -2535,16 +2535,16 @@ [first a x] [second b y]) -(def:''' (unfold-type-def type-codes) +(def:''' (unfold_type_def type_codes) #Nil (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) ({(#Cons [_ (#Record pairs)] #Nil) - (do meta-monad - [members (monad\map meta-monad + (do meta_monad + [members (monad\map meta_monad (: (-> [Code Code] (Meta [Text Code])) (function' [pair] - ({[[_ (#Tag "" member-name)] member-type] - (return [member-name member-type]) + ({[[_ (#Tag "" member_name)] member_type] + (return [member_name member_type]) _ (fail "Wrong syntax for variant case.")} @@ -2554,29 +2554,29 @@ (#Some (list\map first members))])) (#Cons type #Nil) - ({[_ (#Tag "" member-name)] - (return [(` .Any) (#Some (list member-name))]) + ({[_ (#Tag "" member_name)] + (return [(` .Any) (#Some (list member_name))]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~+ member-types))) (#Some (list member-name))]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [(` (& (~+ member_types))) (#Some (list member_name))]) _ (return [type #None])} type) (#Cons case cases) - (do meta-monad - [members (monad\map meta-monad + (do meta_monad + [members (monad\map meta_monad (: (-> Code (Meta [Text Code])) (function' [case] - ({[_ (#Tag "" member-name)] - (return [member-name (` .Any)]) + ({[_ (#Tag "" member_name)] + (return [member_name (` .Any)]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] (#Cons member-type #Nil)))] - (return [member-name member-type]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] (#Cons member_type #Nil)))] + (return [member_name member_type]) - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [member-name (` (& (~+ member-types)))]) + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [member_name (` (& (~+ member_types)))]) _ (fail "Wrong syntax for variant case.")} @@ -2587,22 +2587,22 @@ _ (fail "Improper type-definition syntax")} - type-codes)) + type_codes)) (def:''' (gensym prefix state) #Nil (-> Text ($' Meta Code)) - ({{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + #scope_type_vars scope_type_vars} + (#Right {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed ("lux i64 +" 1 seed) #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (local-identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} + #scope_type_vars scope_type_vars} + (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} state)) (macro:' #export (Rec tokens) @@ -2612,8 +2612,8 @@ "## A name has to be given to the whole type, to use it within its body." __paragraph "(Rec Self [Int (List Self)])"))]) ({(#Cons [_ (#Identifier "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#.Apply (~ (make-parameter 1)) (~ (make-parameter 0))))]) - (update-parameters body))] + (let' [body' (replace_syntax (list [name (` (#.Apply (~ (make_parameter 1)) (~ (make_parameter 0))))]) + (update_parameters body))] (return (list (` (#.Apply .Nothing (#.UnivQ #.Nil (~ body'))))))) _ @@ -2624,13 +2624,13 @@ (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" "## Sequential execution of expressions (great for side-effects)." __paragraph - "(exec" ..new-line - " " "(log! ''#1'')" ..new-line - " " "(log! ''#2'')" ..new-line - " " "(log! ''#3'')" ..new-line + "(exec" ..new_line + " " "(log! ''#1'')" ..new_line + " " "(log! ''#2'')" ..new_line + " " "(log! ''#3'')" ..new_line "''YOLO'')"))]) ({(#Cons value actions) - (let' [dummy (local-identifier$ "")] + (let' [dummy (local_identifier$ "")] (return (list (list\fold ("lux check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) @@ -2679,7 +2679,7 @@ ?type)] (return (list (` ("lux def" (~ name) (~ body'') - [(~ location-code) + [(~ location_code) (#.Record #.Nil)] (~ (bit$ export?))))))) @@ -2687,14 +2687,14 @@ (fail "Wrong syntax for def'")} parts))) -(def:' (rejoin-pair pair) +(def:' (rejoin_pair pair) (-> [Code Code] (List Code)) (let' [[left right] pair] (list left right))) (def:' (text\encode original) (-> Text Text) - ($_ text\compose ..double-quote original ..double-quote)) + ($_ text\compose ..double_quote original ..double_quote)) (def:' (code\encode code) (-> Code Text) @@ -2751,28 +2751,28 @@ (def:' (expander branches) (-> (List Code) (Meta (List Code))) - ({(#Cons [_ (#Form (#Cons [_ (#Identifier macro-name)] macro-args))] + ({(#Cons [_ (#Form (#Cons [_ (#Identifier macro_name)] macro_args))] (#Cons body branches')) - (do meta-monad - [??? (macro? macro-name)] + (do meta_monad + [??? (macro? macro_name)] (if ??? - (do meta-monad - [init-expansion (macro-expand-once (form$ (list& (identifier$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do meta-monad - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (identifier$ macro-name) macro-args)) + (do meta_monad + [init_expansion (macro_expand_once (form$ (list& (identifier$ macro_name) (form$ macro_args) body branches')))] + (expander init_expansion)) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& (form$ (list& (identifier$ macro_name) macro_args)) body - sub-expansion))))) + sub_expansion))))) (#Cons pattern (#Cons body branches')) - (do meta-monad - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& pattern body sub_expansion))) #Nil - (do meta-monad [] (wrap (list))) + (do meta_monad [] (wrap (list))) _ (fail ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches @@ -2785,17 +2785,17 @@ (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## The pattern-matching macro." ..new-line - "## Allows the usage of macros within the patterns to provide custom syntax." ..new-line - "(case (: (List Int) (list +1 +2 +3))" ..new-line - " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new-line + "## The pattern-matching macro." ..new_line + "## Allows the usage of macros within the patterns to provide custom syntax." ..new_line + "(case (: (List Int) (list +1 +2 +3))" ..new_line + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..new_line " " "(#Some ($_ * x y z))" __paragraph - " " "_" ..new-line + " " "_" ..new_line " " "#None)"))]) ({(#Cons value branches) - (do meta-monad + (do meta_monad [expansion (expander branches)] - (wrap (list (` ((~ (record$ (as-pairs expansion))) (~ value)))))) + (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) _ (fail "Wrong syntax for case")} @@ -2804,18 +2804,18 @@ (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-expanding patterns." ..new-line - "## It's a special macro meant to be used with 'case'." ..new-line - "(case (: (List Int) (list +1 +2 +3))" ..new-line - " (^ (list x y z))" ..new-line + "## Macro-expanding patterns." ..new_line + "## It's a special macro meant to be used with 'case'." ..new_line + "(case (: (List Int) (list +1 +2 +3))" ..new_line + " (^ (list x y z))" ..new_line " (#Some ($_ * x y z))" __paragraph - " _" ..new-line + " _" ..new_line " #None)"))]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) - (do meta-monad - [pattern+ (macro-expand-all pattern)] + (do meta_monad + [pattern+ (macro_expand_all pattern)] (case pattern+ (#Cons pattern' #Nil) (wrap (list& pattern' body branches)) @@ -2829,17 +2829,17 @@ (macro:' #export (^or tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Or-patterns." ..new-line - "## It's a special macro meant to be used with 'case'." ..new-line + "## Or-patterns." ..new_line + "## It's a special macro meant to be used with 'case'." ..new_line "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" __paragraph - "(def: (weekend? day)" ..new-line - " (-> Weekday Bit)" ..new-line - " (case day" ..new-line - " (^or #Saturday #Sunday)" ..new-line + "(def: (weekend? day)" ..new_line + " (-> Weekday Bit)" ..new_line + " (case day" ..new_line + " (^or #Saturday #Sunday)" ..new_line " #1" __paragraph - " _" ..new-line + " _" ..new_line " #0))"))]) (case tokens (^ (list& [_ (#Form patterns)] body branches)) @@ -2867,15 +2867,15 @@ (macro:' #export (let tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Creates local bindings." ..new-line - "## Can (optionally) use pattern-matching macros when binding." ..new-line - "(let [x (foo bar)" ..new-line - " y (baz quux)]" ..new-line + "## Creates local bindings." ..new_line + "## Can (optionally) use pattern-matching macros when binding." ..new_line + "(let [x (foo bar)" ..new_line + " y (baz quux)]" ..new_line " (op x y))"))]) (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list\size bindings)) - (|> bindings as-pairs list\reverse + (|> bindings as_pairs list\reverse (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] @@ -2893,12 +2893,12 @@ (macro:' #export (function tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Syntax for creating functions." ..new-line - "## Allows for giving the function itself a name, for the sake of recursion." ..new-line - "(: (All [a b] (-> a b a))" ..new-line + "## Syntax for creating functions." ..new_line + "## Allows for giving the function itself a name, for the sake of recursion." ..new_line + "(: (All [a b] (-> a b a))" ..new_line " (function (_ x y) x))" __paragraph - "(: (All [a b] (-> a b a))" ..new-line + "(: (All [a b] (-> a b a))" ..new_line " (function (const x y) x))"))]) (case (: (Maybe [Text Code (List Code) Code]) (case tokens @@ -2908,7 +2908,7 @@ _ #None)) (#Some g!name head tail body) - (let [g!blank (local-identifier$ "") + (let [g!blank (local_identifier$ "") nest (: (-> Code (-> Code Code Code)) (function' [g!name] (function' [arg body'] @@ -2916,77 +2916,77 @@ (` ([(~ g!name) (~ arg)] (~ body'))) (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] - (return (list (nest (..local-identifier$ g!name) head + (return (list (nest (..local_identifier$ g!name) head (list\fold (nest g!blank) body (list\reverse tail)))))) #None (fail "Wrong syntax for function"))) -(def:' (process-def-meta-value code) +(def:' (process_def_meta_value code) (-> Code Code) (case code [_ (#Bit value)] - (meta-code ["lux" "Bit"] (bit$ value)) + (meta_code ["lux" "Bit"] (bit$ value)) [_ (#Nat value)] - (meta-code ["lux" "Nat"] (nat$ value)) + (meta_code ["lux" "Nat"] (nat$ value)) [_ (#Int value)] - (meta-code ["lux" "Int"] (int$ value)) + (meta_code ["lux" "Int"] (int$ value)) [_ (#Rev value)] - (meta-code ["lux" "Rev"] (rev$ value)) + (meta_code ["lux" "Rev"] (rev$ value)) [_ (#Frac value)] - (meta-code ["lux" "Frac"] (frac$ value)) + (meta_code ["lux" "Frac"] (frac$ value)) [_ (#Text value)] - (meta-code ["lux" "Text"] (text$ value)) + (meta_code ["lux" "Text"] (text$ value)) [_ (#Tag [prefix name])] - (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) + (meta_code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) (^or [_ (#Form _)] [_ (#Identifier _)]) code [_ (#Tuple xs)] (|> xs - (list\map process-def-meta-value) - untemplate-list - (meta-code ["lux" "Tuple"])) + (list\map process_def_meta_value) + untemplate_list + (meta_code ["lux" "Tuple"])) [_ (#Record kvs)] (|> kvs (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))])))) - untemplate-list - (meta-code ["lux" "Record"])) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))])))) + untemplate_list + (meta_code ["lux" "Record"])) )) -(def:' (process-def-meta kvs) +(def:' (process_def_meta kvs) (-> (List [Code Code]) Code) - (untemplate-list (list\map (: (-> [Code Code] Code) + (untemplate_list (list\map (: (-> [Code Code] Code) (function (_ [k v]) - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))]))) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))]))) kvs))) -(def:' (with-func-args args meta) +(def:' (with_func_args args meta) (-> (List Code) Code Code) (case args #Nil meta _ - (` (#.Cons [[(~ location-code) (#.Tag ["lux" "func-args"])] - [(~ location-code) (#.Tuple (.list (~+ (list\map (function (_ arg) - (` [(~ location-code) (#.Text (~ (text$ (code\encode arg))))])) + (` (#.Cons [[(~ location_code) (#.Tag ["lux" "func-args"])] + [(~ location_code) (#.Tuple (.list (~+ (list\map (function (_ arg) + (` [(~ location_code) (#.Text (~ (text$ (code\encode arg))))])) args))))]] (~ meta))))) -(def:' (with-type-args args) +(def:' (with_type_args args) (-> (List Code) Code) (` {#.type-args [(~+ (list\map (function (_ arg) (text$ (code\encode arg))) args))]})) @@ -3009,29 +3009,29 @@ (macro:' #export (def: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Defines global constants/functions." ..new-line - "(def: (rejoin-pair pair)" ..new-line - " (-> [Code Code] (List Code))" ..new-line - " (let [[left right] pair]" ..new-line + "## Defines global constants/functions." ..new_line + "(def: (rejoin_pair pair)" ..new_line + " (-> [Code Code] (List Code))" ..new_line + " (let [[left right] pair]" ..new_line " (list left right)))" __paragraph - "(def: branching-exponent" ..new-line - " Int" ..new-line + "(def: branching_exponent" ..new_line + " Int" ..new_line " +5)"))]) (let [[exported? tokens'] (export^ tokens) parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) (case tokens' - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) - (#Some [name args (#Some type) body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] type body)) + (#Some [name args (#Some type) body meta_kvs]) - (^ (list name [_ (#Record meta-kvs)] type body)) - (#Some [name #Nil (#Some type) body meta-kvs]) + (^ (list name [_ (#Record meta_kvs)] type body)) + (#Some [name #Nil (#Some type) body meta_kvs]) - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) - (#Some [name args #None body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] body)) + (#Some [name args #None body meta_kvs]) - (^ (list name [_ (#Record meta-kvs)] body)) - (#Some [name #Nil #None body meta-kvs]) + (^ (list name [_ (#Record meta_kvs)] body)) + (#Some [name #Nil #None body meta_kvs]) (^ (list [_ (#Form (#Cons name args))] type body)) (#Some [name args (#Some type) body #Nil]) @@ -3061,17 +3061,17 @@ #None body) - =meta (process-def-meta meta)] + =meta (process_def_meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ location-code) - (#.Record (~ (with-func-args args =meta)))] + [(~ location_code) + (#.Record (~ (with_func_args args =meta)))] (~ (bit$ exported?))))))) #None (fail "Wrong syntax for def:")))) -(def: (meta-code-add addition meta) +(def: (meta_code_add addition meta) (-> [Code Code] Code Code) (case [addition meta] [[name value] [location (#Record pairs)]] @@ -3080,11 +3080,11 @@ _ meta)) -(def: (meta-code-merge addition base) +(def: (meta_code_merge addition base) (-> Code Code Code) (case addition [location (#Record pairs)] - (list\fold meta-code-add base pairs) + (list\fold meta_code_add base pairs) _ base)) @@ -3092,16 +3092,16 @@ (macro:' #export (macro: tokens) (list [(tag$ ["lux" "doc"]) (text$ ($_ "lux text concat" - "## Macro-definition macro." ..new-line - "(macro: #export (name-of tokens)" ..new-line - " (case tokens" ..new-line - " (^template [<tag>]" ..new-line - " [(^ (list [_ (<tag> [prefix name])]))" ..new-line - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new-line + "## Macro-definition macro." ..new_line + "(macro: #export (name_of tokens)" ..new_line + " (case tokens" ..new_line + " (^template [<tag>]" ..new_line + " [(^ (list [_ (<tag> [prefix name])]))" ..new_line + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new_line " ([#Identifier] [#Tag])" __paragraph - " _" ..new-line - " (fail ''Wrong syntax for name-of'')))"))]) + " _" ..new_line + " (fail ''Wrong syntax for name_of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) (case tokens @@ -3111,11 +3111,11 @@ (^ (list [_ (#Identifier name)] body)) (#Some [name #Nil (list) body]) - (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta-rec-parts)] body)) - (#Some [name args meta-rec-parts body]) + (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta_rec_parts)] body)) + (#Some [name args meta_rec_parts body]) - (^ (list [_ (#Identifier name)] [_ (#Record meta-rec-parts)] body)) - (#Some [name #Nil meta-rec-parts body]) + (^ (list [_ (#Identifier name)] [_ (#Record meta_rec_parts)] body)) + (#Some [name #Nil meta_rec_parts body]) _ #None))] @@ -3129,10 +3129,10 @@ _ (` ("lux macro" (function ((~ name) (~+ args)) (~ body))))) - =meta (process-def-meta meta)] + =meta (process_def_meta meta)] (return (list (` ("lux def" (~ name) (~ body) - [(~ location-code) + [(~ location_code) (#Record (~ =meta))] (~ (bit$ exported?))))))) @@ -3141,26 +3141,26 @@ (macro: #export (signature: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of signatures ala ML." ..new-line - "(signature: #export (Ord a)" ..new-line - " (: (Equivalence a)" ..new-line - " eq)" ..new-line - " (: (-> a a Bit)" ..new-line - " <)" ..new-line - " (: (-> a a Bit)" ..new-line - " <=)" ..new-line - " (: (-> a a Bit)" ..new-line - " >)" ..new-line - " (: (-> a a Bit)" ..new-line + "## Definition of signatures ala ML." ..new_line + "(signature: #export (Ord a)" ..new_line + " (: (Equivalence a)" ..new_line + " eq)" ..new_line + " (: (-> a a Bit)" ..new_line + " <)" ..new_line + " (: (-> a a Bit)" ..new_line + " <=)" ..new_line + " (: (-> a a Bit)" ..new_line + " >)" ..new_line + " (: (-> a a Bit)" ..new_line " >=))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Name (List Code) Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta-rec-location (#Record meta-rec-parts)] sigs)) - (#Some name args [meta-rec-location (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name args [meta_rec_location (#Record meta_rec_parts)] sigs) - (^ (list& [_ (#Identifier name)] [meta-rec-location (#Record meta-rec-parts)] sigs)) - (#Some name #Nil [meta-rec-location (#Record meta-rec-parts)] sigs) + (^ (list& [_ (#Identifier name)] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name #Nil [meta_rec_location (#Record meta_rec_parts)] sigs) (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] sigs)) (#Some name args (` {}) sigs) @@ -3172,11 +3172,11 @@ #None))] (case ?parts (#Some name args meta sigs) - (do meta-monad + (do meta_monad [name+ (normalize name) - sigs' (monad\map meta-monad macro-expand sigs) + sigs' (monad\map meta_monad macro_expand sigs) members (: (Meta (List [Text Code])) - (monad\map meta-monad + (monad\map meta_monad (: (-> Code (Meta [Text Code])) (function (_ token) (case token @@ -3187,20 +3187,20 @@ (fail "Signatures require typed members!")))) (list\join sigs'))) #let [[_module _name] name+ - def-name (identifier$ name) - sig-type (record$ (list\map (: (-> [Text Code] [Code Code]) - (function (_ [m-name m-type]) - [(local-tag$ m-name) m-type])) + def_name (identifier$ name) + sig_type (record$ (list\map (: (-> [Text Code] [Code Code]) + (function (_ [m_name m_type]) + [(local_tag$ m_name) m_type])) members)) - sig-meta (meta-code-merge (` {#.sig? #1}) + sig_meta (meta_code_merge (` {#.sig? #1}) meta) usage (case args #Nil - def-name + def_name _ - (` ((~ def-name) (~+ args))))]] - (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (` ((~ def_name) (~+ args))))]] + (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) #None (fail "Wrong syntax for signature:")))) @@ -3220,9 +3220,9 @@ (#Some y) (#Some y)))) -(template [<name> <form> <message> <doc-msg>] +(template [<name> <form> <message> <doc_msg>] [(macro: #export (<name> tokens) - {#.doc <doc-msg>} + {#.doc <doc_msg>} (case (list\reverse tokens) (^ (list& last init)) (return (list (list\fold (: (-> Code Code Code) @@ -3236,20 +3236,20 @@ [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) -(def: (index-of part text) +(def: (index_of part text) (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) (def: #export (error! message) {#.doc (text$ ($_ "lux text concat" - "## Causes an error, with the given error message." ..new-line + "## Causes an error, with the given error message." ..new_line "(error! ''OH NO!'')"))} (-> Text Nothing) ("lux io error" message)) (macro: (default tokens state) {#.doc (text$ ($_ "lux text concat" - "## Allows you to provide a default value that will be used" ..new-line + "## Allows you to provide a default value that will be used" ..new_line "## if a (Maybe x) value turns out to be #.None." __paragraph "(default +20 (#.Some +10)) ## => +10" @@ -3257,7 +3257,7 @@ "(default +20 #.None) ## => +20"))} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-location (#Identifier ["" ""])]) + (let [g!temp (: Code [dummy_location (#Identifier ["" ""])]) code (` (case (~ maybe) (#.Some (~ g!temp)) (~ g!temp) @@ -3269,15 +3269,15 @@ _ (#Left "Wrong syntax for default"))) -(def: (text\split-all-with splitter input) +(def: (text\split_all_with splitter input) (-> Text Text (List Text)) - (case (..index-of splitter input) + (case (..index_of splitter input) #None (list input) (#Some idx) (list& ("lux text clip" 0 idx input) - (text\split-all-with splitter + (text\split_all_with splitter ("lux text clip" ("lux i64 +" 1 idx) ("lux text size" input) input))))) (def: (nth idx xs) @@ -3293,36 +3293,36 @@ (nth ("lux i64 -" 1 idx) xs') ))) -(def: (beta-reduce env type) +(def: (beta_reduce env type) (-> (List Type) Type Type) (case type (#Sum left right) - (#Sum (beta-reduce env left) (beta-reduce env right)) + (#Sum (beta_reduce env left) (beta_reduce env right)) (#Product left right) - (#Product (beta-reduce env left) (beta-reduce env right)) + (#Product (beta_reduce env left) (beta_reduce env right)) (#Apply arg func) - (#Apply (beta-reduce env arg) (beta-reduce env func)) + (#Apply (beta_reduce env arg) (beta_reduce env func)) - (#UnivQ ?local-env ?local-def) - (case ?local-env + (#UnivQ ?local_env ?local_def) + (case ?local_env #Nil - (#UnivQ env ?local-def) + (#UnivQ env ?local_def) _ type) - (#ExQ ?local-env ?local-def) - (case ?local-env + (#ExQ ?local_env ?local_def) + (case ?local_env #Nil - (#ExQ env ?local-def) + (#ExQ env ?local_def) _ type) (#Function ?input ?output) - (#Function (beta-reduce env ?input) (beta-reduce env ?output)) + (#Function (beta_reduce env ?input) (beta_reduce env ?output)) (#Parameter idx) (case (nth idx env) @@ -3333,28 +3333,28 @@ type) (#Named name type) - (beta-reduce env type) + (beta_reduce env type) _ type )) -(def: (apply-type type-fn param) +(def: (apply_type type_fn param) (-> Type Type (Maybe Type)) - (case type-fn + (case type_fn (#UnivQ env body) - (#Some (beta-reduce (list& type-fn param env) body)) + (#Some (beta_reduce (list& type_fn param env) body)) (#ExQ env body) - (#Some (beta-reduce (list& type-fn param env) body)) + (#Some (beta_reduce (list& type_fn param env) body)) (#Apply A F) - (do maybe-monad - [type-fn* (apply-type F A)] - (apply-type type-fn* param)) + (do maybe_monad + [type_fn* (apply_type F A)] + (apply_type type_fn* param)) (#Named name type) - (apply-type type param) + (apply_type type param) _ #None)) @@ -3369,40 +3369,40 @@ _ (list type)))] - [flatten-variant #Sum] - [flatten-tuple #Product] - [flatten-lambda #Function] + [flatten_variant #Sum] + [flatten_tuple #Product] + [flatten_lambda #Function] ) -(def: (flatten-app type) +(def: (flatten_app type) (-> Type [Type (List Type)]) (case type (#Apply head func') - (let [[func tail] (flatten-app func')] + (let [[func tail] (flatten_app func')] [func (#Cons head tail)]) _ [type (list)])) -(def: (resolve-struct-type type) +(def: (resolve_struct_type type) (-> Type (Maybe (List Type))) (case type (#Product _) - (#Some (flatten-tuple type)) + (#Some (flatten_tuple type)) (#Apply arg func) - (do maybe-monad - [output (apply-type func arg)] - (resolve-struct-type output)) + (do maybe_monad + [output (apply_type func arg)] + (resolve_struct_type output)) (#UnivQ _ body) - (resolve-struct-type body) + (resolve_struct_type body) (#ExQ _ body) - (resolve-struct-type body) + (resolve_struct_type body) (#Named name type) - (resolve-struct-type type) + (resolve_struct_type type) (#Sum _) #None @@ -3410,13 +3410,13 @@ _ (#Some (list type)))) -(def: (find-module name) +(def: (find_module name) (-> Text (Meta Module)) (function (_ state) - (let [{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] + #scope_type_vars scope_type_vars} state] (case (get name modules) (#Some module) (#Right state module) @@ -3424,43 +3424,43 @@ _ (#Left ($_ text\compose "Unknown module: " name)))))) -(def: get-current-module +(def: get_current_module (Meta Module) - (do meta-monad - [module-name current-module-name] - (find-module module-name))) + (do meta_monad + [module_name current_module_name] + (find_module module_name))) -(def: (resolve-tag [module name]) +(def: (resolve_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) - (do meta-monad - [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]] - (case (get name tags-table) + (do meta_monad + [=module (find_module module) + #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] + (case (get name tags_table) (#Some output) (return output) _ (fail (text\compose "Unknown tag: " (name\encode [module name])))))) -(def: (resolve-type-tags type) +(def: (resolve_type_tags type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) (case type (#Apply arg func) - (resolve-type-tags func) + (resolve_type_tags func) (#UnivQ env body) - (resolve-type-tags body) + (resolve_type_tags body) (#ExQ env body) - (resolve-type-tags body) + (resolve_type_tags body) (#Named [module name] unnamed) - (do meta-monad - [=module (find-module module) - #let [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]] + (do meta_monad + [=module (find_module module) + #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) - (case (resolve-struct-type _type) + (case (resolve_struct_type _type) (#Some members) (return (#Some [tags members])) @@ -3468,18 +3468,18 @@ (return #None)) _ - (resolve-type-tags unnamed))) + (resolve_type_tags unnamed))) _ (return #None))) -(def: get-expected-type +(def: get_expected_type (Meta Type) (function (_ state) - (let [{#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] + #scope_type_vars scope_type_vars} state] (case expected (#Some type) (#Right state type) @@ -3489,10 +3489,10 @@ (macro: #export (structure tokens) {#.doc "Not meant to be used directly. Prefer 'structure:'."} - (do meta-monad - [tokens' (monad\map meta-monad macro-expand tokens) - struct-type get-expected-type - tags+type (resolve-type-tags struct-type) + (do meta_monad + [tokens' (monad\map meta_monad macro_expand tokens) + struct_type get_expected_type + tags+type (resolve_type_tags struct_type) tags (: (Meta (List Name)) (case tags+type (#Some [tags _]) @@ -3500,27 +3500,27 @@ _ (fail "No tags available for type."))) - #let [tag-mappings (: (List [Text Code]) + #let [tag_mappings (: (List [Text Code]) (list\map (function (_ tag) [(second tag) (tag$ tag)]) tags))] - members (monad\map meta-monad + members (monad\map meta_monad (: (-> Code (Meta [Code Code])) (function (_ token) (case token - (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag-name)] value meta [_ (#Bit #0)]))]) - (case (get tag-name tag-mappings) + (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta [_ (#Bit #0)]))]) + (case (get tag_name tag_mappings) (#Some tag) (wrap [tag value]) _ - (fail (text\compose "Unknown structure member: " tag-name))) + (fail (text\compose "Unknown structure member: " tag_name))) _ (fail "Invalid structure member.")))) (list\join tokens'))] (wrap (list (record$ members))))) -(def: (text\join-with separator parts) +(def: (text\join_with separator parts) (-> Text (List Text) Text) (case parts #Nil @@ -3534,27 +3534,27 @@ (macro: #export (structure: tokens) {#.doc (text$ ($_ "lux text concat" - "## Definition of structures ala ML." ..new-line - "(structure: #export order (Order Int)" ..new-line - " (def: &equivalence equivalence)" ..new-line - " (def: (< test subject)" ..new-line - " (< test subject))" ..new-line - " (def: (<= test subject)" ..new-line - " (or (< test subject)" ..new-line - " (= test subject)))" ..new-line - " (def: (> test subject)" ..new-line - " (> test subject))" ..new-line - " (def: (>= test subject)" ..new-line - " (or (> test subject)" ..new-line + "## Definition of structures ala ML." ..new_line + "(structure: #export order (Order Int)" ..new_line + " (def: &equivalence equivalence)" ..new_line + " (def: (< test subject)" ..new_line + " (< test subject))" ..new_line + " (def: (<= test subject)" ..new_line + " (or (< test subject)" ..new_line + " (= test subject)))" ..new_line + " (def: (> test subject)" ..new_line + " (> test subject))" ..new_line + " (def: (>= test subject)" ..new_line + " (or (> test subject)" ..new_line " (= test subject))))"))} (let [[exported? tokens'] (export^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& name args))] [meta-rec-location (#Record meta-rec-parts)] type definitions)) - (#Some name args type [meta-rec-location (#Record meta-rec-parts)] definitions) + (^ (list& [_ (#Form (list& name args))] [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name args type [meta_rec_location (#Record meta_rec_parts)] definitions) - (^ (list& name [meta-rec-location (#Record meta-rec-parts)] type definitions)) - (#Some name #Nil type [meta-rec-location (#Record meta-rec-parts)] definitions) + (^ (list& name [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name #Nil type [meta_rec_location (#Record meta_rec_parts)] definitions) (^ (list& [_ (#Form (list& name args))] type definitions)) (#Some name args type (` {}) definitions) @@ -3573,7 +3573,7 @@ _ (` ((~ name) (~+ args))))] (return (list (` (..def: (~+ (export exported?)) (~ usage) - (~ (meta-code-merge (` {#.struct? #1}) + (~ (meta_code_merge (` {#.struct? #1}) meta)) (~ type) (structure (~+ definitions))))))) @@ -3585,7 +3585,7 @@ (macro: #export (type: tokens) {#.doc (text$ ($_ "lux text concat" - "## The type-definition macro." ..new-line + "## The type-definition macro." ..new_line "(type: (List a) #Nil (#Cons a (List a)))"))} (let [[exported? tokens'] (export^ tokens) [rec? tokens'] (case tokens' @@ -3596,40 +3596,40 @@ [#0 tokens']) parts (: (Maybe [Text (List Code) (List [Code Code]) (List Code)]) (case tokens' - (^ (list [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) - (#Some [name #Nil meta-parts (list [type-location (#Record type-parts)])]) + (^ (list [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name #Nil meta_parts (list [type_location (#Record type_parts)])]) - (^ (list& [_ (#Identifier "" name)] [meta-location (#Record meta-parts)] type-code1 type-codes)) - (#Some [name #Nil meta-parts (#Cons type-code1 type-codes)]) + (^ (list& [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name #Nil meta_parts (#Cons type_code1 type_codes)]) - (^ (list& [_ (#Identifier "" name)] type-codes)) - (#Some [name #Nil (list) type-codes]) + (^ (list& [_ (#Identifier "" name)] type_codes)) + (#Some [name #Nil (list) type_codes]) - (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] [type-location (#Record type-parts)])) - (#Some [name args meta-parts (list [type-location (#Record type-parts)])]) + (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name args meta_parts (list [type_location (#Record type_parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta-location (#Record meta-parts)] type-code1 type-codes)) - (#Some [name args meta-parts (#Cons type-code1 type-codes)]) + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name args meta_parts (#Cons type_code1 type_codes)]) - (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type-codes)) - (#Some [name args (list) type-codes]) + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type_codes)) + (#Some [name args (list) type_codes]) _ #None))] (case parts - (#Some name args meta type-codes) - (do meta-monad - [type+tags?? (unfold-type-def type-codes) - module-name current-module-name] - (let [type-name (local-identifier$ name) + (#Some name args meta type_codes) + (do meta_monad + [type+tags?? (unfold_type_def type_codes) + module_name current_module_name] + (let [type_name (local_identifier$ name) [type tags??] type+tags?? type' (: (Maybe Code) (if rec? (if (empty? args) - (let [g!param (local-identifier$ "") - prime-name (local-identifier$ name) - type+ (replace-syntax (list [name (` ((~ prime-name) .Nothing))]) type)] - (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) + (let [g!param (local_identifier$ "") + prime_name (local_identifier$ name) + type+ (replace_syntax (list [name (` ((~ prime_name) .Nothing))]) type)] + (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) .Nothing)))) #None) (case args @@ -3637,31 +3637,31 @@ (#Some type) _ - (#Some (` (.All (~ type-name) [(~+ args)] (~ type))))))) - total-meta (let [meta (process-def-meta meta) + (#Some (` (.All (~ type_name) [(~+ args)] (~ type))))))) + total_meta (let [meta (process_def_meta meta) meta (if rec? - (` (#.Cons (~ (flag-meta "type-rec?")) (~ meta))) + (` (#.Cons (~ (flag_meta "type-rec?")) (~ meta))) meta)] - (` [(~ location-code) + (` [(~ location_code) (#.Record (~ meta))]))] (case type' (#Some type'') - (let [typeC (` (#.Named [(~ (text$ module-name)) + (let [typeC (` (#.Named [(~ (text$ module_name)) (~ (text$ name))] (.type (~ type''))))] (return (list (case tags?? (#Some tags) - (` ("lux def type tagged" (~ type-name) + (` ("lux def type tagged" (~ type_name) (~ typeC) - (~ total-meta) + (~ total_meta) [(~+ (list\map text$ tags))] (~ (bit$ exported?)))) _ - (` ("lux def" (~ type-name) + (` ("lux def" (~ type_name) ("lux check type" (~ typeC)) - (~ total-meta) + (~ total_meta) (~ (bit$ exported?)))))))) #None @@ -3693,17 +3693,17 @@ [Text (List Text)]) (type: Refer - {#refer-defs Referrals - #refer-open (List Openings)}) + {#refer_defs Referrals + #refer_open (List Openings)}) (type: Importation - {#import-name Text - #import-alias (Maybe Text) - #import-refer Refer}) + {#import_name Text + #import_alias (Maybe Text) + #import_refer Refer}) -(def: (extract-defs defs) +(def: (extract_defs defs) (-> (List Code) (Meta (List Text))) - (monad\map meta-monad + (monad\map meta_monad (: (-> Code (Meta Text)) (function (_ def) (case def @@ -3714,19 +3714,19 @@ (fail "only/exclude requires identifiers.")))) defs)) -(def: (parse-referrals tokens) +(def: (parse_referrals tokens) (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) - (do meta-monad - [defs' (extract-defs defs)] + (do meta_monad + [defs' (extract_defs defs)] (wrap [(#Only defs') tokens'])) (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) - (do meta-monad - [defs' (extract-defs defs)] + (do meta_monad + [defs' (extract_defs defs)] (wrap [(#Exclude defs') tokens'])) (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) @@ -3740,24 +3740,24 @@ _ (return [#Nothing tokens]))) -(def: (parse-openings parts) +(def: (parse_openings parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts #.Nil (return [#.Nil #.Nil]) (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) - (do meta-monad - [structs' (monad\map meta-monad + (do meta_monad + [structs' (monad\map meta_monad (function (_ struct) (case struct - [_ (#Identifier ["" struct-name])] - (return struct-name) + [_ (#Identifier ["" struct_name])] + (return struct_name) _ (fail "Expected all structures of opening form to be identifiers."))) structs) - next+remainder (parse-openings parts')] + next+remainder (parse_openings parts')] (let [[next remainder] next+remainder] (return [(#.Cons [prefix structs'] next) remainder]))) @@ -3770,43 +3770,43 @@ [("lux text clip" 0 at x) ("lux text clip" at ("lux text size" x) x)]) -(def: (split-with token sample) +(def: (split_with token sample) (-> Text Text (Maybe [Text Text])) - (do ..maybe-monad - [index (..index-of token sample) + (do ..maybe_monad + [index (..index_of token sample) #let [[pre post'] (split! index sample) [_ post] (split! ("lux text size" token) post')]] (wrap [pre post]))) -(def: (replace-all pattern value template) +(def: (replace_all pattern value template) (-> Text Text Text Text) - (case (..split-with pattern template) + (case (..split_with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre value (replace-all pattern value post)) + ($_ "lux text concat" pre value (replace_all pattern value post)) #.None template)) -(def: contextual-reference "#") -(def: self-reference ".") +(def: contextual_reference "#") +(def: self_reference ".") -(def: (de-alias context self aliased) +(def: (de_alias context self aliased) (-> Text Text Text Text) (|> aliased - (replace-all ..self-reference self) - (replace-all ..contextual-reference context))) + (replace_all ..self_reference self) + (replace_all ..contextual_reference context))) -(def: #export module-separator "/") +(def: #export module_separator "/") -(def: (count-relatives relatives input) +(def: (count_relatives relatives input) (-> Nat Text Nat) - (case ("lux text index" relatives ..module-separator input) + (case ("lux text index" relatives ..module_separator input) #None relatives (#Some found) (if ("lux i64 =" relatives found) - (count-relatives ("lux i64 +" 1 relatives) input) + (count_relatives ("lux i64 +" 1 relatives) input) relatives))) (def: (list\take amount list) @@ -3827,38 +3827,38 @@ [_ (#Cons _ tail)] (list\drop ("lux i64 -" 1 amount) tail))) -(def: (clean-module nested? relative-root module) +(def: (clean_module nested? relative_root module) (-> Bit Text Text (Meta Text)) - (case (count-relatives 0 module) + (case (count_relatives 0 module) 0 (return (if nested? - ($_ "lux text concat" relative-root ..module-separator module) + ($_ "lux text concat" relative_root ..module_separator module) module)) relatives - (let [parts (text\split-all-with ..module-separator relative-root) + (let [parts (text\split_all_with ..module_separator relative_root) jumps ("lux i64 -" 1 relatives)] (if (n/< (list\size parts) jumps) (let [prefix (|> parts list\reverse (list\drop jumps) list\reverse - (interpose ..module-separator) - (text\join-with "")) + (interpose ..module_separator) + (text\join_with "")) clean ("lux text clip" relatives ("lux text size" module) module) output (case ("lux text size" clean) 0 prefix - _ ($_ text\compose prefix ..module-separator clean))] + _ ($_ text\compose prefix ..module_separator clean))] (return output)) (fail ($_ "lux text concat" - "Cannot climb the module hierarchy..." ..new-line - "Importing module: " module ..new-line - " Relative Root: " relative-root ..new-line)))))) + "Cannot climb the module hierarchy..." ..new_line + "Importing module: " module ..new_line + " Relative Root: " relative_root ..new_line)))))) -(def: (alter-domain alteration domain import) +(def: (alter_domain alteration domain import) (-> Nat Text Importation Importation) - (let [[import-name import-alias import-refer] import - original (text\split-all-with ..module-separator import-name) + (let [[import_name import_alias import_refer] import + original (text\split_all_with ..module_separator import_name) truncated (list\drop (.nat alteration) original) parallel (case domain "" @@ -3866,124 +3866,124 @@ _ (list& domain truncated))] - {#import-name (text\join-with ..module-separator parallel) - #import-alias import-alias - #import-refer import-refer})) + {#import_name (text\join_with ..module_separator parallel) + #import_alias import_alias + #import_refer import_refer})) -(def: (parse-imports nested? relative-root context-alias imports) +(def: (parse_imports nested? relative_root context_alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) - (do meta-monad - [imports' (monad\map meta-monad + (do meta_monad + [imports' (monad\map meta_monad (: (-> Code (Meta (List Importation))) (function (_ token) (case token ## Simple - [_ (#Identifier ["" m-name])] - (do meta-monad - [m-name (clean-module nested? relative-root m-name)] - (wrap (list {#import-name m-name - #import-alias #None - #import-refer {#refer-defs #All - #refer-open (list)}}))) + [_ (#Identifier ["" m_name])] + (do meta_monad + [m_name (clean_module nested? relative_root m_name)] + (wrap (list {#import_name m_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) ## Nested - (^ [_ (#Tuple (list& [_ (#Identifier ["" m-name])] extra))]) - (do meta-monad - [import-name (clean-module nested? relative-root m-name) - referral+extra (parse-referrals extra) + (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (clean_module nested? relative_root m_name) + referral+extra (parse_referrals extra) #let [[referral extra] referral+extra] - openings+extra (parse-openings extra) + openings+extra (parse_openings extra) #let [[openings extra] openings+extra] - sub-imports (parse-imports #1 import-name context-alias extra)] + sub_imports (parse_imports #1 import_name context_alias extra)] (wrap (case [referral openings] - [#Nothing #Nil] sub-imports - _ (list& {#import-name import-name - #import-alias #None - #import-refer {#refer-defs referral - #refer-open openings}} - sub-imports)))) - - (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m-name])] extra))]) - (do meta-monad - [import-name (clean-module nested? relative-root m-name) - referral+extra (parse-referrals extra) + [#Nothing #Nil] sub_imports + _ (list& {#import_name import_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (clean_module nested? relative_root m_name) + referral+extra (parse_referrals extra) #let [[referral extra] referral+extra] - openings+extra (parse-openings extra) + openings+extra (parse_openings extra) #let [[openings extra] openings+extra - de-aliased (de-alias context-alias m-name alias)] - sub-imports (parse-imports #1 import-name de-aliased extra)] + de_aliased (de_alias context_alias m_name alias)] + sub_imports (parse_imports #1 import_name de_aliased extra)] (wrap (case [referral openings] - [#Ignore #Nil] sub-imports - _ (list& {#import-name import-name - #import-alias (#Some de-aliased) - #import-refer {#refer-defs referral - #refer-open openings}} - sub-imports)))) + [#Ignore #Nil] sub_imports + _ (list& {#import_name import_name + #import_alias (#Some de_aliased) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) ## Parallel (^ [_ (#Record (list [[_ (#Tuple (list [_ (#Nat alteration)] [_ (#Tag ["" domain])]))] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list\map (alter-domain alteration domain) parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree))] + (wrap (list\map (alter_domain alteration domain) parallel_imports))) (^ [_ (#Record (list [[_ (#Nat alteration)] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree))] - (wrap (list\map (alter-domain alteration "") parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree))] + (wrap (list\map (alter_domain alteration "") parallel_imports))) (^ [_ (#Record (list [[_ (#Tag ["" domain])] - parallel-tree]))]) - (do meta-monad - [parallel-imports (parse-imports nested? relative-root context-alias (list parallel-tree)) - #let [alteration (list\size (text\split-all-with ..module-separator domain))]] - (wrap (list\map (alter-domain alteration domain) parallel-imports))) + parallel_tree]))]) + (do meta_monad + [parallel_imports (parse_imports nested? relative_root context_alias (list parallel_tree)) + #let [alteration (list\size (text\split_all_with ..module_separator domain))]] + (wrap (list\map (alter_domain alteration domain) parallel_imports))) _ - (do meta-monad - [current-module current-module-name] + (do meta_monad + [current_module current_module_name] (fail ($_ text\compose - "Wrong syntax for import @ " current-module - ..new-line (code\encode token))))))) + "Wrong syntax for import @ " current_module + ..new_line (code\encode token))))))) imports)] (wrap (list\join imports')))) -(def: (exported-definitions module state) +(def: (exported_definitions module state) (-> Text (Meta (List Text))) - (let [[current-module modules] (case state - {#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host + (let [[current_module modules] (case state + {#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - [current-module modules])] + #scope_type_vars scope_type_vars} + [current_module modules])] (case (get module modules) (#Some =module) - (let [to-alias (list\map (: (-> [Text Global] + (let [to_alias (list\map (: (-> [Text Global] (List Text)) (function (_ [name definition]) (case definition (#Left _) (list) - (#Right [exported? def-type def-meta def-value]) + (#Right [exported? def_type def_meta def_value]) (if exported? (list name) (list))))) - (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] + (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] definitions))] - (#Right state (list\join to-alias))) + (#Right state (list\join to_alias))) #None (#Left ($_ text\compose - "Unknown module: " (text\encode module) ..new-line - "Current module: " (case current-module - (#Some current-module) - (text\encode current-module) + "Unknown module: " (text\encode module) ..new_line + "Current module: " (case current_module + (#Some current_module) + (text\encode current_module) #None - "???") ..new-line + "???") ..new_line "Known modules: " (|> modules (list\map (function (_ [name module]) (text$ name))) @@ -4002,7 +4002,7 @@ (#Cons x (filter p xs')) (filter p xs')))) -(def: (is-member? cases name) +(def: (is_member? cases name) (-> (List Text) Text Bit) (let [output (list\fold (function (_ case prev) (or prev @@ -4011,20 +4011,20 @@ cases)] output)) -(def: (try-both f x1 x2) +(def: (try_both f x1 x2) (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) #None (f x2) (#Some y) (#Some y))) -(def: (find-in-env name state) +(def: (find_in_env name state) (-> Text Lux (Maybe Type)) (case state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} + #scope_type_vars scope_type_vars} (find (: (-> Scope (Maybe Type)) (function (_ env) (case env @@ -4032,7 +4032,7 @@ #inner _ #locals {#counter _ #mappings locals} #captured {#counter _ #mappings closure}} - (try-both (find (: (-> [Text [Type Any]] (Maybe Type)) + (try_both (find (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) (if (text\= name bname) (#Some type) @@ -4041,55 +4041,55 @@ (: (List [Text [Type Any]]) closure))))) scopes))) -(def: (find-def-type name state) +(def: (find_def_type name state) (-> Name Lux (Maybe Type)) - (let [[v-prefix v-name] name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - (case (get v-prefix modules) + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) #None #None - (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) - (case (get v-name definitions) + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) #None #None (#Some definition) (case definition - (#Left de-aliased) - (find-def-type de-aliased state) + (#Left de_aliased) + (find_def_type de_aliased state) - (#Right [exported? def-type def-meta def-value]) - (#Some def-type)))))) + (#Right [exported? def_type def_meta def_value]) + (#Some def_type)))))) -(def: (find-def-value name state) +(def: (find_def_value name state) (-> Name (Meta [Type Any])) - (let [[v-prefix v-name] name - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} state] - (case (get v-prefix modules) + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) #None (#Left (text\compose "Unknown definition: " (name\encode name))) - (#Some {#definitions definitions #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-annotations _ #module-state _}) - (case (get v-name definitions) + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) #None (#Left (text\compose "Unknown definition: " (name\encode name))) (#Some definition) (case definition - (#Left de-aliased) - (find-def-value de-aliased state) + (#Left de_aliased) + (find_def_value de_aliased state) - (#Right [exported? def-type def-meta def-value]) - (#Right [state [def-type def-value]])))))) + (#Right [exported? def_type def_meta def_value]) + (#Right [state [def_type def_value]])))))) -(def: (find-type-var idx bindings) +(def: (find_type_var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #Nil @@ -4098,40 +4098,40 @@ (#Cons [var bound] bindings') (if ("lux i64 =" idx var) bound - (find-type-var idx bindings')))) + (find_type_var idx bindings')))) -(def: (find-type full-name) +(def: (find_type full_name) (-> Name (Meta Type)) - (do meta-monad - [#let [[module name] full-name] - current-module current-module-name] + (do meta_monad + [#let [[module name] full_name] + current_module current_module_name] (function (_ compiler) (let [temp (if (text\= "" module) - (case (find-in-env name compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (case (find_in_env name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (case (find-def-type [current-module name] compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (case (find_def_type [current_module name] compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encode full-name))))) - (case (find-def-type full-name compiler) - (#Some struct-type) - (#Right [compiler struct-type]) + (#Left ($_ text\compose "Unknown var: " (name\encode full_name))))) + (case (find_def_type full_name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encode full-name)))))] + (#Left ($_ text\compose "Unknown var: " (name\encode full_name)))))] (case temp - (#Right [compiler (#Var type-id)]) - (let [{#info _ #source _ #current-module _ #modules _ - #scopes _ #type-context type-context #host _ + (#Right [compiler (#Var type_id)]) + (let [{#info _ #source _ #current_module _ #modules _ + #scopes _ #type_context type_context #host _ #seed _ #expected _ #location _ #extensions extensions - #scope-type-vars _} compiler - {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] - (case (find-type-var type-id var-bindings) + #scope_type_vars _} compiler + {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] + (case (find_type_var type_id var_bindings) #None temp @@ -4168,13 +4168,13 @@ ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(| " (|> (flatten-variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(| " (|> (flatten_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flatten-tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flatten_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flatten-lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flatten_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4192,7 +4192,7 @@ ($_ text\compose "(Ex " (type\encode body) ")") (#Apply _) - (let [[func args] (flatten-app type)] + (let [[func args] (flatten_app type)] ($_ text\compose "(" (type\encode func) " " (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) @@ -4204,62 +4204,62 @@ (macro: #export (^open tokens) {#.doc (text$ ($_ "lux text concat" - "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new-line - "## Takes an 'alias' text for the generated local bindings." ..new-line - "(def: #export (range (^open ''.'') from to)" ..new-line - " (All [a] (-> (Enum a) a a (List a)))" ..new-line + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..new_line + "## Takes an 'alias' text for the generated local bindings." ..new_line + "(def: #export (range (^open ''.'') from to)" ..new_line + " (All [a] (-> (Enum a) a a (List a)))" ..new_line " (range' <= succ from to))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) - (do meta-monad + (do meta_monad [g!temp (gensym "temp")] (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) - (do meta-monad - [init-type (find-type name) - struct-evidence (resolve-type-tags init-type)] - (case struct-evidence + (do meta_monad + [init_type (find_type name) + struct_evidence (resolve_type_tags init_type)] + (case struct_evidence #None - (fail (text\compose "Can only 'open' structs: " (type\encode init-type))) + (fail (text\compose "Can only 'open' structs: " (type\encode init_type))) (#Some tags&members) - (do meta-monad - [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) + (do meta_monad + [full_body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) - (let [locals (list\map (function (_ [t-module t-name]) - ["" (de-alias "" t-name alias)]) + (let [locals (list\map (function (_ [t_module t_name]) + ["" (de_alias "" t_name alias)]) tags) pattern (tuple$ (list\map identifier$ locals))] - (do meta-monad - [enhanced-target (monad\fold meta-monad - (function (_ [m-local m-type] enhanced-target) - (do meta-monad - [m-structure (resolve-type-tags m-type)] - (case m-structure - (#Some m-tags&members) - (recur m-local - m-tags&members - enhanced-target) + (do meta_monad + [enhanced_target (monad\fold meta_monad + (function (_ [m_local m_type] enhanced_target) + (do meta_monad + [m_structure (resolve_type_tags m_type)] + (case m_structure + (#Some m_tags&members) + (recur m_local + m_tags&members + enhanced_target) #None - (wrap enhanced-target)))) + (wrap enhanced_target)))) target (zip/2 locals members))] - (wrap (` ({(~ pattern) (~ enhanced-target)} (~ (identifier$ source))))))))) + (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) name tags&members body)] - (wrap (list full-body))))) + (wrap (list full_body))))) _ (fail "Wrong syntax for ^open"))) (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" - "## Branching structures with multiple test conditions." ..new-line - "(cond (even? num) ''even''" ..new-line + "## Branching structures with multiple test conditions." ..new_line + "(cond (even? num) ''even''" ..new_line " (odd? num) ''odd''" __paragraph - " ## else-branch" ..new-line + " ## else_branch" ..new_line " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) (fail "cond requires an uneven number of arguments.") @@ -4270,7 +4270,7 @@ (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) else - (as-pairs branches')))) + (as_pairs branches')))) _ (fail "Wrong syntax for cond")))) @@ -4290,29 +4290,29 @@ (macro: #export (get@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Accesses the value of a record at a given tag." ..new-line - "(get@ #field my-record)" + "## Accesses the value of a record at a given tag." ..new_line + "(get@ #field my_record)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(get@ [#foo #bar #baz] my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(get@ [#foo #bar #baz] my_record)" __paragraph - "## And, if only the slot/path is given, generates an accessor function:" ..new-line - "(let [getter (get@ [#foo #bar #baz])]" ..new-line - " (getter my-record))"))} + "## And, if only the slot/path is given, generates an accessor function:" ..new_line + "(let [getter (get@ [#foo #bar #baz])]" ..new_line + " (getter my_record))"))} (case tokens (^ (list [_ (#Tag slot')] record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output] g!_ (gensym "_") g!output (gensym "")] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) - (function (_ [[r-prefix r-name] [r-idx r-type]]) - [(tag$ [r-prefix r-name]) - (if ("lux i64 =" idx r-idx) + (function (_ [[r_prefix r_name] [r_idx r_type]]) + [(tag$ [r_prefix r_name]) + (if ("lux i64 =" idx r_idx) g!output g!_)])) (zip/2 tags (enumeration members))))] @@ -4329,7 +4329,7 @@ slots))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) @@ -4337,73 +4337,73 @@ _ (fail "Wrong syntax for get@"))) -(def: (open-field alias tags my-tag-index [module short] source type) +(def: (open_field alias tags my_tag_index [module short] source type) (-> Text (List Name) Nat Name Code Type (Meta (List Code))) - (do meta-monad - [output (resolve-type-tags type) + (do meta_monad + [output (resolve_type_tags type) g!_ (gensym "g!_") - #let [g!output (local-identifier$ short) + #let [g!output (local_identifier$ short) pattern (|> tags enumeration - (list\map (function (_ [tag-idx tag]) - (if ("lux i64 =" my-tag-index tag-idx) + (list\map (function (_ [tag_idx tag]) + (if ("lux i64 =" my_tag_index tag_idx) g!output g!_))) tuple$) source+ (` ({(~ pattern) (~ g!output)} (~ source)))]] (case output (#Some [tags' members']) - (do meta-monad - [decls' (monad\map meta-monad + (do meta_monad + [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) - (function (_ [sub-tag-index sname stype]) - (open-field alias tags' sub-tag-index sname source+ stype))) + (function (_ [sub_tag_index sname stype]) + (open_field alias tags' sub_tag_index sname source+ stype))) (enumeration (zip/2 tags' members')))] (return (list\join decls'))) _ - (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias))) + (return (list (` ("lux def" (~ (local_identifier$ (de_alias "" short alias))) (~ source+) - [(~ location-code) (#.Record #Nil)] + [(~ location_code) (#.Record #Nil)] #0))))))) (macro: #export (open: tokens) {#.doc (text$ ($_ "lux text concat" "## Opens a structure and generates a definition for each of its members (including nested members)." __paragraph - "## For example:" ..new-line + "## For example:" ..new_line "(open: ''i:.'' number)" __paragraph - "## Will generate:" ..new-line - "(def: i:+ (\ number +))" ..new-line - "(def: i:- (\ number -))" ..new-line - "(def: i:* (\ number *))" ..new-line + "## Will generate:" ..new_line + "(def: i:+ (\ number +))" ..new_line + "(def: i:- (\ number -))" ..new_line + "(def: i:* (\ number *))" ..new_line "..."))} (case tokens (^ (list [_ (#Text alias)] struct)) (case struct - [_ (#Identifier struct-name)] - (do meta-monad - [struct-type (find-type struct-name) - output (resolve-type-tags struct-type) - #let [source (identifier$ struct-name)]] + [_ (#Identifier struct_name)] + (do meta_monad + [struct_type (find_type struct_name) + output (resolve_type_tags struct_type) + #let [source (identifier$ struct_name)]] (case output (#Some [tags members]) - (do meta-monad - [decls' (monad\map meta-monad (: (-> [Nat Name Type] (Meta (List Code))) - (function (_ [tag-index sname stype]) - (open-field alias tags tag-index sname source stype))) + (do meta_monad + [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) + (function (_ [tag_index sname stype]) + (open_field alias tags tag_index sname source stype))) (enumeration (zip/2 tags members)))] (return (list\join decls'))) _ - (fail (text\compose "Can only 'open:' structs: " (type\encode struct-type))))) + (fail (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) _ - (do meta-monad + (do meta_monad [g!struct (gensym "struct")] (return (list (` ("lux def" (~ g!struct) (~ struct) - [(~ location-code) (#.Record #Nil)] + [(~ location_code) (#.Record #Nil)] #0)) (` (..open: (~ (text$ alias)) (~ g!struct))))))) @@ -4412,81 +4412,81 @@ (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new-line - "## =>" ..new-line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line + "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..new_line + "## =>" ..new_line "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] (return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: #export (<<| tokens) {#.doc (text$ ($_ "lux text concat" - "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new-line - "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new-line - "## =>" ..new-line + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..new_line + "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..new_line + "## =>" ..new_line "(function (_ <arg>) (fold text\compose '''' (interpose '' '' (list\map int\encode <arg>))))"))} - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!arg (gensym "arg")] (return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) -(def: (imported-by? import-name module-name) +(def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) - (do meta-monad - [module (find-module module-name) - #let [{#module-hash _ #module-aliases _ #definitions _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]] - (wrap (is-member? imports import-name)))) + (do meta_monad + [module (find_module module_name) + #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] + (wrap (is_member? imports import_name)))) -(def: (read-refer module-name options) +(def: (read_refer module_name options) (-> Text (List Code) (Meta Refer)) - (do meta-monad - [referral+options (parse-referrals options) + (do meta_monad + [referral+options (parse_referrals options) #let [[referral options] referral+options] - openings+options (parse-openings options) + openings+options (parse_openings options) #let [[openings options] openings+options] - current-module current-module-name] + current_module current_module_name] (case options #Nil - (wrap {#refer-defs referral - #refer-open openings}) + (wrap {#refer_defs referral + #refer_open openings}) _ - (fail ($_ text\compose "Wrong syntax for refer @ " current-module - ..new-line (|> options + (fail ($_ text\compose "Wrong syntax for refer @ " current_module + ..new_line (|> options (list\map code\encode) (interpose " ") (list\fold text\compose ""))))))) -(def: (write-refer module-name [r-defs r-opens]) +(def: (write_refer module_name [r_defs r_opens]) (-> 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\map meta-monad + (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\map meta_monad (: (-> Text (Meta Any)) (function (_ _def) - (if (is-member? all-defs _def) + (if (is_member? all_defs _def) (return []) - (fail ($_ text\compose _def " is not defined in module " module-name " @ " current-module))))) - referred-defs)))] - defs' (case r-defs + (fail ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) + referred_defs)))] + defs' (case r_defs #All - (exported-definitions module-name) + (exported_definitions module_name) (#Only +defs) - (do meta-monad - [*defs (exported-definitions module-name) - _ (test-referrals module-name *defs +defs)] + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs +defs)] (wrap +defs)) - (#Exclude -defs) - (do meta-monad - [*defs (exported-definitions module-name) - _ (test-referrals module-name *defs -defs)] - (wrap (filter (|>> (is-member? -defs) not) *defs))) + (#Exclude _defs) + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs _defs)] + (wrap (filter (|>> (is_member? _defs) not) *defs))) #Ignore (wrap (list)) @@ -4495,13 +4495,13 @@ (wrap (list))) #let [defs (list\map (: (-> Text Code) (function (_ def) - (` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def])))))) + (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) defs') - openings (|> r-opens + openings (|> r_opens (list\map (: (-> Openings (List Code)) (function (_ [alias structs]) (list\map (function (_ name) - (` (open: (~ (text$ alias)) (~ (identifier$ [module-name name]))))) + (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) list\join)]] (wrap (list\compose defs openings)) @@ -4509,27 +4509,27 @@ (macro: #export (refer tokens) (case tokens - (^ (list& [_ (#Text module-name)] options)) - (do meta-monad - [=refer (read-refer module-name options)] - (write-refer module-name =refer)) + (^ (list& [_ (#Text module_name)] options)) + (do meta_monad + [=refer (read_refer module_name options)] + (write_refer module_name =refer)) _ (fail "Wrong syntax for refer"))) -(def: (refer-to-code module-name module-alias' [r-defs r-opens]) +(def: (refer_to_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) - (let [module-alias (..default module-name module-alias') + (let [module_alias (..default module_name module_alias') localizations (: (List Code) - (case r-defs + (case r_defs #All (list (' #*)) (#Only defs) - (list (form$ (list& (' #+) (list\map local-identifier$ defs)))) + (list (form$ (list& (' #+) (list\map local_identifier$ defs)))) (#Exclude defs) - (list (form$ (list& (' #-) (list\map local-identifier$ defs)))) + (list (form$ (list& (' #-) (list\map local_identifier$ defs)))) #Ignore (list) @@ -4537,32 +4537,32 @@ #Nothing (list))) openings (list\map (function (_ [alias structs]) - (form$ (list& (text$ (..replace-all ..contextual-reference module-alias alias)) - (list\map local-identifier$ structs)))) - r-opens)] - (` (..refer (~ (text$ module-name)) + (form$ (list& (text$ (..replace_all ..contextual_reference module_alias alias)) + (list\map local_identifier$ structs)))) + r_opens)] + (` (..refer (~ (text$ module_name)) (~+ localizations) (~+ openings))))) (macro: #export (module: tokens) {#.doc (text$ ($_ "lux text concat" - "## Module-definition macro." + "## Module_definition macro." __paragraph "## Can take optional annotations and allows the specification of modules to import." __paragraph - "## Example" ..new-line - "(.module: {#.doc ''Some documentation...''}" ..new-line - " [lux #*" ..new-line - " [control" ..new-line - " [''M'' monad #*]]" ..new-line - " [data" ..new-line - " maybe" ..new-line - " [''.'' name (''#/.'' codec)]]" ..new-line - " [macro" ..new-line - " code]]" ..new-line - " [//" ..new-line + "## Example" ..new_line + "(.module: {#.doc ''Some documentation...''}" ..new_line + " [lux #*" ..new_line + " [control" ..new_line + " [''M'' monad #*]]" ..new_line + " [data" ..new_line + " maybe" ..new_line + " [''.'' name (''#/.'' codec)]]" ..new_line + " [macro" ..new_line + " code]]" ..new_line + " [//" ..new_line " [type (''.'' equivalence)]])"))} - (do meta-monad + (do meta_monad [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens (^ (list& [_ (#Record _meta)] _imports)) @@ -4570,28 +4570,28 @@ _ [(list) tokens]))] - current-module current-module-name - imports (parse-imports #0 current-module "" _imports) + current_module current_module_name + imports (parse_imports #0 current_module "" _imports) #let [=imports (|> imports (list\map (: (-> Importation Code) - (function (_ [m-name m-alias =refer]) - (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))])))) + (function (_ [m_name m_alias =refer]) + (` [(~ (text$ m_name)) (~ (text$ (default "" m_alias)))])))) tuple$) =refers (list\map (: (-> Importation Code) - (function (_ [m-name m-alias =refer]) - (refer-to-code m-name m-alias =refer))) + (function (_ [m_name m_alias =refer]) + (refer_to_code m_name m_alias =refer))) imports) - =module (` ("lux def module" [(~ location-code) - (#.Record (~ (process-def-meta _meta)))] + =module (` ("lux def module" [(~ location_code) + (#.Record (~ (process_def_meta _meta)))] (~ =imports)))]] (wrap (#Cons =module =refers)))) (macro: #export (\ tokens) {#.doc (text$ ($_ "lux text concat" - "## Allows accessing the value of a structure's member." ..new-line + "## Allows accessing the value of a structure's member." ..new_line "(\ codec encode)" __paragraph - "## Also allows using that value as a function." ..new-line + "## Also allows using that value as a function." ..new_line "(\ codec encode +123)"))} (case tokens (^ (list struct [_ (#Identifier member)])) @@ -4605,42 +4605,42 @@ (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Sets the value of a record at a given tag." ..new-line + "## Sets the value of a record at a given tag." ..new_line "(set@ #name ''Lux'' lang)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(set@ [#foo #bar #baz] value my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(set@ [#foo #bar #baz] value my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line - "(let [setter (set@ [#foo #bar #baz] value)] (setter my-record))" ..new-line - "(let [setter (set@ [#foo #bar #baz])] (setter value my-record))"))} + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line + "(let [setter (set@ [#foo #bar #baz] value)] (setter my_record))" ..new_line + "(let [setter (set@ [#foo #bar #baz])] (setter value my_record))"))} (case tokens (^ (list [_ (#Tag slot')] value record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output]] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) - (do meta-monad - [pattern' (monad\map meta-monad + (do meta_monad + [pattern' (monad\map meta_monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r-slot-name [r-idx r-type]]) - (do meta-monad + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r_slot_name r_idx g!slot])))) (zip/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - r-var])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) pattern')) output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - (if ("lux i64 =" idx r-idx) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) value - r-var)])) + r_var)])) pattern'))] (return (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4653,35 +4653,35 @@ (fail "Wrong syntax for set@") _ - (do meta-monad - [bindings (monad\map meta-monad + (do meta_monad + [bindings (monad\map meta_monad (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) #let [pairs (zip/2 slots bindings) - update-expr (list\fold (: (-> [Code Code] Code Code) + update_expr (list\fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) value (list\reverse pairs)) [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) - (function (_ [new-slot new-binding] [old-record accesses']) - [(` (get@ (~ new-slot) (~ new-binding))) - (#Cons (list new-binding old-record) accesses')])) + (function (_ [new_slot new_binding] [old_record accesses']) + [(` (get@ (~ new_slot) (~ new_binding))) + (#Cons (list new_binding old_record) accesses')])) [record (: (List (List Code)) #Nil)] pairs) accesses (list\join (list\reverse accesses'))]] (wrap (list (` (let [(~+ accesses)] - (~ update-expr))))))) + (~ update_expr))))))) (^ (list selector value)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!value (gensym "value") g!record (gensym "record")] @@ -4692,42 +4692,42 @@ (macro: #export (update@ tokens) {#.doc (text$ ($_ "lux text concat" - "## Modifies the value of a record at a given tag, based on some function." ..new-line + "## Modifies the value of a record at a given tag, based on some function." ..new_line "(update@ #age inc person)" __paragraph - "## Can also work with multiple levels of nesting:" ..new-line - "(update@ [#foo #bar #baz] func my-record)" + "## Can also work with multiple levels of nesting:" ..new_line + "(update@ [#foo #bar #baz] func my_record)" __paragraph - "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new-line - "(let [updater (update@ [#foo #bar #baz] func)] (updater my-record))" ..new-line - "(let [updater (update@ [#foo #bar #baz])] (updater func my-record))"))} + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..new_line + "(let [updater (update@ [#foo #bar #baz] func)] (updater my_record))" ..new_line + "(let [updater (update@ [#foo #bar #baz])] (updater func my_record))"))} (case tokens (^ (list [_ (#Tag slot')] fun record)) - (do meta-monad + (do meta_monad [slot (normalize slot') - output (resolve-tag slot) + output (resolve_tag slot) #let [[idx tags exported? type] output]] - (case (resolve-struct-type type) + (case (resolve_struct_type type) (#Some members) - (do meta-monad - [pattern' (monad\map meta-monad + (do meta_monad + [pattern' (monad\map meta_monad (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r-slot-name [r-idx r-type]]) - (do meta-monad + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r_slot_name r_idx g!slot])))) (zip/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - r-var])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) pattern')) output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r-slot-name r-idx r-var]) - [(tag$ r-slot-name) - (if ("lux i64 =" idx r-idx) - (` ((~ fun) (~ r-var))) - r-var)])) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) + (` ((~ fun) (~ r_var))) + r_var)])) pattern'))] (return (list (` ({(~ pattern) (~ output)} (~ record))))))) @@ -4740,7 +4740,7 @@ (fail "Wrong syntax for update@") _ - (do meta-monad + (do meta_monad [g!record (gensym "record") g!temp (gensym "temp")] (wrap (list (` (let [(~ g!record) (~ record) @@ -4748,13 +4748,13 @@ (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] (wrap (list (` (function ((~ g!_) (~ g!record)) (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) - (do meta-monad + (do meta_monad [g!_ (gensym "_") g!fun (gensym "fun") g!record (gensym "record")] @@ -4765,38 +4765,38 @@ (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" - "## It's similar to template, but meant to be used during pattern-matching." ..new-line - "(def: (beta-reduce env type)" ..new-line - " (-> (List Type) Type Type)" ..new-line - " (case type" ..new-line - " (#.Primitive name params)" ..new-line - " (#.Primitive name (list\map (beta-reduce env) params))" + "## It's similar to template, but meant to be used during pattern-matching." ..new_line + "(def: (beta_reduce env type)" ..new_line + " (-> (List Type) Type Type)" ..new_line + " (case type" ..new_line + " (#.Primitive name params)" ..new_line + " (#.Primitive name (list\map (beta_reduce env) params))" __paragraph - " (^template [<tag>]" ..new-line - " [(<tag> left right)" ..new-line - " (<tag> (beta-reduce env left) (beta-reduce env right))])" ..new-line + " (^template [<tag>]" ..new_line + " [(<tag> left right)" ..new_line + " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..new_line " ([#.Sum] [#.Product])" __paragraph - " (^template [<tag>]" ..new-line - " [(<tag> left right)" ..new-line - " (<tag> (beta-reduce env left) (beta-reduce env right))])" ..new-line + " (^template [<tag>]" ..new_line + " [(<tag> left right)" ..new_line + " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..new_line " ([#.Function] [#.Apply])" __paragraph - " (^template [<tag>]" ..new-line - " [(<tag> old-env def)" ..new-line - " (case old-env" ..new-line - " #.Nil" ..new-line + " (^template [<tag>]" ..new_line + " [(<tag> old_env def)" ..new_line + " (case old_env" ..new_line + " #.Nil" ..new_line " (<tag> env def)" __paragraph - " _" ..new-line - " type)])" ..new-line + " _" ..new_line + " type)])" ..new_line " ([#.UnivQ] [#.ExQ])" __paragraph - " (#.Parameter idx)" ..new-line + " (#.Parameter idx)" ..new_line " (default type (list.nth idx env))" __paragraph - " _" ..new-line - " type" ..new-line + " _" ..new_line + " type" ..new_line " ))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple bindings)] @@ -4804,16 +4804,16 @@ [_ (#Form data)] branches)) (case (: (Maybe (List Code)) - (do maybe-monad - [bindings' (monad\map maybe-monad get-short bindings) - data' (monad\map maybe-monad tuple->list data)] - (let [num-bindings (list\size bindings')] - (if (every? (|>> ("lux i64 =" num-bindings)) + (do maybe_monad + [bindings' (monad\map maybe_monad get_short bindings) + data' (monad\map maybe_monad tuple->list data)] + (let [num_bindings (list\size bindings')] + (if (every? (|>> ("lux i64 =" num_bindings)) (list\map list\size data')) (let [apply (: (-> RepEnv (List Code)) - (function (_ env) (list\map (apply-template env) templates)))] + (function (_ env) (list\map (apply_template env) templates)))] (|> data' - (list\map (compose apply (make-env bindings'))) + (list\map (compose apply (make_env bindings'))) list\join wrap)) #None)))) @@ -4826,7 +4826,7 @@ _ (fail "Wrong syntax for ^template"))) -(def: (find-baseline-column code) +(def: (find_baseline_column code) (-> Code Nat) (case code (^template [<tag>] @@ -4843,28 +4843,28 @@ (^template [<tag>] [[[_ _ column] (<tag> parts)] - (list\fold n/min column (list\map find-baseline-column parts))]) + (list\fold n/min column (list\map find_baseline_column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list\fold n/min column - (list\compose (list\map (|>> first find-baseline-column) pairs) - (list\map (|>> second find-baseline-column) pairs))) + (list\compose (list\map (|>> first find_baseline_column) pairs) + (list\map (|>> second find_baseline_column) pairs))) )) -(type: Doc-Fragment - (#Doc-Comment Text) - (#Doc-Example Code)) +(type: Doc_Fragment + (#Doc_Comment Text) + (#Doc_Example Code)) -(def: (identify-doc-fragment code) - (-> Code Doc-Fragment) +(def: (identify_doc_fragment code) + (-> Code Doc_Fragment) (case code [_ (#Text comment)] - (#Doc-Comment comment) + (#Doc_Comment comment) _ - (#Doc-Example code))) + (#Doc_Example code))) (template [<name> <extension> <doc>] [(def: #export <name> @@ -4886,39 +4886,39 @@ (#Cons x (repeat ("lux i64 +" -1 n) x)) #Nil)) -(def: (location-padding baseline [_ old-line old-column] [_ new-line new-column]) +(def: (location_padding baseline [_ old_line old_column] [_ new_line new_column]) (-> Nat Location Location Text) - (if ("lux i64 =" old-line new-line) - (text\join-with "" (repeat (.int ("lux i64 -" old-column new-column)) " ")) - (let [extra-lines (text\join-with "" (repeat (.int ("lux i64 -" old-line new-line)) ..new-line)) - space-padding (text\join-with "" (repeat (.int ("lux i64 -" baseline new-column)) " "))] - (text\compose extra-lines space-padding)))) + (if ("lux i64 =" old_line new_line) + (text\join_with "" (repeat (.int ("lux i64 -" old_column new_column)) " ")) + (let [extra_lines (text\join_with "" (repeat (.int ("lux i64 -" old_line new_line)) ..new_line)) + space_padding (text\join_with "" (repeat (.int ("lux i64 -" baseline new_column)) " "))] + (text\compose extra_lines space_padding)))) (def: (text\size x) (-> Text Nat) ("lux text size" x)) -(def: (update-location [file line column] code-text) +(def: (update_location [file line column] code_text) (-> Location Text Location) - [file line ("lux i64 +" column (text\size code-text))]) + [file line ("lux i64 +" column (text\size code_text))]) -(def: (delim-update-location [file line column]) +(def: (delim_update_location [file line column]) (-> Location Location) [file line (inc column)]) -(def: rejoin-all-pairs +(def: rejoin_all_pairs (-> (List [Code Code]) (List Code)) - (|>> (list\map rejoin-pair) list\join)) + (|>> (list\map rejoin_pair) list\join)) -(def: (doc-example->Text prev-location baseline example) +(def: (doc_example->Text prev_location baseline example) (-> Location Nat Code [Location Text]) (case example (^template [<tag> <encode>] - [[new-location (<tag> value)] - (let [as-text (<encode> value)] - [(update-location new-location as-text) - (text\compose (location-padding baseline prev-location new-location) - as-text)])]) + [[new_location (<tag> value)] + (let [as_text (<encode> value)] + [(update_location new_location as_text) + (text\compose (location_padding baseline prev_location new_location) + as_text)])]) ([#Bit bit\encode] [#Nat nat\encode] [#Int int\encode] @@ -4928,60 +4928,60 @@ [#Tag tag\encode]) (^template [<tag> <open> <close> <prep>] - [[group-location (<tag> parts)] - (let [[group-location' parts-text] (list\fold (function (_ part [last-location text-accum]) - (let [[part-location part-text] (doc-example->Text last-location baseline part)] - [part-location (text\compose text-accum part-text)])) - [(delim-update-location group-location) ""] + [[group_location (<tag> parts)] + (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) + (let [[part_location part_text] (doc_example->Text last_location baseline part)] + [part_location (text\compose text_accum part_text)])) + [(delim_update_location group_location) ""] (<prep> parts))] - [(delim-update-location group-location') - ($_ text\compose (location-padding baseline prev-location group-location) + [(delim_update_location group_location') + ($_ text\compose (location_padding baseline prev_location group_location) <open> - parts-text + parts_text <close>)])]) ([#Form "(" ")" ..function\identity] [#Tuple "[" "]" ..function\identity] - [#Record "{" "}" rejoin-all-pairs]) + [#Record "{" "}" rejoin_all_pairs]) - [new-location (#Rev value)] + [new_location (#Rev value)] ("lux io error" "Undefined behavior.") )) -(def: (with-baseline baseline [file line column]) +(def: (with_baseline baseline [file line column]) (-> Nat Location Location) [file line baseline]) -(def: (doc-fragment->Text fragment) - (-> Doc-Fragment Text) +(def: (doc_fragment->Text fragment) + (-> Doc_Fragment Text) (case fragment - (#Doc-Comment comment) + (#Doc_Comment comment) (|> comment - (text\split-all-with ..new-line) - (list\map (function (_ line) ($_ text\compose "## " line ..new-line))) - (text\join-with "")) + (text\split_all_with ..new_line) + (list\map (function (_ line) ($_ text\compose "## " line ..new_line))) + (text\join_with "")) - (#Doc-Example example) - (let [baseline (find-baseline-column example) + (#Doc_Example example) + (let [baseline (find_baseline_column example) [location _] example - [_ text] (doc-example->Text (with-baseline baseline location) baseline example)] + [_ text] (doc_example->Text (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) (macro: #export (doc tokens) {#.doc (text$ ($_ "lux text concat" "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." __paragraph - "## For Example:" ..new-line - "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new-line - " ''Can be used in monadic code to create monadic loops.''" ..new-line - " (loop [count +0" ..new-line - " x init]" ..new-line - " (if (< +10 count)" ..new-line - " (recur (inc count) (f x))" ..new-line + "## For Example:" ..new_line + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..new_line + " ''Can be used in monadic code to create monadic loops.''" ..new_line + " (loop [count +0" ..new_line + " x init]" ..new_line + " (if (< +10 count)" ..new_line + " (recur (inc count) (f x))" ..new_line " x)))"))} - (return (list (` [(~ location-code) + (return (list (` [(~ location_code) (#.Text (~ (|> tokens - (list\map (|>> identify-doc-fragment doc-fragment->Text)) - (text\join-with "") + (list\map (|>> identify_doc_fragment doc_fragment->Text)) + (text\join_with "") text$)))])))) (def: (interleave xs ys) @@ -4998,15 +4998,15 @@ (#Cons y ys') (list& x y (interleave xs' ys'))))) -(def: (type-to-code type) +(def: (type_to_code type) (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list\map type-to-code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplate_list (list\map type_to_code params))))) (^template [<tag>] [(<tag> left right) - (` (<tag> (~ (type-to-code left)) (~ (type-to-code right))))]) + (` (<tag> (~ (type_to_code left)) (~ (type_to_code right))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) @@ -5018,15 +5018,15 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplate-list (list\map type-to-code env))] - (` (<tag> (~ env') (~ (type-to-code type)))))]) + (let [env' (untemplate_list (list\map type_to_code env))] + (` (<tag> (~ env') (~ (type_to_code type)))))]) ([#.UnivQ] [#.ExQ]) (#Named [module name] anonymous) ## TODO: Generate the explicit type definition instead of using ## the "identifier$" shortcut below. ## (` (#.Named [(~ (text$ module)) (~ (text$ name))] - ## (~ (type-to-code anonymous)))) + ## (~ (type_to_code anonymous)))) (identifier$ [module name]))) (macro: #export (loop tokens) @@ -5039,41 +5039,41 @@ x)) "Loops can also be given custom names." - (loop my-loop + (loop my_loop [count +0 x init] (if (< +10 count) - (my-loop (inc count) (f x)) + (my_loop (inc count) (f x)) x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) (#.Some [name bindings body]) (^ (list [_ (#Tuple bindings)] body)) - (#.Some [(local-identifier$ "recur") bindings body]) + (#.Some [(local_identifier$ "recur") bindings body]) _ #.None)] (case ?params (#.Some [name bindings body]) - (let [pairs (as-pairs bindings) + (let [pairs (as_pairs bindings) vars (list\map first pairs) inits (list\map second pairs)] (if (every? identifier? inits) - (do meta-monad + (do meta_monad [inits' (: (Meta (List Name)) - (case (monad\map maybe-monad get-name inits) + (case (monad\map maybe_monad get_name inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (monad\map meta-monad find-type inits') - expected get-expected-type] - (return (list (` (("lux check" (-> (~+ (list\map type-to-code init-types)) - (~ (type-to-code expected))) + init_types (monad\map meta_monad find_type inits') + expected get_expected_type] + (return (list (` (("lux check" (-> (~+ (list\map type_to_code init_types)) + (~ (type_to_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) - (do meta-monad - [aliases (monad\map meta-monad + (do meta_monad + [aliases (monad\map meta_monad (: (-> Code (Meta Code)) (function (_ _) (gensym ""))) inits)] @@ -5092,12 +5092,12 @@ (f foo bar baz)))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) - (do meta-monad + (do meta_monad [slots (: (Meta [Name (List Name)]) (case (: (Maybe [Name (List Name)]) - (do maybe-monad - [hslot (get-tag hslot') - tslots (monad\map maybe-monad get-tag tslots')] + (do maybe_monad + [hslot (get_tag hslot') + tslots (monad\map maybe_monad get_tag tslots')] (wrap [hslot tslots]))) (#Some slots) (return slots) @@ -5106,18 +5106,18 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (monad\map meta-monad normalize tslots) - output (resolve-tag hslot) + tslots (monad\map meta_monad normalize tslots) + output (resolve_tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (list\map (: (-> Name [Text Code]) + slot_pairings (list\map (: (-> Name [Text Code]) (function (_ [module name]) - [name (local-identifier$ name)])) + [name (local_identifier$ name)])) (list& hslot tslots)) pattern (record$ (list\map (: (-> Name [Code Code]) (function (_ [module name]) (let [tag (tag$ [module name])] - (case (get name slot-pairings) + (case (get name slot_pairings) (#Some binding) [tag binding] #None [tag g!_])))) tags))]] @@ -5126,7 +5126,7 @@ _ (fail "Wrong syntax for ^slots"))) -(def: (place-tokens label tokens target) +(def: (place_tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target (^or [_ (#Bit _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) @@ -5140,20 +5140,20 @@ (^template [<tag>] [[location (<tag> elems)] - (do maybe-monad - [placements (monad\map maybe-monad (place-tokens label tokens) elems)] + (do maybe_monad + [placements (monad\map maybe_monad (place_tokens label tokens) elems)] (wrap (list [location (<tag> (list\join placements))])))]) ([#Tuple] [#Form]) [location (#Record pairs)] - (do maybe-monad - [=pairs (monad\map maybe-monad + (do maybe_monad + [=pairs (monad\map maybe_monad (: (-> [Code Code] (Maybe [Code Code])) (function (_ [slot value]) - (do maybe-monad - [slot' (place-tokens label tokens slot) - value' (place-tokens label tokens value)] + (do maybe_monad + [slot' (place_tokens label tokens slot) + value' (place_tokens label tokens value)] (case [slot' value'] (^ [(list =slot) (list =value)]) (wrap [=slot =value]) @@ -5164,56 +5164,56 @@ (wrap (list [location (#Record =pairs)]))) )) -(macro: #export (with-expansions tokens) +(macro: #export (with_expansions tokens) {#.doc (doc "Controlled macro-expansion." "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." "Wherever a binding appears, the bound codes will be spliced in there." (test: "Code operations & structures" - (with-expansions - [<tests> (template [<expr> <text> <pattern>] - [(compare <pattern> <expr>) - (compare <text> (\ Code/encode encode <expr>)) - (compare #1 (\ equivalence = <expr> <expr>))] - - [(bit #1) "#1" [_ (#.Bit #1)]] - [(bit #0) "#0" [_ (#.Bit #0)]] - [(int +123) "+123" [_ (#.Int +123)]] - [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] - [(text "123") "'123'" [_ (#.Text "123")]] - [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] - [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] - [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] - [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] - [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] - [(local-identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] - )] - (test-all <tests>))))} + (with_expansions + [<tests> (template [<expr> <text> <pattern>] + [(compare <pattern> <expr>) + (compare <text> (\ Code/encode encode <expr>)) + (compare #1 (\ equivalence = <expr> <expr>))] + + [(bit #1) "#1" [_ (#.Bit #1)]] + [(bit #0) "#0" [_ (#.Bit #0)]] + [(int +123) "+123" [_ (#.Int +123)]] + [(frac +123.0) "+123.0" [_ (#.Frac +123.0)]] + [(text "123") "'123'" [_ (#.Text "123")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(identifier ["yolo" "lol"]) "yolo.lol" [_ (#.Identifier ["yolo" "lol"])]] + [(form (list (bit #1) (int +123))) "(#1 +123)" (^ [_ (#.Form (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(tuple (list (bit #1) (int +123))) "[#1 +123]" (^ [_ (#.Tuple (list [_ (#.Bit #1)] [_ (#.Int +123)]))])] + [(record (list [(bit #1) (int +123)])) "{#1 +123}" (^ [_ (#.Record (list [[_ (#.Bit #1)] [_ (#.Int +123)]]))])] + [(local_tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local_identifier "lol") "lol" [_ (#.Identifier ["" "lol"])]] + )] + (test_all <tests>))))} (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings - (^ (list& [_ (#Identifier ["" var-name])] macro-expr bindings')) - (do meta-monad - [expansion (macro-expand-once macro-expr)] - (case (place-tokens var-name expansion (` (.with-expansions - [(~+ bindings')] - (~+ bodies)))) + (^ (list& [_ (#Identifier ["" var_name])] macro_expr bindings')) + (do meta_monad + [expansion (macro_expand_once macro_expr)] + (case (place_tokens var_name expansion (` (.with_expansions + [(~+ bindings')] + (~+ bodies)))) (#Some output) (wrap output) _ - (fail "[with-expansions] Improper macro expansion."))) + (fail "[with_expansions] Improper macro expansion."))) #Nil (return bodies) _ - (fail "Wrong syntax for with-expansions")) + (fail "Wrong syntax for with_expansions")) _ - (fail "Wrong syntax for with-expansions"))) + (fail "Wrong syntax for with_expansions"))) -(def: (flatten-alias type) +(def: (flatten_alias type) (-> Type Type) (case type (^template [<name>] @@ -5227,17 +5227,17 @@ ["Text"]) (#Named _ type') - (flatten-alias type') + (flatten_alias type') _ type)) -(def: (anti-quote-def name) +(def: (anti_quote_def name) (-> Name (Meta Code)) - (do meta-monad - [type+value (find-def-value name) + (do meta_monad + [type+value (find_def_value name) #let [[type value] type+value]] - (case (flatten-alias type) + (case (flatten_alias type) (^template [<name> <type> <wrapper>] [(#Named ["lux" <name>] _) (wrap (<wrapper> (:coerce <type> value)))]) @@ -5251,53 +5251,53 @@ _ (fail (text\compose "Cannot anti-quote type: " (name\encode name)))))) -(def: (anti-quote token) +(def: (anti_quote token) (-> Code (Meta Code)) (case token - [_ (#Identifier [def-prefix def-name])] - (if (text\= "" def-prefix) - (do meta-monad - [current-module current-module-name] - (anti-quote-def [current-module def-name])) - (anti-quote-def [def-prefix def-name])) + [_ (#Identifier [def_prefix def_name])] + (if (text\= "" def_prefix) + (do meta_monad + [current_module current_module_name] + (anti_quote_def [current_module def_name])) + (anti_quote_def [def_prefix def_name])) (^template [<tag>] [[meta (<tag> parts)] - (do meta-monad - [=parts (monad\map meta-monad anti-quote parts)] + (do meta_monad + [=parts (monad\map meta_monad anti_quote parts)] (wrap [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) [meta (#Record pairs)] - (do meta-monad - [=pairs (monad\map meta-monad + (do meta_monad + [=pairs (monad\map meta_monad (: (-> [Code Code] (Meta [Code Code])) (function (_ [slot value]) - (do meta-monad - [=value (anti-quote value)] + (do meta_monad + [=value (anti_quote value)] (wrap [slot =value])))) pairs)] (wrap [meta (#Record =pairs)])) _ - (\ meta-monad return token) + (\ meta_monad return token) )) (macro: #export (static tokens) (case tokens (^ (list pattern)) - (do meta-monad - [pattern' (anti-quote pattern)] + (do meta_monad + [pattern' (anti_quote pattern)] (wrap (list pattern'))) _ (fail "Wrong syntax for 'static'."))) -(type: Multi-Level-Case +(type: Multi_Level_Case [Code (List [Code Code])]) -(def: (case-level^ level) +(def: (case_level^ level) (-> Code (Meta [Code Code])) (case level (^ [_ (#Tuple (list expr binding))]) @@ -5307,20 +5307,20 @@ (return [level (` #1)]) )) -(def: (multi-level-case^ levels) - (-> (List Code) (Meta Multi-Level-Case)) +(def: (multi_level_case^ levels) + (-> (List Code) (Meta Multi_Level_Case)) (case levels #Nil (fail "Multi-level patterns cannot be empty.") (#Cons init extras) - (do meta-monad - [extras' (monad\map meta-monad case-level^ extras)] + (do meta_monad + [extras' (monad\map meta_monad case_level^ extras)] (wrap [init extras'])))) -(def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> Code [Multi-Level-Case Code] (List Code)) - (let [inner-pattern-body (list\fold (function (_ [calculation pattern] success) +(def: (multi_level_case$ g!_ [[init_pattern levels] body]) + (-> Code [Multi_Level_Case Code] (List Code)) + (let [inner_pattern_body (list\fold (function (_ [calculation pattern] success) (let [bind? (case pattern [_ (#.Identifier _)] #1 @@ -5336,7 +5336,7 @@ (list g!_ (` #.None)))))))) (` (#.Some (~ body))) (: (List [Code Code]) (list\reverse levels)))] - (list init-pattern inner-pattern-body))) + (list init_pattern inner_pattern_body))) (macro: #export (^multi tokens) {#.doc (doc "Multi-level pattern matching." @@ -5344,7 +5344,7 @@ "For example:" (case (split (size static) uri) (^multi (#.Some [chunk uri']) [(text\= static chunk) #1]) - (match-uri endpoint? parts' uri') + (match_uri endpoint? parts' uri') _ (#.Left (format "Static part " (%t static) " does not match URI: " uri))) @@ -5353,21 +5353,21 @@ "The example above can be rewritten as..." (case (split (size static) uri) (^multi (#.Some [chunk uri']) (text\= static chunk)) - (match-uri endpoint? parts' uri') + (match_uri endpoint? parts' uri') _ (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens - (^ (list& [_meta (#Form levels)] body next-branches)) - (do meta-monad - [mlc (multi-level-case^ levels) - #let [initial-bind? (case mlc + (^ (list& [_meta (#Form levels)] body next_branches)) + (do meta_monad + [mlc (multi_level_case^ levels) + #let [initial_bind? (case mlc [[_ (#.Identifier _)] _] #1 _ #0)] - expected get-expected-type + expected get_expected_type g!temp (gensym "temp")] (let [output (list g!temp (` ({(#Some (~ g!temp)) @@ -5375,12 +5375,12 @@ #None (case (~ g!temp) - (~+ next-branches))} - ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) + (~+ next_branches))} + ("lux check" (#.Apply (~ (type_to_code expected)) Maybe) (case (~ g!temp) - (~+ (multi-level-case$ g!temp [mlc body])) + (~+ (multi_level_case$ g!temp [mlc body])) - (~+ (if initial-bind? + (~+ (if initial_bind? (list) (list g!temp (` #.None)))))))))] (wrap output))) @@ -5390,15 +5390,15 @@ ## TODO: Allow asking the compiler for the name of the definition ## currently being defined. That name can then be fed into -## 'wrong-syntax-error' for easier maintenance of the error-messages. -(def: wrong-syntax-error +## 'wrong_syntax_error' for easier maintenance of the error_messages. +(def: wrong_syntax_error (-> Name Text) (|>> name\encode (text\compose "Wrong syntax for "))) -(macro: #export (name-of tokens) +(macro: #export (name_of tokens) {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." - (name-of #.doc) + (name_of #.doc) "=>" ["lux" "doc"])} (case tokens @@ -5408,19 +5408,19 @@ ([#Identifier] [#Tag]) _ - (fail (..wrong-syntax-error ["lux" "name-of"])))) + (fail (..wrong_syntax_error ["lux" "name_of"])))) -(def: (get-scope-type-vars state) +(def: (get_scope_type_vars state) (Meta (List Nat)) (case state - {#info info #source source #current-module _ #modules modules - #scopes scopes #type-context types #host host + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host #seed seed #expected expected #location location #extensions extensions - #scope-type-vars scope-type-vars} - (#Right state scope-type-vars) + #scope_type_vars scope_type_vars} + (#Right state scope_type_vars) )) -(def: (list-at idx xs) +(def: (list_at idx xs) (All [a] (-> Nat (List a) (Maybe a))) (case xs #Nil @@ -5429,12 +5429,12 @@ (#Cons x xs') (if ("lux i64 =" 0 idx) (#Some x) - (list-at (dec idx) xs')))) + (list_at (dec idx) xs')))) (macro: #export ($ tokens) {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, 0 corresponds to the 'a' variable." - (def: #export (from-list list) + (def: #export (from_list list) (All [a] (-> (List a) (Row a))) (list\fold add (: (Row ($ 0)) @@ -5442,17 +5442,17 @@ list)))} (case tokens (^ (list [_ (#Nat idx)])) - (do meta-monad - [stvs get-scope-type-vars] - (case (list-at idx (list\reverse stvs)) - (#Some var-id) - (wrap (list (` (#Ex (~ (nat$ var-id)))))) + (do meta_monad + [stvs get_scope_type_vars] + (case (list_at idx (list\reverse stvs)) + (#Some var_id) + (wrap (list (` (#Ex (~ (nat$ var_id)))))) #None (fail (text\compose "Indexed-type does not exist: " (nat\encode idx))))) _ - (fail (..wrong-syntax-error (name-of ..$))))) + (fail (..wrong_syntax_error (name_of ..$))))) (def: #export (is? reference sample) {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." @@ -5470,16 +5470,16 @@ (def: (hash (^@ set [Hash<a> _])) (list\fold (function (_ elem acc) (+ (\ Hash<a> hash elem) acc)) 0 - (to-list set))))} + (to_list set))))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches)) - (let [g!whole (local-identifier$ name)] + (let [g!whole (local_identifier$ name)] (return (list& g!whole (` (case (~ g!whole) (~ pattern) (~ body))) branches))) _ - (fail (..wrong-syntax-error (name-of ..^@))))) + (fail (..wrong_syntax_error (name_of ..^@))))) (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." @@ -5488,26 +5488,26 @@ (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) - (let [g!name (local-identifier$ name)] + (let [g!name (local_identifier$ name)] (return (list& g!name (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] (~ body))) branches))) _ - (fail (..wrong-syntax-error (name-of ..^|>))))) + (fail (..wrong_syntax_error (name_of ..^|>))))) (macro: #export (:assume tokens) {#.doc (doc "Coerces the given expression to the type of whatever is expected." (: Dinosaur (:assume (list +1 +2 +3))))} (case tokens (^ (list expr)) - (do meta-monad - [type get-expected-type] - (wrap (list (` ("lux coerce" (~ (type-to-code type)) (~ expr)))))) + (do meta_monad + [type get_expected_type] + (wrap (list (` ("lux coerce" (~ (type_to_code type)) (~ expr)))))) _ - (fail (..wrong-syntax-error (name-of ..:assume))))) + (fail (..wrong_syntax_error (name_of ..:assume))))) (macro: #export (undefined tokens) {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." @@ -5521,13 +5521,13 @@ (return (list (` (..error! "Undefined behavior.")))) _ - (fail (..wrong-syntax-error (name-of ..undefined))))) + (fail (..wrong_syntax_error (name_of ..undefined))))) (macro: #export (:of tokens) {#.doc (doc "Generates the type corresponding to a given expression." "Example #1:" - (let [my-num +123] - (:of my-num)) + (let [my_num +123] + (:of my_num)) "==" Int "-------------------" @@ -5536,30 +5536,30 @@ "==" Int)} (case tokens - (^ (list [_ (#Identifier var-name)])) - (do meta-monad - [var-type (find-type var-name)] - (wrap (list (type-to-code var-type)))) + (^ (list [_ (#Identifier var_name)])) + (do meta_monad + [var_type (find_type var_name)] + (wrap (list (type_to_code var_type)))) (^ (list expression)) - (do meta-monad + (do meta_monad [g!temp (gensym "g!temp")] (wrap (list (` (let [(~ g!temp) (~ expression)] (..:of (~ g!temp))))))) _ - (fail (..wrong-syntax-error (name-of ..:of))))) + (fail (..wrong_syntax_error (name_of ..:of))))) -(def: (parse-complex-declaration tokens) +(def: (parse_complex_declaration tokens) (-> (List Code) (Meta [[Text (List Text)] (List Code)])) (case tokens (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) - (do meta-monad - [args (monad\map meta-monad + (do meta_monad + [args (monad\map meta_monad (function (_ arg') (case arg' - [_ (#Identifier ["" arg-name])] - (wrap arg-name) + [_ (#Identifier ["" arg_name])] + (wrap arg_name) _ (fail "Could not parse an argument."))) @@ -5570,7 +5570,7 @@ (fail "Could not parse a complex declaration.") )) -(def: (parse-any tokens) +(def: (parse_any tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) @@ -5580,7 +5580,7 @@ (fail "Could not parse anything.") )) -(def: (parse-many tokens) +(def: (parse_many tokens) (-> (List Code) (Meta [(List Code) (List Code)])) (case tokens (^ (list& head tail)) @@ -5590,7 +5590,7 @@ (fail "Could not parse anything.") )) -(def: (parse-end tokens) +(def: (parse_end tokens) (-> (List Code) (Meta Any)) (case tokens (^ (list)) @@ -5600,7 +5600,7 @@ (fail "Expected input Codes to be empty.") )) -(def: (parse-anns tokens) +(def: (parse_anns tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) @@ -5615,38 +5615,38 @@ "For simple macros that do not need any fancy features." (template: (square x) (* x x)))} - (do meta-monad + (do meta_monad [#let [[export? tokens] (export^ tokens)] - name+args|tokens (parse-complex-declaration tokens) + name+args|tokens (parse_complex_declaration tokens) #let [[[name args] tokens] name+args|tokens] - anns|tokens (parse-anns tokens) + anns|tokens (parse_anns tokens) #let [[anns tokens] anns|tokens] - input-templates|tokens (parse-many tokens) - #let [[input-templates tokens] input-templates|tokens] - _ (parse-end tokens) + input_templates|tokens (parse_many tokens) + #let [[input_templates tokens] input_templates|tokens] + _ (parse_end tokens) g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep-env (list\map (function (_ arg) - [arg (` ((~' ~) (~ (local-identifier$ arg))))]) + #let [rep_env (list\map (function (_ arg) + [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] - this-module current-module-name] + this_module current_module_name] (wrap (list (` (macro: (~+ (export export?)) - ((~ (local-identifier$ name)) (~ g!tokens) (~ g!compiler)) + ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) (~ anns) (case (~ g!tokens) - (^ (list (~+ (list\map local-identifier$ args)))) + (^ (list (~+ (list\map local_identifier$ args)))) (#.Right [(~ g!compiler) (list (~+ (list\map (function (_ template) - (` (`' (~ (replace-syntax rep-env template))))) - input-templates)))]) + (` (`' (~ (replace_syntax rep_env template))))) + input_templates)))]) (~ g!_) - (#.Left (~ (text$ (..wrong-syntax-error [this-module name])))) + (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) ))))) )) -(macro: #export (as-is tokens compiler) +(macro: #export (as_is tokens compiler) (#Right [compiler tokens])) (macro: #export (char tokens compiler) @@ -5658,14 +5658,14 @@ [compiler] #Right) _ - (#Left (..wrong-syntax-error (name-of ..char))))) + (#Left (..wrong_syntax_error (name_of ..char))))) (def: target (Meta Text) (function (_ compiler) (#Right [compiler (get@ [#info #target] compiler)]))) -(def: (target-pick target options default) +(def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (case options #Nil @@ -5677,45 +5677,45 @@ (return (list default))) (#Cons [key pick] options') - (with-expansions [<try-again> (target-pick target options' default)] - (case key - [_ (#Text platform)] - (if (text\= target platform) - (return (list pick)) - <try-again>) - - [_ (#Identifier identifier)] - (do meta-monad - [identifier (..resolve-global-identifier identifier) - type+value (..find-def-value identifier) - #let [[type value] type+value]] - (case (..flatten-alias type) - (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) - (if (text\= target (:coerce ..Text value)) - (wrap (list pick)) - <try-again>) + (with_expansions [<try_again> (target_pick target options' default)] + (case key + [_ (#Text platform)] + (if (text\= target platform) + (return (list pick)) + <try_again>) + + [_ (#Identifier identifier)] + (do meta_monad + [identifier (..resolve_global_identifier identifier) + type+value (..find_def_value identifier) + #let [[type value] type+value]] + (case (..flatten_alias type) + (#Named ["lux" "Text"] (#Primitive "#Text" #Nil)) + (if (text\= target (:coerce ..Text value)) + (wrap (list pick)) + <try_again>) - _ - (fail ($_ text\compose - "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type-to-code type)))))) + _ + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) - _ - <try-again>)) + _ + <try_again>)) )) (macro: #export (for tokens) - (do meta-monad + (do meta_monad [target ..target] (case tokens (^ (list [_ (#Record options)])) - (target-pick target options #.None) + (target_pick target options #.None) (^ (list [_ (#Record options)] default)) - (target-pick target options (#.Some default)) + (target_pick target options (#.Some default)) _ - (fail (..wrong-syntax-error (name-of ..for)))))) + (fail (..wrong_syntax_error (name_of ..for)))))) (template [<name> <type> <output>] [(def: (<name> xy) @@ -5726,32 +5726,32 @@ [left a x] [right b y]) -(def: (label-code code) +(def: (label_code code) (-> Code (Meta [(List [Code Code]) Code])) (case code (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) - (do meta-monad + (do meta_monad [g!expansion (gensym "g!expansion")] (wrap [(list [g!expansion expansion]) g!expansion])) (^template [<tag>] [[ann (<tag> parts)] - (do meta-monad - [=parts (monad\map meta-monad label-code parts)] + (do meta_monad + [=parts (monad\map meta_monad label_code parts)] (wrap [(list\fold list\compose (list) (list\map left =parts)) [ann (<tag> (list\map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] - (do meta-monad - [=kvs (monad\map meta-monad + (do meta_monad + [=kvs (monad\map meta_monad (function (_ [key val]) - (do meta-monad - [=key (label-code key) - =val (label-code val) - #let [[key-labels key-labelled] =key - [val-labels val-labelled] =val]] - (wrap [(list\compose key-labels val-labels) [key-labelled val-labelled]]))) + (do meta_monad + [=key (label_code key) + =val (label_code val) + #let [[key_labels key_labelled] =key + [val_labels val_labelled] =val]] + (wrap [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) kvs)] (wrap [(list\fold list\compose (list) (list\map left =kvs)) [ann (#Record (list\map right =kvs))]])) @@ -5762,37 +5762,37 @@ (macro: #export (`` tokens) (case tokens (^ (list raw)) - (do meta-monad - [=raw (label-code raw) + (do meta_monad + [=raw (label_code raw) #let [[labels labelled] =raw]] - (wrap (list (` (with-expansions [(~+ (|> labels + (wrap (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) list\join))] - (~ labelled)))))) + (~ labelled)))))) _ - (fail (..wrong-syntax-error (name-of ..``))) + (fail (..wrong_syntax_error (name_of ..``))) )) (def: (name$ [module name]) (-> Name Code) (` [(~ (text$ module)) (~ (text$ name))])) -(def: (untemplate-list& last inits) +(def: (untemplate_list& last inits) (-> Code (List Code) Code) (case inits #Nil last (#Cons [init inits']) - (` (#.Cons (~ init) (~ (untemplate-list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) -(def: (untemplate-pattern pattern) +(def: (untemplate_pattern pattern) (-> Code (Meta Code)) (case pattern (^template [<tag> <name> <gen>] [[_ (<tag> value)] - (do meta-monad + (do meta_monad [g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))]) ([#Bit "Bit" bit$] @@ -5805,16 +5805,16 @@ [#Identifier "Identifier" name$]) [_ (#Record fields)] - (do meta-monad - [=fields (monad\map meta-monad + (do meta_monad + [=fields (monad\map meta_monad (function (_ [key value]) - (do meta-monad - [=key (untemplate-pattern key) - =value (untemplate-pattern value)] + (do meta_monad + [=key (untemplate_pattern key) + =value (untemplate_pattern value)] (wrap (` [(~ =key) (~ =value)])))) fields) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))]))) + (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))]))) [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))] (return unquoted) @@ -5827,33 +5827,33 @@ (case (list\reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) - (do meta-monad - [=inits (monad\map meta-monad untemplate-pattern (list\reverse inits)) + (do meta_monad + [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits)) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) + (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list& spliced =inits)))]))) _ - (do meta-monad - [=elems (monad\map meta-monad untemplate-pattern elems) + (do meta_monad + [=elems (monad\map meta_monad untemplate_pattern elems) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))]) + (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list =elems)))]))))]) ([#Tuple] [#Form]) )) (macro: #export (^code tokens) (case tokens (^ (list& [_meta (#Form (list template))] body branches)) - (do meta-monad - [pattern (untemplate-pattern template)] + (do meta_monad + [pattern (untemplate_pattern template)] (wrap (list& pattern body branches))) (^ (list template)) - (do meta-monad - [pattern (untemplate-pattern template)] + (do meta_monad + [pattern (untemplate_pattern template)] (wrap (list pattern))) _ - (fail (..wrong-syntax-error (name-of ..^code))))) + (fail (..wrong_syntax_error (name_of ..^code))))) (template [<zero> <one>] [(def: #export <zero> #0) @@ -5868,12 +5868,12 @@ (case tokens (^ (list [_ (#Tuple bindings)] bodyT)) (if (multiple? 2 (list\size bindings)) - (return (list (` (..with-expansions [(~+ (|> bindings - ..as-pairs + (return (list (` (..with_expansions [(~+ (|> bindings + ..as_pairs (list\map (function (_ [localT valueT]) - (list localT (` (..as-is (~ valueT)))))) + (list localT (` (..as_is (~ valueT)))))) (list\fold list\compose (list))))] - (~ bodyT))))) + (~ bodyT))))) (..fail ":let requires an even number of parts")) _ |