diff options
Diffstat (limited to '')
308 files changed, 13297 insertions, 13293 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")) _ diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index 0a2b6f65c..fd325759a 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -40,7 +40,7 @@ #.None)) (#.Some [?name comonad bindings body]) (if (|> bindings list.size (n.% 2) (n.= 0)) - (let [[module short] (name-of ..be) + (let [[module short] (name_of ..be) gensym (: (-> Text Code) (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) g!_ (gensym "_") @@ -57,7 +57,7 @@ (` (|> (~ value) (~ g!split) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))))) )))) body - (list.reverse (list.as-pairs bindings)))] + (list.reverse (list.as_pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux index b1b026440..fbe3a4c8a 100644 --- a/stdlib/source/lux/abstract/interval.lux +++ b/stdlib/source/lux/abstract/interval.lux @@ -63,14 +63,14 @@ (let [(^open ".") interval] (= <limit> elem)))] - [starts-with? bottom] - [ends-with? top] + [starts_with? bottom] + [ends_with? top] ) (def: #export (borders? interval elem) (All [a] (-> (Interval a) a Bit)) - (or (starts-with? elem interval) - (ends-with? elem interval))) + (or (starts_with? elem interval) + (ends_with? elem interval))) (def: #export (union left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) @@ -125,15 +125,15 @@ (or (meets? reference sample) (meets? sample reference))) -(template [<name> <eq-side> <ineq> <ineq-side>] +(template [<name> <eq_side> <ineq> <ineq_side>] [(def: #export (<name> reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) (let [(^open ",\.") reference] - (and (,\= (\ reference <eq-side>) - (\ sample <eq-side>)) + (and (,\= (\ reference <eq_side>) + (\ sample <eq_side>)) (<ineq> ,\&order - (\ reference <ineq-side>) - (\ sample <ineq-side>)))))] + (\ reference <ineq_side>) + (\ sample <ineq_side>)))))] [starts? ,\bottom order.<= ,\top] [finishes? ,\top order.>= ,\bottom] diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 1d7c67401..900d5cca4 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -33,11 +33,11 @@ #.Nil xs)) -(def: (as-pairs xs) +(def: (as_pairs xs) (All [a] (-> (List a) (List [a a]))) (case xs (#.Cons x1 (#.Cons x2 xs')) - (#.Cons [x1 x2] (as-pairs xs')) + (#.Cons [x1 x2] (as_pairs xs')) _ #.Nil)) @@ -70,7 +70,7 @@ #.None)) (#.Some [?name monad bindings body]) (if (|> bindings list\size .int ("lux i64 %" +2) ("lux i64 =" +0)) - (let [[module short] (name-of ..do) + (let [[module short] (name_of ..do) gensym (: (-> Text Code) (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) g!_ (gensym "_") @@ -87,7 +87,7 @@ (` (|> (~ value) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))) (~ g!join))) )))) body - (reverse (as-pairs bindings)))] + (reverse (as_pairs bindings)))] (#.Right [state (list (case ?name (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index 4e6f51942..0b79a230e 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -39,27 +39,27 @@ (s.tuple (p.some binding))) binding)) -(def: (pair-list [binding value]) +(def: (pair_list [binding value]) (All [a] (-> [a a] (List a))) (list binding value)) -(def: named-monad +(def: named_monad (Parser [(Maybe Text) Code]) (p.either (s.record (p.and (\ p.monad map (|>> #.Some) - s.local-identifier) + s.local_identifier) s.any)) (\ p.monad map (|>> [#.None]) s.any))) -(syntax: #export (do {[?name monad] ..named-monad} +(syntax: #export (do {[?name monad] ..named_monad} {context (s.tuple (p.some context))} expression) - (meta.with-gensyms [g!_ g!bind] + (meta.with_gensyms [g!_ g!bind] (let [body (list\fold (function (_ context next) (case context (#Let bindings) (` (let [(~+ (|> bindings - (list\map pair-list) + (list\map pair_list) list.concat))] (~ next))) @@ -72,7 +72,7 @@ (list.reverse context))] (wrap (list (case ?name (#.Some name) - (let [name (code.local-identifier name)] + (let [name (code.local_identifier name)] (` (let [(~ name) (~ monad) {#..wrap (~' wrap) #..bind (~ g!bind)} (~ name)] diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 2791cce92..de3d5a10d 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -13,7 +13,7 @@ ["i" int] ["r" rev] ["f" frac]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:) @@ -33,7 +33,7 @@ (def: aliases^ (Parser (List Alias)) - (|> (<>.and <c>.local-identifier <c>.any) + (|> (<>.and <c>.local_identifier <c>.any) <>.some <c>.record (<>.default (list)))) @@ -49,7 +49,7 @@ (<>.and (|> bottom^ (<>\map (|>> #.Some))) (<>\wrap (list))))) -(def: (stack-fold tops bottom) +(def: (stack_fold tops bottom) (-> (List Code) Code Code) (list\fold (function (_ top bottom) (` [(~ bottom) (~ top)])) @@ -65,34 +65,34 @@ (wrap singleton) _ - (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line - (|> expansion (list\map %.code) (text.join-with " "))))))) + (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new_line + (|> expansion (list\map %.code) (text.join_with " "))))))) (syntax: #export (=> {aliases aliases^} {inputs stack^} {outputs stack^}) - (let [de-alias (function (_ aliased) + (let [de_alias (function (_ aliased) (list\fold (function (_ [from to] pre) - (code.replace (code.local-identifier from) to pre)) + (code.replace (code.local_identifier from) to pre)) aliased aliases))] (case [(|> inputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`)))) (|> outputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] (monad.do meta.monad - [inputC (singleton (meta.expand-all (stack-fold (get@ #top inputs) bottomI))) - outputC (singleton (meta.expand-all (stack-fold (get@ #top outputs) bottomO)))] - (wrap (list (` (-> (~ (de-alias inputC)) - (~ (de-alias outputC))))))) + [inputC (singleton (meta.expand_all (stack_fold (get@ #top inputs) bottomI))) + outputC (singleton (meta.expand_all (stack_fold (get@ #top outputs) bottomO)))] + (wrap (list (` (-> (~ (de_alias inputC)) + (~ (de_alias outputC))))))) [?bottomI ?bottomO] - (with-gensyms [g!stack] + (with_gensyms [g!stack] (monad.do meta.monad - [inputC (singleton (meta.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) - outputC (singleton (meta.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] + [inputC (singleton (meta.expand_all (stack_fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (meta.expand_all (stack_fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] - (-> (~ (de-alias inputC)) - (~ (de-alias outputC)))))))))))) + (-> (~ (de_alias inputC)) + (~ (de_alias outputC)))))))))))) (def: begin! Any []) @@ -106,24 +106,24 @@ (syntax: #export (word: {export |export|.parser} - {name <c>.local-identifier} - {annotations (<>.default cs.empty-annotations csr.annotations)} + {name <c>.local_identifier} + {annotations (<>.default cs.empty_annotations csr.annotations)} type {commands (<>.some <c>.any)}) - (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local-identifier name)) + (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local_identifier name)) (~ (csw.annotations annotations)) (~ type) (|>> (~+ commands))))))) (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) - (with-gensyms [g! g!func g!stack g!output] + (with_gensyms [g! g!func g!stack g!output] (monad.do {! meta.monad} [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq !))] (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] (-> (-> (~+ g!inputs) (~ g!output)) (=> [(~+ g!inputs)] [(~ g!output)]))) (function ((~ g!) (~ g!func)) - (function ((~ g!) (~ (stack-fold g!inputs g!stack))) + (function ((~ g!) (~ (stack_fold g!inputs g!stack))) [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) (def: #export apply/1 (apply 1)) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 66ea24cd8..6355a43b7 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -25,7 +25,7 @@ ["csr" reader] ["csw" writer] ["|.|" export]]]] - ["." meta (#+ with-gensyms monad) + ["." meta (#+ with_gensyms monad) ["." annotation]] [type (#+ :share) ["." abstract (#+ abstract: :representation :abstraction)]]] @@ -37,10 +37,10 @@ (exception: #export poisoned) (exception: #export dead) -(with-expansions - [<Mail> (as-is (-> s (Actor s) (Promise (Try s)))) - <Obituary> (as-is [Text s (List <Mail>)]) - <Mailbox> (as-is (Rec Mailbox +(with_expansions + [<Mail> (as_is (-> s (Actor s) (Promise (Try s)))) + <Obituary> (as_is [Text s (List <Mail>)]) + <Mailbox> (as_is (Rec Mailbox [(Promise [<Mail> Mailbox]) (Resolver [<Mail> Mailbox])]))] @@ -73,29 +73,29 @@ (type: #export (Behavior o s) {#.doc "An actor's behavior when mail is received and when a fatal error occurs."} - {#on-init (-> o s) - #on-mail (-> (Mail s) s (Actor s) (Promise (Try s))) - #on-stop (-> Text s (Promise Any))}) + {#on_init (-> o s) + #on_mail (-> (Mail s) s (Actor s) (Promise (Try s))) + #on_stop (-> Text s (Promise Any))}) (def: #export (spawn! behavior init) {#.doc "Given a behavior and initial state, spawns an actor and returns it."} (All [o s] (-> (Behavior o s) o (IO (Actor s)))) - (io (let [[on-init on-mail on-stop] behavior + (io (let [[on_init on_mail on_stop] behavior self (:share [o s] {(Behavior o s) behavior} {(Actor s) (:abstraction {#obituary (promise.promise []) #mailbox (atom (promise.promise []))})}) - process (loop [state (on-init init) + process (loop [state (on_init init) [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] (do {! promise.monad} [[head tail] |mailbox| - ?state' (on-mail head state self)] + ?state' (on_mail head state self)] (case ?state' (#try.Failure error) (do ! - [_ (on-stop error state)] + [_ (on_stop error state)] (let [[_ resolve] (get@ #obituary (:representation self))] (exec (io.run (do io.monad @@ -195,19 +195,19 @@ ) ) -(def: (default-on-mail mail state self) +(def: (default_on_mail mail state self) (All [s] (-> (Mail s) s (Actor s) (Promise (Try s)))) (mail state self)) -(def: (default-on-stop cause state) +(def: (default_on_stop cause state) (All [s] (-> Text s (Promise Any))) (promise\wrap [])) (def: #export default (All [s] (Behavior s s)) - {#on-init function.identity - #on-mail ..default-on-mail - #on-stop ..default-on-stop}) + {#on_init function.identity + #on_mail ..default_on_mail + #on_stop ..default_on_stop}) (def: #export (poison! actor) {#.doc (doc "Kills the actor by sending mail that will kill it upon processing," @@ -217,64 +217,64 @@ (promise.resolved (exception.throw ..poisoned []))) actor)) -(def: actor-decl^ +(def: actor_decl^ (Parser [Text (List Text)]) - (<>.either (<c>.form (<>.and <c>.local-identifier (<>.some <c>.local-identifier))) - (<>.and <c>.local-identifier (\ <>.monad wrap (list))))) + (<>.either (<c>.form (<>.and <c>.local_identifier (<>.some <c>.local_identifier))) + (<>.and <c>.local_identifier (\ <>.monad wrap (list))))) -(type: On-MailC +(type: On_MailC [[Text Text Text] Code]) -(type: On-StopC +(type: On_StopC [[Text Text] Code]) (type: BehaviorC - [(Maybe On-MailC) (Maybe On-StopC) (List Code)]) + [(Maybe On_MailC) (Maybe On_StopC) (List Code)]) (def: argument (Parser Text) - <c>.local-identifier) + <c>.local_identifier) (def: behavior^ (Parser BehaviorC) - (let [on-mail-args ($_ <>.and ..argument ..argument ..argument) - on-stop-args ($_ <>.and ..argument ..argument)] + (let [on_mail_args ($_ <>.and ..argument ..argument ..argument) + on_stop_args ($_ <>.and ..argument ..argument)] ($_ <>.and - (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on-mail)) on-mail-args)) + (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on_mail)) on_mail_args)) <c>.any))) - (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on-stop)) on-stop-args)) + (<>.maybe (<c>.form (<>.and (<c>.form (<>.after (<c>.this! (' on_stop)) on_stop_args)) <c>.any))) (<>.some <c>.any)))) -(def: (on-mail g!_ ?on-mail) - (-> Code (Maybe On-MailC) Code) - (case ?on-mail +(def: (on_mail g!_ ?on_mail) + (-> Code (Maybe On_MailC) Code) + (case ?on_mail #.None - (` (~! ..default-on-mail)) + (` (~! ..default_on_mail)) (#.Some [[mailN stateN selfN] bodyC]) (` (function ((~ g!_) - (~ (code.local-identifier mailN)) - (~ (code.local-identifier stateN)) - (~ (code.local-identifier selfN))) + (~ (code.local_identifier mailN)) + (~ (code.local_identifier stateN)) + (~ (code.local_identifier selfN))) (~ bodyC))))) -(def: (on-stop g!_ ?on-stop) - (-> Code (Maybe On-StopC) Code) - (case ?on-stop +(def: (on_stop g!_ ?on_stop) + (-> Code (Maybe On_StopC) Code) + (case ?on_stop #.None - (` (~! ..default-on-stop)) + (` (~! ..default_on_stop)) (#.Some [[causeN stateN] bodyC]) (` (function ((~ g!_) - (~ (code.local-identifier causeN)) - (~ (code.local-identifier stateN))) + (~ (code.local_identifier causeN)) + (~ (code.local_identifier stateN))) (~ bodyC))))) -(with-expansions [<examples> (as-is (actor: #export (Stack a) +(with_expansions [<examples> (as_is (actor: #export (Stack a) (List a) - ((on-mail mail state self) + ((on_mail mail state self) (do (try.with promise.monad) [#let [_ (log! "BEFORE")] output (mail state self) @@ -288,7 +288,7 @@ (actor: #export Counter Nat - ((on-stop cause state) + ((on_stop cause state) (\ promise.monad wrap (log! (if (exception.match? ..poisoned cause) (format "Counter was poisoned: " (%.nat state)) @@ -302,45 +302,45 @@ (promise.resolved (#try.Success [state state])))))] (syntax: #export (actor: {export |export|.parser} - {[name vars] actor-decl^} - {annotations (<>.default cs.empty-annotations csr.annotations)} - state-type - {[?on-mail ?on-stop messages] behavior^}) + {[name vars] actor_decl^} + {annotations (<>.default cs.empty_annotations csr.annotations)} + state_type + {[?on_mail ?on_stop messages] behavior^}) {#.doc (doc "Defines an actor, with its behavior and internal state." - "Messages for the actor must be defined after the on-mail and on-stop handlers." + "Messages for the actor must be defined after the on_mail and on_stop handlers." <examples>)} - (with-gensyms [g!_] + (with_gensyms [g!_] (do meta.monad - [g!type (meta.gensym (format name "-abstract-type")) - #let [g!actor (code.local-identifier name) - g!vars (list\map code.local-identifier vars)]] + [g!type (meta.gensym (format name "_abstract_type")) + #let [g!actor (code.local_identifier name) + g!vars (list\map code.local_identifier vars)]] (wrap (list (` ((~! abstract:) (~+ (|export|.write export)) ((~ g!type) (~+ g!vars)) - (~ state-type) + (~ state_type) (def: (~+ (|export|.write export)) (~ g!actor) (All [(~+ g!vars)] - (..Behavior (~ state-type) ((~ g!type) (~+ g!vars)))) - {#..on-init (|>> ((~! abstract.:abstraction) (~ g!type))) - #..on-mail (~ (..on-mail g!_ ?on-mail)) - #..on-stop (~ (..on-stop g!_ ?on-stop))}) + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail)) + #..on_stop (~ (..on_stop g!_ ?on_stop))}) (~+ messages)))))))) - (syntax: #export (actor {[state-type init] (<c>.record (<>.and <c>.any <c>.any))} - {[?on-mail ?on-stop messages] behavior^}) - (with-gensyms [g!_] - (wrap (list (` (: ((~! io.IO) (..Actor (~ state-type))) - (..spawn! (: (..Behavior (~ state-type) (~ state-type)) - {#..on-init (|>>) - #..on-mail (~ (..on-mail g!_ ?on-mail)) - #..on-stop (~ (..on-stop g!_ ?on-stop))}) - (: (~ state-type) + (syntax: #export (actor {[state_type init] (<c>.record (<>.and <c>.any <c>.any))} + {[?on_mail ?on_stop messages] behavior^}) + (with_gensyms [g!_] + (wrap (list (` (: ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (: (..Behavior (~ state_type) (~ state_type)) + {#..on_init (|>>) + #..on_mail (~ (..on_mail g!_ ?on_mail)) + #..on_stop (~ (..on_stop g!_ ?on_stop))}) + (: (~ state_type) (~ init))))))))) (type: Signature {#vars (List Text) #name Text - #inputs (List cs.Typed-Input) + #inputs (List cs.Typed_Input) #state Text #self Text #output Code}) @@ -348,22 +348,22 @@ (def: signature^ (Parser Signature) (<c>.form ($_ <>.and - (<>.default (list) (<c>.tuple (<>.some <c>.local-identifier))) - <c>.local-identifier - (<>.some csr.typed-input) - <c>.local-identifier - <c>.local-identifier + (<>.default (list) (<c>.tuple (<>.some <c>.local_identifier))) + <c>.local_identifier + (<>.some csr.typed_input) + <c>.local_identifier + <c>.local_identifier <c>.any))) (def: reference^ (Parser [Name (List Text)]) - (<>.either (<c>.form (<>.and <c>.identifier (<>.some <c>.local-identifier))) + (<>.either (<c>.form (<>.and <c>.identifier (<>.some <c>.local_identifier))) (<>.and <c>.identifier (\ <>.monad wrap (list))))) (syntax: #export (message: {export |export|.parser} {signature signature^} - {annotations (<>.default cs.empty-annotations csr.annotations)} + {annotations (<>.default cs.empty_annotations csr.annotations)} body) {#.doc (doc "A message can access the actor's state through the state parameter." "A message can also access the actor itself through the self parameter." @@ -371,30 +371,30 @@ "A message may succeed or fail (in case of failure, the actor dies)." <examples>)} - (with-gensyms [g!_ g!return] + (with_gensyms [g!_ g!return] (do meta.monad - [actor-scope abstract.current - #let [g!type (code.local-identifier (get@ #abstract.name actor-scope)) - g!message (code.local-identifier (get@ #name signature)) - g!actor-vars (get@ #abstract.type-vars actor-scope) - g!all-vars (|> (get@ #vars signature) (list\map code.local-identifier) (list\compose g!actor-vars)) + [actor_scope abstract.current + #let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) + g!message (code.local_identifier (get@ #name signature)) + g!actor_vars (get@ #abstract.type_vars actor_scope) + g!all_vars (|> (get@ #vars signature) (list\map code.local_identifier) (list\compose g!actor_vars)) g!inputsC (|> (get@ #inputs signature) (list\map product.left)) g!inputsT (|> (get@ #inputs signature) (list\map product.right)) - g!state (|> signature (get@ #state) code.local-identifier) - g!self (|> signature (get@ #self) code.local-identifier)]] + g!state (|> signature (get@ #state) code.local_identifier) + g!self (|> signature (get@ #self) code.local_identifier)]] (wrap (list (` (def: (~+ (|export|.write export)) ((~ g!message) (~+ g!inputsC)) (~ (csw.annotations annotations)) - (All [(~+ g!all-vars)] + (All [(~+ g!all_vars)] (-> (~+ g!inputsT) - (..Message (~ (get@ #abstract.abstraction actor-scope)) + (..Message (~ (get@ #abstract.abstraction actor_scope)) (~ (get@ #output signature))))) (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (:coerce (~ (get@ #abstract.representation actor-scope)) + (let [(~ g!state) (:coerce (~ (get@ #abstract.representation actor_scope)) (~ g!state))] (|> (~ body) - (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor-scope)) + (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) (~ (get@ #output signature))]))) - (:coerce ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor-scope)) + (:coerce ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) (~ (get@ #output signature))])))))))) )))))) @@ -416,6 +416,6 @@ (if continue? (do ! [outcome (..mail! (action event stop) actor)] - (wrap (try.to-maybe outcome))) + (wrap (try.to_maybe outcome))) (wrap #.None)))) channel))) diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index 04517cc3e..3920c0214 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -13,15 +13,15 @@ [type abstract]]) -(with-expansions [<jvm> (as-is (host.import: (java/util/concurrent/atomic/AtomicReference a) +(with_expansions [<jvm> (as_is (host.import: (java/util/concurrent/atomic/AtomicReference a) ["#::." (new [a]) (get [] a) (compareAndSet [a a] boolean)]))] - (for {@.old <jvm> - @.jvm <jvm>} - - (as-is))) + (for {@.old <jvm> + @.jvm <jvm>} + + (as_is))) (abstract: #export (Atom a) (for {@.old @@ -60,7 +60,7 @@ ("js array read" 0 (:representation atom)) }))) - (def: #export (compare-and-swap current new atom) + (def: #export (compare_and_swap current new atom) {#.doc (doc "Only mutates an atom if you can present its current value." "That guarantees that atom was not updated since you last read from it.")} (All [a] (-> a a (Atom a) (IO Bit))) @@ -87,7 +87,7 @@ (do io.monad [old (read atom) #let [new (f old)] - swapped? (compare-and-swap old new atom)] + swapped? (compare_and_swap old new atom)] (if swapped? (wrap new) (recur []))))) diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index aea0b082a..0c5303f46 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -22,7 +22,7 @@ {#.doc "An asynchronous channel to distribute values."} (Promise (Maybe [a (Channel a)]))) -(exception: #export channel-is-already-closed) +(exception: #export channel_is_already_closed) (signature: #export (Sink a) (: (IO (Try Any)) @@ -49,7 +49,7 @@ [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink. - (wrap (exception.throw ..channel-is-already-closed [])) + (wrap (exception.throw ..channel_is_already_closed [])) ## Someone else fed the sink while I was closing it. (recur []))))))) @@ -57,7 +57,7 @@ (loop [_ []] (do {! io.monad} [current (atom.read sink) - #let [[next resolve-next] (:share [a] + #let [[next resolve_next] (:share [a] {(promise.Resolver (Maybe [a (Channel a)])) current} {[(Promise (Maybe [a (Channel a)])) @@ -67,14 +67,14 @@ (if fed? ## I fed the sink. (do ! - [_ (atom.compare-and-swap current resolve-next sink)] + [_ (atom.compare_and_swap current resolve_next sink)] (wrap (exception.return []))) ## Someone else interacted with the sink. (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink while I was feeding it. - (wrap (exception.throw ..channel-is-already-closed [])) + (wrap (exception.throw ..channel_is_already_closed [])) ## Someone else fed the sink. (recur [])))))))))) @@ -99,11 +99,11 @@ (def: (apply ff fa) (do promise.monad - [cons-f ff - cons-a fa] - (case [cons-f cons-a] - [(#.Some [head-f tail-f]) (#.Some [head-a tail-a])] - (wrap (#.Some [(head-f head-a) (apply tail-f tail-a)])) + [cons_f ff + cons_a fa] + (case [cons_f cons_a] + [(#.Some [head_f tail_f]) (#.Some [head_a tail_a])] + (wrap (#.Some [(head_f head_a) (apply tail_f tail_a)])) _ (wrap #.None))))) @@ -181,7 +181,7 @@ #.None (wrap #.None)))) -(def: #export (from-promise promise) +(def: #export (from_promise promise) (All [a] (-> (Promise a) (Channel a))) (promise\map (function (_ value) (#.Some [value ..empty])) @@ -219,7 +219,7 @@ [init' (f head init)] (wrap (#.Some [init (folds f init' tail)])))))) -(def: #export (poll milli-seconds action) +(def: #export (poll milli_seconds action) (All [a] (-> Nat (IO a) [(Channel a) (Sink a)])) (let [[output sink] (channel [])] @@ -227,12 +227,12 @@ (do io.monad [value action _ (\ sink feed value)] - (promise.await recur (promise.wait milli-seconds))))) + (promise.await recur (promise.wait milli_seconds))))) [output sink]))) -(def: #export (periodic milli-seconds) +(def: #export (periodic milli_seconds) (-> Nat [(Channel Any) (Sink Any)]) - (..poll milli-seconds (io []))) + (..poll milli_seconds (io []))) (def: #export (iterate f init) (All [s o] (-> (-> s (Promise (Maybe [s o]))) s (Channel o))) @@ -282,7 +282,7 @@ #.None (wrap #.Nil)))) -(def: #export (sequential milli-seconds values) +(def: #export (sequential milli_seconds values) (All [a] (-> Nat (List a) (Channel a))) (case values #.Nil @@ -290,5 +290,5 @@ (#.Cons head tail) (promise.resolved (#.Some [head (do promise.monad - [_ (promise.wait milli-seconds)] - (sequential milli-seconds tail))])))) + [_ (promise.wait milli_seconds)] + (sequential milli_seconds tail))])))) diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index e4835b8d8..96822700d 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -38,7 +38,7 @@ #.None (do ! [#let [new [(#.Some value) #.None]] - succeeded? (atom.compare-and-swap old new promise)] + succeeded? (atom.compare_and_swap old new promise)] (if succeeded? (do ! [_ (monad.map ! (function (_ f) (f value)) @@ -72,7 +72,7 @@ #.None (let [new [_value (#.Cons f _observers)]] - (if (io.run (atom.compare-and-swap old new promise)) + (if (io.run (atom.compare_and_swap old new promise)) (io.io []) (await f (:abstraction promise))))))) ) @@ -134,7 +134,7 @@ {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) (let [[a|b resolve] (..promise [])] - (with-expansions + (with_expansions [<sides> (template [<promise> <tag>] [(io.run (await (|>> <tag> resolve) <promise>))] @@ -155,7 +155,7 @@ [right])) left||right)))) -(def: #export (schedule millis-delay computation) +(def: #export (schedule millis_delay computation) {#.doc (doc "Runs an I/O computation on its own thread (after a specified delay)." "Returns a Promise that will eventually host its result.")} (All [a] (-> Nat (IO a) (Promise a))) @@ -163,7 +163,7 @@ (exec (|> (do io.monad [value computation] (resolve value)) - (thread.schedule millis-delay) + (thread.schedule millis_delay) io.run) !out))) @@ -173,17 +173,17 @@ (All [a] (-> (IO a) (Promise a))) (schedule 0)) -(def: #export (delay time-millis value) +(def: #export (delay time_millis value) {#.doc "Delivers a value after a certain period has passed."} (All [a] (-> Nat a (Promise a))) - (schedule time-millis (io value))) + (schedule time_millis (io value))) -(def: #export (wait time-millis) +(def: #export (wait time_millis) {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Any)) - (delay time-millis [])) + (delay time_millis [])) -(def: #export (time-out time-millis promise) +(def: #export (time_out time_millis promise) {#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."} (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) - (..or (wait time-millis) promise)) + (..or (wait time_millis) promise)) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index a405b7b3e..9e6ff9b29 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -22,25 +22,25 @@ ["." promise (#+ Promise Resolver)]]) (type: State - {#max-positions Nat - #open-positions Int - #waiting-list (Queue (Resolver Any))}) + {#max_positions Nat + #open_positions Int + #waiting_list (Queue (Resolver Any))}) (abstract: #export Semaphore (Atom State) {#.doc "A tool for controlling access to resources by multiple concurrent processes."} - (def: most-positions-possible + (def: most_positions_possible (.nat (\ i.interval top))) - (def: #export (semaphore initial-open-positions) + (def: #export (semaphore initial_open_positions) (-> Nat Semaphore) - (let [max-positions (n.min initial-open-positions - ..most-positions-possible)] - (:abstraction (atom.atom {#max-positions max-positions - #open-positions (.int max-positions) - #waiting-list queue.empty})))) + (let [max_positions (n.min initial_open_positions + ..most_positions_possible)] + (:abstraction (atom.atom {#max_positions max_positions + #open_positions (.int max_positions) + #waiting_list queue.empty})))) (def: #export (wait semaphore) (Ex [k] (-> Semaphore (Promise Any))) @@ -52,13 +52,13 @@ (do io.monad [state (atom.read semaphore) #let [[ready? state'] (: [Bit State] - (if (i.> +0 (get@ #open-positions state)) + (if (i.> +0 (get@ #open_positions state)) [true (|> state - (update@ #open-positions dec))] + (update@ #open_positions dec))] [false (|> state - (update@ #open-positions dec) - (update@ #waiting-list (queue.push sink)))]))] - success? (atom.compare-and-swap state state' semaphore)] + (update@ #open_positions dec) + (update@ #waiting_list (queue.push sink)))]))] + success? (atom.compare_and_swap state state' semaphore)] (if success? (if ready? (sink []) @@ -66,9 +66,9 @@ (recur []))))) signal))) - (exception: #export (semaphore-is-maxed-out {max-positions Nat}) + (exception: #export (semaphore_is_maxed_out {max_positions Nat}) (exception.report - ["Max Positions" (%.nat max-positions)])) + ["Max Positions" (%.nat max_positions)])) (def: #export (signal semaphore) (Ex [k] (-> Semaphore (Promise (Try Int)))) @@ -77,29 +77,29 @@ (loop [_ []] (do {! io.monad} [state (atom.read semaphore) - #let [[?sink state' maxed-out?] (: [(Maybe (Resolver Any)) State Bit] - (case (queue.peek (get@ #waiting-list state)) + #let [[?sink state' maxed_out?] (: [(Maybe (Resolver Any)) State Bit] + (case (queue.peek (get@ #waiting_list state)) #.None - (if (n.= (get@ #max-positions state) - (.nat (get@ #open-positions state))) + (if (n.= (get@ #max_positions state) + (.nat (get@ #open_positions state))) [#.None state true] [#.None - (update@ #open-positions inc state) + (update@ #open_positions inc state) false]) (#.Some head) [(#.Some head) (|> state - (update@ #open-positions inc) - (update@ #waiting-list queue.pop)) + (update@ #open_positions inc) + (update@ #waiting_list queue.pop)) false]))]] - (if maxed-out? - (wrap (exception.throw ..semaphore-is-maxed-out [(get@ #max-positions state)])) + (if maxed_out? + (wrap (exception.throw ..semaphore_is_maxed_out [(get@ #max_positions state)])) (do ! - [#let [open-positions (get@ #open-positions state')] - success? (atom.compare-and-swap state state' semaphore)] + [#let [open_positions (get@ #open_positions state')] + success? (atom.compare_and_swap state state' semaphore)] (if success? (do ! [_ (case ?sink @@ -108,7 +108,7 @@ (#.Some sink) (sink []))] - (wrap (#try.Success open-positions))) + (wrap (#try.Success open_positions))) (recur []))))))))) ) @@ -144,8 +144,8 @@ (abstract: #export Barrier {#limit Limit #count (Atom Nat) - #start-turnstile Semaphore - #end-turnstile Semaphore} + #start_turnstile Semaphore + #end_turnstile Semaphore} {#.doc "A barrier that blocks all processes from proceeding until a given number of processes are parked at the barrier."} @@ -153,10 +153,10 @@ (-> Limit Barrier) (:abstraction {#limit limit #count (atom.atom 0) - #start-turnstile (semaphore 0) - #end-turnstile (semaphore 0)})) + #start_turnstile (semaphore 0) + #end_turnstile (semaphore 0)})) - (def: (un-block times turnstile) + (def: (un_block times turnstile) (-> Nat Semaphore (Promise Any)) (loop [step 0] (if (n.< times step) @@ -169,16 +169,16 @@ [(def: (<phase> (^:representation barrier)) (-> Barrier (Promise Any)) (do promise.monad - [#let [limit (refinement.un-refine (get@ #limit barrier)) + [#let [limit (refinement.un_refine (get@ #limit barrier)) goal <goal> count (io.run (atom.update <update> (get@ #count barrier))) reached? (n.= goal count)]] (if reached? - (un-block limit (get@ <turnstile> barrier)) + (un_block limit (get@ <turnstile> barrier)) (wait (get@ <turnstile> barrier)))))] - [start inc limit #start-turnstile] - [end dec 0 #end-turnstile] + [start inc limit #start_turnstile] + [end dec 0 #end_turnstile] ) (def: #export (block barrier) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 523aa5567..7fd916fdb 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -36,7 +36,7 @@ (All [a] (-> (Var a) a)) (|>> :representation atom.read io.run product.left)) - (def: (un-follow sink var) + (def: (un_follow sink var) (All [a] (-> (Sink a) (Var a) (IO Any))) (do io.monad [_ (atom.update (function (_ [value observers]) @@ -44,26 +44,26 @@ (:representation var))] (wrap []))) - (def: (write! new-value var) + (def: (write! new_value var) (All [a] (-> a (Var a) (IO Any))) (do {! io.monad} [#let [var' (:representation var)] - (^@ old [old-value observers]) (atom.read var') - succeeded? (atom.compare-and-swap old [new-value observers] var')] + (^@ old [old_value observers]) (atom.read var') + succeeded? (atom.compare_and_swap old [new_value observers] var')] (if succeeded? (do ! [_ (monad.map ! (function (_ sink) (do ! - [result (\ sink feed new-value)] + [result (\ sink feed new_value)] (case result (#try.Success _) (wrap []) (#try.Failure _) - (un-follow sink var)))) + (un_follow sink var)))) observers)] (wrap [])) - (write! new-value var)))) + (write! new_value var)))) (def: #export (follow target) {#.doc "Creates a channel that will receive all changes to the value of the given var."} @@ -76,19 +76,19 @@ (wrap [channel sink]))) ) -(type: (Tx-Frame a) +(type: (Tx_Frame a) {#var (Var a) #original a #current a}) (type: Tx - (List (Ex [a] (Tx-Frame a)))) + (List (Ex [a] (Tx_Frame a)))) (type: #export (STM a) {#.doc "A computation which updates a transaction and produces a value."} (-> Tx [Tx a])) -(def: (find-var-value var tx) +(def: (find_var_value var tx) (All [a] (-> (Var a) Tx (Maybe a))) (|> tx (list.find (function (_ [_var _original _current]) @@ -102,7 +102,7 @@ (def: #export (read var) (All [a] (-> (Var a) (STM a))) (function (_ tx) - (case (find-var-value var tx) + (case (find_var_value var tx) (#.Some value) [tx value] @@ -111,7 +111,7 @@ [(#.Cons [var value value] tx) value])))) -(def: (update-tx-value var value tx) +(def: (update_tx_value var value tx) (All [a] (-> (Var a) a Tx Tx)) (case tx #.Nil @@ -127,15 +127,15 @@ (#.Cons {#var _var #original _original #current _current} - (update-tx-value var value tx'))))) + (update_tx_value var value tx'))))) (def: #export (write value var) {#.doc "Writes value to var."} (All [a] (-> a (Var a) (STM Any))) (function (_ tx) - (case (find-var-value var tx) + (case (find_var_value var tx) (#.Some _) - [(update-tx-value var value tx) + [(update_tx_value var value tx) []] #.None @@ -184,40 +184,40 @@ _ (..write a' var)] (wrap [a a']))) -(def: (can-commit? tx) +(def: (can_commit? tx) (-> Tx Bit) (list.every? (function (_ [_var _original _current]) (is? _original (..read! _var))) tx)) -(def: (commit-var! [_var _original _current]) - (-> (Ex [a] (Tx-Frame a)) (IO Any)) +(def: (commit_var! [_var _original _current]) + (-> (Ex [a] (Tx_Frame a)) (IO Any)) (if (is? _original _current) (io []) (..write! _current _var))) -(def: fresh-tx Tx (list)) +(def: fresh_tx Tx (list)) (type: (Commit a) [(STM a) (Promise a) (Resolver a)]) -(def: pending-commits +(def: pending_commits (Atom (Rec Commits [(Promise [(Ex [a] (Commit a)) Commits]) (Resolver [(Ex [a] (Commit a)) Commits])])) (atom (promise.promise []))) -(def: commit-processor-flag +(def: commit_processor_flag (Atom Bit) (atom #0)) -(def: (issue-commit commit) +(def: (issue_commit commit) (All [a] (-> (Commit a) (IO Any))) (let [entry [commit (promise.promise [])]] (do {! io.monad} - [|commits|&resolve (atom.read pending-commits)] + [|commits|&resolve (atom.read pending_commits)] (loop [[|commits| resolve] |commits|&resolve] (do ! [|commits| (promise.poll |commits|)] @@ -226,48 +226,48 @@ (do io.monad [resolved? (resolve entry)] (if resolved? - (atom.write (product.right entry) pending-commits) + (atom.write (product.right entry) pending_commits) (recur |commits|&resolve))) (#.Some [head tail]) (recur tail))))))) -(def: (process-commit commit) +(def: (process_commit commit) (All [a] (-> (Commit a) (IO Any))) - (let [[stm-proc output resolve] commit - [finished-tx value] (stm-proc fresh-tx)] - (if (can-commit? finished-tx) + (let [[stm_proc output resolve] commit + [finished_tx value] (stm_proc fresh_tx)] + (if (can_commit? finished_tx) (do {! io.monad} - [_ (monad.map ! commit-var! finished-tx)] + [_ (monad.map ! commit_var! finished_tx)] (resolve value)) - (issue-commit commit)))) + (issue_commit commit)))) -(def: init-processor! +(def: init_processor! (IO Any) (do {! io.monad} - [flag (atom.read commit-processor-flag)] + [flag (atom.read commit_processor_flag)] (if flag (wrap []) (do ! - [was-first? (atom.compare-and-swap flag #1 commit-processor-flag)] - (if was-first? + [was_first? (atom.compare_and_swap flag #1 commit_processor_flag)] + (if was_first? (do ! - [[promise resolve] (atom.read pending-commits)] + [[promise resolve] (atom.read pending_commits)] (promise.await (function (recur [head [tail _resolve]]) (do ! - [_ (process-commit head)] + [_ (process_commit head)] (promise.await recur tail))) promise)) (wrap []))) ))) -(def: #export (commit stm-proc) +(def: #export (commit stm_proc) {#.doc (doc "Commits a transaction and returns its result (asynchronously)." "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} (All [a] (-> (STM a) (Promise a))) (let [[output resolver] (promise.promise [])] (exec (io.run (do io.monad - [_ init-processor!] - (issue-commit [stm-proc output resolver]))) + [_ init_processor!] + (issue_commit [stm_proc output resolver]))) output))) diff --git a/stdlib/source/lux/control/concurrency/thread.lux b/stdlib/source/lux/control/concurrency/thread.lux index 10ec17815..8bdd2b9c9 100644 --- a/stdlib/source/lux/control/concurrency/thread.lux +++ b/stdlib/source/lux/control/concurrency/thread.lux @@ -15,7 +15,7 @@ [// ["." atom (#+ Atom)]]) -(with-expansions [<jvm> (as-is (host.import: java/lang/Object) +(with_expansions [<jvm> (as_is (host.import: java/lang/Object) (host.import: java/lang/Runtime ["#::." @@ -38,11 +38,11 @@ ["#::." (new [int]) (schedule [java/lang/Runnable long java/util/concurrent/TimeUnit] #io (java/util/concurrent/ScheduledFuture java/lang/Object))]))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) @.js - (as-is (host.import: (setTimeout [host.Function host.Number] #io Any)))} + (as_is (host.import: (setTimeout [host.Function host.Number] #io Any)))} ## Default (type: Thread @@ -53,7 +53,7 @@ (def: #export parallelism Nat - (with-expansions [<jvm> (|> (java/lang/Runtime::getRuntime) + (with_expansions [<jvm> (|> (java/lang/Runtime::getRuntime) (java/lang/Runtime::availableProcessors) .nat)] (for {@.old <jvm> @@ -62,30 +62,30 @@ ## Default 1))) -(with-expansions [<jvm> (as-is (def: runner +(with_expansions [<jvm> (as_is (def: runner java/util/concurrent/ScheduledThreadPoolExecutor (java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))] (for {@.old <jvm> @.jvm <jvm> @.js - (as-is)} + (as_is)} ## Default (def: runner (Atom (List Thread)) (atom.atom (list))))) -(def: #export (schedule milli-seconds action) +(def: #export (schedule milli_seconds action) (-> Nat (IO Any) (IO Any)) (for {@.old (let [runnable (host.object [] [java/lang/Runnable] [] (java/lang/Runnable [] (run self) void (io.run action)))] - (case milli-seconds + (case milli_seconds 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) java/util/concurrent/TimeUnit::MILLISECONDS + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner))) @.jvm @@ -93,34 +93,34 @@ [] (java/lang/Runnable [] (run self) void (io.run action)))] - (case milli-seconds + (case milli_seconds 0 (java/util/concurrent/Executor::execute runnable runner) - _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) java/util/concurrent/TimeUnit::MILLISECONDS + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS runner))) @.js (..setTimeout [(host.closure [] (io.run action)) - (n.frac milli-seconds)])} + (n.frac milli_seconds)])} ## Default (do io.monad [_ (atom.update (|>> (#.Cons {#creation (.nat ("lux io current-time")) - #delay milli-seconds + #delay milli_seconds #action action})) ..runner)] (wrap [])))) (for {@.old - (as-is) + (as_is) @.jvm - (as-is) + (as_is) @.js - (as-is)} + (as_is)} ## Default - (as-is (exception: #export cannot-continue-running-threads) + (as_is (exception: #export cannot_continue_running_threads) (def: #export (run! _) (-> Any (IO Any)) @@ -139,11 +139,11 @@ (n.+ (get@ #delay thread)) (n.<= now))) threads)] - swapped? (atom.compare-and-swap threads pending ..runner)] + swapped? (atom.compare_and_swap threads pending ..runner)] (if swapped? (do ! [_ (monad.map ! (get@ #action) ready)] (run! [])) - (error! (ex.construct ..cannot-continue-running-threads [])))) + (error! (ex.construct ..cannot_continue_running_threads [])))) ))) )) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index ca5a4d183..df79b2c2d 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -8,7 +8,7 @@ ["." function] [parser ["s" code]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]]) @@ -39,8 +39,8 @@ (syntax: #export (pending expr) {#.doc (doc "Turns any expression into a function that is pending a continuation." - (pending (some-function some-input)))} - (with-gensyms [g!_ g!k] + (pending (some_function some_input)))} + (with_gensyms [g!_ g!k] (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) (def: #export (reset scope) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 71bb9ca90..9d7b7acca 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -31,7 +31,7 @@ (def: #export (match? exception error) (All [e] (-> (Exception e) Text Bit)) - (text.starts-with? (get@ #label exception) error)) + (text.starts_with? (get@ #label exception) error)) (def: #export (catch exception then try) {#.doc (doc "If a particular exception is detected on a possibly-erroneous value, handle it." @@ -45,14 +45,14 @@ (#//.Failure error) (let [reference (get@ #label exception)] - (if (text.starts-with? reference error) + (if (text.starts_with? reference error) (#//.Success (|> error (text.clip (text.size reference) (text.size error)) maybe.assume then)) (#//.Failure error))))) -(def: #export (otherwise to-do try) +(def: #export (otherwise to_do try) {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} (All [a] (-> (-> Text a) (Try a) a)) @@ -61,7 +61,7 @@ output (#//.Failure error) - (to-do error))) + (to_do error))) (def: #export (return value) {#.doc "A way to lift normal values into the error-handling context."} @@ -85,57 +85,57 @@ (..throw exception message))) (syntax: #export (exception: {export |export|.parser} - {t-vars (p.default (list) (s.tuple scr.type-variables))} - {[name inputs] (p.either (p.and s.local-identifier (wrap (list))) - (s.form (p.and s.local-identifier (p.some scr.typed-input))))} + {t_vars (p.default (list) (s.tuple scr.type_variables))} + {[name inputs] (p.either (p.and s.local_identifier (wrap (list))) + (s.form (p.and s.local_identifier (p.some scr.typed_input))))} {body (p.maybe s.any)}) {#.doc (doc "Define a new exception type." "It mostly just serves as a way to tag error messages for later catching." "" "Simple case:" - (exception: #export some-exception) + (exception: #export some_exception) "" "Complex case:" - (exception: #export [optional type variables] (some-exception {optional Text} {arguments Int}) - optional-body))} - (meta.with-gensyms [g!descriptor] + (exception: #export [optional type variables] (some_exception {optional Text} {arguments Int}) + optional_body))} + (meta.with_gensyms [g!descriptor] (do meta.monad - [current-module meta.current-module-name - #let [descriptor ($_ text\compose "{" current-module "." name "}" text.new-line) - g!self (code.local-identifier name)]] + [current_module meta.current_module_name + #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) + g!self (code.local_identifier name)]] (wrap (list (` (def: (~+ (|export|.write export)) (~ g!self) - (All [(~+ (scw.type-variables t-vars))] - (..Exception [(~+ (list\map (get@ #sc.input-type) inputs))])) + (All [(~+ (scw.type_variables t_vars))] + (..Exception [(~+ (list\map (get@ #sc.input_type) inputs))])) (let [(~ g!descriptor) (~ (code.text descriptor))] {#..label (~ g!descriptor) - #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input-binding) inputs))]) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #sc.input_binding) inputs))]) ((~! text\compose) (~ g!descriptor) (~ (maybe.default (' "") body))))}))))) ))) (def: (report' entries) (-> (List [Text Text]) Text) - (let [header-separator ": " - largest-header-size (list\fold (function (_ [header _] max) + (let [header_separator ": " + largest_header_size (list\fold (function (_ [header _] max) (n.max (text.size header) max)) 0 entries) - on-new-line (|> " " - (list.repeat (n.+ (text.size header-separator) - largest-header-size)) - (text.join-with "") - (text\compose text.new-line))] + on_new_line (|> " " + (list.repeat (n.+ (text.size header_separator) + largest_header_size)) + (text.join_with "") + (text\compose text.new_line))] (|> entries (list\map (function (_ [header message]) (let [padding (|> " " (list.repeat (n.- (text.size header) - largest-header-size)) - (text.join-with ""))] + largest_header_size)) + (text.join_with ""))] (|> message - (text.replace-all text.new-line on-new-line) - ($_ text\compose padding header header-separator))))) - (text.join-with text.new-line)))) + (text.replace_all text.new_line on_new_line) + ($_ text\compose padding header header_separator))))) + (text.join_with text.new_line)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) (wrap (list (` ((~! report') (list (~+ (|> entries @@ -152,11 +152,11 @@ report')) (def: separator - (let [gap ($_ "lux text concat" text.new-line text.new-line) - horizontal-line (|> "-" (list.repeat 64) (text.join-with ""))] + (let [gap ($_ "lux text concat" text.new_line text.new_line) + horizontal_line (|> "-" (list.repeat 64) (text.join_with ""))] ($_ "lux text concat" gap - horizontal-line + horizontal_line gap))) (def: (decorate prelude error) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index 9333846fe..02ff4ddf8 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -7,7 +7,7 @@ ["i" int]] [text ["%" format (#+ format)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -17,8 +17,8 @@ (exception.report ["Condition" (%.code condition)]))] - [pre-condition-failed] - [post-condition-failed] + [pre_condition_failed] + [post_condition_failed] ) (def: (assert! message test) @@ -33,7 +33,7 @@ "Otherwise, an error is raised." (pre (i.= +4 (i.+ +2 +2)) (foo +123 +456 +789)))} - (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre-condition-failed test))) + (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) (~ test)) (~ expr)))))) @@ -44,8 +44,8 @@ "Otherwise, an error is raised." (post i.even? (i.+ +2 +2)))} - (with-gensyms [g!output] + (with_gensyms [g!output] (wrap (list (` (let [(~ g!output) (~ expr)] - (exec ((~! ..assert!) (~ (code.text (exception.construct ..post-condition-failed test))) + (exec ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) ((~ test) (~ g!output))) (~ g!output)))))))) diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux index 679e534c3..ff6b8d304 100644 --- a/stdlib/source/lux/control/io.lux +++ b/stdlib/source/lux/control/io.lux @@ -9,7 +9,7 @@ ["s" code]]] [type abstract] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." template]]]) @@ -24,7 +24,7 @@ (|>> :abstraction)) (template: (!io computation) - (:abstraction (template.with-locals [g!func g!arg] + (:abstraction (template.with_locals [g!func g!arg] (function (g!func g!arg) computation)))) @@ -38,7 +38,7 @@ (io (exec (log! msg) "Some value...")))} - (with-gensyms [g!func g!arg] + (with_gensyms [g!func g!arg] (wrap (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) (~ computation)))))))) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 1cb4e2298..8f896cf39 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -163,7 +163,7 @@ (wrap (#.Cons x xs))) (\ ..monad wrap (list)))) -(def: #export (at-least n p) +(def: #export (at_least n p) {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (do ..monad @@ -171,7 +171,7 @@ extra (some p)] (wrap (list\compose min extra)))) -(def: #export (at-most n p) +(def: #export (at_most n p) {#.doc "Parse at most N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n.> 0 n) @@ -182,7 +182,7 @@ (#try.Success [input' x]) (run (do ..monad - [xs (at-most (dec n) p)] + [xs (at_most (dec n) p)] (wrap (#.Cons x xs))) input') )) @@ -192,11 +192,11 @@ {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) (do ..monad - [min-xs (exactly from p) - max-xs (at-most (n.- from to) p)] - (wrap (\ list.monad join (list min-xs max-xs))))) + [min_xs (exactly from p) + max_xs (at_most (n.- from to) p)] + (wrap (\ list.monad join (list min_xs max_xs))))) -(def: #export (sep-by sep p) +(def: #export (sep_by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) (do {! ..monad} @@ -315,8 +315,8 @@ (#try.Failure error) (#try.Failure error) - (#try.Success [input' to-decode]) - (case (\ codec decode to-decode) + (#try.Success [input' to_decode]) + (case (\ codec decode to_decode) (#try.Failure error) (#try.Failure error) diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux index d62dca0e8..6a7a1c407 100644 --- a/stdlib/source/lux/control/parser/analysis.lux +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -26,19 +26,19 @@ ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]]] ["." //]) -(def: (remaining-inputs asts) +(def: (remaining_inputs asts) (-> (List Analysis) Text) - (format text.new-line "Remaining input: " + (format text.new_line "Remaining input: " (|> asts (list\map /.%analysis) (list.interpose " ") - (text.join-with "")))) + (text.join_with "")))) -(exception: #export (cannot-parse {input (List Analysis)}) +(exception: #export (cannot_parse {input (List Analysis)}) (exception.report ["Input" (exception.enumerate /.%analysis input)])) -(exception: #export (unconsumed-input {input (List Analysis)}) +(exception: #export (unconsumed_input {input (List Analysis)}) (exception.report ["Input" (exception.enumerate /.%analysis input)])) @@ -55,14 +55,14 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed-input unconsumed))) + (exception.throw ..unconsumed_input unconsumed))) (def: #export any (Parser Analysis) (function (_ input) (case input #.Nil - (exception.throw ..cannot-parse input) + (exception.throw ..cannot_parse input) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -74,7 +74,7 @@ (case tokens #.Nil (#try.Success [tokens []]) _ (#try.Failure (format "Expected list of tokens to be empty!" - (remaining-inputs tokens)))))) + (remaining_inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -93,7 +93,7 @@ (#try.Success [input' x]) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export (<assertion> expected) (-> <type> (Parser Any)) @@ -102,10 +102,10 @@ (^ (list& (<tag> actual) input')) (if (\ <eq> = expected actual) (#try.Success [input' []]) - (exception.throw ..cannot-parse input)) + (exception.throw ..cannot_parse input)) _ - (exception.throw ..cannot-parse input))))] + (exception.throw ..cannot_parse input))))] [bit bit! /.bit Bit bit.equivalence] [nat nat! /.nat Nat nat.equivalence] @@ -128,4 +128,4 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 03bcc9eba..32750d535 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -28,10 +28,10 @@ (type: #export Parser (//.Parser [Offset Binary])) -(exception: #export (binary-was-not-fully-read {binary-length Nat} {bytes-read Nat}) +(exception: #export (binary_was_not_fully_read {binary_length Nat} {bytes_read Nat}) (exception.report - ["Binary length" (%.nat binary-length)] - ["Bytes read" (%.nat bytes-read)])) + ["Binary length" (%.nat binary_length)] + ["Bytes read" (%.nat bytes_read)])) (def: #export (run parser input) (All [a] (-> (Parser a) Binary (Try a))) @@ -43,7 +43,7 @@ (let [length (/.size input)] (if (n.= end length) (#try.Success output) - (exception.throw ..binary-was-not-fully-read [length end]))))) + (exception.throw ..binary_was_not_fully_read [length end]))))) (def: #export end? (Parser Bit) @@ -94,9 +94,9 @@ (def: #export frac (Parser Frac) - (//\map frac.from-bits ..bits/64)) + (//\map frac.from_bits ..bits/64)) -(exception: #export (invalid-tag {range Nat} {byte Nat}) +(exception: #export (invalid_tag {range Nat} {byte Nat}) (exception.report ["Tag range" (%.nat range)] ["Tag value" (%.nat byte)])) @@ -109,7 +109,7 @@ (^template [<number> <tag> <parser>] [<number> (\ ! map (|>> <tag>) <parser>)]) ((~~ (template.splice <case>+))) - _ (//.lift (exception.throw ..invalid-tag [(~~ (template.count <case>+)) flag])))))) + _ (//.lift (exception.throw ..invalid_tag [(~~ (template.count <case>+)) flag])))))) (def: #export (or left right) (All [l r] (-> (Parser l) (Parser r) (Parser (| l r)))) @@ -126,7 +126,7 @@ (Parser Any) (//\wrap [])) -(exception: #export (not-a-bit {value Nat}) +(exception: #export (not_a_bit {value Nat}) (exception.report ["Expected values" "either 0 or 1"] ["Actual value" (%.nat value)])) @@ -139,7 +139,7 @@ (case value 0 (wrap #0) 1 (wrap #1) - _ (//.lift (exception.throw ..not-a-bit [value]))))) + _ (//.lift (exception.throw ..not_a_bit [value]))))) (def: #export (segment size) (-> Nat (Parser Binary)) @@ -214,14 +214,14 @@ (|>> (//.and value) (..or ..any)))) -(exception: #export set-elements-are-not-unique) +(exception: #export set_elements_are_not_unique) (def: #export (set hash value) (All [a] (-> (Hash a) (Parser a) (Parser (Set a)))) (do //.monad [raw (..list value) - #let [output (set.from-list hash raw)] - _ (//.assert (exception.construct ..set-elements-are-not-unique []) + #let [output (set.from_list hash raw)] + _ (//.assert (exception.construct ..set_elements_are_not_unique []) (n.= (list.size raw) (set.size output)))] (wrap output))) diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux index de654eb24..7df6e448e 100644 --- a/stdlib/source/lux/control/parser/cli.lux +++ b/stdlib/source/lux/control/parser/cli.lux @@ -10,7 +10,7 @@ ["." list ("#\." monoid monad)]] ["." text ("#\." equivalence) ["%" format (#+ format)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]] @@ -34,7 +34,7 @@ (#try.Success output) _ - (#try.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining)))) + (#try.Failure (format "Remaining CLI inputs: " (text.join_with " " remaining)))) (#try.Failure try) (#try.Failure try))) @@ -83,10 +83,10 @@ #.Nil (#try.Failure try) - (#.Cons to-omit immediate') + (#.Cons to_omit immediate') (do try.monad [[remaining output] (recur immediate')] - (wrap [(#.Cons to-omit remaining) + (wrap [(#.Cons to_omit remaining) output]))))))) (def: #export end @@ -95,7 +95,7 @@ (function (_ inputs) (case inputs #.Nil (#try.Success [inputs []]) - _ (#try.Failure (format "Unknown parameters: " (text.join-with " " inputs)))))) + _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) (def: #export (named name value) (All [a] (-> Text (Parser a) (Parser a))) @@ -109,27 +109,27 @@ (//.after (//.either (..this short) (..this long))) ..somewhere)) -(type: Program-Args +(type: Program_Args (#Raw Text) (#Parsed (List [Code Code]))) -(def: program-args^ - (s.Parser Program-Args) - (//.or s.local-identifier +(def: program_args^ + (s.Parser Program_Args) + (//.or s.local_identifier (s.tuple (//.some (//.either (do //.monad - [name s.local-identifier] + [name s.local_identifier] (wrap [(code.identifier ["" name]) (` any)])) (s.record (//.and s.any s.any))))))) (syntax: #export (program: - {args program-args^} + {args program_args^} body) {#.doc (doc "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." - (program: all-args + (program: all_args (do io.monad - [foo init-program - bar (do-something all-args)] + [foo init_program + bar (do_something all_args)] (wrap []))) (program: [name] @@ -137,10 +137,10 @@ (program: [{config config^}] (do io.monad - [data (init-program config)] - (do-something data))))} - (with-gensyms [g!program g!args g!_ g!output g!message] - (let [initialization+event-loop + [data (init_program config)] + (do_something data))))} + (with_gensyms [g!program g!args g!_ g!output g!message] + (let [initialization+event_loop (` ((~! do) (~! io.monad) [(~ g!output) (~ body) (~+ (for {@.old @@ -158,7 +158,7 @@ (#Raw args) (wrap (list (` ("lux def program" (.function ((~ g!program) (~ (code.identifier ["" args]))) - (~ initialization+event-loop)))))) + (~ initialization+event_loop)))))) (#Parsed args) (wrap (list (` ("lux def program" @@ -169,7 +169,7 @@ (list\map (function (_ [binding parser]) (list binding parser))) list\join))] - ((~' wrap) (~ initialization+event-loop)))) + ((~' wrap) (~ initialization+event_loop)))) (~ g!args)) (#.Right [(~ g!_) (~ g!output)]) (~ g!output) diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux index 9dc99e49a..82f5fbca8 100644 --- a/stdlib/source/lux/control/parser/code.lux +++ b/stdlib/source/lux/control/parser/code.lux @@ -19,20 +19,20 @@ ["." code ("#\." equivalence)]]] ["." //]) -(def: (join-pairs pairs) +(def: (join_pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs #.Nil #.Nil - (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) (type: #export Parser {#.doc "A Lux syntax parser."} (//.Parser (List Code))) -(def: (remaining-inputs asts) +(def: (remaining_inputs asts) (-> (List Code) Text) - ($_ text\compose text.new-line "Remaining input: " - (|> asts (list\map code.format) (list.interpose " ") (text.join-with "")))) + ($_ text\compose text.new_line "Remaining input: " + (|> asts (list\map code.format) (list.interpose " ") (text.join_with "")))) (def: #export any {#.doc "Just returns the next input without applying any logic."} @@ -46,7 +46,7 @@ (#try.Success [tokens' t])))) (template [<query> <check> <type> <tag> <eq> <desc>] - [(with-expansions [<failure> (as-is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))] + [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))] (def: #export <query> {#.doc (code.text ($_ text\compose "Parses the next " <desc> " input."))} (Parser <type>) @@ -89,13 +89,13 @@ (if (code\= ast token) (#try.Success [tokens' []]) (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token) - (remaining-inputs tokens)))) + (remaining_inputs tokens)))) _ (#try.Failure "There are no tokens to parse!")))) (template [<query> <check> <tag> <eq> <desc>] - [(with-expansions [<failure> (as-is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))] + [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))] (def: #export <query> {#.doc (code.text ($_ text\compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))} (Parser Text) @@ -119,8 +119,8 @@ _ <failure>))))] - [local-identifier local-identifier! #.Identifier text.equivalence "local identifier"] - [ local-tag local-tag! #.Tag text.equivalence "local tag"] + [local_identifier local_identifier! #.Identifier text.equivalence "local identifier"] + [ local_tag local_tag! #.Tag text.equivalence "local tag"] ) (template [<name> <tag> <desc>] @@ -133,10 +133,10 @@ (#.Cons [[_ (<tag> members)] tokens']) (case (p members) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining_inputs tokens)))) _ - (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))))] [ form #.Form "form"] [tuple #.Tuple "tuple"] @@ -149,12 +149,12 @@ (function (_ tokens) (case tokens (#.Cons [[_ (#.Record pairs)] tokens']) - (case (p (join-pairs pairs)) + (case (p (join_pairs pairs)) (#try.Success [#.Nil x]) (#try.Success [tokens' x]) - _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining-inputs tokens)))) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens)))) _ - (#try.Failure ($_ text\compose "Cannot parse record" (remaining-inputs tokens)))))) + (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens)))))) (def: #export end! {#.doc "Ensures there are no more inputs."} @@ -162,7 +162,7 @@ (function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens)))))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -186,7 +186,7 @@ _ (#try.Failure (text\compose "Unconsumed inputs: " (|> (list\map code.format unconsumed) - (text.join-with ", "))))))) + (text.join_with ", "))))))) (def: #export (local inputs syntax) {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux index a7cf8fa9f..9035d41fe 100644 --- a/stdlib/source/lux/control/parser/json.lux +++ b/stdlib/source/lux/control/parser/json.lux @@ -24,11 +24,11 @@ {#.doc "JSON parser."} (//.Parser (List JSON) a)) -(exception: #export (unconsumed-input {input (List JSON)}) +(exception: #export (unconsumed_input {input (List JSON)}) (exception.report ["Input" (exception.enumerate /.format input)])) -(exception: #export empty-input) +(exception: #export empty_input) (def: #export (run parser json) (All [a] (-> (Parser a) JSON (Try a))) @@ -39,7 +39,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed-input remainder)) + (exception.throw ..unconsumed_input remainder)) (#try.Failure error) (#try.Failure error))) @@ -50,12 +50,12 @@ (<| (function (_ inputs)) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (#try.Success [tail head])))) -(exception: #export (unexpected-value {value JSON}) +(exception: #export (unexpected_value {value JSON}) (exception.report ["Value" (/.format value)])) @@ -70,7 +70,7 @@ (wrap value) _ - (//.fail (exception.construct ..unexpected-value [head])))))] + (//.fail (exception.construct ..unexpected_value [head])))))] [null /.Null #/.Null "null"] [boolean /.Boolean #/.Boolean "boolean"] @@ -78,7 +78,7 @@ [string /.String #/.String "string"] ) -(exception: #export [a] (value-mismatch {reference JSON} {sample JSON}) +(exception: #export [a] (value_mismatch {reference JSON} {sample JSON}) (exception.report ["Reference" (/.format reference)] ["Sample" (/.format sample)])) @@ -94,7 +94,7 @@ (wrap (\ <equivalence> = test value)) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) (def: #export (<check> test) {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " <desc> "."))} @@ -105,10 +105,10 @@ (<tag> value) (if (\ <equivalence> = test value) (wrap []) - (//.fail (exception.construct ..value-mismatch [(<tag> test) (<tag> value)]))) + (//.fail (exception.construct ..value_mismatch [(<tag> test) (<tag> value)]))) _ - (//.fail (exception.construct ..unexpected-value [head])))))] + (//.fail (exception.construct ..unexpected_value [head])))))] [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] [number? number! /.Number frac.equivalence #/.Number "number"] @@ -127,7 +127,7 @@ [head ..any] (case head (#/.Array values) - (case (//.run parser (row.to-list values)) + (case (//.run parser (row.to_list values)) (#try.Failure error) (//.fail error) @@ -137,10 +137,10 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) (def: #export (object parser) {#.doc "Parses a JSON object. Use this with the 'field' combinator."} @@ -164,24 +164,24 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected-value [head]))))) + (//.fail (exception.construct ..unexpected_value [head]))))) -(def: #export (field field-name parser) +(def: #export (field field_name parser) {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} (All [a] (-> Text (Parser a) (Parser a))) (function (recur inputs) (case inputs (^ (list& (#/.String key) value inputs')) - (if (text\= key field-name) + (if (text\= key field_name) (case (//.run parser (list value)) (#try.Success [#.Nil output]) (#try.Success [inputs' output]) (#try.Success [inputs'' _]) - (exception.throw ..unconsumed-input inputs'') + (exception.throw ..unconsumed_input inputs'') (#try.Failure error) (#try.Failure error)) @@ -191,10 +191,10 @@ output]))) #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) _ - (exception.throw ..unconsumed-input inputs)))) + (exception.throw ..unconsumed_input inputs)))) (def: #export dictionary {#.doc "Parses a dictionary-like JSON object."} @@ -202,4 +202,4 @@ (|>> (//.and ..string) //.some ..object - (//\map (dictionary.from-list text.hash)))) + (//\map (dictionary.from_list text.hash)))) diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux index e5b0bda2a..ad376d059 100644 --- a/stdlib/source/lux/control/parser/synthesis.lux +++ b/stdlib/source/lux/control/parser/synthesis.lux @@ -30,24 +30,24 @@ Type (type (List Synthesis))) -(exception: #export (cannot-parse {input ..Input}) +(exception: #export (cannot_parse {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (unconsumed-input {input ..Input}) +(exception: #export (unconsumed_input {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (expected-empty-input {input ..Input}) +(exception: #export (expected_empty_input {input ..Input}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (wrong-arity {expected Arity} {actual Arity}) +(exception: #export (wrong_arity {expected Arity} {actual Arity}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(exception: #export empty-input) +(exception: #export empty_input) (type: #export Parser (//.Parser ..Input)) @@ -62,14 +62,14 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed-input unconsumed))) + (exception.throw ..unconsumed_input unconsumed))) (def: #export any (Parser Synthesis) (.function (_ input) (case input #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -80,7 +80,7 @@ (.function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (exception.throw ..expected-empty-input [tokens])))) + _ (exception.throw ..expected_empty_input [tokens])))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -99,7 +99,7 @@ (#try.Success [input' x]) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export (<assertion> expected) (-> <type> (Parser Any)) @@ -108,10 +108,10 @@ (^ (list& (<tag> actual) input')) (if (\ <eq> = expected actual) (#try.Success [input' []]) - (exception.throw ..cannot-parse input)) + (exception.throw ..cannot_parse input)) _ - (exception.throw ..cannot-parse input))))] + (exception.throw ..cannot_parse input))))] [bit bit! /.bit Bit bit.equivalence] [i64 i64! /.i64 (I64 Any) i64.equivalence] @@ -132,7 +132,7 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) (def: #export (function expected parser) (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) @@ -143,20 +143,20 @@ (do try.monad [output (..run parser (list body))] (#try.Success [tail [environment output]])) - (exception.throw ..wrong-arity [expected actual])) + (exception.throw ..wrong_arity [expected actual])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) -(def: #export (loop init-parsers iteration-parser) +(def: #export (loop init_parsers iteration_parser) (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b]))) (.function (_ input) (case input (^ (list& (/.loop/scope [start inits iteration]) tail)) (do try.monad - [inits (..run init-parsers inits) - iteration (..run iteration-parser (list iteration))] + [inits (..run init_parsers inits) + iteration (..run iteration_parser (list iteration))] (#try.Success [tail [start inits iteration]])) _ - (exception.throw ..cannot-parse input)))) + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux index ebcf3c53a..919de78c4 100644 --- a/stdlib/source/lux/control/parser/text.lux +++ b/stdlib/source/lux/control/parser/text.lux @@ -19,7 +19,7 @@ (type: #export Offset Nat) -(def: start-offset Offset 0) +(def: start_offset Offset 0) (type: #export Parser (//.Parser [Offset Text])) @@ -32,37 +32,37 @@ (-> Offset Text Text) (|> tape (/.split offset) maybe.assume product.right)) -(exception: #export (unconsumed-input {offset Offset} {tape Text}) +(exception: #export (unconsumed_input {offset Offset} {tape Text}) (exception.report ["Offset" (n\encode offset)] ["Input size" (n\encode (/.size tape))] ["Remaining input" (remaining offset tape)])) -(exception: #export (expected-to-fail {offset Offset} {tape Text}) +(exception: #export (expected_to_fail {offset Offset} {tape Text}) (exception.report ["Offset" (n\encode offset)] ["Input" (remaining offset tape)])) -(exception: #export cannot-parse) -(exception: #export cannot-slice) +(exception: #export cannot_parse) +(exception: #export cannot_slice) (def: #export (run parser input) (All [a] (-> (Parser a) Text (Try a))) - (case (parser [start-offset input]) + (case (parser [start_offset input]) (#try.Failure msg) (#try.Failure msg) - (#try.Success [[end-offset _] output]) - (if (n.= end-offset (/.size input)) + (#try.Success [[end_offset _] output]) + (if (n.= end_offset (/.size input)) (#try.Success output) - (exception.throw ..unconsumed-input [end-offset input])))) + (exception.throw ..unconsumed_input [end_offset input])))) (def: #export offset (Parser Offset) (function (_ (^@ input [offset tape])) (#try.Success [input offset]))) -(def: (with-slices parser) +(def: (with_slices parser) (-> (Parser (List Slice)) (Parser Slice)) (do //.monad [offset ..offset @@ -80,10 +80,10 @@ (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (#try.Success [[("lux i64 +" 1 offset) tape] (/.from-code output)]) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) (def: #export any! {#.doc "Just returns the next character without applying any logic."} @@ -96,7 +96,7 @@ #distance 1}]) _ - (exception.throw ..cannot-slice [])))) + (exception.throw ..cannot_slice [])))) (template [<name> <type> <any>] [(def: #export (<name> p) @@ -108,13 +108,13 @@ (<any> input) _ - (exception.throw ..expected-to-fail input))))] + (exception.throw ..expected_to_fail input))))] [not Text ..any] [not! Slice ..any!] ) -(exception: #export (cannot-match {reference Text}) +(exception: #export (cannot_match {reference Text}) (exception.report ["Reference" (/.encode reference)])) @@ -122,15 +122,15 @@ {#.doc "Lex a text if it matches the given sample."} (-> Text (Parser Any)) (function (_ [offset tape]) - (case (/.index-of' reference offset tape) + (case (/.index_of' reference offset tape) (#.Some where) (if (n.= offset where) (#try.Success [[("lux i64 +" (/.size reference) offset) tape] []]) - (exception.throw ..cannot-match [reference])) + (exception.throw ..cannot_match [reference])) _ - (exception.throw ..cannot-match [reference])))) + (exception.throw ..cannot_match [reference])))) (def: #export end! {#.doc "Ensure the parser's input is empty."} @@ -138,7 +138,7 @@ (function (_ (^@ input [offset tape])) (if (n.= offset (/.size tape)) (#try.Success [input []]) - (exception.throw ..unconsumed-input input)))) + (exception.throw ..unconsumed_input input)))) (def: #export peek {#.doc "Lex the next character (without consuming it from the input)."} @@ -146,12 +146,12 @@ (function (_ (^@ input [offset tape])) (case (/.nth offset tape) (#.Some output) - (#try.Success [input (/.from-code output)]) + (#try.Success [input (/.from_code output)]) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) -(def: #export get-input +(def: #export get_input {#.doc "Get all of the remaining input (without consuming it)."} (Parser Text) (function (_ (^@ input [offset tape])) @@ -163,7 +163,7 @@ (do //.monad [char any #let [char' (maybe.assume (/.nth 0 char))] - _ (//.assert ($_ /\compose "Character is not within range: " (/.from-code bottom) "-" (/.from-code top)) + _ (//.assert ($_ /\compose "Character is not within range: " (/.from_code bottom) "-" (/.from_code top)) (.and (n.>= bottom char') (n.<= top char')))] (wrap char))) @@ -185,7 +185,7 @@ (Parser Text) (//.either lower upper)) -(def: #export alpha-num +(def: #export alpha_num {#.doc "Only lex alphanumeric characters."} (Parser Text) (//.either alpha decimal)) @@ -202,39 +202,39 @@ [(exception: #export (<name> {options Text} {character Char}) (exception.report ["Options" (/.encode options)] - ["Character" (/.encode (/.from-code character))]))] + ["Character" (/.encode (/.from_code character))]))] - [character-should-be] - [character-should-not-be] + [character_should_be] + [character_should_not_be] ) -(template [<name> <modifier> <exception> <description-modifier>] +(template [<name> <modifier> <exception> <description_modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))} (-> Text (Parser Text)) (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (let [output' (/.from-code output)] + (let [output' (/.from_code output)] (if (<modifier> (/.contains? output' options)) (#try.Success [[("lux i64 +" 1 offset) tape] output']) (exception.throw <exception> [options output]))) _ - (exception.throw ..cannot-parse []))))] + (exception.throw ..cannot_parse []))))] - [one-of |> ..character-should-be ""] - [none-of .not ..character-should-not-be " not"] + [one_of |> ..character_should_be ""] + [none_of .not ..character_should_not_be " not"] ) -(template [<name> <modifier> <exception> <description-modifier>] +(template [<name> <modifier> <exception> <description_modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" <description-modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))} (-> Text (Parser Slice)) (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (let [output' (/.from-code output)] + (let [output' (/.from_code output)] (if (<modifier> (/.contains? output' options)) (#try.Success [[("lux i64 +" 1 offset) tape] {#basis offset @@ -242,15 +242,15 @@ (exception.throw <exception> [options output]))) _ - (exception.throw ..cannot-slice []))))] + (exception.throw ..cannot_slice []))))] - [one-of! |> ..character-should-be ""] - [none-of! .not ..character-should-not-be " not"] + [one_of! |> ..character_should_be ""] + [none_of! .not ..character_should_not_be " not"] ) -(exception: #export (character-does-not-satisfy-predicate {character Char}) +(exception: #export (character_does_not_satisfy_predicate {character Char}) (exception.report - ["Character" (/.encode (/.from-code character))])) + ["Character" (/.encode (/.from_code character))])) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} @@ -259,11 +259,11 @@ (case (/.nth offset tape) (#.Some output) (if (p output) - (#try.Success [[("lux i64 +" 1 offset) tape] (/.from-code output)]) - (exception.throw ..character-does-not-satisfy-predicate [output])) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) + (exception.throw ..character_does_not_satisfy_predicate [output])) _ - (exception.throw ..cannot-parse [])))) + (exception.throw ..cannot_parse [])))) (def: #export space {#.doc "Only lex white-space."} @@ -284,9 +284,9 @@ [right::basis right::distance] right] (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) -(template [<name> <base> <doc-modifier>] +(template [<name> <base> <doc_modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))} (-> (Parser Text) (Parser Text)) (|> parser <base> (\ //.monad map /.concat)))] @@ -294,36 +294,36 @@ [many //.many "many"] ) -(template [<name> <base> <doc-modifier>] +(template [<name> <base> <doc_modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))} (-> (Parser Slice) (Parser Slice)) - (with-slices (<base> parser)))] + (with_slices (<base> parser)))] [some! //.some "some"] [many! //.many "many"] ) -(template [<name> <base> <doc-modifier>] +(template [<name> <base> <doc_modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))} (-> Nat (Parser Text) (Parser Text)) (|> parser (<base> amount) (\ //.monad map /.concat)))] [exactly //.exactly "exactly"] - [at-most //.at-most "at most"] - [at-least //.at-least "at least"] + [at_most //.at_most "at most"] + [at_least //.at_least "at least"] ) -(template [<name> <base> <doc-modifier>] +(template [<name> <base> <doc_modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /\compose "Lex " <doc-modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))} (-> Nat (Parser Slice) (Parser Slice)) - (with-slices (<base> amount parser)))] + (with_slices (<base> amount parser)))] [exactly! //.exactly "exactly"] - [at-most! //.at-most "at most"] - [at-least! //.at-least "at least"] + [at_most! //.at_most "at most"] + [at_least! //.at_least "at least"] ) (def: #export (between from to parser) @@ -334,7 +334,7 @@ (def: #export (between! from to parser) {#.doc "Lex between N and M characters."} (-> Nat Nat (Parser Slice) (Parser Slice)) - (with-slices (//.between from to parser))) + (with_slices (//.between from to parser))) (def: #export (enclosed [start end] parser) (All [a] (-> [Text Text] (Parser a) (Parser a))) @@ -342,16 +342,16 @@ (//.before (this end)) (//.after (this start)))) -(def: #export (local local-input parser) +(def: #export (local local_input parser) {#.doc "Run a parser with the given input, instead of the real one."} (All [a] (-> Text (Parser a) (Parser a))) - (function (_ real-input) - (case (..run parser local-input) + (function (_ real_input) + (case (..run parser local_input) (#try.Failure error) (#try.Failure error) (#try.Success value) - (#try.Success [real-input value])))) + (#try.Success [real_input value])))) (def: #export (slice parser) (-> (Parser Slice) (Parser Text)) @@ -363,7 +363,7 @@ (#try.Success [input output]) #.None - (exception.throw ..cannot-slice []))))) + (exception.throw ..cannot_slice []))))) (def: #export (embed structured text) (All [s a] diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index 8ed5004fe..32329abbe 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -25,16 +25,16 @@ (exception.report ["Type" (%.type type)]))] - [not-existential] - [not-recursive] - [not-named] - [not-parameter] - [unknown-parameter] - [not-function] - [not-application] - [not-polymorphic] - [not-variant] - [not-tuple] + [not_existential] + [not_recursive] + [not_named] + [not_parameter] + [unknown_parameter] + [not_function] + [not_application] + [not_polymorphic] + [not_variant] + [not_tuple] ) (template [<name>] @@ -43,17 +43,17 @@ ["Expected" (%.type expected)] ["Actual" (%.type actual)]))] - [types-do-not-match] - [wrong-parameter] + [types_do_not_match] + [wrong_parameter] ) -(exception: #export empty-input) +(exception: #export empty_input) -(exception: #export (unconsumed-input {remaining (List Type)}) +(exception: #export (unconsumed_input {remaining (List Type)}) (exception.report ["Types" (|> remaining - (list\map (|>> %.type (format text.new-line "* "))) - (text.join-with ""))])) + (list\map (|>> %.type (format text.new_line "* "))) + (text.join_with ""))])) (type: #export Env (Dictionary Nat [Type Code])) @@ -77,7 +77,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed-input remaining)))) + (exception.throw ..unconsumed_input remaining)))) (def: #export (run poly type) (All [a] (-> (Parser a) Type (Try a))) @@ -88,7 +88,7 @@ (.function (_ [env inputs]) (#try.Success [[env inputs] env]))) -(def: (with-env temp poly) +(def: (with_env temp poly) (All [a] (-> Env (Parser a) (Parser a))) (.function (_ [env inputs]) (case (//.run poly [temp inputs]) @@ -103,7 +103,7 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env inputs] headT])))) @@ -113,32 +113,32 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Parser a) (Parser a))) - (.function (_ [env pass-through]) + (.function (_ [env pass_through]) (case (run' env poly types) (#try.Failure error) (#try.Failure error) (#try.Success output) - (#try.Success [[env pass-through] output])))) + (#try.Success [[env pass_through] output])))) (def: (label idx) (-> Nat Code) - (code.local-identifier ($_ text\compose "label" text.tab (n\encode idx)))) + (code.local_identifier ($_ text\compose "label" text.tab (n\encode idx)))) -(def: #export (with-extension type poly) +(def: #export (with_extension type poly) (All [a] (-> Type (Parser a) (Parser [Code a]))) (.function (_ [env inputs]) - (let [current-id (dictionary.size env) - g!var (label current-id)] + (let [current_id (dictionary.size env) + g!var (label current_id)] (case (//.run poly - [(dictionary.put current-id [type g!var] env) + [(dictionary.put current_id [type g!var] env) inputs]) (#try.Failure error) (#try.Failure error) @@ -151,78 +151,78 @@ (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT ..any] - (let [members (<flattener> (type.un-name headT))] + (let [members (<flattener> (type.un_name headT))] (if (n.> 1 (list.size members)) (local members poly) (//.fail (exception.construct <exception> headT))))))] - [variant type.flatten-variant #.Sum ..not-variant] - [tuple type.flatten-tuple #.Product ..not-tuple] + [variant type.flatten_variant #.Sum ..not_variant] + [tuple type.flatten_tuple #.Product ..not_tuple] ) (def: polymorphic' (Parser [Nat Type]) (do //.monad [headT any - #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] - (if (n.= 0 num-arg) - (//.fail (exception.construct ..not-polymorphic headT)) - (wrap [num-arg bodyT])))) + #let [[num_arg bodyT] (type.flatten_univ_q (type.un_name headT))]] + (if (n.= 0 num_arg) + (//.fail (exception.construct ..not_polymorphic headT)) + (wrap [num_arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) (do {! //.monad} [headT any funcI (\ ! map dictionary.size ..env) - [num-args non-poly] (local (list headT) ..polymorphic') + [num_args non_poly] (local (list headT) ..polymorphic') env ..env #let [funcL (label funcI) - [all-varsL env'] (loop [current-arg 0 + [all_varsL env'] (loop [current_arg 0 env' env - all-varsL (: (List Code) (list))] - (if (n.< num-args current-arg) - (if (n.= 0 current-arg) + all_varsL (: (List Code) (list))] + (if (n.< num_args current_arg) + (if (n.= 0 current_arg) (let [varL (label (inc funcI))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put funcI [headT funcL]) (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL])) - (#.Cons varL all-varsL))) - (let [partialI (|> current-arg (n.* 2) (n.+ funcI)) - partial-varI (inc partialI) - partial-varL (label partial-varI) - partialC (` ((~ funcL) (~+ (|> (list.indices num-args) + (#.Cons varL all_varsL))) + (let [partialI (|> current_arg (n.* 2) (n.+ funcI)) + partial_varI (inc partialI) + partial_varL (label partial_varI) + partialC (` ((~ funcL) (~+ (|> (list.indices num_args) (list\map (|>> (n.* 2) inc (n.+ funcI) label)) list.reverse))))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put partialI [.Nothing partialC]) - (dictionary.put partial-varI [(#.Parameter partial-varI) partial-varL])) - (#.Cons partial-varL all-varsL)))) - [all-varsL env']))]] - (<| (with-env env') - (local (list non-poly)) + (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL])) + (#.Cons partial_varL all_varsL)))) + [all_varsL env']))]] + (<| (with_env env') + (local (list non_poly)) (do ! [output poly] - (wrap [funcL all-varsL output]))))) + (wrap [funcL all_varsL output]))))) -(def: #export (function in-poly out-poly) +(def: #export (function in_poly out_poly) (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) (do //.monad [headT any - #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] + #let [[inputsT outputT] (type.flatten_function (type.un_name headT))]] (if (n.> 0 (list.size inputsT)) - (//.and (local inputsT in-poly) - (local (list outputT) out-poly)) - (//.fail (exception.construct ..not-function headT))))) + (//.and (local inputsT in_poly) + (local (list outputT) out_poly)) + (//.fail (exception.construct ..not_function headT))))) (def: #export (apply poly) (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT any - #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] + #let [[funcT paramsT] (type.flatten_application (type.un_name headT))]] (if (n.= 0 (list.size paramsT)) - (//.fail (exception.construct ..not-application headT)) + (//.fail (exception.construct ..not_application headT)) (..local (#.Cons funcT paramsT) poly)))) (template [<name> <test>] @@ -232,19 +232,19 @@ [actual any] (if (<test> expected actual) (wrap []) - (//.fail (exception.construct ..types-do-not-match [expected actual])))))] + (//.fail (exception.construct ..types_do_not_match [expected actual])))))] [exactly type\=] [sub check.checks?] [super (function.flip check.checks?)] ) -(def: #export (adjusted-idx env idx) +(def: #export (adjusted_idx env idx) (-> Env Nat Nat) - (let [env-level (n./ 2 (dictionary.size env)) - parameter-level (n./ 2 idx) - parameter-idx (n.% 2 idx)] - (|> env-level dec (n.- parameter-level) (n.* 2) (n.+ parameter-idx)))) + (let [env_level (n./ 2 (dictionary.size env)) + parameter_level (n./ 2 idx) + parameter_idx (n.% 2 idx)] + (|> env_level dec (n.- parameter_level) (n.* 2) (n.+ parameter_idx)))) (def: #export parameter (Parser Code) @@ -253,15 +253,15 @@ headT any] (case headT (#.Parameter idx) - (case (dictionary.get (adjusted-idx env idx) env) - (#.Some [poly-type poly-code]) - (wrap poly-code) + (case (dictionary.get (adjusted_idx env idx) env) + (#.Some [poly_type poly_code]) + (wrap poly_code) #.None - (//.fail (exception.construct ..unknown-parameter headT))) + (//.fail (exception.construct ..unknown_parameter headT))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export (parameter! id) (-> Nat (Parser Any)) @@ -270,23 +270,23 @@ headT any] (case headT (#.Parameter idx) - (if (n.= id (adjusted-idx env idx)) + (if (n.= id (adjusted_idx env idx)) (wrap []) - (//.fail (exception.construct ..wrong-parameter [(#.Parameter id) headT]))) + (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export existential (Parser Nat) (do //.monad [headT any] (case headT - (#.Ex ex-id) - (wrap ex-id) + (#.Ex ex_id) + (wrap ex_id) _ - (//.fail (exception.construct ..not-existential headT))))) + (//.fail (exception.construct ..not_existential headT))))) (def: #export named (Parser [Name Type]) @@ -297,7 +297,7 @@ (wrap [name anonymousT]) _ - (//.fail (exception.construct ..not-named inputT))))) + (//.fail (exception.construct ..not_named inputT))))) (template: (|nothing|) (#.Named ["lux" "Nothing"] @@ -308,33 +308,33 @@ (All [a] (-> (Parser a) (Parser [Code a]))) (do {! //.monad} [headT any] - (case (type.un-name headT) + (case (type.un_name headT) (^ (#.Apply (|nothing|) (#.UnivQ _ headT'))) (do ! [[recT _ output] (|> poly - (with-extension .Nothing) - (with-extension headT) + (with_extension .Nothing) + (with_extension headT) (local (list headT')))] (wrap [recT output])) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-self +(def: #export recursive_self (Parser Code) (do //.monad [env ..env headT any] - (case (type.un-name headT) - (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT-idx))) - (n.= 0 (adjusted-idx env funcT-idx)) - [(dictionary.get 0 env) (#.Some [self-type self-call])]) - (wrap self-call) + (case (type.un_name headT) + (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx))) + (n.= 0 (adjusted_idx env funcT_idx)) + [(dictionary.get 0 env) (#.Some [self_type self_call])]) + (wrap self_call) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-call +(def: #export recursive_call (Parser Code) (do {! //.monad} [env ..env diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux index bc8c6ad93..3b9732ae5 100644 --- a/stdlib/source/lux/control/parser/xml.lux +++ b/stdlib/source/lux/control/parser/xml.lux @@ -19,20 +19,20 @@ (type: #export (Parser a) (//.Parser (List XML) a)) -(exception: #export empty-input) -(exception: #export unexpected-input) +(exception: #export empty_input) +(exception: #export unexpected_input) -(exception: #export (wrong-tag {expected Tag} {actual Tag}) +(exception: #export (wrong_tag {expected Tag} {actual Tag}) (exception.report ["Expected" (%.text (/.tag expected))] ["Actual" (%.text (/.tag actual))])) -(exception: #export (unknown-attribute {expected Attribute} {available (List Attribute)}) +(exception: #export (unknown_attribute {expected Attribute} {available (List Attribute)}) (exception.report ["Expected" (%.text (/.attribute expected))] ["Available" (exception.enumerate (|>> /.attribute %.text) available)])) -(exception: #export (unconsumed-inputs {inputs (List XML)}) +(exception: #export (unconsumed_inputs {inputs (List XML)}) (exception.report ["Inputs" (exception.enumerate (\ /.codec encode) inputs)])) @@ -41,7 +41,7 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (case head @@ -49,36 +49,36 @@ (#try.Success [tail value]) (#/.Node _) - (exception.throw ..unexpected-input []))))) + (exception.throw ..unexpected_input []))))) (def: #export (node expected) (-> Tag (Parser Any)) (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node actual _attributes _children) (if (name\= expected actual) (#try.Success [docs []]) - (exception.throw ..wrong-tag [expected actual])))))) + (exception.throw ..wrong_tag [expected actual])))))) (def: #export tag (Parser Tag) (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node tag _attributes _children) (#try.Success [docs tag]))))) @@ -88,17 +88,17 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node tag attributes children) (case (dictionary.get name attributes) #.None - (exception.throw ..unknown-attribute [name (dictionary.keys attributes)]) + (exception.throw ..unknown_attribute [name (dictionary.keys attributes)]) (#.Some value) (#try.Success [docs value])))))) @@ -109,7 +109,7 @@ (#try.Success [remaining output]) (if (list.empty? remaining) (#try.Success output) - (exception.throw ..unconsumed-inputs remaining)) + (exception.throw ..unconsumed_inputs remaining)) (#try.Failure error) (#try.Failure error))) @@ -119,12 +119,12 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (case head (#/.Text _) - (exception.throw ..unexpected-input []) + (exception.throw ..unexpected_input []) (#/.Node _tag _attributes children) (do try.monad @@ -136,7 +136,7 @@ (function (_ docs) (case docs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons head tail) (#try.Success [tail []])))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index bba7317a9..4c98b5f3f 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -13,7 +13,7 @@ ["i" int]] [collection ["." list ("#\." fold monad)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]]) @@ -57,7 +57,7 @@ (cond> [i.even?] [(i.* +2)] [i.odd?] [(i.* +3)] [(new> -1 [])])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] (cond (~+ (do list.monad [[test then] branches] @@ -83,7 +83,7 @@ (|> +1 (loop> [(i.< +10)] [inc])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (loop [(~ g!temp) (~ prev)] (if (|> (~ g!temp) (~+ test)) ((~' recur) (|> (~ g!temp) (~+ then))) @@ -99,16 +99,16 @@ [(i.* +3)] [(i.+ +4)] [inc])))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (case (list.reverse steps) - (^ (list& last-step prev-steps)) - (let [step-bindings (do list.monad - [step (list.reverse prev-steps)] + (^ (list& last_step prev_steps)) + (let [step_bindings (do list.monad + [step (list.reverse prev_steps)] (list g!temp (` (|> (~ g!temp) (~+ step)))))] (wrap (list (` ((~! do) (~ monad) [(~' #let) [(~ g!temp) (~ prev)] - (~+ step-bindings)] - (|> (~ g!temp) (~+ last-step))))))) + (~+ step_bindings)] + (|> (~ g!temp) (~+ last_step))))))) _ (wrap (list prev))))) @@ -120,7 +120,7 @@ (|> +5 (exec> [.nat %n log!]) (i.* +10)))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] (exec (|> (~ g!temp) (~+ body)) (~ g!temp)))))))) @@ -134,7 +134,7 @@ [dec (i./ +2)] [Int/encode])) "Will become: [+50 +2 '+5']")} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) paths))])))))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 54f6c9fae..f707a748e 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -24,13 +24,13 @@ (def: separator Text - (format text.new-line - "-----------------------------------------" text.new-line - "-----------------------------------------" text.new-line - "-----------------------------------------" text.new-line - text.new-line)) + (format text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + text.new_line)) -(exception: #export [a] (clean-up-error {error Text} +(exception: #export [a] (clean_up_error {error Text} {output (Try a)}) (format error (case output @@ -41,14 +41,14 @@ (format separator error|output)))) -(def: (combine-outcomes clean-up output) +(def: (combine_outcomes clean_up output) (All [a] (-> (Try Any) (Try a) (Try a))) - (case clean-up + (case clean_up (#try.Success _) output (#try.Failure error) - (exception.throw ..clean-up-error [error output]))) + (exception.throw ..clean_up_error [error output]))) (def: #export (run monad computation) (All [! a] @@ -58,7 +58,7 @@ [[cleaners output] (computation [[] (list)]) results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] - (wrap (list\fold combine-outcomes output results)))) + (wrap (list\fold combine_outcomes output results)))) (def: #export (acquire monad cleaner value) (All [! a] (-> (Monad !) (-> a (! (Try Any))) a diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux index 8092fb6a2..aeda22262 100644 --- a/stdlib/source/lux/control/remember.lux +++ b/stdlib/source/lux/control/remember.lux @@ -19,7 +19,7 @@ ["." code] [syntax (#+ syntax:)]]]) -(exception: #export (must-remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) +(exception: #export (must_remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) (exception.report ["Deadline" (%.date deadline)] ["Today" (%.date today)] @@ -34,7 +34,7 @@ (def: deadline (Parser Date) ($_ <>.either - (<>\map (|>> instant.from-millis instant.date) + (<>\map (|>> instant.from_millis instant.date) <c>.int) (do <>.monad [raw <c>.text] @@ -55,7 +55,7 @@ #.None (list))) - (meta.fail (exception.construct ..must-remember [deadline today message focus]))))) + (meta.fail (exception.construct ..must_remember [deadline today message focus]))))) (template [<name> <message>] [(syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) @@ -68,6 +68,6 @@ #.None (list))))))))] - [to-do "TODO"] - [fix-me "FIXME"] + [to_do "TODO"] + [fix_me "FIXME"] ) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 2a4e5427b..8d1ef44ad 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -46,18 +46,18 @@ (syntax: #export (capability: {export |export|.parser} {declaration reader.declaration} {annotations (<>.maybe reader.annotations)} - {[forge input output] (<c>.form ($_ <>.and <c>.local-identifier <c>.any <c>.any))}) + {[forge input output] (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))}) (do {! meta.monad} - [this-module meta.current-module-name + [this_module meta.current_module_name #let [[name vars] declaration] g!brand (\ ! map (|>> %.code code.text) - (meta.gensym (format (%.name [this-module name])))) + (meta.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (|export|.write export)) (~ (writer.declaration declaration)) (~ capability))) - (` (def: (~ (code.local-identifier forge)) - (All [(~+ (list\map code.local-identifier vars))] + (` (def: (~ (code.local_identifier forge)) + (All [(~+ (list\map code.local_identifier vars))] (-> (-> (~ input) (~ output)) (~ capability))) (~! ..forge))) diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux index fac867520..56b8d6b11 100644 --- a/stdlib/source/lux/control/security/policy.lux +++ b/stdlib/source/lux/control/security/policy.lux @@ -12,23 +12,23 @@ (abstract: #export (Policy brand value label) value - (capability: #export (Can-Upgrade brand label value) + (capability: #export (Can_Upgrade brand label value) {#.doc (doc "Represents the capacity to 'upgrade' a value.")} - (can-upgrade value (Policy brand value label))) + (can_upgrade value (Policy brand value label))) - (capability: #export (Can-Downgrade brand label value) + (capability: #export (Can_Downgrade brand label value) {#.doc (doc "Represents the capacity to 'downgrade' a value.")} - (can-downgrade (Policy brand value label) value)) + (can_downgrade (Policy brand value label) value)) (type: #export (Privilege brand label) {#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")} - {#can-upgrade (Can-Upgrade brand label) - #can-downgrade (Can-Downgrade brand label)}) + {#can_upgrade (Can_Upgrade brand label) + #can_downgrade (Can_Downgrade brand label)}) (def: privilege Privilege - {#can-upgrade (..can-upgrade (|>> :abstraction)) - #can-downgrade (..can-downgrade (|>> :representation))}) + {#can_upgrade (..can_upgrade (|>> :abstraction)) + #can_downgrade (..can_downgrade (|>> :representation))}) (type: #export (Delegation brand from to) {#.doc (doc "Represents the act of delegating policy capacities.")} @@ -39,7 +39,7 @@ (def: #export (delegation downgrade upgrade) {#.doc (doc "Delegating policy capacities.")} (All [brand from to] - (-> (Can-Downgrade brand from) (Can-Upgrade brand to) + (-> (Can_Downgrade brand from) (Can_Upgrade brand to) (Delegation brand from to))) (|>> (!.use downgrade) (!.use upgrade))) @@ -48,7 +48,7 @@ (-> (Privilege brand label) (scope label))) - (def: #export (with-policy context) + (def: #export (with_policy context) (All [brand scope] (Ex [label] (-> (Context brand scope label) @@ -85,10 +85,10 @@ Any (type: #export <value> (Policy <brand>)) - (type: #export <upgrade> (Can-Upgrade <brand>)) - (type: #export <downgrade> (Can-Downgrade <brand>)) + (type: #export <upgrade> (Can_Upgrade <brand>)) + (type: #export <downgrade> (Can_Downgrade <brand>)) )] - [Privacy Private Can-Conceal Can-Reveal] - [Safety Safe Can-Trust Can-Distrust] + [Privacy Private Can_Conceal Can_Reveal] + [Safety Safe Can_Trust Can_Distrust] ) diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index 94a01b0f7..3cc00bf0a 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -112,7 +112,7 @@ (#Failure message) (error! message))) -(def: #export (to-maybe try) +(def: #export (to_maybe try) (All [a] (-> (Try a) (Maybe a))) (case try (#Success value) @@ -121,14 +121,14 @@ (#Failure message) #.None)) -(def: #export (from-maybe maybe) +(def: #export (from_maybe maybe) (All [a] (-> (Maybe a) (Try a))) (case maybe (#.Some value) (#Success value) #.None - (#Failure (("lux in-module" "lux" .name\encode) (name-of ..from-maybe))))) + (#Failure (("lux in-module" "lux" .name\encode) (name_of ..from_maybe))))) (macro: #export (default tokens compiler) {#.doc (doc "Allows you to provide a default value that will be used" diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index 12c50328b..a9c2de090 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -20,7 +20,7 @@ [collection ["." array]]]]) -(exception: #export (index-out-of-bounds {size Nat} {index Nat}) +(exception: #export (index_out_of_bounds {size Nat} {index Nat}) (exception.report ["Size" (%.nat size)] ["Index" (%.nat index)])) @@ -32,11 +32,11 @@ ["From" (%.nat from)] ["To" (%.nat to)]))] - [slice-out-of-bounds] - [inverted-slice] + [slice_out_of_bounds] + [inverted_slice] ) -(with-expansions [<for-jvm> (as-is (type: #export Binary (host.type [byte])) +(with_expansions [<for_jvm> (as_is (type: #export Binary (host.type [byte])) (host.import: java/lang/Object) @@ -49,29 +49,29 @@ (#static copyOfRange [[byte] int int] [byte]) (#static equals [[byte] [byte]] boolean)]) - (def: byte-mask + (def: byte_mask I64 - (|> i64.bits-per-byte i64.mask .i64)) + (|> i64.bits_per_byte i64.mask .i64)) (def: i64 (-> (primitive "java.lang.Byte") I64) - (|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask))) + (|>> host.byte_to_long (:coerce I64) (i64.and ..byte_mask))) (def: byte (-> (I64 Any) (primitive "java.lang.Byte")) (for {@.old - (|>> .int host.long-to-byte) + (|>> .int host.long_to_byte) @.jvm - (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)})))] + (|>> .int (:coerce (primitive "java.lang.Long")) host.long_to_byte)})))] (for {@.old - (as-is <for-jvm>) + (as_is <for_jvm>) @.jvm - (as-is <for-jvm>) + (as_is <for_jvm>) @.js - (as-is (host.import: ArrayBuffer + (as_is (host.import: ArrayBuffer (new [host.Number])) (host.import: Uint8Array @@ -83,20 +83,20 @@ (template: (!size binary) (for {@.old - (host.array-length binary) + (host.array_length binary) @.jvm - (host.array-length binary) + (host.array_length binary) @.js (f.nat (Uint8Array::length binary))})) (template: (!read idx binary) (for {@.old - (..i64 (host.array-read idx binary)) + (..i64 (host.array_read idx binary)) @.jvm - (..i64 (host.array-read idx binary)) + (..i64 (host.array_read idx binary)) @.js (|> binary @@ -108,10 +108,10 @@ (template: (!write idx value binary) (for {@.old - (host.array-write idx (..byte value) binary) + (host.array_write idx (..byte value) binary) @.jvm - (host.array-write idx (..byte value) binary) + (host.array_write idx (..byte value) binary) @.js (|> binary @@ -148,39 +148,39 @@ (-> Nat Binary (Try I64)) (if (n.< (..!size binary) idx) (#try.Success (!read idx binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/16 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 1 idx)) (#try.Success ($_ i64.or - (i64.left-shift 8 (!read idx binary)) + (i64.left_shift 8 (!read idx binary)) (!read (n.+ 1 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/32 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 3 idx)) (#try.Success ($_ i64.or - (i64.left-shift 24 (!read idx binary)) - (i64.left-shift 16 (!read (n.+ 1 idx) binary)) - (i64.left-shift 8 (!read (n.+ 2 idx) binary)) + (i64.left_shift 24 (!read idx binary)) + (i64.left_shift 16 (!read (n.+ 1 idx) binary)) + (i64.left_shift 8 (!read (n.+ 2 idx) binary)) (!read (n.+ 3 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/64 idx binary) (-> Nat Binary (Try I64)) (if (n.< (..!size binary) (n.+ 7 idx)) (#try.Success ($_ i64.or - (i64.left-shift 56 (!read idx binary)) - (i64.left-shift 48 (!read (n.+ 1 idx) binary)) - (i64.left-shift 40 (!read (n.+ 2 idx) binary)) - (i64.left-shift 32 (!read (n.+ 3 idx) binary)) - (i64.left-shift 24 (!read (n.+ 4 idx) binary)) - (i64.left-shift 16 (!read (n.+ 5 idx) binary)) - (i64.left-shift 8 (!read (n.+ 6 idx) binary)) + (i64.left_shift 56 (!read idx binary)) + (i64.left_shift 48 (!read (n.+ 1 idx) binary)) + (i64.left_shift 40 (!read (n.+ 2 idx) binary)) + (i64.left_shift 32 (!read (n.+ 3 idx) binary)) + (i64.left_shift 24 (!read (n.+ 4 idx) binary)) + (i64.left_shift 16 (!read (n.+ 5 idx) binary)) + (i64.left_shift 8 (!read (n.+ 6 idx) binary)) (!read (n.+ 7 idx) binary))) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/8 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) @@ -188,42 +188,42 @@ (exec (|> binary (!write idx value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/16 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 1 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 8 value)) (!write (n.+ 1 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/32 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 3 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 24 value)) - (!write (n.+ 1 idx) (i64.logic-right-shift 16 value)) - (!write (n.+ 2 idx) (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 24 value)) + (!write (n.+ 1 idx) (i64.logic_right_shift 16 value)) + (!write (n.+ 2 idx) (i64.logic_right_shift 8 value)) (!write (n.+ 3 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/64 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) (n.+ 7 idx)) (exec (|> binary - (!write idx (i64.logic-right-shift 56 value)) - (!write (n.+ 1 idx) (i64.logic-right-shift 48 value)) - (!write (n.+ 2 idx) (i64.logic-right-shift 40 value)) - (!write (n.+ 3 idx) (i64.logic-right-shift 32 value)) - (!write (n.+ 4 idx) (i64.logic-right-shift 24 value)) - (!write (n.+ 5 idx) (i64.logic-right-shift 16 value)) - (!write (n.+ 6 idx) (i64.logic-right-shift 8 value)) + (!write idx (i64.logic_right_shift 56 value)) + (!write (n.+ 1 idx) (i64.logic_right_shift 48 value)) + (!write (n.+ 2 idx) (i64.logic_right_shift 40 value)) + (!write (n.+ 3 idx) (i64.logic_right_shift 32 value)) + (!write (n.+ 4 idx) (i64.logic_right_shift 24 value)) + (!write (n.+ 5 idx) (i64.logic_right_shift 16 value)) + (!write (n.+ 6 idx) (i64.logic_right_shift 8 value)) (!write (n.+ 7 idx) value)) (#try.Success binary)) - (exception.throw ..index-out-of-bounds [(..!size binary) idx]))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) (structure: #export equivalence (Equivalence Binary) @@ -245,43 +245,43 @@ true))))))) (for {@.old - (as-is) + (as_is) @.jvm - (as-is)} + (as_is)} ## Default - (exception: #export (cannot-copy-bytes {bytes Nat} - {source-input Nat} - {target-output Nat}) + (exception: #export (cannot_copy_bytes {bytes Nat} + {source_input Nat} + {target_output Nat}) (exception.report ["Bytes" (%.nat bytes)] - ["Source input space" (%.nat source-input)] - ["Target output space" (%.nat target-output)]))) + ["Source input space" (%.nat source_input)] + ["Target output space" (%.nat target_output)]))) -(def: #export (copy bytes source-offset source target-offset target) +(def: #export (copy bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) - (with-expansions [<for-jvm> (as-is (do try.monad - [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] + (with_expansions [<for_jvm> (as_is (do try.monad + [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] (wrap target)))] (for {@.old - <for-jvm> + <for_jvm> @.jvm - <for-jvm>} + <for_jvm>} ## Default - (let [source-input (n.- source-offset (!size source)) - target-output (n.- target-offset (!size target))] - (if (n.<= source-input bytes) + (let [source_input (n.- source_offset (!size source)) + target_output (n.- target_offset (!size target))] + (if (n.<= source_input bytes) (loop [idx 0] (if (n.< bytes idx) - (exec (!write (n.+ target-offset idx) - (!read (n.+ source-offset idx) source) + (exec (!write (n.+ target_offset idx) + (!read (n.+ source_offset idx) source) target) (recur (inc idx))) (#try.Success target))) - (exception.throw ..cannot-copy-bytes [bytes source-input target-output])))))) + (exception.throw ..cannot_copy_bytes [bytes source_input target_output])))))) (def: #export (slice from to binary) (-> Nat Nat Binary (Try Binary)) @@ -289,18 +289,18 @@ (if (n.<= to from) (if (and (n.< size from) (n.< size to)) - (with-expansions [<for-jvm> (as-is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] + (with_expansions [<for_jvm> (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))] (for {@.old - <for-jvm> + <for_jvm> @.jvm - <for-jvm>} + <for_jvm>} ## Default - (let [how-many (n.- from to)] - (..copy how-many from binary 0 (..create how-many))))) - (exception.throw ..slice-out-of-bounds [size from to])) - (exception.throw ..inverted-slice [size from to])))) + (let [how_many (n._ from to)] + (..copy how_many from binary 0 (..create how_many))))) + (exception.throw ..slice_out_of_bounds [size from to])) + (exception.throw ..inverted_slice [size from to])))) (def: #export (drop from binary) (-> Nat Binary Binary) diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux index 630b8351f..705654ca0 100644 --- a/stdlib/source/lux/data/collection/array.lux +++ b/stdlib/source/lux/data/collection/array.lux @@ -15,22 +15,22 @@ [collection ["." list ("#\." fold)]]]]) -(def: #export type-name "#Array") +(def: #export type_name "#Array") (type: #export (Array a) {#.doc "Mutable arrays."} - (#.Primitive ..type-name (#.Cons a #.Nil))) + (#.Primitive ..type_name (#.Cons a #.Nil))) -(with-expansions [<index-type> (primitive "java.lang.Long") - <elem-type> (primitive "java.lang.Object") - <array-type> (type (Array <elem-type>))] +(with_expansions [<index_type> (primitive "java.lang.Long") + <elem_type> (primitive "java.lang.Object") + <array_type> (type (Array <elem_type>))] (for {@.jvm (template: (!int value) (|> value - (:coerce <index-type>) + (:coerce <index_type>) "jvm object cast" "jvm conversion long-to-int"))} - (as-is)) + (as_is)) (def: #export (new size) (All [a] (-> Nat (Array a))) @@ -41,7 +41,7 @@ (|> size !int "jvm array new object" - (: <array-type>) + (: <array_type>) :assume) @.js @@ -54,11 +54,11 @@ @.jvm (|> array - (:coerce <array-type>) + (:coerce <array_type>) "jvm array length object" "jvm conversion int-to-long" "jvm object cast" - (: <index-type>) + (: <index_type>) (:coerce Nat)) @.js @@ -76,7 +76,7 @@ @.jvm (let [value (|> array - (:coerce <array-type>) + (:coerce <array_type>) ("jvm array read object" (!int index)))] (if ("jvm object null?" value) #.None @@ -97,8 +97,8 @@ @.jvm (|> array - (:coerce <array-type>) - ("jvm array write object" (!int index) (:coerce <elem-type> value)) + (:coerce <array_type>) + ("jvm array write object" (!int index) (:coerce <elem_type> value)) :assume) @.js @@ -112,7 +112,7 @@ (write! index (:assume ("jvm object null")) array) @.jvm - (write! index (:assume (: <elem-type> ("jvm object null"))) array) + (write! index (:assume (: <elem_type> ("jvm object null"))) array) @.js ("js array delete" index array)}) @@ -146,20 +146,20 @@ (|> array (read index) (maybe.default default) transform) array)) -(def: #export (copy! length src-start src-array dest-start dest-array) +(def: #export (copy! length src_start src_array dest_start dest_array) (All [a] (-> Nat Nat (Array a) Nat (Array a) (Array a))) (if (n.= 0 length) - dest-array + dest_array (list\fold (function (_ offset target) - (case (read (n.+ offset src-start) src-array) + (case (read (n.+ offset src_start) src_array) #.None target (#.Some value) - (write! (n.+ offset dest-start) value target))) - dest-array + (write! (n.+ offset dest_start) value target))) + dest_array (list.indices length)))) (def: #export (occupancy array) @@ -198,9 +198,9 @@ (def: #export (find p xs) (All [a] (-> (Predicate a) (Array a) (Maybe a))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (loop [idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None (recur (inc idx)) @@ -215,9 +215,9 @@ {#.doc "Just like 'find', but with access to the index of each value."} (All [a] (-> (-> Nat a Bit) (Array a) (Maybe [Nat a]))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (loop [idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None (recur (inc idx)) @@ -230,7 +230,7 @@ (def: #export (clone xs) (All [a] (-> (Array a) (Array a))) - (let [arr-size (size xs)] + (let [arr_size (size xs)] (list\fold (function (_ idx ys) (case (read idx xs) #.None @@ -238,10 +238,10 @@ (#.Some x) (write! idx x ys))) - (new arr-size) - (list.indices arr-size)))) + (new arr_size) + (list.indices arr_size)))) -(def: #export (from-list xs) +(def: #export (from_list xs) (All [a] (-> (List a) (Array a))) (product.right (list\fold (function (_ x [idx arr]) [(inc idx) (write! idx x arr)]) @@ -250,7 +250,7 @@ (def: underflow Nat (dec 0)) -(def: #export (to-list array) +(def: #export (to_list array) (All [a] (-> (Array a) (List a))) (loop [idx (dec (size array)) output #.Nil] @@ -264,7 +264,7 @@ #.None output))))) -(def: #export (to-list' default array) +(def: #export (to_list' default array) (All [a] (-> a (Array a) (List a))) (loop [idx (dec (size array)) output #.Nil] @@ -311,9 +311,9 @@ (Functor Array) (def: (map f ma) - (let [arr-size (size ma)] - (if (n.= 0 arr-size) - (new arr-size) + (let [arr_size (size ma)] + (if (n.= 0 arr_size) + (new arr_size) (list\fold (function (_ idx mb) (case (read idx ma) #.None @@ -321,25 +321,25 @@ (#.Some x) (write! idx (f x) mb))) - (new arr-size) - (list.indices arr-size)) + (new arr_size) + (list.indices arr_size)) )))) (structure: #export fold (Fold Array) (def: (fold f init xs) - (let [arr-size (size xs)] - (loop [so-far init + (let [arr_size (size xs)] + (loop [so_far init idx 0] - (if (n.< arr-size idx) + (if (n.< arr_size idx) (case (read idx xs) #.None - (recur so-far (inc idx)) + (recur so_far (inc idx)) (#.Some value) - (recur (f value so-far) (inc idx))) - so-far))))) + (recur (f value so_far) (inc idx))) + so_far))))) (template [<name> <init> <op>] [(def: #export (<name> predicate array) diff --git a/stdlib/source/lux/data/collection/dictionary.lux b/stdlib/source/lux/data/collection/dictionary.lux index 8ca61b453..46f299e31 100644 --- a/stdlib/source/lux/data/collection/dictionary.lux +++ b/stdlib/source/lux/data/collection/dictionary.lux @@ -39,7 +39,7 @@ Nat) ## A hash-code derived from a key during tree-traversal. -(type: Hash-Code +(type: Hash_Code Nat) ## Represents the nesting level of a leaf or node, when looking-it-up @@ -47,8 +47,8 @@ ## Changes in levels are done by right-shifting the hashes of keys by ## the appropriate multiple of the branching-exponent. ## A shift of 0 means root level. -## A shift of (* branching-exponent 1) means level 2. -## A shift of (* branching-exponent N) means level N+1. +## A shift of (* branching_exponent 1) means level 2. +## A shift of (* branching_exponent N) means level N+1. (type: Level Nat) @@ -59,7 +59,7 @@ (#Base BitMap (Array (Either (Node k v) [k v]))) - (#Collisions Hash-Code (Array [k v]))) + (#Collisions Hash_Code (Array [k v]))) ## #Hierarchy nodes are meant to point down only to lower-level nodes. (type: (Hierarchy k v) @@ -81,7 +81,7 @@ ## Which is the same as 0000 0000 0000 0000 0000 0000 0000 0000. ## Or 0x00000000. ## Which is 32 zeroes, since the branching factor is 32. -(def: clean-bitmap +(def: clean_bitmap BitMap 0) @@ -94,47 +94,47 @@ ## factor). ## The initial shifting level, though, is 0 (which corresponds to the ## shift in the shallowest node on the tree, which is the root node). -(def: root-level +(def: root_level Level 0) ## The exponent to which 2 must be elevated, to reach the branching ## factor of the data-structure. -(def: branching-exponent +(def: branching_exponent Nat 5) ## The threshold on which #Hierarchy nodes are demoted to #Base nodes, ## which is 1/4 of the branching factor (or a left-shift 2). -(def: demotion-threshold +(def: demotion_threshold Nat - (i64.left-shift (n.- 2 branching-exponent) 1)) + (i64.left_shift (n.- 2 branching_exponent) 1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). -(def: promotion-threshold +(def: promotion_threshold Nat - (i64.left-shift (n.- 1 branching-exponent) 1)) + (i64.left_shift (n.- 1 branching_exponent) 1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). -(def: hierarchy-nodes-size +(def: hierarchy_nodes_size Nat - (i64.left-shift branching-exponent 1)) + (i64.left_shift branching_exponent 1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty Node - (#Base clean-bitmap (array.new 0))) + (#Base clean_bitmap (array.new 0))) ## Expands a copy of the array, to have 1 extra slot, which is used ## for storing the value. -(def: (insert! idx value old-array) +(def: (insert! idx value old_array) (All [a] (-> Index a (Array a) (Array a))) - (let [old-size (array.size old-array)] - (|> (array.new (inc old-size)) - (array.copy! idx 0 old-array 0) + (let [old_size (array.size old_array)] + (|> (array.new (inc old_size)) + (array.copy! idx 0 old_array 0) (array.write! idx value) - (array.copy! (n.- idx old-size) idx old-array (inc idx))))) + (array.copy! (n.- idx old_size) idx old_array (inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) @@ -149,74 +149,74 @@ ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (dec (array.size array))] - (|> (array.new new-size) + (let [new_size (dec (array.size array))] + (|> (array.new new_size) (array.copy! idx 0 array 0) - (array.copy! (n.- idx new-size) (inc idx) array idx)))) + (array.copy! (n.- idx new_size) (inc idx) array idx)))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. -(def: level-up +(def: level_up (-> Level Level) - (n.+ branching-exponent)) + (n.+ branching_exponent)) -(def: hierarchy-mask BitMap (dec hierarchy-nodes-size)) +(def: hierarchy_mask BitMap (dec hierarchy_nodes_size)) ## Gets the branching-factor sized section of the hash corresponding ## to a particular level, and uses that as an index into the array. -(def: (level-index level hash) - (-> Level Hash-Code Index) - (i64.and hierarchy-mask - (i64.logic-right-shift level hash))) +(def: (level_index level hash) + (-> Level Hash_Code Index) + (i64.and hierarchy_mask + (i64.logic_right_shift level hash))) ## A mechanism to go from indices to bit-positions. -(def: (->bit-position index) +(def: (->bit_position index) (-> Index BitPosition) - (i64.left-shift index 1)) + (i64.left_shift index 1)) ## The bit-position within a base that a given hash-code would have. -(def: (bit-position level hash) - (-> Level Hash-Code BitPosition) - (->bit-position (level-index level hash))) +(def: (bit_position level hash) + (-> Level Hash_Code BitPosition) + (->bit_position (level_index level hash))) -(def: (bit-position-is-set? bit bitmap) +(def: (bit_position_is_set? bit bitmap) (-> BitPosition BitMap Bit) - (not (n.= clean-bitmap (i64.and bit bitmap)))) + (not (n.= clean_bitmap (i64.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. -(def: only-bit-position? +(def: only_bit_position? (-> BitPosition BitMap Bit) n.=) -(def: (set-bit-position bit bitmap) +(def: (set_bit_position bit bitmap) (-> BitPosition BitMap BitMap) (i64.or bit bitmap)) -(def: unset-bit-position +(def: unset_bit_position (-> BitPosition BitMap BitMap) i64.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. -(def: bitmap-size +(def: bitmap_size (-> BitMap Nat) i64.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) ## associated with it. -(def: bit-position-mask +(def: bit_position_mask (-> BitPosition BitMap) dec) ## The index on the base array, based on it's bit-position. -(def: (base-index bit-position bitmap) +(def: (base_index bit_position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (i64.and (bit-position-mask bit-position) + (bitmap_size (i64.and (bit_position_mask bit_position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. -(def: (collision-index Hash<k> key colls) +(def: (collision_index Hash<k> key colls) (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) (\ maybe.monad map product.left (array.find+ (function (_ idx [key' val']) @@ -225,51 +225,51 @@ ## When #Hierarchy nodes grow too small, they're demoted to #Base ## nodes to save space. -(def: (demote-hierarchy except-idx [h-size h-array]) +(def: (demote_hierarchy except_idx [h_size h_array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product.right (list\fold (function (_ idx [insertion-idx node]) + (product.right (list\fold (function (_ idx [insertion_idx node]) (let [[bitmap base] node] - (case (array.read idx h-array) - #.None [insertion-idx node] - (#.Some sub-node) (if (n.= except-idx idx) - [insertion-idx node] - [(inc insertion-idx) - [(set-bit-position (->bit-position idx) bitmap) - (array.write! insertion-idx (#.Left sub-node) base)]]) + (case (array.read idx h_array) + #.None [insertion_idx node] + (#.Some sub_node) (if (n.= except_idx idx) + [insertion_idx node] + [(inc insertion_idx) + [(set_bit_position (->bit_position idx) bitmap) + (array.write! insertion_idx (#.Left sub_node) base)]]) ))) - [0 [clean-bitmap - (array.new (dec h-size))]] - (list.indices (array.size h-array))))) + [0 [clean_bitmap + (array.new (dec h_size))]] + (list.indices (array.size h_array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. -(def: hierarchy-indices (List Index) (list.indices hierarchy-nodes-size)) +(def: hierarchy_indices (List Index) (list.indices hierarchy_nodes_size)) -(def: (promote-base put' Hash<k> level bitmap base) +(def: (promote_base put' Hash<k> level bitmap base) (All [k v] - (-> (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v)) + (-> (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v)) (Hash k) Level BitMap (Base k v) (Array (Node k v)))) - (product.right (list\fold (function (_ hierarchy-idx (^@ default [base-idx h-array])) - (if (bit-position-is-set? (->bit-position hierarchy-idx) + (product.right (list\fold (function (_ hierarchy_idx (^@ default [base_idx h_array])) + (if (bit_position_is_set? (->bit_position hierarchy_idx) bitmap) - [(inc base-idx) - (case (array.read base-idx base) - (#.Some (#.Left sub-node)) - (array.write! hierarchy-idx sub-node h-array) + [(inc base_idx) + (case (array.read base_idx base) + (#.Some (#.Left sub_node)) + (array.write! hierarchy_idx sub_node h_array) (#.Some (#.Right [key' val'])) - (array.write! hierarchy-idx - (put' (level-up level) (\ Hash<k> hash key') key' val' Hash<k> empty) - h-array) + (array.write! hierarchy_idx + (put' (level_up level) (\ Hash<k> hash key') key' val' Hash<k> empty) + h_array) #.None (undefined))] default)) [0 - (array.new hierarchy-nodes-size)] - hierarchy-indices))) + (array.new hierarchy_nodes_size)] + hierarchy_indices))) ## All empty nodes look the same (a #Base node with clean bitmap is ## used). @@ -277,44 +277,44 @@ (def: (empty?' node) (All [k v] (-> (Node k v) Bit)) (`` (case node - (#Base (~~ (static ..clean-bitmap)) _) + (#Base (~~ (static ..clean_bitmap)) _) #1 _ #0))) (def: (put' level hash key val Hash<k> node) - (All [k v] (-> Level Hash-Code k v (Hash k) (Node k v) (Node k v))) + (All [k v] (-> Level Hash_Code k v (Hash k) (Node k v) (Node k v))) (case node ## For #Hierarchy nodes, I check whether I can add the element to ## a sub-node. If impossible, I introduced a new singleton sub-node. (#Hierarchy _size hierarchy) - (let [idx (level-index level hash) - [_size' sub-node] (case (array.read idx hierarchy) - (#.Some sub-node) - [_size sub-node] + (let [idx (level_index level hash) + [_size' sub_node] (case (array.read idx hierarchy) + (#.Some sub_node) + [_size sub_node] _ [(inc _size) empty])] (#Hierarchy _size' - (update! idx (put' (level-up level) hash key val Hash<k> sub-node) + (update! idx (put' (level_up level) hash key val Hash<k> sub_node) hierarchy))) ## For #Base nodes, I check if the corresponding BitPosition has ## already been used. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) ## If so... - (let [idx (base-index bit bitmap)] + (let [idx (base_index bit bitmap)] (case (array.read idx base) #.None (undefined) ## If it's being used by a node, I add the KV to it. - (#.Some (#.Left sub-node)) - (let [sub-node' (put' (level-up level) hash key val Hash<k> sub-node)] - (#Base bitmap (update! idx (#.Left sub-node') base))) + (#.Some (#.Left sub_node)) + (let [sub_node' (put' (level_up level) hash key val Hash<k> sub_node)] + (#Base bitmap (update! idx (#.Left sub_node') base))) ## Otherwise, if it's being used by a KV, I compare the keys. (#.Some (#.Right key' val')) @@ -337,117 +337,117 @@ ## #Base nodes, so I ## add both KV-pairs ## to the empty one. - (let [next-level (level-up level)] + (let [next_level (level_up level)] (|> empty - (put' next-level hash' key' val' Hash<k>) - (put' next-level hash key val Hash<k>)))))) + (put' next_level hash' key' val' Hash<k>) + (put' next_level hash key val Hash<k>)))))) base))))) ## However, if the BitPosition has not been used yet, I check ## whether this #Base node is ready for a promotion. - (let [base-count (bitmap-size bitmap)] - (if (n.>= ..promotion-threshold base-count) + (let [base_count (bitmap_size bitmap)] + (if (n.>= ..promotion_threshold base_count) ## If so, I promote it to a #Hierarchy node, and add the new ## KV-pair as a singleton node to it. - (#Hierarchy (inc base-count) - (|> (promote-base put' Hash<k> level bitmap base) - (array.write! (level-index level hash) - (put' (level-up level) hash key val Hash<k> empty)))) + (#Hierarchy (inc base_count) + (|> (promote_base put' Hash<k> level bitmap base) + (array.write! (level_index level hash) + (put' (level_up level) hash key val Hash<k> empty)))) ## Otherwise, I just resize the #Base node to accommodate the ## new KV-pair. - (#Base (set-bit-position bit bitmap) - (insert! (base-index bit bitmap) (#.Right [key val]) base)))))) + (#Base (set_bit_position bit bitmap) + (insert! (base_index bit bitmap) (#.Right [key val]) base)))))) ## For #Collisions nodes, I compare the hashes. (#Collisions _hash _colls) (if (n.= hash _hash) ## If they're equal, that means the new KV contributes to the ## collisions. - (case (collision-index Hash<k> key _colls) + (case (collision_index Hash<k> key _colls) ## If the key was already present in the collisions-list, it's ## value gets updated. - (#.Some coll-idx) - (#Collisions _hash (update! coll-idx [key val] _colls)) + (#.Some coll_idx) + (#Collisions _hash (update! coll_idx [key val] _colls)) ## Otherwise, the KV-pair is added to the collisions-list. #.None (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) ## If the hashes are not equal, I create a new #Base node that ## contains the old #Collisions node, plus the new KV-pair. - (|> (#Base (bit-position level _hash) + (|> (#Base (bit_position level _hash) (|> (array.new 1) (array.write! 0 (#.Left node)))) (put' level hash key val Hash<k>))) )) (def: (remove' level hash key Hash<k> node) - (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Node k v))) + (All [k v] (-> Level Hash_Code k (Hash k) (Node k v) (Node k v))) (case node ## For #Hierarchy nodes, find out if there's a valid sub-node for ## the Hash-Code. - (#Hierarchy h-size h-array) - (let [idx (level-index level hash)] - (case (array.read idx h-array) + (#Hierarchy h_size h_array) + (let [idx (level_index level hash)] + (case (array.read idx h_array) ## If not, there's nothing to remove. #.None node ## But if there is, try to remove the key from the sub-node. - (#.Some sub-node) - (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] + (#.Some sub_node) + (let [sub_node' (remove' (level_up level) hash key Hash<k> sub_node)] ## Then check if a removal was actually done. - (if (is? sub-node sub-node') + (if (is? sub_node sub_node') ## If not, then there's nothing to change here either. node - ## But if the sub-removal yielded an empty sub-node... - (if (empty?' sub-node') + ## But if the sub_removal yielded an empty sub_node... + (if (empty?' sub_node') ## Check if it's due time for a demotion. - (if (n.<= demotion-threshold h-size) + (if (n.<= demotion_threshold h_size) ## If so, perform it. - (#Base (demote-hierarchy idx [h-size h-array])) + (#Base (demote_hierarchy idx [h_size h_array])) ## Otherwise, just clear the space. - (#Hierarchy (dec h-size) (vacant! idx h-array))) - ## But if the sub-removal yielded a non-empty node, then + (#Hierarchy (dec h_size) (vacant! idx h_array))) + ## But if the sub_removal yielded a non_empty node, then ## just update the hiearchy branch. - (#Hierarchy h-size (update! idx sub-node' h-array))))))) + (#Hierarchy h_size (update! idx sub_node' h_array))))))) ## For #Base nodes, check whether the BitPosition is set. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) - (let [idx (base-index bit bitmap)] + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) + (let [idx (base_index bit bitmap)] (case (array.read idx base) #.None (undefined) - ## If set, check if it's a sub-node, and remove the KV + ## If set, check if it's a sub_node, and remove the KV ## from it. - (#.Some (#.Left sub-node)) - (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] + (#.Some (#.Left sub_node)) + (let [sub_node' (remove' (level_up level) hash key Hash<k> sub_node)] ## Verify that it was removed. - (if (is? sub-node sub-node') + (if (is? sub_node sub_node') ## If not, there's also nothing to change here. node ## But if it came out empty... - (if (empty?' sub-node') + (if (empty?' sub_node') ### ... figure out whether that's the only position left. - (if (only-bit-position? bit bitmap) + (if (only_bit_position? bit bitmap) ## If so, removing it leaves this node empty too. empty ## But if not, then just unset the position and ## remove the node. - (#Base (unset-bit-position bit bitmap) + (#Base (unset_bit_position bit bitmap) (remove! idx base))) ## But, if it did not come out empty, then the ## position is kept, and the node gets updated. (#Base bitmap - (update! idx (#.Left sub-node') base))))) + (update! idx (#.Left sub_node') base))))) ## If, however, there was a KV-pair instead of a sub-node. (#.Some (#.Right [key' val'])) ## Check if the keys match. (if (\ Hash<k> = key key') ## If so, remove the KV-pair and unset the BitPosition. - (#Base (unset-bit-position bit bitmap) + (#Base (unset_bit_position bit bitmap) (remove! idx base)) ## Otherwise, there's nothing to remove. node))) @@ -456,7 +456,7 @@ ## For #Collisions nodes, It need to find out if the key already existst. (#Collisions _hash _colls) - (case (collision-index Hash<k> key _colls) + (case (collision_index Hash<k> key _colls) ## If not, then there's nothing to remove. #.None node @@ -472,24 +472,24 @@ )) (def: (get' level hash key Hash<k> node) - (All [k v] (-> Level Hash-Code k (Hash k) (Node k v) (Maybe v))) + (All [k v] (-> Level Hash_Code k (Hash k) (Node k v) (Maybe v))) (case node ## For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array.read (level-index level hash) hierarchy) + (case (array.read (level_index level hash) hierarchy) #.None #.None - (#.Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) + (#.Some sub_node) (get' (level_up level) hash key Hash<k> sub_node)) ## For #Base nodes, check the leaves, and recursively check the branches. (#Base bitmap base) - (let [bit (bit-position level hash)] - (if (bit-position-is-set? bit bitmap) - (case (array.read (base-index bit bitmap) base) + (let [bit (bit_position level hash)] + (if (bit_position_is_set? bit bitmap) + (case (array.read (base_index bit bitmap) base) #.None (undefined) - (#.Some (#.Left sub-node)) - (get' (level-up level) hash key Hash<k> sub-node) + (#.Some (#.Left sub_node)) + (get' (level_up level) hash key Hash<k> sub_node) (#.Some (#.Right [key' val'])) (if (\ Hash<k> = key key') @@ -511,9 +511,9 @@ (array\fold n.+ 0 (array\map size' hierarchy)) (#Base _ base) - (array\fold n.+ 0 (array\map (function (_ sub-node') - (case sub-node' - (#.Left sub-node) (size' sub-node) + (array\fold n.+ 0 (array\map (function (_ sub_node') + (case sub_node' + (#.Left sub_node) (size' sub_node) (#.Right _) 1)) base)) @@ -525,15 +525,15 @@ (All [k v] (-> (Node k v) (List [k v]))) (case node (#Hierarchy _size hierarchy) - (array\fold (function (_ sub-node tail) (list\compose (entries' sub-node) tail)) + (array\fold (function (_ sub_node tail) (list\compose (entries' sub_node) tail)) #.Nil hierarchy) (#Base bitmap base) (array\fold (function (_ branch tail) (case branch - (#.Left sub-node) - (list\compose (entries' sub-node) tail) + (#.Left sub_node) + (list\compose (entries' sub_node) tail) (#.Right [key' val']) (#.Cons [key' val'] tail))) @@ -550,7 +550,7 @@ {#hash (Hash k) #root (Node k v)}) -(def: #export key-hash +(def: #export key_hash (All [k v] (-> (Dictionary k v) (Hash k))) (get@ #..hash)) @@ -562,17 +562,17 @@ (def: #export (put key val dict) (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) (let [[Hash<k> node] dict] - [Hash<k> (put' root-level (\ Hash<k> hash key) key val Hash<k> node)])) + [Hash<k> (put' root_level (\ Hash<k> hash key) key val Hash<k> node)])) (def: #export (remove key dict) (All [k v] (-> k (Dictionary k v) (Dictionary k v))) (let [[Hash<k> node] dict] - [Hash<k> (remove' root-level (\ Hash<k> hash key) key Hash<k> node)])) + [Hash<k> (remove' root_level (\ Hash<k> hash key) key Hash<k> node)])) (def: #export (get key dict) (All [k v] (-> k (Dictionary k v) (Maybe v))) (let [[Hash<k> node] dict] - (get' root-level (\ Hash<k> hash key) key Hash<k> node))) + (get' root_level (\ Hash<k> hash key) key Hash<k> node))) (def: #export (key? dict key) (All [k v] (-> (Dictionary k v) k Bit)) @@ -580,14 +580,14 @@ #.None #0 (#.Some _) #1)) -(exception: #export key-already-exists) +(exception: #export key_already_exists) -(def: #export (try-put key val dict) +(def: #export (try_put key val dict) {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) (case (get key dict) #.None (#try.Success (put key val dict)) - (#.Some _) (exception.throw ..key-already-exists []))) + (#.Some _) (exception.throw ..key_already_exists []))) (def: #export (update key f dict) {#.doc "Transforms the value located at key (if available), using the given function."} @@ -620,16 +620,16 @@ (All [k v] (-> (Dictionary k v) (List [k v]))) (entries' (product.right dict))) -(def: #export (from-list Hash<k> kvs) +(def: #export (from_list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dictionary k v))) (list\fold (function (_ [k v] dict) (put k v dict)) (new Hash<k>) kvs)) -(template [<name> <elem-type> <side>] +(template [<name> <elem_type> <side>] [(def: #export (<name> dict) - (All [k v] (-> (Dictionary k v) (List <elem-type>))) + (All [k v] (-> (Dictionary k v) (List <elem_type>))) (|> dict entries (list\map <side>)))] [keys k product.left] @@ -644,7 +644,7 @@ dict1 (entries dict2))) -(def: #export (merge-with f dict2 dict1) +(def: #export (merge_with f dict2 dict1) {#.doc (doc "Merges 2 dictionaries." "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) @@ -658,25 +658,25 @@ dict1 (entries dict2))) -(def: #export (re-bind from-key to-key dict) +(def: #export (re_bind from_key to_key dict) (All [k v] (-> k k (Dictionary k v) (Dictionary k v))) - (case (get from-key dict) + (case (get from_key dict) #.None dict (#.Some val) (|> dict - (remove from-key) - (put to-key val)))) + (remove from_key) + (put to_key val)))) (def: #export (select keys dict) {#.doc "Creates a sub-set of the given dict, with only the specified keys."} (All [k v] (-> (List k) (Dictionary k v) (Dictionary k v))) (let [[Hash<k> _] dict] - (list\fold (function (_ key new-dict) + (list\fold (function (_ key new_dict) (case (get key dict) - #.None new-dict - (#.Some val) (put key val new-dict))) + #.None new_dict + (#.Some val) (put key val new_dict))) (new Hash<k>) keys))) diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index 49886a459..6907bfdc5 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -14,7 +14,7 @@ [macro ["." code]]]) -(def: error-message +(def: error_message "Invariant violation") (type: Color @@ -62,13 +62,13 @@ #.None (#.Some node) - (let [node-key (get@ #key node)] - (cond (\ dict = node-key key) - ## (_\= node-key key) + (let [node_key (get@ #key node)] + (cond (\ dict = node_key key) + ## (_\= node_key key) (#.Some (get@ #value node)) - (\ dict < node-key key) - ## (_\< node-key key) + (\ dict < node_key key) + ## (_\< node_key key) (recur (get@ #left node)) ## (_\> (get@ #key node) key) @@ -87,11 +87,11 @@ #0 (#.Some node) - (let [node-key (get@ #key node)] - (or (\ dict = node-key key) - ## (_\= node-key key) - (if (\ dict < node-key key) - ## (_\< node-key key) + (let [node_key (get@ #key node)] + (or (\ dict = node_key key) + ## (_\= node_key key) + (if (\ dict < node_key key) + ## (_\< node_key key) (recur (get@ #left node)) (recur (get@ #right node))))))))) @@ -130,25 +130,25 @@ (All [k v] (-> (Dictionary k v) Bit)) (|>> ..size (n.= 0))) -(template [<name> <other-color> <self-color> <no-change>] +(template [<name> <other_color> <self_color> <no_change>] [(def: (<name> self) (All [k v] (-> (Node k v) (Node k v))) (case (get@ #color self) - <other-color> - (set@ #color <self-color> self) + <other_color> + (set@ #color <self_color> self) - <self-color> - <no-change> + <self_color> + <no_change> ))] [blacken #Red #Black self] - [redden #Black #Red (error! error-message)] + [redden #Black #Red (error! error_message)] ) -(def: (balance-left-add parent self) +(def: (balance_left_add parent self) (All [k v] (-> (Node k v) (Node k v) (Node k v))) - (with-expansions - [<default-behavior> (as-is (black (get@ #key parent) + (with_expansions + [<default_behavior> (as_is (black (get@ #key parent) (get@ #value parent) (#.Some self) (get@ #right parent)))] @@ -181,16 +181,16 @@ (get@ #right parent)))) _ - <default-behavior>)) + <default_behavior>)) #Black - <default-behavior> + <default_behavior> ))) -(def: (balance-right-add parent self) +(def: (balance_right_add parent self) (All [k v] (-> (Node k v) (Node k v) (Node k v))) - (with-expansions - [<default-behavior> (as-is (black (get@ #key parent) + (with_expansions + [<default_behavior> (as_is (black (get@ #key parent) (get@ #value parent) (get@ #left parent) (#.Some self)))] @@ -223,30 +223,30 @@ (get@ #right self)))) _ - <default-behavior>)) + <default_behavior>)) #Black - <default-behavior> + <default_behavior> ))) -(def: (add-left addition center) +(def: (add_left addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red (red (get@ #key center) (get@ #value center) (#.Some addition) (get@ #right center)) #Black - (balance-left-add center addition) + (balance_left_add center addition) )) -(def: (add-right addition center) +(def: (add_right addition center) (All [k v] (-> (Node k v) (Node k v) (Node k v))) (case (get@ #color center) #Red (red (get@ #key center) (get@ #value center) (get@ #left center) (#.Some addition)) #Black - (balance-right-add center addition) + (balance_right_add center addition) )) (def: #export (put key value dict) @@ -261,15 +261,15 @@ (let [reference (get@ #key root)] (`` (cond (~~ (template [<comp> <tag> <add>] [(<comp> reference key) - (let [side-root (get@ <tag> root) - outcome (recur side-root)] - (if (is? side-root outcome) + (let [side_root (get@ <tag> root) + outcome (recur side_root)] + (if (is? side_root outcome) ?root (#.Some (<add> (maybe.assume outcome) root))))] - [_\< #left add-left] - [(order.> (get@ #&order dict)) #right add-right] + [_\< #left add_left] + [(order.> (get@ #&order dict)) #right add_right] )) ## (_\= reference key) @@ -278,7 +278,7 @@ ))] (set@ #root root' dict))) -(def: (left-balance key value ?left ?right) +(def: (left_balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left (^multi (#.Some left) @@ -307,7 +307,7 @@ _ (black key value ?left ?right))) -(def: (right-balance key value ?left ?right) +(def: (right_balance key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right (^multi (#.Some right) @@ -334,7 +334,7 @@ _ (black key value ?left ?right))) -(def: (balance-left-remove key value ?left ?right) +(def: (balance_left_remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?left (^multi (#.Some left) @@ -345,7 +345,7 @@ (case ?right (^multi (#.Some right) [(get@ #color right) #Black]) - (right-balance key value ?left (#.Some (redden right))) + (right_balance key value ?left (#.Some (redden right))) (^multi (#.Some right) [(get@ #color right) #Red] @@ -354,16 +354,16 @@ (red (get@ #key right>>left) (get@ #value right>>left) (#.Some (black key value ?left (get@ #left right>>left))) - (#.Some (right-balance (get@ #key right) + (#.Some (right_balance (get@ #key right) (get@ #value right) (get@ #right right>>left) (\ maybe.functor map redden (get@ #right right))))) _ - (error! error-message)) + (error! error_message)) )) -(def: (balance-right-remove key value ?left ?right) +(def: (balance_right_remove key value ?left ?right) (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) (case ?right (^multi (#.Some right) @@ -374,7 +374,7 @@ (case ?left (^multi (#.Some left) [(get@ #color left) #Black]) - (left-balance key value (#.Some (redden left)) ?right) + (left_balance key value (#.Some (redden left)) ?right) (^multi (#.Some left) [(get@ #color left) #Red] @@ -382,14 +382,14 @@ [(get@ #color left>>right) #Black]) (red (get@ #key left>>right) (get@ #value left>>right) - (#.Some (left-balance (get@ #key left) + (#.Some (left_balance (get@ #key left) (get@ #value left) (\ maybe.functor map redden (get@ #left left)) (get@ #left left>>right))) (#.Some (black key value (get@ #right left>>right) ?right))) _ - (error! error-message) + (error! error_message) ))) (def: (prepend ?left ?right) @@ -459,7 +459,7 @@ (get@ #right right))))) #Black - (wrap (balance-left-remove (get@ #key left) + (wrap (balance_left_remove (get@ #key left) (get@ #value left) (get@ #left left) (#.Some (black (get@ #key right) @@ -481,38 +481,38 @@ [#.None #0] (#.Some root) - (let [root-key (get@ #key root) - root-val (get@ #value root)] - (if (_\= root-key key) + (let [root_key (get@ #key root) + root_val (get@ #value root)] + (if (_\= root_key key) [(prepend (get@ #left root) (get@ #right root)) #1] - (let [go-left? (_\< root-key key)] - (case (recur (if go-left? + (let [go_left? (_\< root_key key)] + (case (recur (if go_left? (get@ #left root) (get@ #right root))) [#.None #0] [#.None #0] - [side-outcome _] - (if go-left? + [side_outcome _] + (if go_left? (case (get@ #left root) (^multi (#.Some left) [(get@ #color left) #Black]) - [(#.Some (balance-left-remove root-key root-val side-outcome (get@ #right root))) + [(#.Some (balance_left_remove root_key root_val side_outcome (get@ #right root))) #0] _ - [(#.Some (red root-key root-val side-outcome (get@ #right root))) + [(#.Some (red root_key root_val side_outcome (get@ #right root))) #0]) (case (get@ #right root) (^multi (#.Some right) [(get@ #color right) #Black]) - [(#.Some (balance-right-remove root-key root-val (get@ #left root) side-outcome)) + [(#.Some (balance_right_remove root_key root_val (get@ #left root) side_outcome)) #0] _ - [(#.Some (red root-key root-val (get@ #left root) side-outcome)) + [(#.Some (red root_key root_val (get@ #left root) side_outcome)) #0]) ))) )) @@ -536,7 +536,7 @@ #.None dict)) -(def: #export (from-list Order<l> list) +(def: #export (from_list Order<l> list) (All [k v] (-> (Order k) (List [k v]) (Dictionary k v))) (list\fold (function (_ [key value] dict) (put key value dict)) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 62e8a417d..108c4a509 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -73,13 +73,13 @@ [(#.Cons head in) out] [in (#.Cons head out)])))) -(def: #export (as-pairs xs) +(def: #export (as_pairs xs) {#.doc (doc "Cut the list into pairs of 2." "Caveat emptor: If the list has an uneven number of elements, the last one will be skipped.")} (All [a] (-> (List a) (List [a a]))) (case xs (^ (list& x1 x2 xs')) - (#.Cons [x1 x2] (as-pairs xs')) + (#.Cons [x1 x2] (as_pairs xs')) _ #.Nil)) @@ -114,8 +114,8 @@ <then> <else>)))] - [take-while (#.Cons x (take-while predicate xs')) #.Nil] - [drop-while (drop-while predicate xs') xs] + [take_while (#.Cons x (take_while predicate xs')) #.Nil] + [drop_while (drop_while predicate xs') xs] ) (def: #export (split n xs) @@ -131,7 +131,7 @@ [(#.Cons x tail) rest])) [#.Nil xs])) -(def: (split-with' predicate ys xs) +(def: (split_with' predicate ys xs) (All [a] (-> (Predicate a) (List a) (List a) [(List a) (List a)])) (case xs @@ -140,14 +140,14 @@ (#.Cons x xs') (if (predicate x) - (split-with' predicate (#.Cons x ys) xs') + (split_with' predicate (#.Cons x ys) xs') [ys xs]))) -(def: #export (split-with predicate xs) +(def: #export (split_with predicate xs) {#.doc "Segment the list by using a predicate to tell when to cut."} (All [a] (-> (Predicate a) (List a) [(List a) (List a)])) - (let [[ys' xs'] (split-with' predicate #.Nil xs)] + (let [[ys' xs'] (split_with' predicate #.Nil xs)] [(reverse ys') xs'])) (def: #export (chunk n xs) @@ -452,15 +452,15 @@ (def: #export zip/3 (zip 3)) ((zip 3) xs ys zs))} (case tokens - (^ (list [_ (#.Nat num-lists)])) - (if (n.> 0 num-lists) + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) (let [(^open ".") ..functor - indices (..indices num-lists) - type-vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip-type (` (All [(~+ type-vars)] + indices (..indices num_lists) + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars)] (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type-vars)) - (List [(~+ type-vars)])))) + type_vars)) + (List [(~+ type_vars)])))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -471,13 +471,13 @@ vars+lists))]) g!step (identifier$ "0step0") g!blank (identifier$ "0,0") - list-vars (map product.right vars+lists) - code (` (: (~ zip-type) - (function ((~ g!step) (~+ list-vars)) - (case [(~+ list-vars)] + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ g!step) (~+ list_vars)) + (case [(~+ list_vars)] (~ pattern) (#.Cons [(~+ (map product.left vars+lists))] - ((~ g!step) (~+ list-vars))) + ((~ g!step) (~+ list_vars))) (~ g!blank) #.Nil))))] @@ -490,24 +490,24 @@ (def: #export zip/2 (zip 2)) (def: #export zip/3 (zip 3)) -(macro: #export (zip-with tokens state) +(macro: #export (zip_with tokens state) {#.doc (doc "Create list zippers with the specified number of input lists." - (def: #export zip-with/2 (zip-with 2)) - (def: #export zip-with/3 (zip-with 3)) - ((zip-with 2) + xs ys))} + (def: #export zip_with/2 (zip_with 2)) + (def: #export zip_with/3 (zip_with 3)) + ((zip_with 2) + xs ys))} (case tokens - (^ (list [_ (#.Nat num-lists)])) - (if (n.> 0 num-lists) + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) (let [(^open ".") ..functor - indices (..indices num-lists) - g!return-type (identifier$ "0return-type0") + indices (..indices num_lists) + g!return_type (identifier$ "0return_type0") g!func (identifier$ "0func0") - type-vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip-type (` (All [(~+ type-vars) (~ g!return-type)] - (-> (-> (~+ type-vars) (~ g!return-type)) + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars) (~ g!return_type)] + (-> (-> (~+ type_vars) (~ g!return_type)) (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type-vars)) - (List (~ g!return-type))))) + type_vars)) + (List (~ g!return_type))))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -518,24 +518,24 @@ vars+lists))]) g!step (identifier$ "0step0") g!blank (identifier$ "0,0") - list-vars (map product.right vars+lists) - code (` (: (~ zip-type) - (function ((~ g!step) (~ g!func) (~+ list-vars)) - (case [(~+ list-vars)] + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ g!step) (~ g!func) (~+ list_vars)) + (case [(~+ list_vars)] (~ pattern) (#.Cons ((~ g!func) (~+ (map product.left vars+lists))) - ((~ g!step) (~ g!func) (~+ list-vars))) + ((~ g!step) (~ g!func) (~+ list_vars))) (~ g!blank) #.Nil))))] (#.Right [state (list code)])) - (#.Left "Cannot zip-with 0 lists.")) + (#.Left "Cannot zip_with 0 lists.")) _ - (#.Left "Wrong syntax for zip-with"))) + (#.Left "Wrong syntax for zip_with"))) -(def: #export zip-with/2 (zip-with 2)) -(def: #export zip-with/3 (zip-with 3)) +(def: #export zip_with/2 (zip_with 2)) +(def: #export zip_with/3 (zip_with 3)) (def: #export (last xs) (All [a] (-> (List a) (Maybe a))) diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux index 2d8712b82..b7b7f56e2 100644 --- a/stdlib/source/lux/data/collection/queue.lux +++ b/stdlib/source/lux/data/collection/queue.lux @@ -18,12 +18,12 @@ {#front (list) #rear (list)}) -(def: #export (from-list entries) +(def: #export (from_list entries) (All [a] (-> (List a) (Queue a))) {#front entries #rear (list)}) -(def: #export (to-list queue) +(def: #export (to_list queue) (All [a] (-> (Queue a) (List a))) (let [(^slots [#front #rear]) queue] (list\compose front (list.reverse rear)))) @@ -80,8 +80,8 @@ (def: (= reference subject) (\ (list.equivalence super) = - (..to-list reference) - (..to-list subject)))) + (..to_list reference) + (..to_list subject)))) (structure: #export functor (Functor Queue) diff --git a/stdlib/source/lux/data/collection/queue/priority.lux b/stdlib/source/lux/data/collection/queue/priority.lux index 4c559e331..6904497d2 100644 --- a/stdlib/source/lux/data/collection/queue/priority.lux +++ b/stdlib/source/lux/data/collection/queue/priority.lux @@ -10,7 +10,7 @@ [collection ["." tree #_ ["#" finger (#+ Tree)]]]] - [type (#+ :by-example) + [type (#+ :by_example) [abstract (#+ abstract: :abstraction :representation)]]]) (type: #export Priority @@ -23,7 +23,7 @@ (tree.builder n.maximum)) (def: :@: - (:by-example [@] + (:by_example [@] {(tree.Builder @ Priority) ..builder} @)) @@ -78,16 +78,16 @@ (:abstraction (do maybe.monad [tree (:representation queue) - #let [highest-priority (tree.tag tree)]] + #let [highest_priority (tree.tag tree)]] (loop [node tree] (case (tree.root node) (0 #0 reference) - (if (n.= highest-priority (tree.tag node)) + (if (n.= highest_priority (tree.tag node)) #.None (#.Some node)) (0 #1 left right) - (if (n.= highest-priority (tree.tag left)) + (if (n.= highest_priority (tree.tag left)) (case (recur left) #.None (#.Some right) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 9bc47be18..bcfd297a2 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -23,7 +23,7 @@ [collection ["." list ("#\." fold functor monoid)] ["." array (#+ Array) ("#\." functor fold)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]]]) @@ -39,143 +39,143 @@ (type: Index Nat) -(def: branching-exponent +(def: branching_exponent Nat 5) -(def: root-level +(def: root_level Level 0) (template [<name> <op>] [(def: <name> (-> Level Level) - (<op> branching-exponent))] + (<op> branching_exponent))] - [level-up n.+] - [level-down n.-] + [level_up n.+] + [level_down n.-] ) -(def: full-node-size +(def: full_node_size Nat - (i64.left-shift branching-exponent 1)) + (i64.left_shift branching_exponent 1)) -(def: branch-idx-mask +(def: branch_idx_mask Nat - (dec full-node-size)) + (dec full_node_size)) -(def: branch-idx +(def: branch_idx (-> Index Index) - (i64.and branch-idx-mask)) + (i64.and branch_idx_mask)) -(def: (new-hierarchy _) +(def: (new_hierarchy _) (All [a] (-> Any (Hierarchy a))) - (array.new full-node-size)) + (array.new full_node_size)) -(def: (tail-off row-size) +(def: (tail_off row_size) (-> Nat Nat) - (if (n.< full-node-size row-size) + (if (n.< full_node_size row_size) 0 - (|> (dec row-size) - (i64.logic-right-shift branching-exponent) - (i64.left-shift branching-exponent)))) + (|> (dec row_size) + (i64.logic_right_shift branching_exponent) + (i64.left_shift branching_exponent)))) -(def: (new-path level tail) +(def: (new_path level tail) (All [a] (-> Level (Base a) (Node a))) (if (n.= 0 level) (#Base tail) - (|> (new-hierarchy []) - (array.write! 0 (new-path (level-down level) tail)) + (|> (new_hierarchy []) + (array.write! 0 (new_path (level_down level) tail)) #Hierarchy))) -(def: (new-tail singleton) +(def: (new_tail singleton) (All [a] (-> a (Base a))) (|> (array.new 1) (array.write! 0 singleton))) -(def: (push-tail size level tail parent) +(def: (push_tail size level tail parent) (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (i64.logic-right-shift level (dec size))) + (let [sub_idx (branch_idx (i64.logic_right_shift level (dec size))) ## If we're currently on a bottom node - sub-node (if (n.= branching-exponent level) + sub_node (if (n.= branching_exponent level) ## Just add the tail to it (#Base tail) ## Otherwise, check whether there's a vacant spot - (case (array.read sub-idx parent) + (case (array.read sub_idx parent) ## If so, set the path to the tail #.None - (new-path (level-down level) tail) - ## If not, push the tail onto the sub-node. - (#.Some (#Hierarchy sub-node)) - (#Hierarchy (push-tail size (level-down level) tail sub-node)) + (new_path (level_down level) tail) + ## If not, push the tail onto the sub_node. + (#.Some (#Hierarchy sub_node)) + (#Hierarchy (push_tail size (level_down level) tail sub_node)) _ (undefined)) )] (|> (array.clone parent) - (array.write! sub-idx sub-node)))) + (array.write! sub_idx sub_node)))) -(def: (expand-tail val tail) +(def: (expand_tail val tail) (All [a] (-> a (Base a) (Base a))) - (let [tail-size (array.size tail)] - (|> (array.new (inc tail-size)) - (array.copy! tail-size 0 tail 0) - (array.write! tail-size val)))) + (let [tail_size (array.size tail)] + (|> (array.new (inc tail_size)) + (array.copy! tail_size 0 tail 0) + (array.write! tail_size val)))) (def: (put' level idx val hierarchy) (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) - (let [sub-idx (branch-idx (i64.logic-right-shift level idx))] - (case (array.read sub-idx hierarchy) - (#.Some (#Hierarchy sub-node)) + (let [sub_idx (branch_idx (i64.logic_right_shift level idx))] + (case (array.read sub_idx hierarchy) + (#.Some (#Hierarchy sub_node)) (|> (array.clone hierarchy) - (array.write! sub-idx (#Hierarchy (put' (level-down level) idx val sub-node)))) + (array.write! sub_idx (#Hierarchy (put' (level_down level) idx val sub_node)))) (^multi (#.Some (#Base base)) - (n.= 0 (level-down level))) + (n.= 0 (level_down level))) (|> (array.clone hierarchy) - (array.write! sub-idx (|> (array.clone base) - (array.write! (branch-idx idx) val) + (array.write! sub_idx (|> (array.clone base) + (array.write! (branch_idx idx) val) #Base))) _ (undefined)))) -(def: (pop-tail size level hierarchy) +(def: (pop_tail size level hierarchy) (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a)))) - (let [sub-idx (branch-idx (i64.logic-right-shift level (n.- 2 size)))] - (cond (n.= 0 sub-idx) + (let [sub_idx (branch_idx (i64.logic_right_shift level (n.- 2 size)))] + (cond (n.= 0 sub_idx) #.None - (n.> branching-exponent level) + (n.> branching_exponent level) (do maybe.monad - [base|hierarchy (array.read sub-idx hierarchy) + [base|hierarchy (array.read sub_idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) - (pop-tail size (level-down level) sub) + (pop_tail size (level_down level) sub) (#Base _) (undefined))] (|> (array.clone hierarchy) - (array.write! sub-idx (#Hierarchy sub)) + (array.write! sub_idx (#Hierarchy sub)) #.Some)) ## Else... (|> (array.clone hierarchy) - (array.delete! sub-idx) + (array.delete! sub_idx) #.Some) ))) -(def: (to-list' node) +(def: (to_list' node) (All [a] (-> (Node a) (List a))) (case node (#Base base) - (array.to-list base) + (array.to_list base) (#Hierarchy hierarchy) (|> hierarchy - array.to-list + array.to_list list.reverse - (list\fold (function (_ sub acc) (list\compose (to-list' sub) acc)) + (list\fold (function (_ sub acc) (list\compose (to_list' sub) acc)) #.Nil)))) (type: #export (Row a) @@ -186,9 +186,9 @@ (def: #export empty Row - {#level (level-up root-level) + {#level (level_up root_level) #size 0 - #root (array.new full-node-size) + #root (array.new full_node_size) #tail (array.new 0)}) (def: #export (size row) @@ -198,94 +198,94 @@ (def: #export (add val row) (All [a] (-> a (Row a) (Row a))) ## Check if there is room in the tail. - (let [row-size (get@ #size row)] - (if (|> row-size (n.- (tail-off row-size)) (n.< full-node-size)) + (let [row_size (get@ #size row)] + (if (|> row_size (n.- (tail_off row_size)) (n.< full_node_size)) ## If so, append to it. (|> row (update@ #size inc) - (update@ #tail (expand-tail val))) + (update@ #tail (expand_tail val))) ## Otherwise, push tail into the tree ## -------------------------------------------------------- ## Will the root experience an overflow with this addition? - (|> (if (n.> (i64.left-shift (get@ #level row) 1) - (i64.logic-right-shift branching-exponent row-size)) + (|> (if (n.> (i64.left_shift (get@ #level row) 1) + (i64.logic_right_shift branching_exponent row_size)) ## If so, a brand-new root must be established, that is ## 1-level taller. (|> row (set@ #root (|> (for {@.old (: (Hierarchy ($ 0)) - (new-hierarchy []))} - (new-hierarchy [])) + (new_hierarchy []))} + (new_hierarchy [])) (array.write! 0 (#Hierarchy (get@ #root row))) - (array.write! 1 (new-path (get@ #level row) (get@ #tail row))))) - (update@ #level level-up)) + (array.write! 1 (new_path (get@ #level row) (get@ #tail row))))) + (update@ #level level_up)) ## Otherwise, just push the current tail onto the root. (|> row - (update@ #root (push-tail row-size (get@ #level row) (get@ #tail row))))) + (update@ #root (push_tail row_size (get@ #level row) (get@ #tail row))))) ## Finally, update the size of the row and grow a new ## tail with the new element as it's sole member. (update@ #size inc) - (set@ #tail (new-tail val))) + (set@ #tail (new_tail val))) ))) -(exception: incorrect-row-structure) +(exception: incorrect_row_structure) -(exception: #export [a] (index-out-of-bounds {row (Row a)} {index Nat}) +(exception: #export [a] (index_out_of_bounds {row (Row a)} {index Nat}) (exception.report ["Size" (\ n.decimal encode (get@ #size row))] ["Index" (\ n.decimal encode index)])) -(exception: base-was-not-found) +(exception: base_was_not_found) -(def: #export (within-bounds? row idx) +(def: #export (within_bounds? row idx) (All [a] (-> (Row a) Nat Bit)) (n.< (get@ #size row) idx)) -(def: (base-for idx row) +(def: (base_for idx row) (All [a] (-> Index (Row a) (Try (Base a)))) - (if (within-bounds? row idx) - (if (n.>= (tail-off (get@ #size row)) idx) + (if (within_bounds? row idx) + (if (n.>= (tail_off (get@ #size row)) idx) (#try.Success (get@ #tail row)) (loop [level (get@ #level row) hierarchy (get@ #root row)] - (case [(n.> branching-exponent level) - (array.read (branch-idx (i64.logic-right-shift level idx)) hierarchy)] + (case [(n.> branching_exponent level) + (array.read (branch_idx (i64.logic_right_shift level idx)) hierarchy)] [#1 (#.Some (#Hierarchy sub))] - (recur (level-down level) sub) + (recur (level_down level) sub) [#0 (#.Some (#Base base))] (#try.Success base) [_ #.None] - (exception.throw ..base-was-not-found []) + (exception.throw ..base_was_not_found []) _ - (exception.throw ..incorrect-row-structure [])))) - (exception.throw ..index-out-of-bounds [row idx]))) + (exception.throw ..incorrect_row_structure [])))) + (exception.throw ..index_out_of_bounds [row idx]))) (def: #export (nth idx row) (All [a] (-> Nat (Row a) (Try a))) (do try.monad - [base (base-for idx row)] - (case (array.read (branch-idx idx) base) + [base (base_for idx row)] + (case (array.read (branch_idx idx) base) (#.Some value) (#try.Success value) #.None - (exception.throw ..incorrect-row-structure [])))) + (exception.throw ..incorrect_row_structure [])))) (def: #export (put idx val row) (All [a] (-> Nat a (Row a) (Try (Row a)))) - (let [row-size (get@ #size row)] - (if (within-bounds? row idx) - (#try.Success (if (n.>= (tail-off row-size) idx) + (let [row_size (get@ #size row)] + (if (within_bounds? row idx) + (#try.Success (if (n.>= (tail_off row_size) idx) (update@ #tail (for {@.old (: (-> (Base ($ 0)) (Base ($ 0))) - (|>> array.clone (array.write! (branch-idx idx) val)))} - (|>> array.clone (array.write! (branch-idx idx) val))) + (|>> array.clone (array.write! (branch_idx idx) val)))} + (|>> array.clone (array.write! (branch_idx idx) val))) row) (update@ #root (put' (get@ #level row) idx val) row))) - (exception.throw ..index-out-of-bounds [row idx])))) + (exception.throw ..index_out_of_bounds [row idx])))) (def: #export (update idx f row) (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) @@ -302,25 +302,25 @@ 1 empty - row-size - (if (|> row-size (n.- (tail-off row-size)) (n.> 1)) - (let [old-tail (get@ #tail row) - new-tail-size (dec (array.size old-tail))] + row_size + (if (|> row_size (n.- (tail_off row_size)) (n.> 1)) + (let [old_tail (get@ #tail row) + new_tail_size (dec (array.size old_tail))] (|> row (update@ #size dec) - (set@ #tail (|> (array.new new-tail-size) - (array.copy! new-tail-size 0 old-tail 0))))) + (set@ #tail (|> (array.new new_tail_size) + (array.copy! new_tail_size 0 old_tail 0))))) (maybe.assume (do maybe.monad - [new-tail (base-for (n.- 2 row-size) row) - #let [[level' root'] (let [init-level (get@ #level row)] - (loop [level init-level - root (maybe.default (new-hierarchy []) - (pop-tail row-size init-level (get@ #root row)))] - (if (n.> branching-exponent level) + [new_tail (base_for (n.- 2 row_size) row) + #let [[level' root'] (let [init_level (get@ #level row)] + (loop [level init_level + root (maybe.default (new_hierarchy []) + (pop_tail row_size init_level (get@ #root row)))] + (if (n.> branching_exponent level) (case [(array.read 1 root) (array.read 0 root)] - [#.None (#.Some (#Hierarchy sub-node))] - (recur (level-down level) sub-node) + [#.None (#.Some (#Hierarchy sub_node))] + (recur (level_down level) sub_node) ## [#.None (#.Some (#Base _))] ## (undefined) @@ -332,21 +332,21 @@ (update@ #size dec) (set@ #level level') (set@ #root root') - (set@ #tail new-tail)))))) + (set@ #tail new_tail)))))) )) -(def: #export (to-list row) +(def: #export (to_list row) (All [a] (-> (Row a) (List a))) - (list\compose (to-list' (#Hierarchy (get@ #root row))) - (to-list' (#Base (get@ #tail row))))) + (list\compose (to_list' (#Hierarchy (get@ #root row))) + (to_list' (#Base (get@ #tail row))))) -(def: #export from-list +(def: #export from_list (All [a] (-> (List a) (Row a))) (list\fold ..add ..empty)) (def: #export (member? a/Equivalence row val) (All [a] (-> (Equivalence a) (Row a) a Bit)) - (list.member? a/Equivalence (to-list row) val)) + (list.member? a/Equivalence (to_list row) val)) (def: #export empty? (All [a] (-> (Row a) Bit)) @@ -355,9 +355,9 @@ (syntax: #export (row {elems (p.some s.any)}) {#.doc (doc "Row literals." (row +10 +20 +30 +40))} - (wrap (list (` (..from-list (list (~+ elems))))))) + (wrap (list (` (..from_list (list (~+ elems))))))) -(structure: (node-equivalence Equivalence<a>) +(structure: (node_equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a)))) (def: (= v1 v2) @@ -366,7 +366,7 @@ (\ (array.equivalence Equivalence<a>) = b1 b2) [(#Hierarchy h1) (#Hierarchy h2)] - (\ (array.equivalence (node-equivalence Equivalence<a>)) = h1 h2) + (\ (array.equivalence (node_equivalence Equivalence<a>)) = h1 h2) _ #0))) @@ -376,13 +376,13 @@ (def: (= v1 v2) (and (n.= (get@ #size v1) (get@ #size v2)) - (let [(^open "node\.") (node-equivalence Equivalence<a>)] + (let [(^open "node\.") (node_equivalence Equivalence<a>)] (and (node\= (#Base (get@ #tail v1)) (#Base (get@ #tail v2))) (node\= (#Hierarchy (get@ #root v1)) (#Hierarchy (get@ #root v2)))))))) -(structure: node-fold +(structure: node_fold (Fold Node) (def: (fold f init xs) @@ -399,7 +399,7 @@ (Fold Row) (def: (fold f init xs) - (let [(^open ".") node-fold] + (let [(^open ".") node_fold] (fold f (fold f init @@ -412,9 +412,9 @@ (def: identity ..empty) (def: (compose xs ys) - (list\fold add xs (..to-list ys)))) + (list\fold add xs (..to_list ys)))) -(structure: node-functor +(structure: node_functor (Functor Node) (def: (map f xs) @@ -431,7 +431,7 @@ (def: (map f xs) {#level (get@ #level xs) #size (get@ #size xs) - #root (|> xs (get@ #root) (array\map (\ node-functor map f))) + #root (|> xs (get@ #root) (array\map (\ node_functor map f))) #tail (|> xs (get@ #tail) (array\map f))})) (structure: #export apply @@ -461,7 +461,7 @@ (def: #export reverse (All [a] (-> (Row a) (Row a))) - (|>> ..to-list list.reverse (list\fold add ..empty))) + (|>> ..to_list list.reverse (list\fold add ..empty))) (template [<name> <array> <init> <op>] [(def: #export <name> diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index e76355fe1..ddb508c39 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -7,7 +7,7 @@ ["//" continuation (#+ Cont)] ["<>" parser ["<.>" code (#+ Parser)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]] @@ -65,33 +65,33 @@ 0 head _ (nth (dec idx) tail)))) -(template [<taker> <dropper> <splitter> <pred-type> <pred-test> <pred-step>] +(template [<taker> <dropper> <splitter> <pred_type> <pred_test> <pred_step>] [(def: #export (<taker> pred xs) (All [a] - (-> <pred-type> (Sequence a) (List a))) + (-> <pred_type> (Sequence a) (List a))) (let [[x xs'] (//.run xs)] - (if <pred-test> - (list& x (<taker> <pred-step> xs')) + (if <pred_test> + (list& x (<taker> <pred_step> xs')) (list)))) (def: #export (<dropper> pred xs) (All [a] - (-> <pred-type> (Sequence a) (Sequence a))) + (-> <pred_type> (Sequence a) (Sequence a))) (let [[x xs'] (//.run xs)] - (if <pred-test> - (<dropper> <pred-step> xs') + (if <pred_test> + (<dropper> <pred_step> xs') xs))) (def: #export (<splitter> pred xs) (All [a] - (-> <pred-type> (Sequence a) [(List a) (Sequence a)])) + (-> <pred_type> (Sequence a) [(List a) (Sequence a)])) (let [[x xs'] (//.run xs)] - (if <pred-test> - (let [[tail next] (<splitter> <pred-step> xs')] + (if <pred_test> + (let [[tail next] (<splitter> <pred_step> xs')] [(#.Cons [x tail]) next]) [(list) xs])))] - [take-while drop-while split-while (-> a Bit) (pred x) pred] + [take_while drop_while split_while (-> a Bit) (pred x) pred] [take drop split Nat (n.> 0 pred) (dec pred)] ) @@ -139,9 +139,9 @@ {branches (<>.some <code>.any)}) {#.doc (doc "Allows destructuring of sequences in pattern-matching expressions." "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences." - (let [(^sequence& x y z _tail) (some-sequence-func +1 +2 +3)] + (let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] (func x y z)))} - (with-gensyms [g!sequence] + (with_gensyms [g!sequence] (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) (list (` [(~ pattern) (~ g!sequence)]) (` ((~! //.run) (~ g!sequence))))) diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux index b47c5761d..67e241b78 100644 --- a/stdlib/source/lux/data/collection/set.lux +++ b/stdlib/source/lux/data/collection/set.lux @@ -15,9 +15,9 @@ (type: #export (Set a) (Dictionary a Any)) -(def: #export member-hash +(def: #export member_hash (All [a] (-> (Set a) (Hash a))) - //.key-hash) + //.key_hash) (def: #export new (All [a] (-> (Hash a) (Set a))) @@ -39,7 +39,7 @@ (All [a] (-> (Set a) a Bit)) //.key?) -(def: #export to-list +(def: #export to_list (All [a] (-> (Set a) (List a))) //.keys) @@ -49,7 +49,7 @@ (def: #export (difference sub base) (All [a] (-> (Set a) (Set a) (Set a))) - (list\fold ..remove base (..to-list sub))) + (list\fold ..remove base (..to_list sub))) (def: #export (intersection filter base) (All [a] (-> (Set a) (Set a) (Set a))) @@ -63,7 +63,7 @@ (and (n.= (..size reference) (..size sample)) (list.every? (..member? reference) - (..to-list sample))))) + (..to_list sample))))) (structure: #export hash (All [a] (Hash (Set a))) @@ -73,7 +73,7 @@ (def: (hash (^@ set [hash _])) (list\fold (function (_ elem acc) (n.+ (\ hash hash elem) acc)) 0 - (..to-list set)))) + (..to_list set)))) (structure: #export (monoid hash) (All [a] (-> (Hash a) (Monoid (Set a)))) @@ -85,13 +85,13 @@ (All [a] (-> (Set a) Bit)) (|>> ..size (n.= 0))) -(def: #export (from-list hash elements) +(def: #export (from_list hash elements) (All [a] (-> (Hash a) (List a) (Set a))) (list\fold ..add (..new hash) elements)) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bit)) - (list.every? (..member? super) (..to-list sub))) + (list.every? (..member? super) (..to_list sub))) (def: #export (super? sub super) (All [a] (-> (Set a) (Set a) Bit)) diff --git a/stdlib/source/lux/data/collection/set/multi.lux b/stdlib/source/lux/data/collection/set/multi.lux index 7e4c0f7fe..727cf2d8d 100644 --- a/stdlib/source/lux/data/collection/set/multi.lux +++ b/stdlib/source/lux/data/collection/set/multi.lux @@ -55,7 +55,7 @@ (All [a] (-> (Set a) a Nat)) (|> set :representation (dictionary.get elem) (maybe.default 0))) - (def: #export to-list + (def: #export to_list (All [a] (-> (Set a) (List a))) (|>> :representation dictionary.entries @@ -66,7 +66,7 @@ (template [<name> <compose>] [(def: #export (<name> parameter subject) (All [a] (-> (Set a) (Set a) (Set a))) - (:abstraction (dictionary.merge-with <compose> (:representation parameter) (:representation subject))))] + (:abstraction (dictionary.merge_with <compose> (:representation parameter) (:representation subject))))] [union n.max] [sum n.+] @@ -79,7 +79,7 @@ multiplicity) elem output)) - (..new (dictionary.key-hash subject)) + (..new (dictionary.key_hash subject)) (dictionary.entries subject))) (def: #export (difference parameter subject) @@ -106,7 +106,7 @@ (let [(^@ set [hash _]) (:representation set)] (|> set dictionary.keys - (//.from-list hash)))) + (//.from_list hash)))) (structure: #export equivalence (All [a] (Equivalence (Set a))) @@ -142,14 +142,14 @@ (All [a] (-> (Set a) Bit)) (|>> ..size (n.= 0))) -(def: #export (from-list hash subject) +(def: #export (from_list hash subject) (All [a] (-> (Hash a) (List a) (Set a))) (list\fold (..add 1) (..new hash) subject)) -(def: #export (from-set subject) +(def: #export (from_set subject) (All [a] (-> (//.Set a) (Set a))) - (..from-list (//.member-hash subject) - (//.to-list subject))) + (..from_list (//.member_hash subject) + (//.to_list subject))) (def: #export super? (All [a] (-> (Set a) (Set a) Bit)) diff --git a/stdlib/source/lux/data/collection/set/ordered.lux b/stdlib/source/lux/data/collection/set/ordered.lux index 68449daa3..71183d2e4 100644 --- a/stdlib/source/lux/data/collection/set/ordered.lux +++ b/stdlib/source/lux/data/collection/set/ordered.lux @@ -41,42 +41,42 @@ (All [a] (-> a (Set a) (Set a))) (|> set :representation (/.remove elem) :abstraction)) - (def: #export to-list + (def: #export to_list (All [a] (-> (Set a) (List a))) (|>> :representation /.keys)) - (def: #export (from-list &order list) + (def: #export (from_list &order list) (All [a] (-> (Order a) (List a) (Set a))) (list\fold add (..new &order) list)) (def: #export (union left right) (All [a] (-> (Set a) (Set a) (Set a))) - (list\fold ..add right (..to-list left))) + (list\fold ..add right (..to_list left))) (def: #export (intersection left right) (All [a] (-> (Set a) (Set a) (Set a))) - (|> (..to-list right) + (|> (..to_list right) (list.filter (..member? left)) - (..from-list (get@ #/.&order (:representation right))))) + (..from_list (get@ #/.&order (:representation right))))) (def: #export (difference param subject) (All [a] (-> (Set a) (Set a) (Set a))) - (|> (..to-list subject) + (|> (..to_list subject) (list.filter (|>> (..member? param) not)) - (..from-list (get@ #/.&order (:representation subject))))) + (..from_list (get@ #/.&order (:representation subject))))) (structure: #export equivalence (All [a] (Equivalence (Set a))) (def: (= reference sample) (\ (list.equivalence (\ (:representation reference) &equivalence)) - = (..to-list reference) (..to-list sample)))) + = (..to_list reference) (..to_list sample)))) ) (def: #export (sub? super sub) (All [a] (-> (Set a) (Set a) Bit)) (|> sub - ..to-list + ..to_list (list.every? (..member? super)))) (def: #export (super? sub super) diff --git a/stdlib/source/lux/data/collection/tree/finger.lux b/stdlib/source/lux/data/collection/tree/finger.lux index c18ff7251..96f7af432 100644 --- a/stdlib/source/lux/data/collection/tree/finger.lux +++ b/stdlib/source/lux/data/collection/tree/finger.lux @@ -6,7 +6,7 @@ [data [collection ["." list ("#\." monoid)]]] - [type (#+ :by-example) + [type (#+ :by_example) [abstract (#+ abstract: :abstraction :representation)]]]) (abstract: #export (Tree @ t v) @@ -90,10 +90,10 @@ (#.Some value) (0 #1 [left right]) - (let [shifted-tag (tag//compose _tag (..tag left))] - (if (predicate shifted-tag) + (let [shifted_tag (tag//compose _tag (..tag left))] + (if (predicate shifted_tag) (recur _tag (get@ #root (:representation left))) - (recur shifted-tag (get@ #root (:representation right)))))))) + (recur shifted_tag (get@ #root (:representation right)))))))) #.None))) ) diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 2ce752cfd..82d421715 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -20,15 +20,15 @@ (def: rgb 256) (def: top (dec rgb)) -(def: rgb-factor (|> top .int int.frac)) +(def: rgb_factor (|> top .int int.frac)) -(def: scale-down +(def: scale_down (-> Nat Frac) - (|>> .int int.frac (f./ rgb-factor))) + (|>> .int int.frac (f./ rgb_factor))) -(def: scale-up +(def: scale_up (-> Frac Nat) - (|>> (f.* rgb-factor) f.int .nat)) + (|>> (f.* rgb_factor) f.int .nat)) (type: #export RGB {#red Nat @@ -50,13 +50,13 @@ (abstract: #export Color RGB - (def: #export (from-rgb [red green blue]) + (def: #export (from_rgb [red green blue]) (-> RGB Color) (:abstraction {#red (n.% ..rgb red) #green (n.% ..rgb green) #blue (n.% ..rgb blue)})) - (def: #export to-rgb + (def: #export to_rgb (-> Color RGB) (|>> :representation)) @@ -78,17 +78,17 @@ (def: (hash value) (let [[r g b] (:representation value)] ($_ i64.or - (i64.left-shift 16 r) - (i64.left-shift 8 g) + (i64.left_shift 16 r) + (i64.left_shift 8 g) b)))) (def: #export black - (..from-rgb {#red 0 + (..from_rgb {#red 0 #green 0 #blue 0})) (def: #export white - (..from-rgb {#red ..top + (..from_rgb {#red ..top #green ..top #blue ..top})) @@ -128,12 +128,12 @@ #blue (n.min lB rB)})))) ) -(def: #export (to-hsl color) +(def: #export (to_hsl color) (-> Color HSL) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) luminance (|> (f.+ max min) (f./ +2.0))] @@ -163,7 +163,7 @@ saturation luminance])))) -(def: (hue-to-rgb p q t) +(def: (hue_to_rgb p q t) (-> Frac Frac Frac Frac) (let [t (cond (f.< +0.0 t) (f.+ +1.0 t) (f.> +1.0 t) (f.- +1.0 t) @@ -182,12 +182,12 @@ ## else p))) -(def: #export (from-hsl [hue saturation luminance]) +(def: #export (from_hsl [hue saturation luminance]) (-> HSL Color) (if (f.= +0.0 saturation) ## Achromatic - (let [intensity (scale-up luminance)] - (from-rgb {#red intensity + (let [intensity (scale_up luminance)] + (from_rgb {#red intensity #green intensity #blue intensity})) ## Chromatic @@ -196,16 +196,16 @@ (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) p (|> luminance (f.* +2.0) (f.- q)) third (|> +1.0 (f./ +3.0))] - (from-rgb {#red (scale-up (|> hue (f.+ third) (hue-to-rgb p q))) - #green (scale-up (|> hue (hue-to-rgb p q))) - #blue (scale-up (|> hue (f.- third) (hue-to-rgb p q)))})))) + (from_rgb {#red (scale_up (|> hue (f.+ third) (hue_to_rgb p q))) + #green (scale_up (|> hue (hue_to_rgb p q))) + #blue (scale_up (|> hue (f.- third) (hue_to_rgb p q)))})))) -(def: #export (to-hsb color) +(def: #export (to_hsb color) (-> Color HSB) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) brightness max @@ -232,7 +232,7 @@ saturation brightness])))) -(def: #export (from-hsb [hue saturation brightness]) +(def: #export (from_hsb [hue saturation brightness]) (-> HSB Color) (let [hue (|> hue (f.* +6.0)) i (math.floor hue) @@ -245,16 +245,16 @@ red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] - (from-rgb {#red (scale-up red) - #green (scale-up green) - #blue (scale-up blue)}))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)}))) -(def: #export (to-cmyk color) +(def: #export (to_cmyk color) (-> Color CMYK) - (let [[red green blue] (to-rgb color) - red (scale-down red) - green (scale-down green) - blue (scale-down blue) + (let [[red green blue] (to_rgb color) + red (scale_down red) + green (scale_down green) + blue (scale_down blue) key (|> +1.0 (f.- ($_ f.max red green blue))) f (if (f.< +1.0 key) (|> +1.0 (f./ (|> +1.0 (f.- key)))) @@ -267,10 +267,10 @@ #yellow yellow #key key})) -(def: #export (from-cmyk [cyan magenta yellow key]) +(def: #export (from_cmyk [cyan magenta yellow key]) (-> CMYK Color) (if (f.= +1.0 key) - (from-rgb {#red 0 + (from_rgb {#red 0 #green 0 #blue 0}) (let [red (|> (|> +1.0 (f.- cyan)) @@ -279,9 +279,9 @@ (f.* (|> +1.0 (f.- key)))) blue (|> (|> +1.0 (f.- yellow)) (f.* (|> +1.0 (f.- key))))] - (from-rgb {#red (scale-up red) - #green (scale-up green) - #blue (scale-up blue)})))) + (from_rgb {#red (scale_up red) + #green (scale_up green) + #blue (scale_up blue)})))) (def: (normalize ratio) (-> Frac Frac) @@ -304,9 +304,9 @@ (f.+ (|> end .int int.frac (f.* dE))) f.int .nat))) - [redS greenS blueS] (to-rgb start) - [redE greenE blueE] (to-rgb end)] - (from-rgb {#red (interpolate' redE redS) + [redS greenS blueS] (to_rgb start) + [redE greenE blueE] (to_rgb end)] + (from_rgb {#red (interpolate' redE redS) #green (interpolate' greenE greenS) #blue (interpolate' blueE blueS)}))) @@ -322,53 +322,53 @@ (template [<name> <op>] [(def: #export (<name> ratio color) (-> Frac Color Color) - (let [[hue saturation luminance] (to-hsl color)] - (from-hsl [hue + (let [[hue saturation luminance] (to_hsl color)] + (from_hsl [hue (|> saturation (f.* (|> +1.0 (<op> (..normalize ratio)))) (f.min +1.0)) luminance])))] [saturate f.+] - [de-saturate f.-] + [de_saturate f.-] ) -(def: #export (gray-scale color) +(def: #export (gray_scale color) (-> Color Color) - (let [[_ _ luminance] (to-hsl color)] - (from-hsl [+0.0 + (let [[_ _ luminance] (to_hsl color)] + (from_hsl [+0.0 +0.0 luminance]))) (template [<name> <1> <2>] [(def: #export (<name> color) (-> Color [Color Color Color]) - (let [[hue saturation luminance] (to-hsl color)] + (let [[hue saturation luminance] (to_hsl color)] [color - (from-hsl [(|> hue (f.+ <1>) ..normalize) + (from_hsl [(|> hue (f.+ <1>) ..normalize) saturation luminance]) - (from-hsl [(|> hue (f.+ <2>) ..normalize) + (from_hsl [(|> hue (f.+ <2>) ..normalize) saturation luminance])]))] [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] - [split-complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] ) (template [<name> <1> <2> <3>] [(def: #export (<name> color) (-> Color [Color Color Color Color]) - (let [[hue saturation luminance] (to-hsb color)] + (let [[hue saturation luminance] (to_hsb color)] [color - (from-hsb [(|> hue (f.+ <1>) ..normalize) + (from_hsb [(|> hue (f.+ <1>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <2>) ..normalize) + (from_hsb [(|> hue (f.+ <2>) ..normalize) saturation luminance]) - (from-hsb [(|> hue (f.+ <3>) ..normalize) + (from_hsb [(|> hue (f.+ <3>) ..normalize) saturation luminance])]))] @@ -384,17 +384,17 @@ (def: #export (analogous spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (list\map (function (_ idx) - (from-hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) + (from_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) saturation brightness])) (list.indices variations)))) (def: #export (monochromatic spread variations color) (-> Spread Nat Color (List Color)) - (let [[hue saturation brightness] (to-hsb color) + (let [[hue saturation brightness] (to_hsb color) spread (..normalize spread)] (|> (list.indices variations) (list\map (|>> inc .int int.frac @@ -402,7 +402,7 @@ (f.+ brightness) ..normalize [hue saturation] - from-hsb))))) + from_hsb))))) (type: #export Alpha Rev) diff --git a/stdlib/source/lux/data/color/named.lux b/stdlib/source/lux/data/color/named.lux index 09e021727..39c762081 100644 --- a/stdlib/source/lux/data/color/named.lux +++ b/stdlib/source/lux/data/color/named.lux @@ -7,140 +7,140 @@ (template [<red> <green> <blue> <name>] [(def: #export <name> Color - (//.from-rgb {#//.red (hex <red>) + (//.from_rgb {#//.red (hex <red>) #//.green (hex <green>) #//.blue (hex <blue>)}))] - ["F0" "F8" "FF" alice-blue] - ["FA" "EB" "D7" antique-white] + ["F0" "F8" "FF" alice_blue] + ["FA" "EB" "D7" antique_white] ["00" "FF" "FF" aqua] ["7F" "FF" "D4" aquamarine] ["F0" "FF" "FF" azure] ["F5" "F5" "DC" beige] ["FF" "E4" "C4" bisque] ["00" "00" "00" black] - ["FF" "EB" "CD" blanched-almond] + ["FF" "EB" "CD" blanched_almond] ["00" "00" "FF" blue] - ["8A" "2B" "E2" blue-violet] + ["8A" "2B" "E2" blue_violet] ["A5" "2A" "2A" brown] - ["DE" "B8" "87" burly-wood] - ["5F" "9E" "A0" cadet-blue] + ["DE" "B8" "87" burly_wood] + ["5F" "9E" "A0" cadet_blue] ["7F" "FF" "00" chartreuse] ["D2" "69" "1E" chocolate] ["FF" "7F" "50" coral] - ["64" "95" "ED" cornflower-blue] + ["64" "95" "ED" cornflower_blue] ["FF" "F8" "DC" cornsilk] ["DC" "14" "3C" crimson] ["00" "FF" "FF" cyan] - ["00" "00" "8B" dark-blue] - ["00" "8B" "8B" dark-cyan] - ["B8" "86" "0B" dark-goldenrod] - ["A9" "A9" "A9" dark-gray] - ["00" "64" "00" dark-green] - ["BD" "B7" "6B" dark-khaki] - ["8B" "00" "8B" dark-magenta] - ["55" "6B" "2F" dark-olive-green] - ["FF" "8C" "00" dark-orange] - ["99" "32" "CC" dark-orchid] - ["8B" "00" "00" dark-red] - ["E9" "96" "7A" dark-salmon] - ["8F" "BC" "8F" dark-sea-green] - ["48" "3D" "8B" dark-slate-blue] - ["2F" "4F" "4F" dark-slate-gray] - ["00" "CE" "D1" dark-turquoise] - ["94" "00" "D3" dark-violet] - ["FF" "14" "93" deep-pink] - ["00" "BF" "FF" deep-sky-blue] - ["69" "69" "69" dim-gray] - ["1E" "90" "FF" dodger-blue] - ["B2" "22" "22" fire-brick] - ["FF" "FA" "F0" floral-white] - ["22" "8B" "22" forest-green] + ["00" "00" "8B" dark_blue] + ["00" "8B" "8B" dark_cyan] + ["B8" "86" "0B" dark_goldenrod] + ["A9" "A9" "A9" dark_gray] + ["00" "64" "00" dark_green] + ["BD" "B7" "6B" dark_khaki] + ["8B" "00" "8B" dark_magenta] + ["55" "6B" "2F" dark_olive_green] + ["FF" "8C" "00" dark_orange] + ["99" "32" "CC" dark_orchid] + ["8B" "00" "00" dark_red] + ["E9" "96" "7A" dark_salmon] + ["8F" "BC" "8F" dark_sea_green] + ["48" "3D" "8B" dark_slate_blue] + ["2F" "4F" "4F" dark_slate_gray] + ["00" "CE" "D1" dark_turquoise] + ["94" "00" "D3" dark_violet] + ["FF" "14" "93" deep_pink] + ["00" "BF" "FF" deep_sky_blue] + ["69" "69" "69" dim_gray] + ["1E" "90" "FF" dodger_blue] + ["B2" "22" "22" fire_brick] + ["FF" "FA" "F0" floral_white] + ["22" "8B" "22" forest_green] ["FF" "00" "FF" fuchsia] ["DC" "DC" "DC" gainsboro] - ["F8" "F8" "FF" ghost-white] + ["F8" "F8" "FF" ghost_white] ["FF" "D7" "00" gold] ["DA" "A5" "20" goldenrod] ["80" "80" "80" gray] ["00" "80" "00" green] - ["AD" "FF" "2F" green-yellow] - ["F0" "FF" "F0" honey-dew] - ["FF" "69" "B4" hot-pink] - ["CD" "5C" "5C" indian-red] + ["AD" "FF" "2F" green_yellow] + ["F0" "FF" "F0" honey_dew] + ["FF" "69" "B4" hot_pink] + ["CD" "5C" "5C" indian_red] ["4B" "00" "82" indigo] ["FF" "FF" "F0" ivory] ["F0" "E6" "8C" khaki] ["E6" "E6" "FA" lavender] - ["FF" "F0" "F5" lavender-blush] - ["7C" "FC" "00" lawn-green] - ["FF" "FA" "CD" lemon-chiffon] - ["AD" "D8" "E6" light-blue] - ["F0" "80" "80" light-coral] - ["E0" "FF" "FF" light-cyan] - ["FA" "FA" "D2" light-goldenrod-yellow] - ["D3" "D3" "D3" light-gray] - ["90" "EE" "90" light-green] - ["FF" "B6" "C1" light-pink] - ["FF" "A0" "7A" light-salmon] - ["20" "B2" "AA" light-sea-green] - ["87" "CE" "FA" light-sky-blue] - ["77" "88" "99" light-slate-gray] - ["B0" "C4" "DE" light-steel-blue] - ["FF" "FF" "E0" light-yellow] + ["FF" "F0" "F5" lavender_blush] + ["7C" "FC" "00" lawn_green] + ["FF" "FA" "CD" lemon_chiffon] + ["AD" "D8" "E6" light_blue] + ["F0" "80" "80" light_coral] + ["E0" "FF" "FF" light_cyan] + ["FA" "FA" "D2" light_goldenrod_yellow] + ["D3" "D3" "D3" light_gray] + ["90" "EE" "90" light_green] + ["FF" "B6" "C1" light_pink] + ["FF" "A0" "7A" light_salmon] + ["20" "B2" "AA" light_sea_green] + ["87" "CE" "FA" light_sky_blue] + ["77" "88" "99" light_slate_gray] + ["B0" "C4" "DE" light_steel_blue] + ["FF" "FF" "E0" light_yellow] ["00" "FF" "00" lime] - ["32" "CD" "32" lime-green] + ["32" "CD" "32" lime_green] ["FA" "F0" "E6" linen] ["FF" "00" "FF" magenta] ["80" "00" "00" maroon] - ["66" "CD" "AA" medium-aquamarine] - ["00" "00" "CD" medium-blue] - ["BA" "55" "D3" medium-orchid] - ["93" "70" "DB" medium-purple] - ["3C" "B3" "71" medium-sea-green] - ["7B" "68" "EE" medium-slate-blue] - ["00" "FA" "9A" medium-spring-green] - ["48" "D1" "CC" medium-turquoise] - ["C7" "15" "85" medium-violet-red] - ["19" "19" "70" midnight-blue] - ["F5" "FF" "FA" mint-cream] - ["FF" "E4" "E1" misty-rose] + ["66" "CD" "AA" medium_aquamarine] + ["00" "00" "CD" medium_blue] + ["BA" "55" "D3" medium_orchid] + ["93" "70" "DB" medium_purple] + ["3C" "B3" "71" medium_sea_green] + ["7B" "68" "EE" medium_slate_blue] + ["00" "FA" "9A" medium_spring_green] + ["48" "D1" "CC" medium_turquoise] + ["C7" "15" "85" medium_violet_red] + ["19" "19" "70" midnight_blue] + ["F5" "FF" "FA" mint_cream] + ["FF" "E4" "E1" misty_rose] ["FF" "E4" "B5" moccasin] - ["FF" "DE" "AD" navajo-white] + ["FF" "DE" "AD" navajo_white] ["00" "00" "80" navy] - ["FD" "F5" "E6" old-lace] + ["FD" "F5" "E6" old_lace] ["80" "80" "00" olive] - ["6B" "8E" "23" olive-drab] + ["6B" "8E" "23" olive_drab] ["FF" "A5" "00" orange] - ["FF" "45" "00" orange-red] + ["FF" "45" "00" orange_red] ["DA" "70" "D6" orchid] - ["EE" "E8" "AA" pale-goldenrod] - ["98" "FB" "98" pale-green] - ["AF" "EE" "EE" pale-turquoise] - ["DB" "70" "93" pale-violet-red] - ["FF" "EF" "D5" papaya-whip] - ["FF" "DA" "B9" peach-puff] + ["EE" "E8" "AA" pale_goldenrod] + ["98" "FB" "98" pale_green] + ["AF" "EE" "EE" pale_turquoise] + ["DB" "70" "93" pale_violet_red] + ["FF" "EF" "D5" papaya_whip] + ["FF" "DA" "B9" peach_puff] ["CD" "85" "3F" peru] ["FF" "C0" "CB" pink] ["DD" "A0" "DD" plum] - ["B0" "E0" "E6" powder-blue] + ["B0" "E0" "E6" powder_blue] ["80" "00" "80" purple] - ["66" "33" "99" rebecca-purple] + ["66" "33" "99" rebecca_purple] ["FF" "00" "00" red] - ["BC" "8F" "8F" rosy-brown] - ["41" "69" "E1" royal-blue] - ["8B" "45" "13" saddle-brown] + ["BC" "8F" "8F" rosy_brown] + ["41" "69" "E1" royal_blue] + ["8B" "45" "13" saddle_brown] ["FA" "80" "72" salmon] - ["F4" "A4" "60" sandy-brown] - ["2E" "8B" "57" sea-green] - ["FF" "F5" "EE" sea-shell] + ["F4" "A4" "60" sandy_brown] + ["2E" "8B" "57" sea_green] + ["FF" "F5" "EE" sea_shell] ["A0" "52" "2D" sienna] ["C0" "C0" "C0" silver] - ["87" "CE" "EB" sky-blue] - ["6A" "5A" "CD" slate-blue] - ["70" "80" "90" slate-gray] + ["87" "CE" "EB" sky_blue] + ["6A" "5A" "CD" slate_blue] + ["70" "80" "90" slate_gray] ["FF" "FA" "FA" snow] - ["00" "FF" "7F" spring-green] - ["46" "82" "B4" steel-blue] + ["00" "FF" "7F" spring_green] + ["46" "82" "B4" steel_blue] ["D2" "B4" "8C" tan] ["00" "80" "80" teal] ["D8" "BF" "D8" thistle] @@ -149,7 +149,7 @@ ["EE" "82" "EE" violet] ["F5" "DE" "B3" wheat] ["FF" "FF" "FF" white] - ["F5" "F5" "F5" white-smoke] + ["F5" "F5" "F5" white_smoke] ["FF" "FF" "00" yellow] - ["9A" "CD" "32" yellow-green] + ["9A" "CD" "32" yellow_green] ) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index d32829e88..078331963 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -29,7 +29,7 @@ (def: mask (-> Size (I64 Any)) - (|>> (n.* i64.bits-per-byte) i64.mask)) + (|>> (n.* i64.bits_per_byte) i64.mask)) (type: #export Mutation (-> [Offset Binary] [Offset Binary])) @@ -37,7 +37,7 @@ (type: #export Specification [Size Mutation]) -(def: #export no-op +(def: #export no_op Specification [0 function.identity]) @@ -49,7 +49,7 @@ (Monoid Specification) (def: identity - ..no-op) + ..no_op) (def: (compose [sizeL mutL] [sizeR mutR]) [(n.+ sizeL sizeR) @@ -109,7 +109,7 @@ (def: #export any (Writer Any) - (function.constant ..no-op)) + (function.constant ..no_op)) (def: #export bit (Writer Bit) @@ -125,7 +125,7 @@ (def: #export frac (Writer Frac) - (|>> frac.to-bits ..bits/64)) + (|>> frac.to_bits ..bits/64)) (def: #export (segment size) (-> Nat (Writer Binary)) @@ -178,12 +178,12 @@ [(def: #export (<name> valueW) (All [v] (-> (Writer v) (Writer (Row v)))) (function (_ value) - (let [original-count (row.size value) - capped-count (i64.and (..mask <size>) - original-count) - value (if (n.= original-count capped-count) + (let [original_count (row.size value) + capped_count (i64.and (..mask <size>) + original_count) + value (if (n.= original_count capped_count) value - (|> value row.to-list (list.take capped-count) row.from-list)) + (|> value row.to_list (list.take capped_count) row.from_list)) (^open "specification\.") ..monoid [size mutation] (|> value (row\map valueW) @@ -195,7 +195,7 @@ (function (_ [offset binary]) (try.assume (do try.monad - [_ (<write> offset capped-count binary)] + [_ (<write> offset capped_count binary)] (wrap (mutation [(n.+ <size> offset) binary])))))])))] [row/8 /.size/8 binary.write/8] @@ -216,7 +216,7 @@ (def: #export (set value) (All [a] (-> (Writer a) (Writer (Set a)))) - (|>> set.to-list (..list value))) + (|>> set.to_list (..list value))) (def: #export name (Writer Name) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 04b7a51d1..0ac868859 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,7 +1,7 @@ (.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." "For more information, please see: http://www.json.org/")} [lux #* - ["." meta (#+ monad with-gensyms)] + ["." meta (#+ monad with_gensyms)] [abstract [equivalence (#+ Equivalence)] [codec (#+ Codec)] @@ -61,7 +61,7 @@ (def: #export object (-> (List [String JSON]) JSON) - (|>> (dictionary.from-list text.hash) #..Object)) + (|>> (dictionary.from_list text.hash) #..Object)) (syntax: #export (json token) {#.doc (doc "A simple way to produce JSON literals." @@ -75,9 +75,9 @@ (let [(^open ".") ..monad wrapper (function (_ x) (` (..json (~ x))))] (case token - (^template [<ast-tag> <ctor> <json-tag>] - [[_ (<ast-tag> value)] - (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))]) + (^template [<ast_tag> <ctor> <json_tag>] + [[_ (<ast_tag> value)] + (wrap (list (` (: JSON (<json_tag> (~ (<ctor> value)))))))]) ([#.Bit code.bit #..Boolean] [#.Frac code.frac #..Number] [#.Text code.text #..String]) @@ -93,13 +93,13 @@ [pairs' (monad.map ! (function (_ [slot value]) (case slot - [_ (#.Text key-name)] - (wrap (` [(~ (code.text key-name)) (~ (wrapper value))])) + [_ (#.Text key_name)] + (wrap (` [(~ (code.text key_name)) (~ (wrapper value))])) _ (meta.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#..Object ((~! dictionary.from-list) + (wrap (list (` (: JSON (#..Object ((~! dictionary.from_list) (~! text.hash) (list (~+ pairs'))))))))) @@ -155,11 +155,11 @@ (#try.Failure error) (#try.Failure error)))] - [get-boolean #Boolean Boolean "booleans"] - [get-number #Number Number "numbers"] - [get-string #String String "strings"] - [get-array #Array Array "arrays"] - [get-object #Object Object "objects"] + [get_boolean #Boolean Boolean "booleans"] + [get_number #Number Number "numbers"] + [get_string #String String "strings"] + [get_array #Array Array "arrays"] + [get_object #Object Object "objects"] ) (structure: #export equivalence @@ -206,17 +206,17 @@ ############################################################ ############################################################ -(def: (format-null _) +(def: (format_null _) (-> Null Text) "null") -(def: format-boolean +(def: format_boolean (-> Boolean Text) (|>> (case> #0 "false" #1 "true"))) -(def: format-number +(def: format_number (-> Number Text) (|>> (case> (^or +0.0 -0.0) "0.0" @@ -226,12 +226,12 @@ (|> raw (text.split 1) maybe.assume product.right)))))) (def: escape "\") -(def: escaped-dq (text\compose ..escape text.double-quote)) +(def: escaped_dq (text\compose ..escape text.double_quote)) -(def: format-string +(def: format_string (-> String Text) - (|>> (text.replace-all text.double-quote ..escaped-dq) - (text.enclose [text.double-quote text.double-quote]))) + (|>> (text.replace_all text.double_quote ..escaped_dq) + (text.enclose [text.double_quote text.double_quote]))) (template [<token> <name>] [(def: <name> @@ -239,36 +239,36 @@ <token>)] ["," separator] - [":" entry-separator] + [":" entry_separator] - ["[" open-array] - ["]" close-array] + ["[" open_array] + ["]" close_array] - ["{" open-object] - ["}" close-object] + ["{" open_object] + ["}" close_object] ) -(def: (format-array format) +(def: (format_array format) (-> (-> JSON Text) (-> Array Text)) (|>> (row\map format) - row.to-list - (text.join-with ..separator) - (text.enclose [..open-array ..close-array]))) + row.to_list + (text.join_with ..separator) + (text.enclose [..open_array ..close_array]))) -(def: (format-kv format [key value]) +(def: (format_kv format [key value]) (-> (-> JSON Text) (-> [String JSON] Text)) ($_ text\compose - (..format-string key) - ..entry-separator + (..format_string key) + ..entry_separator (format value) )) -(def: (format-object format) +(def: (format_object format) (-> (-> JSON Text) (-> Object Text)) (|>> dictionary.entries - (list\map (..format-kv format)) - (text.join-with ..separator) - (text.enclose [..open-object ..close-object]))) + (list\map (..format_kv format)) + (text.join_with ..separator) + (text.enclose [..open_object ..close_object]))) (def: #export (format json) (-> JSON Text) @@ -276,30 +276,30 @@ (^template [<tag> <format>] [(<tag> value) (<format> value)]) - ([#Null ..format-null] - [#Boolean ..format-boolean] - [#Number ..format-number] - [#String ..format-string] - [#Array (..format-array format)] - [#Object (..format-object format)]) + ([#Null ..format_null] + [#Boolean ..format_boolean] + [#Number ..format_number] + [#String ..format_string] + [#Array (..format_array format)] + [#Object (..format_object format)]) )) ############################################################ ############################################################ ############################################################ -(def: parse-space +(def: parse_space (Parser Text) (<text>.some <text>.space)) -(def: parse-separator +(def: parse_separator (Parser [Text Any Text]) ($_ <>.and - ..parse-space + ..parse_space (<text>.this ..separator) - ..parse-space)) + ..parse_space)) -(def: parse-null +(def: parse_null (Parser Null) (do <>.monad [_ (<text>.this "null")] @@ -312,17 +312,17 @@ [_ (<text>.this <token>)] (wrap <value>)))] - [parse-true "true" #1] - [parse-false "false" #0] + [parse_true "true" #1] + [parse_false "false" #0] ) -(def: parse-boolean +(def: parse_boolean (Parser Boolean) ($_ <>.either - ..parse-true - ..parse-false)) + ..parse_true + ..parse_false)) -(def: parse-number +(def: parse_number (Parser Number) (do {! <>.monad} [signed? (<>.parses? (<text>.this "-")) @@ -333,7 +333,7 @@ (<text>.many <text>.decimal))) exp (<>.default "" (do ! - [mark (<text>.one-of "eE") + [mark (<text>.one_of "eE") signed?' (<>.parses? (<text>.this "-")) offset (<text>.many <text>.decimal)] (wrap ($_ text\compose mark (if signed?' "-" "") offset))))] @@ -344,77 +344,77 @@ (#try.Success value) (wrap value)))) -(def: parse-escaped +(def: parse_escaped (Parser Text) ($_ <>.either (<>.after (<text>.this "\t") (<>\wrap text.tab)) (<>.after (<text>.this "\b") - (<>\wrap text.back-space)) + (<>\wrap text.back_space)) (<>.after (<text>.this "\n") - (<>\wrap text.new-line)) + (<>\wrap text.new_line)) (<>.after (<text>.this "\r") - (<>\wrap text.carriage-return)) + (<>\wrap text.carriage_return)) (<>.after (<text>.this "\f") - (<>\wrap text.form-feed)) - (<>.after (<text>.this (text\compose "\" text.double-quote)) - (<>\wrap text.double-quote)) + (<>\wrap text.form_feed)) + (<>.after (<text>.this (text\compose "\" text.double_quote)) + (<>\wrap text.double_quote)) (<>.after (<text>.this "\\") (<>\wrap "\")))) -(def: parse-string +(def: parse_string (Parser String) - (<| (<text>.enclosed [text.double-quote text.double-quote]) + (<| (<text>.enclosed [text.double_quote text.double_quote]) (loop [_ []]) (do {! <>.monad} - [chars (<text>.some (<text>.none-of (text\compose "\" text.double-quote))) + [chars (<text>.some (<text>.none_of (text\compose "\" text.double_quote))) stop <text>.peek]) (if (text\= "\" stop) (do ! - [escaped parse-escaped - next-chars (recur [])] - (wrap ($_ text\compose chars escaped next-chars))) + [escaped parse_escaped + next_chars (recur [])] + (wrap ($_ text\compose chars escaped next_chars))) (wrap chars)))) -(def: (parse-kv parse-json) +(def: (parse_kv parse_json) (-> (Parser JSON) (Parser [String JSON])) (do <>.monad - [key ..parse-string - _ ..parse-space - _ (<text>.this ..entry-separator) - _ ..parse-space - value parse-json] + [key ..parse_string + _ ..parse_space + _ (<text>.this ..entry_separator) + _ ..parse_space + value parse_json] (wrap [key value]))) -(template [<name> <type> <open> <close> <elem-parser> <prep>] - [(def: (<name> parse-json) +(template [<name> <type> <open> <close> <elem_parser> <prep>] + [(def: (<name> parse_json) (-> (Parser JSON) (Parser <type>)) (do <>.monad [_ (<text>.this <open>) - _ parse-space - elems (<>.sep-by ..parse-separator <elem-parser>) - _ parse-space + _ parse_space + elems (<>.sep_by ..parse_separator <elem_parser>) + _ parse_space _ (<text>.this <close>)] (wrap (<prep> elems))))] - [parse-array Array ..open-array ..close-array parse-json row.from-list] - [parse-object Object ..open-object ..close-object (parse-kv parse-json) (dictionary.from-list text.hash)] + [parse_array Array ..open_array ..close_array parse_json row.from_list] + [parse_object Object ..open_object ..close_object (parse_kv parse_json) (dictionary.from_list text.hash)] ) -(def: parse-json +(def: parse_json (Parser JSON) (<>.rec - (function (_ parse-json) + (function (_ parse_json) ($_ <>.or - parse-null - parse-boolean - parse-number - parse-string - (parse-array parse-json) - (parse-object parse-json))))) + parse_null + parse_boolean + parse_number + parse_string + (parse_array parse_json) + (parse_object parse_json))))) (structure: #export codec (Codec Text JSON) (def: encode ..format) - (def: decode (<text>.run parse-json))) + (def: decode (<text>.run parse_json))) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 0b55a77a2..16b801676 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -32,29 +32,29 @@ (type: Size Nat) -(def: octal-size Size 8) +(def: octal_size Size 8) -(def: (octal-padding max-size number) +(def: (octal_padding max_size number) (-> Size Text Text) - (let [padding-size (n.- (text.size number) - max-size) + (let [padding_size (n.- (text.size number) + max_size) padding (|> "0" - (list.repeat padding-size) - (text.join-with ""))] + (list.repeat padding_size) + (text.join_with ""))] (format padding number))) (def: blank " ") (def: null text.null) -(def: small-size Size 6) -(def: big-size Size 11) +(def: small_size Size 6) +(def: big_size Size 11) (template [<exception> <limit> <size> <type> <in> <out> <writer> <suffix> <coercion>] [(def: #export <limit> Nat - (|> ..octal-size + (|> ..octal_size (list.repeat <size>) (list\fold n.* 1) inc)) @@ -80,13 +80,13 @@ (def: <writer> (Writer <type>) (let [suffix <suffix> - padded-size (n.+ (text.size suffix) <size>)] + padded_size (n.+ (text.size suffix) <size>)] (|>> :representation (\ n.octal encode) - (..octal-padding <size>) + (..octal_padding <size>) (text.suffix suffix) (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) (def: <coercion> (-> Nat <type>) @@ -94,53 +94,53 @@ :abstraction)) )] - [not-a-small-number small-limit ..small-size - Small small from-small - small-writer (format ..blank ..null) - coerce-small] - [not-a-big-number big-limit ..big-size - Big big from-big - big-writer ..blank - coerce-big] + [not_a_small_number small_limit ..small_size + Small small from_small + small_writer (format ..blank ..null) + coerce_small] + [not_a_big_number big_limit ..big_size + Big big from_big + big_writer ..blank + coerce_big] ) -(exception: #export (wrong-character {expected Char} {actual Char}) +(exception: #export (wrong_character {expected Char} {actual Char}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(def: verify-small-suffix +(def: verify_small_suffix (Parser Any) (do <>.monad - [pre-end <b>.bits/8 + [pre_end <b>.bits/8 end <b>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong-character [expected pre-end]) - (n.= expected pre-end))) + (<>.assert (exception.construct ..wrong_character [expected pre_end]) + (n.= expected pre_end))) _ (let [expected (`` (char (~~ (static ..null))))] - (<>.assert (exception.construct ..wrong-character [expected end]) + (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end)))] (wrap []))) -(def: small-parser +(def: small_parser (Parser Small) (do <>.monad - [digits (<b>.segment ..small-size) + [digits (<b>.segment ..small_size) digits (<>.lift (\ encoding.utf8 decode digits)) - _ ..verify-small-suffix] + _ ..verify_small_suffix] (<>.lift (do {! try.monad} [value (\ n.octal decode digits)] (..small value))))) -(def: big-parser +(def: big_parser (Parser Big) (do <>.monad - [digits (<b>.segment ..big-size) + [digits (<b>.segment ..big_size) digits (<>.lift (\ encoding.utf8 decode digits)) end <b>.bits/8 _ (let [expected (`` (char (~~ (static ..blank))))] - (<>.assert (exception.construct ..wrong-character [expected end]) + (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end)))] (<>.lift (do {! try.monad} @@ -150,58 +150,58 @@ (abstract: Checksum Text - (def: from-checksum + (def: from_checksum (-> Checksum Text) (|>> :representation)) - (def: dummy-checksum + (def: dummy_checksum Checksum (:abstraction " ")) - (def: checksum-suffix + (def: checksum_suffix (format ..blank ..null)) (def: checksum (-> Binary Nat) (binary.fold n.+ 0)) - (def: checksum-checksum - (|> ..dummy-checksum + (def: checksum_checksum + (|> ..dummy_checksum :representation (\ encoding.utf8 encode) ..checksum)) - (def: checksum-code + (def: checksum_code (-> Binary Checksum) (|>> ..checksum - ..coerce-small - ..from-small + ..coerce_small + ..from_small (\ n.octal encode) - (..octal-padding ..small-size) - (text.suffix ..checksum-suffix) + (..octal_padding ..small_size) + (text.suffix ..checksum_suffix) :abstraction)) - (def: checksum-writer + (def: checksum_writer (Writer Checksum) - (let [padded-size (n.+ (text.size ..checksum-suffix) - ..small-size)] + (let [padded_size (n.+ (text.size ..checksum_suffix) + ..small_size)] (|>> :representation (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) - (def: checksum-parser + (def: checksum_parser (Parser [Nat Checksum]) (do <>.monad - [ascii (<b>.segment ..small-size) + [ascii (<b>.segment ..small_size) digits (<>.lift (\ encoding.utf8 decode ascii)) - _ ..verify-small-suffix + _ ..verify_small_suffix value (<>.lift (\ n.octal decode digits))] (wrap [value - (:abstraction (format digits ..checksum-suffix))]))) + (:abstraction (format digits ..checksum_suffix))]))) ) -(def: last-ascii +(def: last_ascii Char (number.hex "007F")) @@ -210,17 +210,17 @@ (|>> (\ encoding.utf8 encode) (binary.fold (function (_ char verdict) (.and verdict - (n.<= ..last-ascii char))) + (n.<= ..last_ascii char))) true))) -(exception: #export (not-ascii {text Text}) +(exception: #export (not_ascii {text Text}) (exception.report ["Text" (%.text text)])) -(def: #export name-size Size 31) -(def: #export path-size Size 99) +(def: #export name_size Size 31) +(def: #export path_size Size 99) -(def: (un-pad string) +(def: (un_pad string) (-> Binary (Try Binary)) (case (binary.size string) 0 (#try.Success string) @@ -228,8 +228,8 @@ (case end 0 (#try.Success (\ encoding.utf8 encode "")) _ (do try.monad - [last-char (binary.read/8 end string)] - (`` (case (.nat last-char) + [last_char (binary.read/8 end string)] + (`` (case (.nat last_char) (^ (char (~~ (static ..null)))) (recur (dec end)) @@ -252,7 +252,7 @@ (if (|> value (\ encoding.utf8 encode) binary.size (n.<= <size>)) (#try.Success (:abstraction value)) (exception.throw <exception> [value])) - (exception.throw ..not-ascii [value]))) + (exception.throw ..not_ascii [value]))) (def: #export <out> (-> <type> <representation>) @@ -261,11 +261,11 @@ (def: <writer> (Writer <type>) (let [suffix ..null - padded-size (n.+ (text.size suffix) <size>)] + padded_size (n.+ (text.size suffix) <size>)] (|>> :representation (text.suffix suffix) (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) (def: <parser> (Parser <type>) @@ -273,11 +273,11 @@ [string (<b>.segment <size>) end <b>.bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong-character [expected end]) + _ (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end))] (<>.lift (do {! try.monad} - [ascii (..un-pad string) + [ascii (..un_pad string) text (\ encoding.utf8 decode ascii)] (<in> text))))) @@ -286,114 +286,114 @@ (try.assume (<in> ""))) )] - [Name Text ..name-size name-is-too-long name from-name name-writer name-parser anonymous] - [Path file.Path ..path-size path-is-too-long path from-path path-writer path-parser no-path] + [Name Text ..name_size name_is_too_long name from_name name_writer name_parser anonymous] + [Path file.Path ..path_size path_is_too_long path from_path path_writer path_parser no_path] ) -(def: magic-size Size 7) +(def: magic_size Size 7) (abstract: Magic Text (def: ustar (:abstraction "ustar ")) - (def: from-magic + (def: from_magic (-> Magic Text) (|>> :representation)) - (def: magic-writer + (def: magic_writer (Writer Magic) - (let [padded-size (n.+ (text.size ..null) - ..magic-size)] + (let [padded_size (n.+ (text.size ..null) + ..magic_size)] (|>> :representation (\ encoding.utf8 encode) - (format.segment padded-size)))) + (format.segment padded_size)))) - (def: magic-parser + (def: magic_parser (Parser Magic) (do <>.monad - [string (<b>.segment ..magic-size) + [string (<b>.segment ..magic_size) end <b>.bits/8 #let [expected (`` (char (~~ (static ..null))))] - _ (<>.assert (exception.construct ..wrong-character [expected end]) + _ (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end))] (<>.lift (\ try.monad map (|>> :abstraction) (\ encoding.utf8 decode string))))) ) -(def: block-size Size 512) +(def: block_size Size 512) -(def: owner-id-size ..small-size) +(def: owner_id_size ..small_size) -(def: blank-size Size (text.size ..blank)) -(def: null-size Size (text.size ..null)) -(def: mode-size Size ..small-size) -(def: content-size Size ..big-size) -(def: modification-time-size Size ..big-size) -(def: checksum-size Size ..small-size) -(def: link-flag-size Size 1) -(def: device-size Size ..small-size) +(def: blank_size Size (text.size ..blank)) +(def: null_size Size (text.size ..null)) +(def: mode_size Size ..small_size) +(def: content_size Size ..big_size) +(def: modification_time_size Size ..big_size) +(def: checksum_size Size ..small_size) +(def: link_flag_size Size 1) +(def: device_size Size ..small_size) -(def: small-number +(def: small_number (-> Size Size) - (|>> ($_ n.+ ..blank-size ..null-size))) + (|>> ($_ n.+ ..blank_size ..null_size))) -(def: big-number +(def: big_number (-> Size Size) - (|>> ($_ n.+ ..blank-size))) + (|>> ($_ n.+ ..blank_size))) (def: string (-> Size Size) - (|>> ($_ n.+ ..null-size))) + (|>> ($_ n.+ ..null_size))) -(def: header-size +(def: header_size ($_ n.+ ## name - (..string ..path-size) + (..string ..path_size) ## mode - (..small-number ..mode-size) + (..small_number ..mode_size) ## uid - (..small-number ..owner-id-size) + (..small_number ..owner_id_size) ## gid - (..small-number ..owner-id-size) + (..small_number ..owner_id_size) ## size - (..big-number ..content-size) + (..big_number ..content_size) ## mtime - (..big-number ..modification-time-size) + (..big_number ..modification_time_size) ## chksum - (..small-number ..checksum-size) + (..small_number ..checksum_size) ## linkflag - ..link-flag-size + ..link_flag_size ## linkname - (..string ..path-size) + (..string ..path_size) ## magic - (..string ..magic-size) + (..string ..magic_size) ## uname - (..string ..name-size) + (..string ..name_size) ## gname - (..string ..name-size) + (..string ..name_size) ## devmajor - (..small-number ..device-size) + (..small_number ..device_size) ## devminor - (..small-number ..device-size))) + (..small_number ..device_size))) -(abstract: Link-Flag +(abstract: Link_Flag Char - (def: link-flag - (-> Link-Flag Char) + (def: link_flag + (-> Link_Flag Char) (|>> :representation)) - (def: link-flag-writer - (Writer Link-Flag) + (def: link_flag_writer + (Writer Link_Flag) (|>> :representation format.bits/8)) - (with-expansions [<options> (as-is [0 old-normal] + (with_expansions [<options> (as_is [0 old_normal] [(char "0") normal] [(char "1") link] - [(char "2") symbolic-link] + [(char "2") symbolic_link] [(char "3") character] [(char "4") block] [(char "5") directory] @@ -401,29 +401,29 @@ [(char "7") contiguous])] (template [<flag> <name>] [(def: <name> - Link-Flag + Link_Flag (:abstraction <flag>))] <options> ) - (exception: #export (invalid-link-flag {value Nat}) + (exception: #export (invalid_link_flag {value Nat}) (exception.report ["Value" (%.nat value)])) - (def: link-flag-parser - (Parser Link-Flag) + (def: link_flag_parser + (Parser Link_Flag) (do <>.monad [linkflag <b>.bits/8] (case (.nat linkflag) - (^template [<value> <link-flag>] + (^template [<value> <link_flag>] [(^ <value>) - (wrap <link-flag>)]) + (wrap <link_flag>)]) (<options>) _ (<>.lift - (exception.throw ..invalid-link-flag [(.nat linkflag)])))))) + (exception.throw ..invalid_link_flag [(.nat linkflag)])))))) ) (abstract: #export Mode @@ -439,34 +439,34 @@ (i64.or (:representation left) (:representation right)))) - (def: mode-writer + (def: mode_writer (Writer Mode) (|>> :representation ..small try.assume - ..small-writer)) + ..small_writer)) - (exception: #export (invalid-mode {value Nat}) + (exception: #export (invalid_mode {value Nat}) (exception.report ["Value" (%.nat value)])) - (with-expansions [<options> (as-is ["0000" none] + (with_expansions [<options> (as_is ["0000" none] - ["0001" execute-by-other] - ["0002" write-by-other] - ["0004" read-by-other] + ["0001" execute_by_other] + ["0002" write_by_other] + ["0004" read_by_other] - ["0010" execute-by-group] - ["0020" write-by-group] - ["0040" read-by-group] + ["0010" execute_by_group] + ["0020" write_by_group] + ["0040" read_by_group] - ["0100" execute-by-owner] - ["0200" write-by-owner] - ["0400" read-by-owner] + ["0100" execute_by_owner] + ["0200" write_by_owner] + ["0400" read_by_owner] - ["1000" save-text] - ["2000" set-group-id-on-execution] - ["4000" set-user-id-on-execution])] + ["1000" save_text] + ["2000" set_group_id_on_execution] + ["4000" set_user_id_on_execution])] (template [<code> <name>] [(def: #export <name> Mode @@ -475,43 +475,43 @@ <options> ) - (def: maximum-mode + (def: maximum_mode Mode ($_ and ..none - ..execute-by-other - ..write-by-other - ..read-by-other + ..execute_by_other + ..write_by_other + ..read_by_other - ..execute-by-group - ..write-by-group - ..read-by-group + ..execute_by_group + ..write_by_group + ..read_by_group - ..execute-by-owner - ..write-by-owner - ..read-by-owner + ..execute_by_owner + ..write_by_owner + ..read_by_owner - ..save-text - ..set-group-id-on-execution - ..set-user-id-on-execution + ..save_text + ..set_group_id_on_execution + ..set_user_id_on_execution )) - (def: mode-parser + (def: mode_parser (Parser Mode) (do {! <>.monad} - [value (\ ! map ..from-small ..small-parser)] - (if (n.<= (:representation ..maximum-mode) + [value (\ ! map ..from_small ..small_parser)] + (if (n.<= (:representation ..maximum_mode) value) (wrap (:abstraction value)) (<>.lift - (exception.throw ..invalid-mode [value])))))) + (exception.throw ..invalid_mode [value])))))) ) -(def: maximum-content-size +(def: maximum_content_size Nat - (|> ..octal-size - (list.repeat ..content-size) + (|> ..octal_size + (list.repeat ..content_size) (list\fold n.* 1))) (abstract: #export Content @@ -523,7 +523,7 @@ [size (..big (binary.size content))] (wrap (:abstraction [size content])))) - (def: from-content + (def: from_content (-> Content [Big Binary]) (|>> :representation)) @@ -535,9 +535,9 @@ (type: #export ID Small) -(def: #export no-id +(def: #export no_id ID - (..coerce-small 0)) + (..coerce_small 0)) (type: #export Owner {#name Name @@ -551,20 +551,20 @@ [Path Instant Mode Ownership Content]) (type: #export Normal File) -(type: #export Symbolic-Link Path) +(type: #export Symbolic_Link Path) (type: #export Directory Path) (type: #export Contiguous File) (type: #export Entry (#Normal ..Normal) - (#Symbolic-Link ..Symbolic-Link) + (#Symbolic_Link ..Symbolic_Link) (#Directory ..Directory) (#Contiguous ..Contiguous)) (type: #export Device Small) -(def: no-device +(def: no_device Device (try.assume (..small 0))) @@ -573,163 +573,163 @@ (def: (blocks size) (-> Big Nat) - (n.+ (n./ ..block-size - (..from-big size)) - (case (n.% ..block-size (..from-big size)) + (n.+ (n./ ..block_size + (..from_big size)) + (case (n.% ..block_size (..from_big size)) 0 0 _ 1))) -(def: rounded-content-size +(def: rounded_content_size (-> Big Nat) (|>> ..blocks - (n.* ..block-size))) + (n.* ..block_size))) (type: Header {#path Path #mode Mode - #user-id ID - #group-id ID + #user_id ID + #group_id ID #size Big - #modification-time Big + #modification_time Big #checksum Checksum - #link-flag Link-Flag - #link-name Path + #link_flag Link_Flag + #link_name Path #magic Magic - #user-name Name - #group-name Name - #major-device Device - #minor-device Device}) + #user_name Name + #group_name Name + #major_device Device + #minor_device Device}) -(def: header-writer' +(def: header_writer' (Writer Header) ($_ format.and - ..path-writer - ..mode-writer - ..small-writer - ..small-writer - ..big-writer - ..big-writer - ..checksum-writer - ..link-flag-writer - ..path-writer - ..magic-writer - ..name-writer - ..name-writer - ..small-writer - ..small-writer + ..path_writer + ..mode_writer + ..small_writer + ..small_writer + ..big_writer + ..big_writer + ..checksum_writer + ..link_flag_writer + ..path_writer + ..magic_writer + ..name_writer + ..name_writer + ..small_writer + ..small_writer )) -(def: (header-writer header) +(def: (header_writer header) (Writer Header) (let [checksum (|> header - (set@ #checksum ..dummy-checksum) - (format.run ..header-writer') - ..checksum-code)] + (set@ #checksum ..dummy_checksum) + (format.run ..header_writer') + ..checksum_code)] (|> header (set@ #checksum checksum) - (format.run ..header-writer') - (format.segment ..block-size)))) + (format.run ..header_writer') + (format.segment ..block_size)))) -(def: modification-time +(def: modification_time (-> Instant Big) (|>> instant.relative (duration.query duration.second) .nat - ..coerce-big)) + ..coerce_big)) -(def: (file-writer link-flag) - (-> Link-Flag (Writer File)) - (function (_ [path modification-time mode ownership content]) - (let [[size content] (..from-content content) +(def: (file_writer link_flag) + (-> Link_Flag (Writer File)) + (function (_ [path modification_time mode ownership content]) + (let [[size content] (..from_content content) writer ($_ format.and - ..header-writer - (format.segment (..rounded-content-size size)))] + ..header_writer + (format.segment (..rounded_content_size size)))] (writer [{#path path #mode mode - #user-id (get@ [#user #id] ownership) - #group-id (get@ [#group #id] ownership) + #user_id (get@ [#user #id] ownership) + #group_id (get@ [#group #id] ownership) #size size - #modification-time (..modification-time modification-time) - #checksum ..dummy-checksum - #link-flag link-flag - #link-name ..no-path + #modification_time (..modification_time modification_time) + #checksum ..dummy_checksum + #link_flag link_flag + #link_name ..no_path #magic ..ustar - #user-name (get@ [#user #name] ownership) - #group-name (get@ [#group #name] ownership) - #major-device ..no-device - #minor-device ..no-device} + #user_name (get@ [#user #name] ownership) + #group_name (get@ [#group #name] ownership) + #major_device ..no_device + #minor_device ..no_device} content])))) -(def: normal-file-writer +(def: normal_file_writer (Writer File) - (..file-writer ..normal)) + (..file_writer ..normal)) -(def: contiguous-file-writer +(def: contiguous_file_writer (Writer File) - (..file-writer ..contiguous)) + (..file_writer ..contiguous)) -(def: (symbolic-link-writer path) +(def: (symbolic_link_writer path) (Writer Path) - (..header-writer - {#path ..no-path + (..header_writer + {#path ..no_path #mode ..none - #user-id ..no-id - #group-id ..no-id - #size (..coerce-big 0) - #modification-time (..coerce-big 0) - #checksum ..dummy-checksum - #link-flag ..symbolic-link - #link-name path + #user_id ..no_id + #group_id ..no_id + #size (..coerce_big 0) + #modification_time (..coerce_big 0) + #checksum ..dummy_checksum + #link_flag ..symbolic_link + #link_name path #magic ..ustar - #user-name ..anonymous - #group-name ..anonymous - #major-device ..no-device - #minor-device ..no-device})) + #user_name ..anonymous + #group_name ..anonymous + #major_device ..no_device + #minor_device ..no_device})) -(def: (directory-writer path) +(def: (directory_writer path) (Writer Path) - (..header-writer + (..header_writer {#path path #mode ..none - #user-id ..no-id - #group-id ..no-id - #size (..coerce-big 0) - #modification-time (..coerce-big 0) - #checksum ..dummy-checksum - #link-flag ..directory - #link-name ..no-path + #user_id ..no_id + #group_id ..no_id + #size (..coerce_big 0) + #modification_time (..coerce_big 0) + #checksum ..dummy_checksum + #link_flag ..directory + #link_name ..no_path #magic ..ustar - #user-name ..anonymous - #group-name ..anonymous - #major-device ..no-device - #minor-device ..no-device})) + #user_name ..anonymous + #group_name ..anonymous + #major_device ..no_device + #minor_device ..no_device})) -(def: entry-writer +(def: entry_writer (Writer Entry) - (|>> (case> (#Normal value) (..normal-file-writer value) - (#Symbolic-Link value) (..symbolic-link-writer value) - (#Directory value) (..directory-writer value) - (#Contiguous value) (..contiguous-file-writer value)))) + (|>> (case> (#Normal value) (..normal_file_writer value) + (#Symbolic_Link value) (..symbolic_link_writer value) + (#Directory value) (..directory_writer value) + (#Contiguous value) (..contiguous_file_writer value)))) -(def: end-of-archive-size Size (n.* 2 ..block-size)) +(def: end_of_archive_size Size (n.* 2 ..block_size)) (def: #export writer (Writer Tar) - (let [end-of-archive (binary.create ..end-of-archive-size)] + (let [end_of_archive (binary.create ..end_of_archive_size)] (function (_ tar) (format\compose (row\fold (function (_ next total) - (format\compose total (..entry-writer next))) + (format\compose total (..entry_writer next))) format\identity tar) - (format.segment ..end-of-archive-size end-of-archive))))) + (format.segment ..end_of_archive_size end_of_archive))))) -(exception: #export (wrong-checksum {expected Nat} {actual Nat}) +(exception: #export (wrong_checksum {expected Nat} {actual Nat}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) -(def: header-padding-size - (n.- header-size block-size)) +(def: header_padding_size + (n.- header_size block_size)) ## When the checksum gets originally calculated, the assumption is that all the characters in the checksum field ## of the header will be spaces. @@ -737,132 +737,132 @@ ## an incorrect result, as the contents of the checksum field would be an actual checksum, instead of just spaces. ## To correct for this, it is necessary to calculate the checksum of just the checksum field, subtract that, and then ## add-in the checksum of the spaces. -(def: (expected-checksum checksum header) +(def: (expected_checksum checksum header) (-> Checksum Binary Nat) (let [|checksum| (|> checksum - ..from-checksum + ..from_checksum (\ encoding.utf8 encode) ..checksum)] (|> (..checksum header) (n.- |checksum|) - (n.+ ..checksum-checksum)))) + (n.+ ..checksum_checksum)))) -(def: header-parser +(def: header_parser (Parser Header) (do <>.monad - [binary-header (<>.speculative (<b>.segment block-size)) - path ..path-parser - mode ..mode-parser - user-id ..small-parser - group-id ..small-parser - size ..big-parser - modification-time ..big-parser - [actual checksum-code] ..checksum-parser - _ (let [expected (expected-checksum checksum-code binary-header)] + [binary_header (<>.speculative (<b>.segment block_size)) + path ..path_parser + mode ..mode_parser + user_id ..small_parser + group_id ..small_parser + size ..big_parser + modification_time ..big_parser + [actual checksum_code] ..checksum_parser + _ (let [expected (expected_checksum checksum_code binary_header)] (<>.lift - (exception.assert ..wrong-checksum [expected actual] + (exception.assert ..wrong_checksum [expected actual] (n.= expected actual)))) - link-flag ..link-flag-parser - link-name ..path-parser - magic ..magic-parser - user-name ..name-parser - group-name ..name-parser - major-device ..small-parser - minor-device ..small-parser - _ (<b>.segment ..header-padding-size)] + link_flag ..link_flag_parser + link_name ..path_parser + magic ..magic_parser + user_name ..name_parser + group_name ..name_parser + major_device ..small_parser + minor_device ..small_parser + _ (<b>.segment ..header_padding_size)] (wrap {#path path #mode mode - #user-id user-id - #group-id group-id + #user_id user_id + #group_id group_id #size size - #modification-time modification-time - #checksum checksum-code - #link-flag link-flag - #link-name link-name + #modification_time modification_time + #checksum checksum_code + #link_flag link_flag + #link_name link_name #magic magic - #user-name user-name - #group-name group-name - #major-device major-device - #minor-device minor-device}))) + #user_name user_name + #group_name group_name + #major_device major_device + #minor_device minor_device}))) -(exception: #export (wrong-link-flag {expected Link-Flag} {actual Link-Flag}) +(exception: #export (wrong_link_flag {expected Link_Flag} {actual Link_Flag}) (exception.report - ["Expected" (%.nat (..link-flag expected))] - ["Actual" (%.nat (..link-flag actual))])) + ["Expected" (%.nat (..link_flag expected))] + ["Actual" (%.nat (..link_flag actual))])) -(def: (file-parser expected) - (-> Link-Flag (Parser File)) +(def: (file_parser expected) + (-> Link_Flag (Parser File)) (do <>.monad - [header ..header-parser - _ (<>.assert (exception.construct ..wrong-link-flag [expected (get@ #link-flag header)]) - (is? expected (get@ #link-flag header))) + [header ..header_parser + _ (<>.assert (exception.construct ..wrong_link_flag [expected (get@ #link_flag header)]) + (is? expected (get@ #link_flag header))) #let [size (get@ #size header) - rounded-size (..rounded-content-size size)] - content (<b>.segment (..from-big size)) + rounded_size (..rounded_content_size size)] + content (<b>.segment (..from_big size)) content (<>.lift (..content content)) - _ (<b>.segment (n.- (..from-big size) rounded-size))] + _ (<b>.segment (n.- (..from_big size) rounded_size))] (wrap [(get@ #path header) (|> header - (get@ #modification-time) - ..from-big + (get@ #modification_time) + ..from_big .int - duration.from-millis - (duration.scale-up (|> duration.second duration.to-millis .nat)) + duration.from_millis + (duration.scale_up (|> duration.second duration.to_millis .nat)) instant.absolute) (get@ #mode header) - {#user {#name (get@ #user-name header) - #id (get@ #user-id header)} - #group {#name (get@ #group-name header) - #id (get@ #group-id header)}} + {#user {#name (get@ #user_name header) + #id (get@ #user_id header)} + #group {#name (get@ #group_name header) + #id (get@ #group_id header)}} content]))) -(def: (file-name-parser expected extractor) - (-> Link-Flag (-> Header Path) (Parser Path)) +(def: (file_name_parser expected extractor) + (-> Link_Flag (-> Header Path) (Parser Path)) (do <>.monad - [header ..header-parser + [header ..header_parser _ (<>.lift - (exception.assert ..wrong-link-flag [expected (get@ #link-flag header)] - (n.= (..link-flag expected) - (..link-flag (get@ #link-flag header)))))] + (exception.assert ..wrong_link_flag [expected (get@ #link_flag header)] + (n.= (..link_flag expected) + (..link_flag (get@ #link_flag header)))))] (wrap (extractor header)))) -(def: entry-parser +(def: entry_parser (Parser Entry) ($_ <>.either (\ <>.monad map (|>> #..Normal) - (<>.either (..file-parser ..normal) - (..file-parser ..old-normal))) - (\ <>.monad map (|>> #..Symbolic-Link) - (..file-name-parser ..symbolic-link (get@ #link-name))) + (<>.either (..file_parser ..normal) + (..file_parser ..old_normal))) + (\ <>.monad map (|>> #..Symbolic_Link) + (..file_name_parser ..symbolic_link (get@ #link_name))) (\ <>.monad map (|>> #..Directory) - (..file-name-parser ..directory (get@ #path))) + (..file_name_parser ..directory (get@ #path))) (\ <>.monad map (|>> #..Contiguous) - (..file-parser ..contiguous)))) + (..file_parser ..contiguous)))) ## It's safe to implement the parser this way because the range of values for Nat is 2^64 ## Whereas the maximum possible value for the checksum of a 512 block is (256 × 512) = 131,072 -(def: end-of-archive-block-parser +(def: end_of_archive_block_parser (Parser Any) (do <>.monad - [block (<b>.segment ..block-size)] + [block (<b>.segment ..block_size)] (let [actual (..checksum block)] (<>.lift - (exception.assert ..wrong-checksum [0 actual] + (exception.assert ..wrong_checksum [0 actual] (n.= 0 actual)))))) -(exception: #export invalid-end-of-archive) +(exception: #export invalid_end_of_archive) -(def: end-of-archive-parser +(def: end_of_archive_parser (Parser Any) (do <>.monad - [_ (<>.at-most 2 end-of-archive-block-parser) + [_ (<>.at_most 2 end_of_archive_block_parser) done? <b>.end?] (<>.lift - (exception.assert ..invalid-end-of-archive [] + (exception.assert ..invalid_end_of_archive [] done?)))) (def: #export parser (Parser Tar) - (|> (<>.some entry-parser) - (\ <>.monad map row.from-list) - (<>.before ..end-of-archive-parser))) + (|> (<>.some entry_parser) + (\ <>.monad map row.from_list) + (<>.before ..end_of_archive_parser))) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 4f79fb4c9..8c040d828 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -36,20 +36,20 @@ (#Text Text) (#Node Tag Attrs (List XML))) -(def: namespace-separator +(def: namespace_separator ":") -(def: xml-standard-escape-char^ +(def: xml_standard_escape_char^ (Parser Text) ($_ <>.either (<>.after (<text>.this "<") (<>\wrap "<")) (<>.after (<text>.this ">") (<>\wrap ">")) (<>.after (<text>.this "&") (<>\wrap "&")) (<>.after (<text>.this "'") (<>\wrap "'")) - (<>.after (<text>.this """) (<>\wrap text.double-quote)) + (<>.after (<text>.this """) (<>\wrap text.double_quote)) )) -(def: xml-unicode-escape-char^ +(def: xml_unicode_escape_char^ (Parser Text) (|> (do <>.monad [hex? (<>.maybe (<text>.this "x")) @@ -59,74 +59,74 @@ (#.Some _) (<>.codec int.decimal (<text>.many <text>.hexadecimal)))] - (wrap (|> code .nat text.from-code))) + (wrap (|> code .nat text.from_code))) (<>.before (<text>.this ";")) (<>.after (<text>.this "&#")))) -(def: xml-escape-char^ +(def: xml_escape_char^ (Parser Text) - (<>.either xml-standard-escape-char^ - xml-unicode-escape-char^)) + (<>.either xml_standard_escape_char^ + xml_unicode_escape_char^)) -(def: xml-char^ +(def: xml_char^ (Parser Text) - (<>.either (<text>.none-of ($_ text\compose "<>&'" text.double-quote)) - xml-escape-char^)) + (<>.either (<text>.none_of ($_ text\compose "<>&'" text.double_quote)) + xml_escape_char^)) -(def: xml-identifier +(def: xml_identifier (Parser Text) (do <>.monad - [head (<>.either (<text>.one-of "_") + [head (<>.either (<text>.one_of "_") <text>.alpha) - tail (<text>.some (<>.either (<text>.one-of "_.-") - <text>.alpha-num))] + tail (<text>.some (<>.either (<text>.one_of "_.-") + <text>.alpha_num))] (wrap ($_ text\compose head tail)))) -(def: namespaced-symbol^ +(def: namespaced_symbol^ (Parser Name) (do <>.monad - [first-part xml-identifier - ?second-part (<| <>.maybe (<>.after (<text>.this ..namespace-separator)) xml-identifier)] - (case ?second-part + [first_part xml_identifier + ?second_part (<| <>.maybe (<>.after (<text>.this ..namespace_separator)) xml_identifier)] + (case ?second_part #.None - (wrap ["" first-part]) + (wrap ["" first_part]) - (#.Some second-part) - (wrap [first-part second-part])))) + (#.Some second_part) + (wrap [first_part second_part])))) -(def: tag^ namespaced-symbol^) -(def: attr-name^ namespaced-symbol^) +(def: tag^ namespaced_symbol^) +(def: attr_name^ namespaced_symbol^) (def: spaced^ (All [a] (-> (Parser a) (Parser a))) - (let [white-space^ (<>.some <text>.space)] - (|>> (<>.before white-space^) - (<>.after white-space^)))) + (let [white_space^ (<>.some <text>.space)] + (|>> (<>.before white_space^) + (<>.after white_space^)))) -(def: attr-value^ +(def: attr_value^ (Parser Text) - (let [value^ (<text>.some xml-char^)] - (<>.either (<text>.enclosed [text.double-quote text.double-quote] value^) + (let [value^ (<text>.some xml_char^)] + (<>.either (<text>.enclosed [text.double_quote text.double_quote] value^) (<text>.enclosed ["'" "'"] value^)))) (def: attrs^ (Parser Attrs) - (<| (\ <>.monad map (dictionary.from-list name.hash)) + (<| (\ <>.monad map (dictionary.from_list name.hash)) <>.some - (<>.and (spaced^ attr-name^)) + (<>.and (spaced^ attr_name^)) (<>.after (<text>.this "=")) - (spaced^ attr-value^))) + (spaced^ attr_value^))) -(def: (close-tag^ expected) +(def: (close_tag^ expected) (-> Tag (Parser [])) (do <>.monad [actual (|> tag^ spaced^ (<>.after (<text>.this "/")) (<text>.enclosed ["<" ">"]))] - (<>.assert ($_ text\compose "Close tag does not match open tag." text.new-line - "Expected: " (name\encode expected) text.new-line - " Actual: " (name\encode actual) text.new-line) + (<>.assert ($_ text\compose "Close tag does not match open tag." text.new_line + "Expected: " (name\encode expected) text.new_line + " Actual: " (name\encode actual) text.new_line) (name\= expected actual)))) (def: comment^ @@ -136,7 +136,7 @@ (<text>.enclosed ["<--" "-->"]) spaced^)) -(def: xml-header^ +(def: xml_header^ (Parser Attrs) (|> (spaced^ attrs^) (<>.before (<text>.this "?>")) @@ -154,12 +154,12 @@ (def: text^ (Parser XML) (|> (<>.either cdata^ - (..spaced^ (<text>.many xml-char^))) + (..spaced^ (<text>.many xml_char^))) (<>\map (|>> #Text)))) (def: null^ (Parser Any) - (<text>.this (text.from-code 0))) + (<text>.this (text.from_code 0))) (def: xml^ (Parser XML) @@ -171,60 +171,60 @@ [_ (<text>.this "<") tag (spaced^ tag^) attrs (spaced^ attrs^) - #let [no-children^ (do <>.monad + #let [no_children^ (do <>.monad [_ (<text>.this "/>")] (wrap (#Node tag attrs (list)))) - with-children^ (do <>.monad + with_children^ (do <>.monad [_ (<text>.this ">") children (<>.some node^) - _ (close-tag^ tag)] + _ (close_tag^ tag)] (wrap (#Node tag attrs children)))]] - (<>.either no-children^ - with-children^)))))) + (<>.either no_children^ + with_children^)))))) ## This is put outside of the call to "rec" because comments ## cannot be located inside of XML nodes. ## This way, the comments can only be before or after the main document. (<>.before (<>.some comment^)) (<>.before (<>.some ..null^)) (<>.after (<>.some comment^)) - (<>.after (<>.maybe xml-header^)))) + (<>.after (<>.maybe xml_header^)))) (def: read (-> Text (Try XML)) (<text>.run xml^)) -(def: (sanitize-value input) +(def: (sanitize_value input) (-> Text Text) (|> input - (text.replace-all "&" "&") - (text.replace-all "<" "<") - (text.replace-all ">" ">") - (text.replace-all "'" "'") - (text.replace-all text.double-quote """))) + (text.replace_all "&" "&") + (text.replace_all "<" "<") + (text.replace_all ">" ">") + (text.replace_all "'" "'") + (text.replace_all text.double_quote """))) (def: #export (tag [namespace name]) (-> Tag Text) (case namespace "" name - _ ($_ text\compose namespace ..namespace-separator name))) + _ ($_ text\compose namespace ..namespace_separator name))) (def: #export attribute (-> Attribute Text) ..tag) -(def: (write-attrs attrs) +(def: (write_attrs attrs) (-> Attrs Text) (|> attrs dictionary.entries (list\map (function (_ [key value]) - ($_ text\compose (..attribute key) "=" text.double-quote (sanitize-value value) text.double-quote))) - (text.join-with " "))) + ($_ text\compose (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) + (text.join_with " "))) -(def: xml-header +(def: xml_header Text (let [quote (: (-> Text Text) (function (_ value) - ($_ text\compose text.double-quote value text.double-quote)))] + ($_ text\compose text.double_quote value text.double_quote)))] ($_ text\compose "<?xml" " version=" (quote "1.0") @@ -234,35 +234,35 @@ (def: (write input) (-> XML Text) ($_ text\compose - ..xml-header text.new-line + ..xml_header text.new_line (loop [prefix "" input input] (case input (#Text value) - (sanitize-value value) + (sanitize_value value) - (^ (#Node xml-tag xml-attrs (list (#Text value)))) - (let [tag (..tag xml-tag) - attrs (if (dictionary.empty? xml-attrs) + (^ (#Node xml_tag xml_attrs (list (#Text value)))) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) "" - ($_ text\compose " " (..write-attrs xml-attrs)))] + ($_ text\compose " " (..write_attrs xml_attrs)))] ($_ text\compose prefix "<" tag attrs ">" - (sanitize-value value) + (sanitize_value value) "</" tag ">")) - (#Node xml-tag xml-attrs xml-children) - (let [tag (..tag xml-tag) - attrs (if (dictionary.empty? xml-attrs) + (#Node xml_tag xml_attrs xml_children) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) "" - ($_ text\compose " " (..write-attrs xml-attrs)))] - (if (list.empty? xml-children) + ($_ text\compose " " (..write_attrs xml_attrs)))] + (if (list.empty? xml_children) ($_ text\compose prefix "<" tag attrs "/>") ($_ text\compose prefix "<" tag attrs ">" - (|> xml-children - (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new-line))) - (text.join-with "")) - text.new-line prefix "</" tag ">"))))) + (|> xml_children + (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new_line))) + (text.join_with "")) + text.new_line prefix "</" tag ">"))))) )) (structure: #export codec diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 87be68d66..d92050e90 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -11,7 +11,7 @@ ["s" code]] [concurrency ["." atom]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)]] [type @@ -30,15 +30,15 @@ _ (let [value (generator [])] - (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) + (exec (io.run (atom.compare_and_swap _ (#.Some value) cache)) value))))))) - (def: #export (thaw l-value) + (def: #export (thaw l_value) (All [a] (-> (Lazy a) a)) - ((:representation l-value) []))) + ((:representation l_value) []))) (syntax: #export (freeze expr) - (with-gensyms [g!_] + (with_gensyms [g!_] (wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr)))))))) (structure: #export (equivalence (^open "_\.")) diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux index c9a32cf6a..697987a16 100644 --- a/stdlib/source/lux/data/name.lux +++ b/stdlib/source/lux/data/name.lux @@ -38,18 +38,21 @@ (\ text.order < shortP shortS) (\ text.order < moduleP moduleS)))) +(def: separator + ".") + (structure: #export codec (Codec Text Name) (def: (encode [module short]) (case module "" short - _ ($_ text\compose module "." short))) + _ ($_ text\compose module ..separator short))) (def: (decode input) (if (text\= "" input) (#.Left (text\compose "Invalid format for Name: " input)) - (case (text.split-all-with "." input) + (case (text.split_all_with ..separator input) (^ (list short)) (#.Right ["" short]) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4ac7ed07b..dd7dba194 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,9 +12,9 @@ ["#." rev] ["#." frac]]) -(macro: (encoding-doc tokens state) +(macro: (encoding_doc tokens state) (case tokens - (^ (list [location (#.Text encoding)] example-1 example-2)) + (^ (list [location (#.Text encoding)] example_1 example_2)) (let [encoding ($_ "lux text concat" "Given syntax for a " encoding @@ -22,13 +22,13 @@ commas "Allows for the presence of commas among the digits." description [location (#.Text ($_ "lux text concat" encoding " " commas))]] (#try.Success [state (list (` (doc (~ description) - (~ example-1) - (~ example-2))))])) + (~ example_1) + (~ example_2))))])) _ - (#try.Failure "Wrong syntax for 'encoding-doc'."))) + (#try.Failure "Wrong syntax for 'encoding_doc'."))) -(def: (comma-prefixed? number) +(def: (comma_prefixed? number) (-> Text Bit) (case ("lux text index" 0 "," number) (#.Some 0) @@ -37,18 +37,18 @@ _ #0)) -(def: clean-commas +(def: clean_commas (-> Text Text) - (text.replace-all "," "")) + (text.replace_all "," "")) (template [<macro> <nat> <int> <rev> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) {#.doc <doc>} (case tokens (#.Cons [meta (#.Text repr')] #.Nil) - (if (comma-prefixed? repr') + (if (comma_prefixed? repr') (#try.Failure <error>) - (let [repr (clean-commas repr')] + (let [repr (clean_commas repr')] (case (\ <nat> decode repr) (#try.Success value) (#try.Success [state (list [meta (#.Nat value)])]) @@ -73,11 +73,11 @@ [bin /nat.binary /int.binary /rev.binary /frac.binary "Invalid binary syntax." - (encoding-doc "binary" (bin "11001001") (bin "11,00,10,01"))] + (encoding_doc "binary" (bin "11001001") (bin "11,00,10,01"))] [oct /nat.octal /int.octal /rev.octal /frac.octal "Invalid octal syntax." - (encoding-doc "octal" (oct "615243") (oct "615,243"))] + (encoding_doc "octal" (oct "615243") (oct "615,243"))] [hex /nat.hex /int.hex /rev.hex /frac.hex "Invalid hexadecimal syntax." - (encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))] + (encoding_doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))] ) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 306815880..500b9870a 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -45,9 +45,9 @@ (def: #export zero (..complex +0.0 +0.0)) -(def: #export (not-a-number? complex) - (or (f.not-a-number? (get@ #real complex)) - (f.not-a-number? (get@ #imaginary complex)))) +(def: #export (not_a_number? complex) + (or (f.not_a_number? (get@ #real complex)) + (f.not_a_number? (get@ #imaginary complex)))) (def: #export (= param input) (-> Complex Complex Bit) @@ -203,9 +203,9 @@ (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r-exp (math.exp real)] - {#real (f.* r-exp (math.cos imaginary)) - #imaginary (f.* r-exp (math.sin imaginary))})) + r_exp (math.exp real)] + {#real (f.* r_exp (math.cos imaginary)) + #imaginary (f.* r_exp (math.sin imaginary))})) (def: #export (log subject) (-> Complex Complex) @@ -222,7 +222,7 @@ [pow' Frac ..*'] ) -(def: (copy-sign sign magnitude) +(def: (copy_sign sign magnitude) (-> Frac Frac Frac) (f.* (f.signum sign) magnitude)) @@ -235,7 +235,7 @@ imaginary)} {#real (f./ (f.* +2.0 t) (f.abs imaginary)) - #imaginary (f.* t (..copy-sign imaginary +1.0))}))) + #imaginary (f.* t (..copy_sign imaginary +1.0))}))) (def: (root/2-1z input) (-> Complex Complex) @@ -287,27 +287,27 @@ (-> Nat Complex (List Complex)) (if (n.= 0 nth) (list) - (let [r-nth (|> nth .int int.frac) - nth-root-of-abs (|> input ..abs (math.pow (f./ r-nth +1.0))) - nth-phi (|> input ..argument (f./ r-nth)) - slice (|> math.pi (f.* +2.0) (f./ r-nth))] + (let [r_nth (|> nth .int int.frac) + nth_root_of_abs (|> input ..abs (math.pow (f./ r_nth +1.0))) + nth_phi (|> input ..argument (f./ r_nth)) + slice (|> math.pi (f.* +2.0) (f./ r_nth))] (|> (list.indices nth) (list\map (function (_ nth') (let [inner (|> nth' .int int.frac (f.* slice) - (f.+ nth-phi)) - real (f.* nth-root-of-abs + (f.+ nth_phi)) + real (f.* nth_root_of_abs (math.cos inner)) - imaginary (f.* nth-root-of-abs + imaginary (f.* nth_root_of_abs (math.sin inner))] {#real real #imaginary imaginary}))))))) -(def: #export (within? margin-of-error standard value) +(def: #export (within? margin_of_error standard value) (-> Frac Complex Complex Bit) - (and (f.within? margin-of-error + (and (f.within? margin_of_error (get@ #..real standard) (get@ #..real value)) - (f.within? margin-of-error + (f.within? margin_of_error (get@ #..imaginary standard) (get@ #..imaginary value)))) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index e4f26154c..3e1fadc2e 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -92,8 +92,8 @@ ## else +1.0)) -(def: min-exponent -1022) -(def: max-exponent (//int.frac +1023)) +(def: min_exponent -1022) +(def: max_exponent (//int.frac +1023)) (template [<name> <test> <doc>] [(def: #export (<name> left right) @@ -115,21 +115,21 @@ (-> Frac Int) (|>> "lux f64 i64")) -(def: mantissa-size Nat 52) -(def: exponent-size Nat 11) +(def: mantissa_size Nat 52) +(def: exponent_size Nat 11) -(def: frac-denominator +(def: frac_denominator (|> -1 - ("lux i64 logical-right-shift" ..exponent-size) + ("lux i64 logical-right-shift" ..exponent_size) "lux i64 f64")) (def: #export rev (-> Frac Rev) (|>> ..abs (..% +1.0) - (..* ..frac-denominator) + (..* ..frac_denominator) "lux f64 i64" - ("lux i64 left-shift" ..exponent-size))) + ("lux i64 left-shift" ..exponent_size))) (structure: #export equivalence (Equivalence Frac) @@ -144,13 +144,13 @@ (def: #export smallest Frac - (math.pow (//int.frac (//int.- (.int ..mantissa-size) ..min-exponent)) + (math.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) +2.0)) (def: #export biggest Frac - (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa-size 0)) +2.0) - f2^+1023 (math.pow ..max-exponent +2.0)] + (let [f2^-52 (math.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) + f2^+1023 (math.pow ..max_exponent +2.0)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) @@ -174,21 +174,21 @@ Frac (../ +0.0 <numerator>))] - [not-a-number +0.0 "Not a number."] - [positive-infinity +1.0 "Positive infinity."] - [negative-infinity -1.0 "Negative infinity."] + [not_a_number +0.0 "Not a number."] + [positive_infinity +1.0 "Positive infinity."] + [negative_infinity -1.0 "Negative infinity."] ) -(def: #export (not-a-number? number) +(def: #export (not_a_number? number) {#.doc "Tests whether a frac is actually not-a-number."} (-> Frac Bit) (not (..= number number))) (def: #export (number? value) (-> Frac Bit) - (not (or (..not-a-number? value) - (..= ..positive-infinity value) - (..= ..negative-infinity value)))) + (not (or (..not_a_number? value) + (..= ..positive_infinity value) + (..= ..negative_infinity value)))) (structure: #export decimal (Codec Text Frac) @@ -196,7 +196,7 @@ (def: (encode x) (case x -0.0 (let [output ("lux f64 encode" x)] - (if (text.starts-with? "-" output) + (if (text.starts_with? "-" output) output ("lux text concat" "+" output))) _ (if (..< +0.0 x) @@ -216,103 +216,103 @@ (|>> math.log (../ (math.log +2.0)))) -(def: double-bias Nat 1023) +(def: double_bias Nat 1023) -(def: exponent-mask (//i64.mask ..exponent-size)) +(def: exponent_mask (//i64.mask ..exponent_size)) -(def: exponent-offset ..mantissa-size) -(def: sign-offset (//nat.+ ..exponent-size ..exponent-offset)) +(def: exponent_offset ..mantissa_size) +(def: sign_offset (//nat.+ ..exponent_size ..exponent_offset)) (template [<cast> <hex> <name>] [(def: <name> (|> <hex> (\ //nat.hex decode) try.assume <cast>))] - [.i64 "FFF8000000000000" not-a-number-bits] - [.i64 "7FF0000000000000" positive-infinity-bits] - [.i64 "FFF0000000000000" negative-infinity-bits] - [.i64 "0000000000000000" positive-zero-bits] - [.i64 "8000000000000000" negative-zero-bits] - [.nat "7FF" special-exponent-bits] + [.i64 "FFF8000000000000" not_a_number_bits] + [.i64 "7FF0000000000000" positive_infinity_bits] + [.i64 "FFF0000000000000" negative_infinity_bits] + [.i64 "0000000000000000" positive_zero_bits] + [.i64 "8000000000000000" negative_zero_bits] + [.nat "7FF" special_exponent_bits] ) -(def: smallest-exponent +(def: smallest_exponent (..log/2 ..smallest)) -(def: #export (to-bits input) +(def: #export (to_bits input) (-> Frac I64) - (.i64 (cond (..not-a-number? input) - ..not-a-number-bits + (.i64 (cond (..not_a_number? input) + ..not_a_number_bits - (..= positive-infinity input) - ..positive-infinity-bits + (..= positive_infinity input) + ..positive_infinity_bits - (..= negative-infinity input) - ..negative-infinity-bits + (..= negative_infinity input) + ..negative_infinity_bits (..= +0.0 input) (let [reciprocal (../ input +1.0)] - (if (..= positive-infinity reciprocal) + (if (..= positive_infinity reciprocal) ## Positive zero - ..positive-zero-bits + ..positive_zero_bits ## Negative zero - ..negative-zero-bits)) + ..negative_zero_bits)) ## else - (let [sign-bit (if (..< -0.0 input) + (let [sign_bit (if (..< -0.0 input) 1 0) input (..abs input) exponent (|> input ..log/2 math.floor - (..min ..max-exponent)) - min-gap (..- (//int.frac ..min-exponent) exponent) - power (|> (//nat.frac ..mantissa-size) - (..+ (..min +0.0 min-gap)) + (..min ..max_exponent)) + min_gap (..- (//int.frac ..min_exponent) exponent) + power (|> (//nat.frac ..mantissa_size) + (..+ (..min +0.0 min_gap)) (..- exponent)) - max-gap (..- ..max-exponent power) + max_gap (..- ..max_exponent power) mantissa (|> input - (..* (math.pow (..min ..max-exponent power) +2.0)) - (..* (if (..> +0.0 max-gap) - (math.pow max-gap +2.0) + (..* (math.pow (..min ..max_exponent power) +2.0)) + (..* (if (..> +0.0 max_gap) + (math.pow max_gap +2.0) +1.0))) - exponent-bits (|> (if (..< +0.0 min-gap) + exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) - (//int.- (..int min-gap)) + (//int.- (..int min_gap)) dec) (..int exponent)) - (//int.+ (.int ..double-bias)) - (//i64.and ..exponent-mask)) - mantissa-bits (..int mantissa)] + (//int.+ (.int ..double_bias)) + (//i64.and ..exponent_mask)) + mantissa_bits (..int mantissa)] ($_ //i64.or - (//i64.left-shift ..sign-offset sign-bit) - (//i64.left-shift ..exponent-offset exponent-bits) - (//i64.clear ..mantissa-size mantissa-bits))) + (//i64.left_shift ..sign_offset sign_bit) + (//i64.left_shift ..exponent_offset exponent_bits) + (//i64.clear ..mantissa_size mantissa_bits))) ))) (template [<getter> <size> <offset>] [(def: <getter> (-> (I64 Any) I64) - (let [mask (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>))] - (|>> (//i64.and mask) (//i64.logic-right-shift <offset>) .i64)))] + (let [mask (|> 1 (//i64.left_shift <size>) dec (//i64.left_shift <offset>))] + (|>> (//i64.and mask) (//i64.logic_right_shift <offset>) .i64)))] - [mantissa ..mantissa-size 0] - [exponent ..exponent-size ..mantissa-size] - [sign 1 ..sign-offset] + [mantissa ..mantissa_size 0] + [exponent ..exponent_size ..mantissa_size] + [sign 1 ..sign_offset] ) -(def: #export (from-bits input) +(def: #export (from_bits input) (-> I64 Frac) (case [(: Nat (..exponent input)) (: Nat (..mantissa input)) (: Nat (..sign input))] - (^ [(static ..special-exponent-bits) 0 0]) - ..positive-infinity + (^ [(static ..special_exponent_bits) 0 0]) + ..positive_infinity - (^ [(static ..special-exponent-bits) 0 1]) - ..negative-infinity + (^ [(static ..special_exponent_bits) 0 1]) + ..negative_infinity - (^ [(static ..special-exponent-bits) _ _]) - ..not-a-number + (^ [(static ..special_exponent_bits) _ _]) + ..not_a_number ## Positive zero [0 0 0] +0.0 @@ -323,23 +323,23 @@ (let [sign (if (//nat.= 0 S) +1.0 -1.0) - [mantissa power] (if (//nat.< ..mantissa-size E) + [mantissa power] (if (//nat.< ..mantissa_size E) [(if (//nat.= 0 E) M - (//i64.set ..mantissa-size M)) + (//i64.set ..mantissa_size M)) (|> E - (//nat.- ..double-bias) + (//nat.- ..double_bias) .int - (//int.max ..min-exponent) - (//int.- (.int ..mantissa-size)))] - [(//i64.set ..mantissa-size M) - (|> E (//nat.- ..double-bias) (//nat.- ..mantissa-size) .int)]) + (//int.max ..min_exponent) + (//int.- (.int ..mantissa_size)))] + [(//i64.set ..mantissa_size M) + (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) exponent (math.pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) -(def: (split-exponent codec representation) +(def: (split_exponent codec representation) (-> (Codec Text Nat) Text (Try [Text Int])) (case [("lux text index" 0 "e+" representation) ("lux text index" 0 "E+" representation) @@ -349,14 +349,14 @@ [<patterns> (do try.monad [exponent (|> representation - ("lux text clip" (//nat.+ 2 split-index) ("lux text size" representation)) + ("lux text clip" (//nat.+ 2 split_index) ("lux text size" representation)) (\ codec decode))] - (wrap [("lux text clip" 0 split-index representation) + (wrap [("lux text clip" 0 split_index representation) (//int.* <factor> (.int exponent))]))]) - ([+1 (^or [(#.Some split-index) #.None #.None #.None] - [#.None (#.Some split-index) #.None #.None])] - [-1 (^or [#.None #.None (#.Some split-index) #.None] - [#.None #.None #.None (#.Some split-index)])]) + ([+1 (^or [(#.Some split_index) #.None #.None #.None] + [#.None (#.Some split_index) #.None #.None])] + [-1 (^or [#.None #.None (#.Some split_index) #.None] + [#.None #.None #.None (#.Some split_index)])]) _ (#try.Success [representation +0]))) @@ -366,9 +366,9 @@ (Codec Text Frac) (def: (encode value) - (let [bits (..to-bits value) + (let [bits (..to_bits value) mantissa (..mantissa bits) - exponent (//int.- (.int ..double-bias) (..exponent bits)) + exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] ($_ "lux text concat" (case (.nat sign) @@ -380,18 +380,18 @@ (\ <int> encode exponent)))) (def: (decode representation) - (let [negative? (text.starts-with? "-" representation) - positive? (text.starts-with? "+" representation)] + (let [negative? (text.starts_with? "-" representation) + positive? (text.starts_with? "+" representation)] (if (or negative? positive?) (do {! try.monad} - [[mantissa exponent] (..split-exponent <nat> representation) + [[mantissa exponent] (..split_exponent <nat> representation) [whole decimal] (case ("lux text index" 0 "." mantissa) - (#.Some split-index) + (#.Some split_index) (do ! [decimal (|> mantissa - ("lux text clip" (inc split-index) ("lux text size" mantissa)) + ("lux text clip" (inc split_index) ("lux text size" mantissa)) (\ <nat> decode))] - (wrap [("lux text clip" 0 split-index mantissa) + (wrap [("lux text clip" 0 split_index mantissa) decimal])) #.None @@ -401,11 +401,11 @@ 0 whole _ ("lux text concat" whole (\ <nat> encode decimal)))) #let [sign (if negative? 1 0)]] - (wrap (..from-bits + (wrap (..from_bits ($_ //i64.or - (//i64.left-shift ..sign-offset (.i64 sign)) - (//i64.left-shift ..mantissa-size (.i64 (//int.+ (.int ..double-bias) exponent))) - (//i64.clear ..mantissa-size (.i64 mantissa)))))) + (//i64.left_shift ..sign_offset (.i64 sign)) + (//i64.left_shift ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) + (//i64.clear ..mantissa_size (.i64 mantissa)))))) (#try.Failure ("lux text concat" <error> representation))))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] @@ -417,14 +417,14 @@ (Hash Frac) (def: &equivalence ..equivalence) - (def: hash ..to-bits)) + (def: hash ..to_bits)) -(def: #export (within? margin-of-error standard value) +(def: #export (within? margin_of_error standard value) (-> Frac Frac Frac Bit) (|> value (..- standard) ..abs - (..< margin-of-error))) + (..< margin_of_error))) (def: #export (mod divisor dividend) (All [m] (-> Frac Frac Frac)) diff --git a/stdlib/source/lux/data/number/i16.lux b/stdlib/source/lux/data/number/i16.lux index 4ca313730..9168b5925 100644 --- a/stdlib/source/lux/data/number/i16.lux +++ b/stdlib/source/lux/data/number/i16.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 16))) -(def: #export I16 (:by-example [size] +(def: #export I16 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/i32.lux b/stdlib/source/lux/data/number/i32.lux index 35391519b..3a1811b81 100644 --- a/stdlib/source/lux/data/number/i32.lux +++ b/stdlib/source/lux/data/number/i32.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 32))) -(def: #export I32 (:by-example [size] +(def: #export I32 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index ea4b1987f..71bb8ef2b 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -10,30 +10,30 @@ [number ["n" nat]]]]) -(def: #export bits-per-byte +(def: #export bits_per_byte 8) -(def: #export bytes-per-i64 +(def: #export bytes_per_i64 8) (def: #export width Nat - (n.* ..bits-per-byte - ..bytes-per-i64)) + (n.* ..bits_per_byte + ..bytes_per_i64)) -(template [<parameter-type> <name> <op> <doc>] +(template [<parameter_type> <name> <op> <doc>] [(def: #export (<name> parameter subject) {#.doc <doc>} - (All [s] (-> <parameter-type> (I64 s) (I64 s))) + (All [s] (-> <parameter_type> (I64 s) (I64 s))) (<op> parameter subject))] [(I64 Any) or "lux i64 or" "Bitwise or."] [(I64 Any) xor "lux i64 xor" "Bitwise xor."] [(I64 Any) and "lux i64 and" "Bitwise and."] - [Nat left-shift "lux i64 left-shift" "Bitwise left-shift."] - [Nat logic-right-shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] - [Nat arithmetic-right-shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] + [Nat left_shift "lux i64 left-shift" "Bitwise left-shift."] + [Nat logic_right_shift "lux i64 logical-right-shift" "Unsigned bitwise logic-right-shift."] + [Nat arithmetic_right_shift "lux i64 arithmetic-right-shift" "Signed bitwise arithmetic-right-shift."] ) (def: #export not @@ -52,37 +52,37 @@ Mask (..not ..false)) -(def: #export (mask amount-of-bits) +(def: #export (mask amount_of_bits) (-> Nat Mask) - (case amount-of-bits + (case amount_of_bits 0 ..false bits (case (n.% ..width bits) 0 ..true - bits (|> 1 .i64 (..left-shift (n.% ..width bits)) .dec)))) + bits (|> 1 .i64 (..left_shift (n.% ..width bits)) .dec)))) (def: #export (bit position) (-> Nat Mask) - (|> 1 .i64 (..left-shift (n.% ..width position)))) + (|> 1 .i64 (..left_shift (n.% ..width position)))) (def: #export sign Mask (..bit (dec ..width))) -(def: (add-shift shift value) +(def: (add_shift shift value) (-> Nat Nat Nat) - (|> value (logic-right-shift shift) (n.+ value))) + (|> value (logic_right_shift shift) (n.+ value))) (def: #export (count subject) {#.doc "Count the number of 1s in a bit-map."} (-> (I64 Any) Nat) - (let [count' (n.- (|> subject (logic-right-shift 1) (..and 6148914691236517205) i64) + (let [count' (n.- (|> subject (logic_right_shift 1) (..and 6148914691236517205) i64) (i64 subject))] (|> count' - (logic-right-shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) - (add-shift 4) (..and 1085102592571150095) - (add-shift 8) - (add-shift 16) - (add-shift 32) + (logic_right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count')) + (add_shift 4) (..and 1085102592571150095) + (add_shift 8) + (add_shift 16) + (add_shift 32) (..and 127)))) (def: #export (clear idx input) @@ -111,18 +111,18 @@ (template [<name> <main> <comp>] [(def: #export (<name> distance input) (All [s] (-> Nat (I64 s) (I64 s))) - (let [backwards-distance (n.- (n.% width distance) width)] + (let [backwards_distance (n.- (n.% width distance) width)] (|> input - (<comp> backwards-distance) + (<comp> backwards_distance) (..or (<main> distance input)))))] - [rotate-left left-shift logic-right-shift] - [rotate-right logic-right-shift left-shift] + [rotate_left left_shift logic_right_shift] + [rotate_right logic_right_shift left_shift] ) (def: #export (region size offset) (-> Nat Nat Mask) - (..left-shift offset (..mask size))) + (..left_shift offset (..mask size))) (structure: #export equivalence (All [a] (Equivalence (I64 a))) @@ -152,10 +152,10 @@ [(def: <swap> (All [a] (-> (I64 a) (I64 a))) (let [high (try.assume (\ n.binary decode <pattern>)) - low (..rotate-right <size> high)] + low (..rotate_right <size> high)] (function (_ value) - (..or (..logic-right-shift <size> (..and high value)) - (..left-shift <size> (..and low value))))))] + (..or (..logic_right_shift <size> (..and high value)) + (..left_shift <size> (..and low value))))))] [swap/32 32 "1111111111111111111111111111111100000000000000000000000000000000"] [swap/16 16 "1111111111111111000000000000000011111111111111110000000000000000"] @@ -188,19 +188,19 @@ (Ex [size] (-> Nat (Maybe (Sub size)))) (if (.and (n.> 0 width) (n.< ..width width)) - (let [sign-shift (n.- width ..width) + (let [sign_shift (n.- width ..width) sign (..bit (dec width)) mantissa (..mask (dec width)) - co-mantissa (..xor (.i64 -1) mantissa)] + co_mantissa (..xor (.i64 -1) mantissa)] (#.Some (: Sub (structure (def: &equivalence ..equivalence) (def: width width) (def: (narrow value) - (..or (|> value (..and ..sign) (..logic-right-shift sign-shift)) + (..or (|> value (..and ..sign) (..logic_right_shift sign_shift)) (|> value (..and mantissa)))) (def: (widen value) (.i64 (case (.nat (..and sign value)) 0 value - _ (..or co-mantissa value)))))))) + _ (..or co_mantissa value)))))))) #.None)) diff --git a/stdlib/source/lux/data/number/i8.lux b/stdlib/source/lux/data/number/i8.lux index 49b9cca95..bea35ff22 100644 --- a/stdlib/source/lux/data/number/i8.lux +++ b/stdlib/source/lux/data/number/i8.lux @@ -4,13 +4,13 @@ [equivalence (#+ Equivalence)]] [data ["." maybe]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] [// ["." i64 (#+ Sub)]]) (def: sub (maybe.assume (i64.sub 8))) -(def: #export I8 (:by-example [size] +(def: #export I8 (:by_example [size] {(Sub size) ..sub} (I64 size))) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index ea942bde5..8d24d729d 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -169,12 +169,12 @@ (def: &enum ..enum) (def: top ## +9,223,372,036,854,775,807 - (let [half (//i64.left-shift 62 +1)] + (let [half (//i64.left_shift 62 +1)] (+ half (dec half)))) (def: bottom ## -9,223,372,036,854,775,808 - (//i64.left-shift 63 +1))) + (//i64.left_shift 63 +1))) (template [<name> <compose> <identity>] [(structure: #export <name> @@ -202,18 +202,18 @@ (|> value .nat (\ <codec> encode) ("lux text concat" ..+sign)))) (def: (decode repr) - (let [input-size ("lux text size" repr)] - (if (//nat.> 1 input-size) + (let [input_size ("lux text size" repr)] + (if (//nat.> 1 input_size) (case ("lux text clip" 0 1 repr) (^ (static ..+sign)) (|> repr - ("lux text clip" 1 input-size) + ("lux text clip" 1 input_size) (\ <codec> decode) (\ try.functor map .int)) (^ (static ..-sign)) (|> repr - ("lux text clip" 1 input-size) + ("lux text clip" 1 input_size) (\ <codec> decode) (\ try.functor map (|>> dec .int ..negate dec))) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 0d67bd3d6..943e10a87 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -139,7 +139,7 @@ ($_ text\compose (n\encode numerator) ..separator (n\encode denominator))) (def: (decode input) - (case (text.split-with ..separator input) + (case (text.split_with ..separator input) (#.Some [num denom]) (do try.monad [numerator (n\decode num) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index cc3dce828..36436bf99 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -22,7 +22,7 @@ (template [<power> <name>] [(def: #export <name> Rev - (.rev (//i64.left-shift (//nat.- <power> //i64.width) 1)))] + (.rev (//i64.left_shift (//nat.- <power> //i64.width) 1)))] [01 /2] [02 /4] @@ -117,40 +117,40 @@ ..high ("lux i64 +" top)))) -(def: even-one (//i64.rotate-right 1 1)) -(def: odd-one (dec 0)) +(def: even_one (//i64.rotate_right 1 1)) +(def: odd_one (dec 0)) -(def: (even-reciprocal numerator) +(def: (even_reciprocal numerator) (-> Nat Nat) - (//nat./ (//i64.logic-right-shift 1 numerator) - ..even-one)) + (//nat./ (//i64.logic_right_shift 1 numerator) + ..even_one)) -(def: (odd-reciprocal numerator) +(def: (odd_reciprocal numerator) (-> Nat Nat) - (//nat./ numerator ..odd-one)) + (//nat./ numerator ..odd_one)) -(with-expansions [<least-significant-bit> 1] +(with_expansions [<least_significant_bit> 1] (def: #export (reciprocal numerator) {#.doc "Rev(olution) reciprocal of a Nat(ural)."} (-> Nat Rev) - (.rev (case (: Nat ("lux i64 and" <least-significant-bit> numerator)) - 0 (..even-reciprocal numerator) - _ (..odd-reciprocal numerator)))) + (.rev (case (: Nat ("lux i64 and" <least_significant_bit> numerator)) + 0 (..even_reciprocal numerator) + _ (..odd_reciprocal numerator)))) (def: #export (/ param subject) {#.doc "Rev(olution) division."} (-> Rev Rev Rev) (if ("lux i64 =" +0 param) (error! "Cannot divide Rev by zero!") - (let [reciprocal (case (: Nat ("lux i64 and" <least-significant-bit> param)) - 0 (..even-reciprocal (.nat param)) - _ (..odd-reciprocal (.nat param)))] + (let [reciprocal (case (: Nat ("lux i64 and" <least_significant_bit> param)) + 0 (..even_reciprocal (.nat param)) + _ (..odd_reciprocal (.nat param)))] (.rev (//nat.* reciprocal (.nat subject))))))) -(template [<operator> <name> <output> <output-type> <documentation>] +(template [<operator> <name> <output> <output_type> <documentation>] [(def: #export (<name> param subject) {#.doc <documentation>} - (-> Rev Rev <output-type>) + (-> Rev Rev <output_type>) (<output> (<operator> (.nat param) (.nat subject))))] [//nat.% % .rev Rev "Rev(olution) remainder."] @@ -176,12 +176,12 @@ (|>> ("lux i64 logical-right-shift" 11) "lux i64 f64")) -(def: frac-denominator +(def: frac_denominator (..mantissa -1)) (def: #export frac (-> Rev Frac) - (|>> ..mantissa ("lux f64 /" ..frac-denominator))) + (|>> ..mantissa ("lux f64 /" ..frac_denominator))) (structure: #export equivalence (Equivalence Rev) @@ -226,47 +226,47 @@ [minimum ..min top] ) -(def: (de-prefix input) +(def: (de_prefix input) (-> Text Text) ("lux text clip" 1 ("lux text size" input) input)) -(template [<struct> <codec> <char-bit-size> <error>] - [(with-expansions [<error-output> (as-is (#try.Failure ("lux text concat" <error> repr)))] +(template [<struct> <codec> <char_bit_size> <error>] + [(with_expansions [<error_output> (as_is (#try.Failure ("lux text concat" <error> repr)))] (structure: #export <struct> (Codec Text Rev) (def: (encode value) - (let [raw-output (\ <codec> encode (.nat value)) - max-num-chars (//nat.+ (//nat./ <char-bit-size> //i64.width) - (case (//nat.% <char-bit-size> //i64.width) + (let [raw_output (\ <codec> encode (.nat value)) + max_num_chars (//nat.+ (//nat./ <char_bit_size> //i64.width) + (case (//nat.% <char_bit_size> //i64.width) 0 0 _ 1)) - raw-size ("lux text size" raw-output) - zero-padding (loop [zeroes-left (//nat.- raw-size max-num-chars) + raw_size ("lux text size" raw_output) + zero_padding (loop [zeroes_left (//nat.- raw_size max_num_chars) output ""] - (if (//nat.= 0 zeroes-left) + (if (//nat.= 0 zeroes_left) output - (recur (dec zeroes-left) + (recur (dec zeroes_left) ("lux text concat" "0" output))))] - (|> raw-output - ("lux text concat" zero-padding) + (|> raw_output + ("lux text concat" zero_padding) ("lux text concat" ".")))) (def: (decode repr) - (let [repr-size ("lux text size" repr)] - (if (//nat.> 1 repr-size) + (let [repr_size ("lux text size" repr)] + (if (//nat.> 1 repr_size) (case ("lux text char" 0 repr) (^ (char ".")) - (case (\ <codec> decode (de-prefix repr)) + (case (\ <codec> decode (de_prefix repr)) (#try.Success output) (#try.Success (.rev output)) _ - <error-output>) + <error_output>) _ - <error-output>) - <error-output>)))))] + <error_output>) + <error_output>)))))] [binary //nat.binary 1 "Invalid binary syntax: "] [octal //nat.octal 3 "Invalid octal syntax: "] @@ -301,7 +301,7 @@ (-> Text Text Text) ("lux text concat" left right)) -(def: (digits::times-5! idx output) +(def: (digits::times_5! idx output) (-> Nat Digits Digits) (loop [idx idx carry 0 @@ -322,25 +322,25 @@ (digits::put power 1))] (if (//int.>= +0 (.int times)) (recur (dec times) - (digits::times-5! power output)) + (digits::times_5! power output)) output))) (def: (digits::format digits) (-> Digits Text) (loop [idx (dec //i64.width) - all-zeroes? true + all_zeroes? true output ""] (if (//int.>= +0 (.int idx)) (let [digit (digits::get idx digits)] (if (and (//nat.= 0 digit) - all-zeroes?) + all_zeroes?) (recur (dec idx) true output) (recur (dec idx) false ("lux text concat" (\ //nat.decimal encode digit) output)))) - (if all-zeroes? + (if all_zeroes? "0" output)))) @@ -359,7 +359,7 @@ (digits::put idx (//nat.% 10 raw) output))) output))) -(def: (text-to-digits input) +(def: (text_to_digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] (if (//nat.<= //i64.width length) @@ -416,12 +416,12 @@ ".0" input - (let [last-idx (dec //i64.width)] - (loop [idx last-idx + (let [last_idx (dec //i64.width)] + (loop [idx last_idx digits (digits::new [])] (if (//int.>= +0 (.int idx)) (if (//i64.set? idx input) - (let [digits' (digits::+ (digits::power (//nat.- idx last-idx)) + (let [digits' (digits::+ (digits::power (//nat.- idx last_idx)) digits)] (recur (dec idx) digits')) @@ -437,10 +437,10 @@ _ false) - within-limits? (//nat.<= (inc //i64.width) + within_limits? (//nat.<= (inc //i64.width) ("lux text size" input))] - (if (and dotted? within-limits?) - (case (text-to-digits (de-prefix input)) + (if (and dotted? within_limits?) + (case (text_to_digits (de_prefix input)) (#.Some digits) (loop [digits digits idx 0 diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 042919c24..2997c388b 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -21,26 +21,26 @@ ## TODO: Instead of ints, chars should be produced fron nats. ## (The JVM specifies chars as 16-bit unsigned integers) -(def: #export from-code +(def: #export from_code (-> Char Text) (|>> (:coerce Int) "lux i64 char")) (template [<code> <short> <long>] - [(def: #export <long> (from-code <code>)) + [(def: #export <long> (from_code <code>)) (def: #export <short> <long>)] [00 \0 null] [07 \a alarm] - [08 \b back-space] + [08 \b back_space] [09 \t tab] - [10 \n new-line] - [11 \v vertical-tab] - [12 \f form-feed] - [13 \r carriage-return] - [34 \'' double-quote] + [10 \n new_line] + [11 \v vertical_tab] + [12 \f form_feed] + [13 \r carriage_return] + [34 \'' double_quote] ) -(def: #export line-feed ..new-line) +(def: #export line_feed ..new_line) (def: #export (size x) (-> Text Nat) @@ -52,53 +52,53 @@ (#.Some ("lux text char" idx input)) #.None)) -(def: #export (index-of' pattern from input) +(def: #export (index_of' pattern from input) (-> Text Nat Text (Maybe Nat)) ("lux text index" from pattern input)) -(def: #export (index-of pattern input) +(def: #export (index_of pattern input) (-> Text Text (Maybe Nat)) ("lux text index" 0 pattern input)) -(def: (last-index-of'' part since text) +(def: (last_index_of'' part since text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" (inc since) part text) #.None (#.Some since) (#.Some since') - (last-index-of'' part since' text))) + (last_index_of'' part since' text))) -(def: #export (last-index-of' part from text) +(def: #export (last_index_of' part from text) (-> Text Nat Text (Maybe Nat)) (case ("lux text index" from part text) (#.Some since) - (last-index-of'' part since text) + (last_index_of'' part since text) #.None #.None)) -(def: #export (last-index-of part text) +(def: #export (last_index_of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" 0 part text) (#.Some since) - (last-index-of'' part since text) + (last_index_of'' part since text) #.None #.None)) -(def: #export (starts-with? prefix x) +(def: #export (starts_with? prefix x) (-> Text Text Bit) - (case (index-of prefix x) + (case (index_of prefix x) (#.Some 0) true _ false)) -(def: #export (ends-with? postfix x) +(def: #export (ends_with? postfix x) (-> Text Text Bit) - (case (last-index-of postfix x) + (case (last_index_of postfix x) (#.Some n) (n.= (size x) (n.+ (size postfix) n)) @@ -108,8 +108,8 @@ (def: #export (encloses? boundary value) (-> Text Text Bit) - (and (starts-with? boundary value) - (ends-with? boundary value))) + (and (starts_with? boundary value) + (ends_with? boundary value))) (def: #export (contains? sub text) (-> Text Text Bit) @@ -143,35 +143,35 @@ _ #.None)) -(def: #export (split-with token sample) +(def: #export (split_with token sample) (-> Text Text (Maybe [Text Text])) (do maybe.monad - [index (index-of token sample) + [index (index_of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] (wrap [pre post]))) -(def: #export (split-all-with token sample) +(def: #export (split_all_with token sample) (-> Text Text (List Text)) - (case (..split-with token sample) + (case (..split_with token sample) (#.Some [pre post]) - (#.Cons pre (split-all-with token post)) + (#.Cons pre (split_all_with token post)) #.None (#.Cons sample #.Nil))) -(def: #export (replace-once pattern replacement template) +(def: #export (replace_once pattern replacement template) (-> Text Text Text Text) (<| (maybe.default template) (do maybe.monad - [[pre post] (split-with pattern template)] + [[pre post] (split_with pattern template)] (wrap ($_ "lux text concat" pre replacement post))))) -(def: #export (replace-all pattern replacement template) +(def: #export (replace_all pattern replacement template) (-> Text Text Text Text) - (case (..split-with pattern template) + (case (..split_with pattern template) (#.Some [pre post]) - ($_ "lux text concat" pre replacement (replace-all pattern replacement post)) + ($_ "lux text concat" pre replacement (replace_all pattern replacement post)) #.None template)) @@ -226,7 +226,7 @@ (if (n.< length idx) (recur (inc idx) (|> hash - (i64.left-shift 5) + (i64.left_shift 5) (n.- hash) (n.+ ("lux text char" idx input)))) hash)))))) @@ -236,7 +236,7 @@ (let [(^open ".") ..monoid] (|>> list.reverse (list\fold compose identity)))) -(def: #export (join-with sep texts) +(def: #export (join_with sep texts) (-> Text (List Text) Text) (|> texts (list.interpose sep) concat)) @@ -266,7 +266,7 @@ (def: #export encode (-> Text Text) - (..enclose' ..double-quote)) + (..enclose' ..double_quote)) (def: #export space Text @@ -275,19 +275,19 @@ (def: #export (space? char) {#.doc "Checks whether the character is white-space."} (-> Char Bit) - (with-expansions [<options> (template [<char>] + (with_expansions [<options> (template [<char>] [(^ (char (~~ (static <char>))))] [..tab] - [..vertical-tab] + [..vertical_tab] [..space] - [..new-line] - [..carriage-return] - [..form-feed] + [..new_line] + [..carriage_return] + [..form_feed] )] - (`` (case char - (^or <options>) - true + (`` (case char + (^or <options>) + true - _ - false)))) + _ + false)))) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 397501cd2..13316dcc5 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -16,7 +16,7 @@ abstract]] ["." //]) -(with-expansions [<jvm> (as-is (import: java/lang/CharSequence) +(with_expansions [<jvm> (as_is (import: java/lang/CharSequence) (import: java/lang/Appendable ["#::." @@ -31,8 +31,8 @@ ["#::." (new [int]) (toString [] java/lang/String)]))] - (`` (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)}))) + (`` (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)}))) (`` (abstract: #export Buffer (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] @@ -44,7 +44,7 @@ (def: #export empty Buffer - (:abstraction (with-expansions [<jvm> [0 function.identity]] + (:abstraction (with_expansions [<jvm> [0 function.identity]] (for {@.old <jvm> @.jvm <jvm>} ## default @@ -52,7 +52,7 @@ (def: #export (append chunk buffer) (-> Text Buffer Buffer) - (with-expansions [<jvm> (let [[capacity transform] (:representation buffer) + (with_expansions [<jvm> (let [[capacity transform] (:representation buffer) append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) (function (_ chunk builder) (exec (java/lang/Appendable::append (:coerce java/lang/CharSequence chunk) @@ -67,7 +67,7 @@ (def: #export size (-> Buffer Nat) - (with-expansions [<jvm> (|>> :representation product.left)] + (with_expansions [<jvm> (|>> :representation product.left)] (for {@.old <jvm> @.jvm <jvm>} ## default @@ -78,7 +78,7 @@ (def: #export (text buffer) (-> Buffer Text) - (with-expansions [<jvm> (let [[capacity transform] (:representation buffer)] + (with_expansions [<jvm> (let [[capacity transform] (:representation buffer)] (|> (java/lang/StringBuilder::new (.int capacity)) transform java/lang/StringBuilder::toString))] diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 32793f515..df1714484 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -21,147 +21,147 @@ [ascii "ASCII"] - [ibm-37 "IBM037"] - [ibm-273 "IBM273"] - [ibm-277 "IBM277"] - [ibm-278 "IBM278"] - [ibm-280 "IBM280"] - [ibm-284 "IBM284"] - [ibm-285 "IBM285"] - [ibm-290 "IBM290"] - [ibm-297 "IBM297"] - [ibm-300 "IBM300"] - [ibm-420 "IBM420"] - [ibm-424 "IBM424"] - [ibm-437 "IBM437"] - [ibm-500 "IBM500"] - [ibm-737 "IBM737"] - [ibm-775 "IBM775"] - [ibm-833 "IBM833"] - [ibm-834 "IBM834"] - [ibm-838 "IBM-Thai"] - [ibm-850 "IBM850"] - [ibm-852 "IBM852"] - [ibm-855 "IBM855"] - [ibm-856 "IBM856"] - [ibm-857 "IBM857"] - [ibm-858 "IBM00858"] - [ibm-860 "IBM860"] - [ibm-861 "IBM861"] - [ibm-862 "IBM862"] - [ibm-863 "IBM863"] - [ibm-864 "IBM864"] - [ibm-865 "IBM865"] - [ibm-866 "IBM866"] - [ibm-868 "IBM868"] - [ibm-869 "IBM869"] - [ibm-870 "IBM870"] - [ibm-871 "IBM871"] - [ibm-874 "IBM874"] - [ibm-875 "IBM875"] - [ibm-918 "IBM918"] - [ibm-921 "IBM921"] - [ibm-922 "IBM922"] - [ibm-930 "IBM930"] - [ibm-933 "IBM933"] - [ibm-935 "IBM935"] - [ibm-937 "IBM937"] - [ibm-939 "IBM939"] - [ibm-942 "IBM942"] - [ibm-942c "IBM942C"] - [ibm-943 "IBM943"] - [ibm-943c "IBM943C"] - [ibm-948 "IBM948"] - [ibm-949 "IBM949"] - [ibm-949c "IBM949C"] - [ibm-950 "IBM950"] - [ibm-964 "IBM964"] - [ibm-970 "IBM970"] - [ibm-1006 "IBM1006"] - [ibm-1025 "IBM1025"] - [ibm-1026 "IBM1026"] - [ibm-1046 "IBM1046"] - [ibm-1047 "IBM1047"] - [ibm-1097 "IBM1097"] - [ibm-1098 "IBM1098"] - [ibm-1112 "IBM1112"] - [ibm-1122 "IBM1122"] - [ibm-1123 "IBM1123"] - [ibm-1124 "IBM1124"] - [ibm-1140 "IBM01140"] - [ibm-1141 "IBM01141"] - [ibm-1142 "IBM01142"] - [ibm-1143 "IBM01143"] - [ibm-1144 "IBM01144"] - [ibm-1145 "IBM01145"] - [ibm-1146 "IBM01146"] - [ibm-1147 "IBM01147"] - [ibm-1148 "IBM01148"] - [ibm-1149 "IBM01149"] - [ibm-1166 "IBM1166"] - [ibm-1364 "IBM1364"] - [ibm-1381 "IBM1381"] - [ibm-1383 "IBM1383"] - [ibm-33722 "IBM33722"] + [ibm_37 "IBM037"] + [ibm_273 "IBM273"] + [ibm_277 "IBM277"] + [ibm_278 "IBM278"] + [ibm_280 "IBM280"] + [ibm_284 "IBM284"] + [ibm_285 "IBM285"] + [ibm_290 "IBM290"] + [ibm_297 "IBM297"] + [ibm_300 "IBM300"] + [ibm_420 "IBM420"] + [ibm_424 "IBM424"] + [ibm_437 "IBM437"] + [ibm_500 "IBM500"] + [ibm_737 "IBM737"] + [ibm_775 "IBM775"] + [ibm_833 "IBM833"] + [ibm_834 "IBM834"] + [ibm_838 "IBM-Thai"] + [ibm_850 "IBM850"] + [ibm_852 "IBM852"] + [ibm_855 "IBM855"] + [ibm_856 "IBM856"] + [ibm_857 "IBM857"] + [ibm_858 "IBM00858"] + [ibm_860 "IBM860"] + [ibm_861 "IBM861"] + [ibm_862 "IBM862"] + [ibm_863 "IBM863"] + [ibm_864 "IBM864"] + [ibm_865 "IBM865"] + [ibm_866 "IBM866"] + [ibm_868 "IBM868"] + [ibm_869 "IBM869"] + [ibm_870 "IBM870"] + [ibm_871 "IBM871"] + [ibm_874 "IBM874"] + [ibm_875 "IBM875"] + [ibm_918 "IBM918"] + [ibm_921 "IBM921"] + [ibm_922 "IBM922"] + [ibm_930 "IBM930"] + [ibm_933 "IBM933"] + [ibm_935 "IBM935"] + [ibm_937 "IBM937"] + [ibm_939 "IBM939"] + [ibm_942 "IBM942"] + [ibm_942c "IBM942C"] + [ibm_943 "IBM943"] + [ibm_943c "IBM943C"] + [ibm_948 "IBM948"] + [ibm_949 "IBM949"] + [ibm_949c "IBM949C"] + [ibm_950 "IBM950"] + [ibm_964 "IBM964"] + [ibm_970 "IBM970"] + [ibm_1006 "IBM1006"] + [ibm_1025 "IBM1025"] + [ibm_1026 "IBM1026"] + [ibm_1046 "IBM1046"] + [ibm_1047 "IBM1047"] + [ibm_1097 "IBM1097"] + [ibm_1098 "IBM1098"] + [ibm_1112 "IBM1112"] + [ibm_1122 "IBM1122"] + [ibm_1123 "IBM1123"] + [ibm_1124 "IBM1124"] + [ibm_1140 "IBM01140"] + [ibm_1141 "IBM01141"] + [ibm_1142 "IBM01142"] + [ibm_1143 "IBM01143"] + [ibm_1144 "IBM01144"] + [ibm_1145 "IBM01145"] + [ibm_1146 "IBM01146"] + [ibm_1147 "IBM01147"] + [ibm_1148 "IBM01148"] + [ibm_1149 "IBM01149"] + [ibm_1166 "IBM1166"] + [ibm_1364 "IBM1364"] + [ibm_1381 "IBM1381"] + [ibm_1383 "IBM1383"] + [ibm_33722 "IBM33722"] - [iso-2022-cn "ISO-2022-CN"] - [iso2022-cn-cns "ISO2022-CN-CNS"] - [iso2022-cn-gb "ISO2022-CN-GB"] - [iso-2022-jp "ISO-2022-JP"] - [iso-2022-jp-2 "ISO-2022-JP-2"] - [iso-2022-kr "ISO-2022-KR"] - [iso-8859-1 "ISO-8859-1"] - [iso-8859-2 "ISO-8859-2"] - [iso-8859-3 "ISO-8859-3"] - [iso-8859-4 "ISO-8859-4"] - [iso-8859-5 "ISO-8859-5"] - [iso-8859-6 "ISO-8859-6"] - [iso-8859-7 "ISO-8859-7"] - [iso-8859-8 "ISO-8859-8"] - [iso-8859-9 "ISO-8859-9"] - [iso-8859-11 "iso-8859-11"] - [iso-8859-13 "ISO-8859-13"] - [iso-8859-15 "ISO-8859-15"] - - [mac-arabic "MacArabic"] - [mac-central-europe "MacCentralEurope"] - [mac-croatian "MacCroatian"] - [mac-cyrillic "MacCyrillic"] - [mac-dingbat "MacDingbat"] - [mac-greek "MacGreek"] - [mac-hebrew "MacHebrew"] - [mac-iceland "MacIceland"] - [mac-roman "MacRoman"] - [mac-romania "MacRomania"] - [mac-symbol "MacSymbol"] - [mac-thai "MacThai"] - [mac-turkish "MacTurkish"] - [mac-ukraine "MacUkraine"] + [iso_2022_cn "ISO-2022-CN"] + [iso2022_cn_cns "ISO2022-CN-CNS"] + [iso2022_cn_gb "ISO2022-CN-GB"] + [iso_2022_jp "ISO-2022-JP"] + [iso_2022_jp_2 "ISO-2022-JP-2"] + [iso_2022_kr "ISO-2022-KR"] + [iso_8859_1 "ISO-8859-1"] + [iso_8859_2 "ISO-8859-2"] + [iso_8859_3 "ISO-8859-3"] + [iso_8859_4 "ISO-8859-4"] + [iso_8859_5 "ISO-8859-5"] + [iso_8859_6 "ISO-8859-6"] + [iso_8859_7 "ISO-8859-7"] + [iso_8859_8 "ISO-8859-8"] + [iso_8859_9 "ISO-8859-9"] + [iso_8859_11 "iso-8859-11"] + [iso_8859_13 "ISO-8859-13"] + [iso_8859_15 "ISO-8859-15"] + + [mac_arabic "MacArabic"] + [mac_central_europe "MacCentralEurope"] + [mac_croatian "MacCroatian"] + [mac_cyrillic "MacCyrillic"] + [mac_dingbat "MacDingbat"] + [mac_greek "MacGreek"] + [mac_hebrew "MacHebrew"] + [mac_iceland "MacIceland"] + [mac_roman "MacRoman"] + [mac_romania "MacRomania"] + [mac_symbol "MacSymbol"] + [mac_thai "MacThai"] + [mac_turkish "MacTurkish"] + [mac_ukraine "MacUkraine"] - [utf-8 "UTF-8"] - [utf-16 "UTF-16"] - [utf-32 "UTF-32"] - - [windows-31j "windows-31j"] - [windows-874 "windows-874"] - [windows-949 "windows-949"] - [windows-950 "windows-950"] - [windows-1250 "windows-1250"] - [windows-1252 "windows-1252"] - [windows-1251 "windows-1251"] - [windows-1253 "windows-1253"] - [windows-1254 "windows-1254"] - [windows-1255 "windows-1255"] - [windows-1256 "windows-1256"] - [windows-1257 "windows-1257"] - [windows-1258 "windows-1258"] - [windows-iso2022jp "windows-iso2022jp"] - [windows-50220 "windows-50220"] - [windows-50221 "windows-50221"] + [utf_8 "UTF-8"] + [utf_16 "UTF-16"] + [utf_32 "UTF-32"] + + [windows_31j "windows-31j"] + [windows_874 "windows-874"] + [windows_949 "windows-949"] + [windows_950 "windows-950"] + [windows_1250 "windows-1250"] + [windows_1252 "windows-1252"] + [windows_1251 "windows-1251"] + [windows_1253 "windows-1253"] + [windows_1254 "windows-1254"] + [windows_1255 "windows-1255"] + [windows_1256 "windows-1256"] + [windows_1257 "windows-1257"] + [windows_1258 "windows-1258"] + [windows_iso2022jp "windows-iso2022jp"] + [windows_50220 "windows-50220"] + [windows_50221 "windows-50221"] - [cesu-8 "CESU-8"] - [koi8-r "KOI8-R"] - [koi8-u "KOI8-U"] + [cesu_8 "CESU-8"] + [koi8_r "KOI8-R"] + [koi8_u "KOI8-U"] ) (def: #export name @@ -169,18 +169,18 @@ (|>> :representation)) ) -(with-expansions [<jvm> (as-is (host.import: java/lang/String +(with_expansions [<jvm> (as_is (host.import: java/lang/String ["#::." (new [[byte] java/lang/String]) (getBytes [java/lang/String] [byte])]))] (for {@.old - (as-is <jvm>) + (as_is <jvm>) @.jvm - (as-is <jvm>) + (as_is <jvm>) @.js - (as-is (host.import: Uint8Array) + (as_is (host.import: Uint8Array) ## On Node (host.import: Buffer @@ -197,59 +197,59 @@ (new [host.String]) (decode [Uint8Array] host.String)))})) -(def: (to-utf8 value) +(def: (to_utf8 value) (-> Text Binary) (for {@.old - (java/lang/String::getBytes (..name ..utf-8) + (java/lang/String::getBytes (..name ..utf_8) ## The coercion below may seem ## gratuitous, but removing it ## causes a grave compilation problem. (:coerce java/lang/String value)) @.jvm - (java/lang/String::getBytes (..name ..utf-8) value) + (java/lang/String::getBytes (..name ..utf_8) value) @.js - (cond host.on-nashorn? + (cond host.on_nashorn? (:coerce Binary ("js object do" "getBytes" value ["utf8"])) - host.on-node-js? + host.on_node_js? (|> (Buffer::from|encode [value "utf8"]) ## This coercion is valid as per NodeJS's documentation: ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays (:coerce Uint8Array)) ## On the browser - (|> (TextEncoder::new [(..name ..utf-8)]) + (|> (TextEncoder::new [(..name ..utf_8)]) (TextEncoder::encode [value])) )})) -(def: (from-utf8 value) +(def: (from_utf8 value) (-> Binary (Try Text)) (for {@.old - (#try.Success (java/lang/String::new value (..name ..utf-8))) + (#try.Success (java/lang/String::new value (..name ..utf_8))) @.jvm - (#try.Success (java/lang/String::new value (..name ..utf-8))) + (#try.Success (java/lang/String::new value (..name ..utf_8))) @.js - (cond host.on-nashorn? + (cond host.on_nashorn? (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"]) (:coerce Text) #try.Success) - host.on-node-js? + host.on_node_js? (|> (Buffer::from|decode [value]) (Buffer::toString ["utf8"]) #try.Success) ## On the browser - (|> (TextDecoder::new [(..name ..utf-8)]) + (|> (TextDecoder::new [(..name ..utf_8)]) (TextDecoder::decode [value]) #try.Success))})) (structure: #export utf8 (Codec Binary Text) - (def: encode ..to-utf8) - (def: decode ..from-utf8)) + (def: encode ..to_utf8) + (def: decode ..from_utf8)) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index a8fca807a..fb00b4cad 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -106,11 +106,11 @@ (def: #export (mod modular) (All [m] (Format (modular.Mod m))) - (let [[modulus _] (modular.un-modular modular)] + (let [[modulus _] (modular.un_modular modular)] (\ (modular.codec modulus) encode modular))) (def: #export (list formatter) (All [a] (-> (Format a) (Format (List a)))) (|>> (list\map (|>> formatter (format " "))) - (text.join-with "") + (text.join_with "") (text.enclose ["(list" ")"]))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index bd2d8133a..050e55475 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -14,24 +14,24 @@ ["n" nat ("#\." decimal)]] [collection ["." list ("#\." fold monad)]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]] ["." // ["%" format (#+ format)]]) -(def: regex-char^ +(def: regex_char^ (Parser Text) - (<t>.none-of "\.|&()[]{}")) + (<t>.none_of "\.|&()[]{}")) -(def: escaped-char^ +(def: escaped_char^ (Parser Text) (do <>.monad [? (<>.parses? (<t>.this "\"))] (if ? <t>.any - regex-char^))) + regex_char^))) (def: (refine^ refinement^ base^) (All [a] (-> (Parser a) (Parser Text) (Parser Text))) @@ -42,82 +42,82 @@ (def: word^ (Parser Text) - (<>.either <t>.alpha-num - (<t>.one-of "_"))) + (<>.either <t>.alpha_num + (<t>.one_of "_"))) (def: (copy reference) (-> Text (Parser Text)) (<>.after (<t>.this reference) (<>\wrap reference))) -(def: (join-text^ part^) +(def: (join_text^ part^) (-> (Parser (List Text)) (Parser Text)) (do <>.monad [parts part^] - (wrap (//.join-with "" parts)))) + (wrap (//.join_with "" parts)))) -(def: name-char^ +(def: name_char^ (Parser Text) - (<t>.none-of (format "[]{}()s#.<>" //.double-quote))) + (<t>.none_of (format "[]{}()s#.<>" //.double_quote))) -(def: name-part^ +(def: name_part^ (Parser Text) (do <>.monad [head (refine^ (<t>.not <t>.decimal) - name-char^) - tail (<t>.some name-char^)] + name_char^) + tail (<t>.some name_char^)] (wrap (format head tail)))) -(def: (name^ current-module) +(def: (name^ current_module) (-> Text (Parser Name)) ($_ <>.either - (<>.and (<>\wrap current-module) (<>.after (<t>.this "..") name-part^)) - (<>.and name-part^ (<>.after (<t>.this ".") name-part^)) - (<>.and (<>\wrap "lux") (<>.after (<t>.this ".") name-part^)) - (<>.and (<>\wrap "") name-part^))) + (<>.and (<>\wrap current_module) (<>.after (<t>.this "..") name_part^)) + (<>.and name_part^ (<>.after (<t>.this ".") name_part^)) + (<>.and (<>\wrap "lux") (<>.after (<t>.this ".") name_part^)) + (<>.and (<>\wrap "") name_part^))) -(def: (re-var^ current-module) +(def: (re_var^ current_module) (-> Text (Parser Code)) (do <>.monad - [name (<t>.enclosed ["\@<" ">"] (name^ current-module))] + [name (<t>.enclosed ["\@<" ">"] (name^ current_module))] (wrap (` (: (Parser Text) (~ (code.identifier name))))))) -(def: re-range^ +(def: re_range^ (Parser Code) (do {! <>.monad} - [from (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume))) + [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) _ (<t>.this "-") - to (|> regex-char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] + to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) -(def: re-char^ +(def: re_char^ (Parser Code) (do <>.monad - [char escaped-char^] + [char escaped_char^] (wrap (` ((~! ..copy) (~ (code.text char))))))) -(def: re-options^ +(def: re_options^ (Parser Code) (do <>.monad - [options (<t>.many escaped-char^)] - (wrap (` (<t>.one-of (~ (code.text options))))))) + [options (<t>.many escaped_char^)] + (wrap (` (<t>.one_of (~ (code.text options))))))) -(def: re-user-class^' +(def: re_user_class^' (Parser Code) (do <>.monad [negate? (<>.maybe (<t>.this "^")) parts (<>.many ($_ <>.either - re-range^ - re-options^))] + re_range^ + re_options^))] (wrap (case negate? (#.Some _) (` (<t>.not ($_ <>.either (~+ parts)))) #.None (` ($_ <>.either (~+ parts))))))) -(def: re-user-class^ +(def: re_user_class^ (Parser Code) (do <>.monad [_ (wrap []) - init re-user-class^' - rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re-user-class^')))] + init re_user_class^' + rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re_user_class^')))] (wrap (list\fold (function (_ refinement base) (` ((~! refine^) (~ refinement) (~ base)))) init @@ -125,7 +125,7 @@ (def: blank^ (Parser Text) - (<t>.one-of (format " " //.tab))) + (<t>.one_of (format " " //.tab))) (def: ascii^ (Parser Text) @@ -134,23 +134,23 @@ (def: control^ (Parser Text) (<>.either (<t>.range (hex "0") (hex "1F")) - (<t>.one-of (//.from-code (hex "7F"))))) + (<t>.one_of (//.from_code (hex "7F"))))) (def: punct^ (Parser Text) - (<t>.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" - //.double-quote))) + (<t>.one_of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~" + //.double_quote))) (def: graph^ (Parser Text) - (<>.either punct^ <t>.alpha-num)) + (<>.either punct^ <t>.alpha_num)) (def: print^ (Parser Text) (<>.either graph^ - (<t>.one-of (//.from-code (hex "20"))))) + (<t>.one_of (//.from_code (hex "20"))))) -(def: re-system-class^ +(def: re_system_class^ (Parser Code) (do <>.monad [] @@ -167,7 +167,7 @@ (<>.after (<t>.this "\p{Upper}") (wrap (` <t>.upper))) (<>.after (<t>.this "\p{Alpha}") (wrap (` <t>.alpha))) (<>.after (<t>.this "\p{Digit}") (wrap (` <t>.decimal))) - (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha-num))) + (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha_num))) (<>.after (<t>.this "\p{Space}") (wrap (` <t>.space))) (<>.after (<t>.this "\p{HexDigit}") (wrap (` <t>.hexadecimal))) (<>.after (<t>.this "\p{OctDigit}") (wrap (` <t>.octal))) @@ -179,17 +179,17 @@ (<>.after (<t>.this "\p{Print}") (wrap (` (~! print^)))) ))) -(def: re-class^ +(def: re_class^ (Parser Code) - (<>.either re-system-class^ - (<t>.enclosed ["[" "]"] re-user-class^))) + (<>.either re_system_class^ + (<t>.enclosed ["[" "]"] re_user_class^))) (def: number^ (Parser Nat) (|> (<t>.many <t>.decimal) (<>.codec n.decimal))) -(def: re-back-reference^ +(def: re_back_reference^ (Parser Code) (<>.either (do <>.monad [_ (<t>.this "\") @@ -197,102 +197,102 @@ (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) (do <>.monad [_ (<t>.this "\k<") - captured-name name-part^ + captured_name name_part^ _ (<t>.this ">")] - (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name])))))))) + (wrap (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) -(def: (re-simple^ current-module) +(def: (re_simple^ current_module) (-> Text (Parser Code)) ($_ <>.either - re-class^ - (re-var^ current-module) - re-back-reference^ - re-char^ + re_class^ + (re_var^ current_module) + re_back_reference^ + re_char^ )) -(def: (re-simple-quantified^ current-module) +(def: (re_simple_quantified^ current_module) (-> Text (Parser Code)) (do <>.monad - [base (re-simple^ current-module) - quantifier (<t>.one-of "?*+")] + [base (re_simple^ current_module) + quantifier (<t>.one_of "?*+")] (case quantifier "?" (wrap (` (<>.default "" (~ base)))) "*" - (wrap (` ((~! join-text^) (<>.some (~ base))))) + (wrap (` ((~! join_text^) (<>.some (~ base))))) ## "+" _ - (wrap (` ((~! join-text^) (<>.many (~ base))))) + (wrap (` ((~! join_text^) (<>.many (~ base))))) ))) -(def: (re-counted-quantified^ current-module) +(def: (re_counted_quantified^ current_module) (-> Text (Parser Code)) (do {! <>.monad} - [base (re-simple^ current-module)] + [base (re_simple^ current_module)] (<t>.enclosed ["{" "}"] ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))] - (wrap (` ((~! join-text^) (<>.between (~ (code.nat from)) + (wrap (` ((~! join_text^) (<>.between (~ (code.nat from)) (~ (code.nat to)) (~ base)))))) (do ! [limit (<>.after (<t>.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) (do ! [limit (<>.before (<t>.this ",") number^)] - (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base)))))) + (wrap (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) (do ! [limit number^] - (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) + (wrap (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) -(def: (re-quantified^ current-module) +(def: (re_quantified^ current_module) (-> Text (Parser Code)) - (<>.either (re-simple-quantified^ current-module) - (re-counted-quantified^ current-module))) + (<>.either (re_simple_quantified^ current_module) + (re_counted_quantified^ current_module))) -(def: (re-complex^ current-module) +(def: (re_complex^ current_module) (-> Text (Parser Code)) ($_ <>.either - (re-quantified^ current-module) - (re-simple^ current-module))) + (re_quantified^ current_module) + (re_simple^ current_module))) -(type: Re-Group - #Non-Capturing +(type: Re_Group + #Non_Capturing (#Capturing [(Maybe Text) Nat])) -(def: (re-sequential^ capturing? re-scoped^ current-module) +(def: (re_sequential^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [parts (<>.many (<>.or (re-complex^ current-module) - (re-scoped^ current-module))) + [parts (<>.many (<>.or (re_complex^ current_module) + (re_scoped^ current_module))) #let [g!total (code.identifier ["" "0total"]) g!temp (code.identifier ["" "0temp"]) - [_ names steps] (list\fold (: (-> (Either Code [Re-Group Code]) + [_ names steps] (list\fold (: (-> (Either Code [Re_Group Code]) [Nat (List Code) (List (List Code))] [Nat (List Code) (List (List Code))]) (function (_ part [idx names steps]) (case part - (^or (#.Left complex) (#.Right [#Non-Capturing complex])) + (^or (#.Left complex) (#.Right [#Non_Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (\ (~! //.monoid) (~' compose) (~ g!total) (~ g!temp))])) steps)] - (#.Right [(#Capturing [?name num-captures]) scoped]) + (#.Right [(#Capturing [?name num_captures]) scoped]) (let [[idx! name!] (case ?name (#.Some _name) [idx (code.identifier ["" _name])] #.None [(inc idx) (code.identifier ["" (n\encode idx)])]) - access (if (n.> 0 num-captures) + access (if (n.> 0 num_captures) (` ((~! product.left) (~ name!))) name!)] [idx! @@ -348,19 +348,19 @@ (#try.Failure error) (#try.Failure error))))) -(def: (prep-alternative [num-captures alt]) +(def: (prep_alternative [num_captures alt]) (-> [Nat Code] Code) - (if (n.> 0 num-captures) + (if (n.> 0 num_captures) alt (` ((~! unflatten^) (~ alt))))) -(def: (re-alternative^ capturing? re-scoped^ current-module) +(def: (re_alternative^ capturing? re_scoped^ current_module) (-> Bit - (-> Text (Parser [Re-Group Code])) + (-> Text (Parser [Re_Group Code])) Text (Parser [Nat Code])) (do <>.monad - [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] + [#let [sub^ (re_sequential^ capturing? re_scoped^ current_module)] head sub^ tail (<>.some (<>.after (<t>.this "|") sub^))] (if (list.empty? tail) @@ -369,36 +369,36 @@ (` ($_ ((~ (if capturing? (` (~! |||^)) (` (~! |||_^))))) - (~ (prep-alternative head)) - (~+ (list\map prep-alternative tail))))])))) + (~ (prep_alternative head)) + (~+ (list\map prep_alternative tail))))])))) -(def: (re-scoped^ current-module) - (-> Text (Parser [Re-Group Code])) +(def: (re_scoped^ current_module) + (-> Text (Parser [Re_Group Code])) ($_ <>.either (do <>.monad [_ (<t>.this "(?:") - [_ scoped] (re-alternative^ #0 re-scoped^ current-module) + [_ scoped] (re_alternative^ #0 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [#Non-Capturing scoped])) + (wrap [#Non_Capturing scoped])) (do <>.monad - [complex (re-complex^ current-module)] - (wrap [#Non-Capturing complex])) + [complex (re_complex^ current_module)] + (wrap [#Non_Capturing complex])) (do <>.monad [_ (<t>.this "(?<") - captured-name name-part^ + captured_name name_part^ _ (<t>.this ">") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern])) + (wrap [(#Capturing [(#.Some captured_name) num_captures]) pattern])) (do <>.monad [_ (<t>.this "(") - [num-captures pattern] (re-alternative^ #1 re-scoped^ current-module) + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [#.None num-captures]) pattern])))) + (wrap [(#Capturing [#.None num_captures]) pattern])))) -(def: (regex^ current-module) +(def: (regex^ current_module) (-> Text (Parser Code)) - (\ <>.monad map product.right (re-alternative^ #1 re-scoped^ current-module))) + (\ <>.monad map product.right (re_alternative^ #1 re_scoped^ current_module))) (syntax: #export (regex {pattern <c>.text}) {#.doc (doc "Create lexers using regular-expression syntax." @@ -460,11 +460,11 @@ (regex "a(.)(.)|b(.)(.)") )} (do meta.monad - [current-module meta.current-module-name] - (case (<t>.run (regex^ current-module) + [current_module meta.current_module_name] + (case (<t>.run (regex^ current_module) pattern) (#try.Failure error) - (meta.fail (format "Error while parsing regular-expression:" //.new-line + (meta.fail (format "Error while parsing regular-expression:" //.new_line error)) (#try.Success regex) @@ -475,19 +475,19 @@ body {branches (<>.many <c>.any)}) {#.doc (doc "Allows you to test text against regular expressions." - (case some-text + (case some_text (^regex "(\d{3})-(\d{3})-(\d{4})" - [_ country-code area-code place-code]) - do-some-thing-when-number + [_ country_code area_code place_code]) + do_some_thing_when_number (^regex "\w+") - do-some-thing-when-word + do_some_thing_when_word _ - do-something-else))} - (with-gensyms [g!temp] - (wrap (list& (` (^multi (~ g!temp) - [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) - (#try.Success (~ (maybe.default g!temp bindings)))])) - body - branches)))) + do_something_else))} + (with_gensyms [g!temp] + (wrap (list& (` (^multi (~ g!temp) + [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) + (#try.Success (~ (maybe.default g!temp bindings)))])) + body + branches)))) diff --git a/stdlib/source/lux/data/text/unicode/block.lux b/stdlib/source/lux/data/text/unicode/block.lux index a4844258a..7e81ff850 100644 --- a/stdlib/source/lux/data/text/unicode/block.lux +++ b/stdlib/source/lux/data/text/unicode/block.lux @@ -67,23 +67,23 @@ (def: &equivalence ..equivalence) (def: (hash value) - (i64.or (i64.left-shift 32 (..start value)) + (i64.or (i64.left_shift 32 (..start value)) (..end value)))) (template [<name> <start> <end>] [(def: #export <name> Block (..block (hex <start>) (hex <end>)))] ## Normal blocks - [basic-latin "0000" "007F"] - [latin-1-supplement "00A0" "00FF"] - [latin-extended-a "0100" "017F"] - [latin-extended-b "0180" "024F"] - [ipa-extensions "0250" "02AF"] - [spacing-modifier-letters "02B0" "02FF"] - [combining-diacritical-marks "0300" "036F"] - [greek-and-coptic "0370" "03FF"] + [basic_latin "0000" "007F"] + [latin_1_supplement "00A0" "00FF"] + [latin_extended_a "0100" "017F"] + [latin_extended_b "0180" "024F"] + [ipa_extensions "0250" "02AF"] + [spacing_modifier_letters "02B0" "02FF"] + [combining_diacritical_marks "0300" "036F"] + [greek_and_coptic "0370" "03FF"] [cyrillic "0400" "04FF"] - [cyrillic-supplementary "0500" "052F"] + [cyrillic_supplementary "0500" "052F"] [armenian "0530" "058F"] [hebrew "0590" "05FF"] [arabic "0600" "06FF"] @@ -104,10 +104,10 @@ [tibetan "0F00" "0FFF"] [myanmar "1000" "109F"] [georgian "10A0" "10FF"] - [hangul-jamo "1100" "11FF"] + [hangul_jamo "1100" "11FF"] [ethiopic "1200" "137F"] [cherokee "13A0" "13FF"] - [unified-canadian-aboriginal-syllabics "1400" "167F"] + [unified_canadian_aboriginal_syllabics "1400" "167F"] [ogham "1680" "169F"] [runic "16A0" "16FF"] [tagalog "1700" "171F"] @@ -117,88 +117,88 @@ [khmer "1780" "17FF"] [mongolian "1800" "18AF"] [limbu "1900" "194F"] - [tai-le "1950" "197F"] - [khmer-symbols "19E0" "19FF"] - [phonetic-extensions "1D00" "1D7F"] - [latin-extended-additional "1E00" "1EFF"] - [greek-extended "1F00" "1FFF"] - [general-punctuation "2000" "206F"] - [superscripts-and-subscripts "2070" "209F"] - [currency-symbols "20A0" "20CF"] - [combining-diacritical-marks-for-symbols "20D0" "20FF"] - [letterlike-symbols "2100" "214F"] - [number-forms "2150" "218F"] + [tai_le "1950" "197F"] + [khmer_symbols "19E0" "19FF"] + [phonetic_extensions "1D00" "1D7F"] + [latin_extended_additional "1E00" "1EFF"] + [greek_extended "1F00" "1FFF"] + [general_punctuation "2000" "206F"] + [superscripts_and_subscripts "2070" "209F"] + [currency_symbols "20A0" "20CF"] + [combining_diacritical_marks_for_symbols "20D0" "20FF"] + [letterlike_symbols "2100" "214F"] + [number_forms "2150" "218F"] [arrows "2190" "21FF"] - [mathematical-operators "2200" "22FF"] - [miscellaneous-technical "2300" "23FF"] - [control-pictures "2400" "243F"] - [optical-character-recognition "2440" "245F"] - [enclosed-alphanumerics "2460" "24FF"] - [box-drawing "2500" "257F"] - [block-elements "2580" "259F"] - [geometric-shapes "25A0" "25FF"] - [miscellaneous-symbols "2600" "26FF"] + [mathematical_operators "2200" "22FF"] + [miscellaneous_technical "2300" "23FF"] + [control_pictures "2400" "243F"] + [optical_character_recognition "2440" "245F"] + [enclosed_alphanumerics "2460" "24FF"] + [box_drawing "2500" "257F"] + [block_elements "2580" "259F"] + [geometric_shapes "25A0" "25FF"] + [miscellaneous_symbols "2600" "26FF"] [dingbats "2700" "27BF"] - [miscellaneous-mathematical-symbols-a "27C0" "27EF"] - [supplemental-arrows-a "27F0" "27FF"] - [braille-patterns "2800" "28FF"] - [supplemental-arrows-b "2900" "297F"] - [miscellaneous-mathematical-symbols-b "2980" "29FF"] - [supplemental-mathematical-operators "2A00" "2AFF"] - [miscellaneous-symbols-and-arrows "2B00" "2BFF"] - [cjk-radicals-supplement "2E80" "2EFF"] - [kangxi-radicals "2F00" "2FDF"] - [ideographic-description-characters "2FF0" "2FFF"] - [cjk-symbols-and-punctuation "3000" "303F"] + [miscellaneous_mathematical_symbols_a "27C0" "27EF"] + [supplemental_arrows_a "27F0" "27FF"] + [braille_patterns "2800" "28FF"] + [supplemental_arrows_b "2900" "297F"] + [miscellaneous_mathematical_symbols_b "2980" "29FF"] + [supplemental_mathematical_operators "2A00" "2AFF"] + [miscellaneous_symbols_and_arrows "2B00" "2BFF"] + [cjk_radicals_supplement "2E80" "2EFF"] + [kangxi_radicals "2F00" "2FDF"] + [ideographic_description_characters "2FF0" "2FFF"] + [cjk_symbols_and_punctuation "3000" "303F"] [hiragana "3040" "309F"] [katakana "30A0" "30FF"] [bopomofo "3100" "312F"] - [hangul-compatibility-jamo "3130" "318F"] + [hangul_compatibility_jamo "3130" "318F"] [kanbun "3190" "319F"] - [bopomofo-extended "31A0" "31BF"] - [katakana-phonetic-extensions "31F0" "31FF"] - [enclosed-cjk-letters-and-months "3200" "32FF"] - [cjk-compatibility "3300" "33FF"] - [cjk-unified-ideographs-extension-a "3400" "4DBF"] - [yijing-hexagram-symbols "4DC0" "4DFF"] - [cjk-unified-ideographs "4E00" "9FFF"] - [yi-syllables "A000" "A48F"] - [yi-radicals "A490" "A4CF"] - [hangul-syllables "AC00" "D7AF"] - [high-surrogates "D800" "DB7F"] - [high-private-use-surrogates "DB80" "DBFF"] - [low-surrogates "DC00" "DFFF"] - [private-use-area "E000" "F8FF"] - [cjk-compatibility-ideographs "F900" "FAFF"] - [alphabetic-presentation-forms "FB00" "FB4F"] - [arabic-presentation-forms-a "FB50" "FDFF"] - [variation-selectors "FE00" "FE0F"] - [combining-half-marks "FE20" "FE2F"] - [cjk-compatibility-forms "FE30" "FE4F"] - [small-form-variants "FE50" "FE6F"] - [arabic-presentation-forms-b "FE70" "FEFF"] - [halfwidth-and-fullwidth-forms "FF00" "FFEF"] + [bopomofo_extended "31A0" "31BF"] + [katakana_phonetic_extensions "31F0" "31FF"] + [enclosed_cjk_letters_and_months "3200" "32FF"] + [cjk_compatibility "3300" "33FF"] + [cjk_unified_ideographs_extension_a "3400" "4DBF"] + [yijing_hexagram_symbols "4DC0" "4DFF"] + [cjk_unified_ideographs "4E00" "9FFF"] + [yi_syllables "A000" "A48F"] + [yi_radicals "A490" "A4CF"] + [hangul_syllables "AC00" "D7AF"] + [high_surrogates "D800" "DB7F"] + [high_private_use_surrogates "DB80" "DBFF"] + [low_surrogates "DC00" "DFFF"] + [private_use_area "E000" "F8FF"] + [cjk_compatibility_ideographs "F900" "FAFF"] + [alphabetic_presentation_forms "FB00" "FB4F"] + [arabic_presentation_forms_a "FB50" "FDFF"] + [variation_selectors "FE00" "FE0F"] + [combining_half_marks "FE20" "FE2F"] + [cjk_compatibility_forms "FE30" "FE4F"] + [small_form_variants "FE50" "FE6F"] + [arabic_presentation_forms_b "FE70" "FEFF"] + [halfwidth_and_fullwidth_forms "FF00" "FFEF"] [specials "FFF0" "FFFF"] - ## [linear-b-syllabary "10000" "1007F"] - ## [linear-b-ideograms "10080" "100FF"] - ## [aegean-numbers "10100" "1013F"] - ## [old-italic "10300" "1032F"] + ## [linear_b_syllabary "10000" "1007F"] + ## [linear_b_ideograms "10080" "100FF"] + ## [aegean_numbers "10100" "1013F"] + ## [old_italic "10300" "1032F"] ## [gothic "10330" "1034F"] ## [ugaritic "10380" "1039F"] ## [deseret "10400" "1044F"] ## [shavian "10450" "1047F"] ## [osmanya "10480" "104AF"] - ## [cypriot-syllabary "10800" "1083F"] - ## [byzantine-musical-symbols "1D000" "1D0FF"] - ## [musical-symbols "1D100" "1D1FF"] - ## [tai-xuan-jing-symbols "1D300" "1D35F"] - ## [mathematical-alphanumeric-symbols "1D400" "1D7FF"] - ## [cjk-unified-ideographs-extension-b "20000" "2A6DF"] - ## [cjk-compatibility-ideographs-supplement "2F800" "2FA1F"] + ## [cypriot_syllabary "10800" "1083F"] + ## [byzantine_musical_symbols "1D000" "1D0FF"] + ## [musical_symbols "1D100" "1D1FF"] + ## [tai_xuan_jing_symbols "1D300" "1D35F"] + ## [mathematical_alphanumeric_symbols "1D400" "1D7FF"] + ## [cjk_unified_ideographs_extension_b "20000" "2A6DF"] + ## [cjk_compatibility_ideographs_supplement "2F800" "2FA1F"] ## [tags "E0000" "E007F"] ## Specialized blocks - [basic-latin/decimal "0030" "0039"] - [basic-latin/upper-alpha "0041" "005A"] - [basic-latin/lower-alpha "0061" "007A"] + [basic_latin/decimal "0030" "0039"] + [basic_latin/upper_alpha "0041" "005A"] + [basic_latin/lower_alpha "0061" "007A"] ) diff --git a/stdlib/source/lux/data/text/unicode/set.lux b/stdlib/source/lux/data/text/unicode/set.lux index 8d350a28b..55d7941ca 100644 --- a/stdlib/source/lux/data/text/unicode/set.lux +++ b/stdlib/source/lux/data/text/unicode/set.lux @@ -8,7 +8,7 @@ ["." set ("#\." equivalence)] ["." tree #_ ["#" finger (#+ Tree)]]]] - [type (#+ :by-example) + [type (#+ :by_example) abstract]] ["." / #_ ["/#" // #_ @@ -19,7 +19,7 @@ (tree.builder //block.monoid)) (def: :@: - (:by-example [@] + (:by_example [@] {(tree.Builder @ Block) ..builder} @)) @@ -45,16 +45,16 @@ (def: #export character Set - (..set [//block.basic-latin - (list //block.latin-1-supplement - //block.latin-extended-a - //block.latin-extended-b - //block.ipa-extensions - //block.spacing-modifier-letters - //block.combining-diacritical-marks - //block.greek-and-coptic + (..set [//block.basic_latin + (list //block.latin_1_supplement + //block.latin_extended_a + //block.latin_extended_b + //block.ipa_extensions + //block.spacing_modifier_letters + //block.combining_diacritical_marks + //block.greek_and_coptic //block.cyrillic - //block.cyrillic-supplementary + //block.cyrillic_supplementary //block.armenian //block.hebrew //block.arabic @@ -75,10 +75,10 @@ //block.tibetan //block.myanmar //block.georgian - //block.hangul-jamo + //block.hangul_jamo //block.ethiopic //block.cherokee - //block.unified-canadian-aboriginal-syllabics + //block.unified_canadian_aboriginal_syllabics //block.ogham //block.runic //block.tagalog @@ -88,89 +88,89 @@ //block.khmer //block.mongolian //block.limbu - //block.tai-le - //block.khmer-symbols - //block.phonetic-extensions - //block.latin-extended-additional - //block.greek-extended - //block.general-punctuation - //block.superscripts-and-subscripts - //block.currency-symbols - //block.combining-diacritical-marks-for-symbols - //block.letterlike-symbols - //block.number-forms + //block.tai_le + //block.khmer_symbols + //block.phonetic_extensions + //block.latin_extended_additional + //block.greek_extended + //block.general_punctuation + //block.superscripts_and_subscripts + //block.currency_symbols + //block.combining_diacritical_marks_for_symbols + //block.letterlike_symbols + //block.number_forms //block.arrows - //block.mathematical-operators - //block.miscellaneous-technical - //block.control-pictures - //block.optical-character-recognition - //block.enclosed-alphanumerics - //block.box-drawing - - //block.block-elements - //block.geometric-shapes - //block.miscellaneous-symbols + //block.mathematical_operators + //block.miscellaneous_technical + //block.control_pictures + //block.optical_character_recognition + //block.enclosed_alphanumerics + //block.box_drawing + + //block.block_elements + //block.geometric_shapes + //block.miscellaneous_symbols //block.dingbats - //block.miscellaneous-mathematical-symbols-a - //block.supplemental-arrows-a - //block.braille-patterns - //block.supplemental-arrows-b - //block.miscellaneous-mathematical-symbols-b - //block.supplemental-mathematical-operators - //block.miscellaneous-symbols-and-arrows - //block.cjk-radicals-supplement - //block.kangxi-radicals - //block.ideographic-description-characters - //block.cjk-symbols-and-punctuation + //block.miscellaneous_mathematical_symbols_a + //block.supplemental_arrows_a + //block.braille_patterns + //block.supplemental_arrows_b + //block.miscellaneous_mathematical_symbols_b + //block.supplemental_mathematical_operators + //block.miscellaneous_symbols_and_arrows + //block.cjk_radicals_supplement + //block.kangxi_radicals + //block.ideographic_description_characters + //block.cjk_symbols_and_punctuation //block.hiragana //block.katakana //block.bopomofo - //block.hangul-compatibility-jamo + //block.hangul_compatibility_jamo //block.kanbun - //block.bopomofo-extended - //block.katakana-phonetic-extensions - //block.enclosed-cjk-letters-and-months - //block.cjk-compatibility - //block.cjk-unified-ideographs-extension-a - //block.yijing-hexagram-symbols - //block.cjk-unified-ideographs - //block.yi-syllables - //block.yi-radicals - //block.hangul-syllables + //block.bopomofo_extended + //block.katakana_phonetic_extensions + //block.enclosed_cjk_letters_and_months + //block.cjk_compatibility + //block.cjk_unified_ideographs_extension_a + //block.yijing_hexagram_symbols + //block.cjk_unified_ideographs + //block.yi_syllables + //block.yi_radicals + //block.hangul_syllables )])) - (def: #export non-character + (def: #export non_character Set - (..set [//block.high-surrogates - (list //block.high-private-use-surrogates - //block.low-surrogates - //block.private-use-area - //block.cjk-compatibility-ideographs - //block.alphabetic-presentation-forms - //block.arabic-presentation-forms-a - //block.variation-selectors - //block.combining-half-marks - //block.cjk-compatibility-forms - //block.small-form-variants - //block.arabic-presentation-forms-b - //block.halfwidth-and-fullwidth-forms + (..set [//block.high_surrogates + (list //block.high_private_use_surrogates + //block.low_surrogates + //block.private_use_area + //block.cjk_compatibility_ideographs + //block.alphabetic_presentation_forms + //block.arabic_presentation_forms_a + //block.variation_selectors + //block.combining_half_marks + //block.cjk_compatibility_forms + //block.small_form_variants + //block.arabic_presentation_forms_b + //block.halfwidth_and_fullwidth_forms //block.specials - ## //block.linear-b-syllabary - ## //block.linear-b-ideograms - ## //block.aegean-numbers - ## //block.old-italic + ## //block.linear_b_syllabary + ## //block.linear_b_ideograms + ## //block.aegean_numbers + ## //block.old_italic ## //block.gothic ## //block.ugaritic ## //block.deseret ## //block.shavian ## //block.osmanya - ## //block.cypriot-syllabary - ## //block.byzantine-musical-symbols - ## //block.musical-symbols - ## //block.tai-xuan-jing-symbols - ## //block.mathematical-alphanumeric-symbols - ## //block.cjk-unified-ideographs-extension-b - ## //block.cjk-compatibility-ideographs-supplement + ## //block.cypriot_syllabary + ## //block.byzantine_musical_symbols + ## //block.musical_symbols + ## //block.tai_xuan_jing_symbols + ## //block.mathematical_alphanumeric_symbols + ## //block.cjk_unified_ideographs_extension_b + ## //block.cjk_compatibility_ideographs_supplement ## //block.tags )])) @@ -178,7 +178,7 @@ Set ($_ ..compose ..character - ..non-character + ..non_character )) (def: #export (range set) @@ -204,17 +204,17 @@ (Equivalence Set) (def: (= reference subject) - (set\= (set.from-list //block.hash (tree.tags (:representation reference))) - (set.from-list //block.hash (tree.tags (:representation subject)))))) + (set\= (set.from_list //block.hash (tree.tags (:representation reference))) + (set.from_list //block.hash (tree.tags (:representation subject)))))) ) (template [<name> <blocks>] [(def: #export <name> (..set <blocks>))] - [ascii [//block.basic-latin (list)]] - [ascii/alpha [//block.basic-latin/upper-alpha (list //block.basic-latin/lower-alpha)]] - [ascii/alpha-num [//block.basic-latin/upper-alpha (list //block.basic-latin/lower-alpha //block.basic-latin/decimal)]] - [ascii/upper-alpha [//block.basic-latin/upper-alpha (list)]] - [ascii/lower-alpha [//block.basic-latin/lower-alpha (list)]] + [ascii [//block.basic_latin (list)]] + [ascii/alpha [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha)]] + [ascii/alpha_num [//block.basic_latin/upper_alpha (list //block.basic_latin/lower_alpha //block.basic_latin/decimal)]] + [ascii/upper_alpha [//block.basic_latin/upper_alpha (list)]] + [ascii/lower_alpha [//block.basic_latin/lower_alpha (list)]] ) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 847cc9225..c537148c8 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -31,7 +31,7 @@ ["." syntax (#+ syntax:)] ["." code]]]) -(with-expansions [<jvm> (as-is (import: java/lang/String) +(with_expansions [<jvm> (as_is (import: java/lang/String) (import: (java/lang/Class a) ["#::." @@ -57,30 +57,30 @@ (longValue [] long) (doubleValue [] double)]))] (for {@.old - (as-is <jvm>) + (as_is <jvm>) @.jvm - (as-is <jvm>) + (as_is <jvm>) @.js - (as-is (import: JSON + (as_is (import: JSON (#static stringify [.Any] host.String)) (import: Array (#static isArray [.Any] host.Boolean)))})) (def: Inspector (-> Any Text)) -(def: (inspect-tuple inspect) +(def: (inspect_tuple inspect) (-> Inspector Inspector) (|>> (:coerce (array.Array Any)) - array.to-list + array.to_list (list\map inspect) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))) (def: #export (inspect value) Inspector - (with-expansions [<jvm> (let [object (:coerce java/lang/Object value)] + (with_expansions [<jvm> (let [object (:coerce java/lang/Object value)] (`` (<| (~~ (template [<class> <processing>] [(case (host.check <class> object) (#.Some value) @@ -112,7 +112,7 @@ (text.enclose ["(" ")"]))) _ - (inspect-tuple inspect value))) + (inspect_tuple inspect value))) #.None) (java/lang/Object::toString object))))] (for {@.old @@ -122,9 +122,9 @@ <jvm> @.js - (case (host.type-of value) - (^template [<type-of> <then>] - [<type-of> + (case (host.type_of value) + (^template [<type_of> <then>] + [<type_of> (`` (|> value (~~ (template.splice <then>))))]) (["boolean" [(:coerce .Bit) %.bit]] ["string" [(:coerce .Text) %.text]] @@ -132,15 +132,15 @@ ["undefined" [JSON::stringify]]) "object" - (let [variant-tag ("js object get" "_lux_tag" value) - variant-flag ("js object get" "_lux_flag" value) - variant-value ("js object get" "_lux_value" value)] - (cond (not (or ("js object undefined?" variant-tag) - ("js object undefined?" variant-flag) - ("js object undefined?" variant-value))) - (|> (format (JSON::stringify variant-tag) - " " (%.bit (not ("js object null?" variant-flag))) - " " (inspect variant-value)) + (let [variant_tag ("js object get" "_lux_tag" value) + variant_flag ("js object get" "_lux_flag" value) + variant_value ("js object get" "_lux_value" value)] + (cond (not (or ("js object undefined?" variant_tag) + ("js object undefined?" variant_flag) + ("js object undefined?" variant_value))) + (|> (format (JSON::stringify variant_tag) + " " (%.bit (not ("js object null?" variant_flag))) + " " (inspect variant_value)) (text.enclose ["(" ")"])) (not (or ("js object undefined?" ("js object get" "_lux_low" value)) @@ -148,7 +148,7 @@ (|> value (:coerce .Int) %.int) (Array::isArray value) - (inspect-tuple inspect value) + (inspect_tuple inspect value) ## else (JSON::stringify value))) @@ -157,13 +157,13 @@ (undefined)) }))) -(exception: #export (cannot-represent-value {type Type}) +(exception: #export (cannot_represent_value {type Type}) (exception.report ["Type" (%.type type)])) (type: Representation (-> Any Text)) -(def: primitive-representation +(def: primitive_representation (Parser Representation) (`` ($_ <>.either (do <>.monad @@ -182,7 +182,7 @@ [Frac %.frac] [Text %.text]))))) -(def: (special-representation representation) +(def: (special_representation representation) (-> (Parser Representation) (Parser Representation)) (`` ($_ <>.either (~~ (template [<type> <formatter>] @@ -213,12 +213,12 @@ (#.Some elemV) (format "(#.Some " (elemR elemV) ")")))))))) -(def: (variant-representation representation) +(def: (variant_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (<type>.variant (<>.many representation))] (wrap (function (_ variantV) - (let [[lefts right? sub-repr] (loop [lefts 0 + (let [[lefts right? sub_repr] (loop [lefts 0 representations membersR+ variantV variantV] (case representations @@ -237,14 +237,14 @@ _ (undefined)))] - (format "(" (%.nat lefts) " " (%.bit right?) " " sub-repr ")")))))) + (format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")")))))) -(def: (tuple-representation representation) +(def: (tuple_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (<type>.tuple (<>.many representation))] (wrap (function (_ tupleV) - (let [tuple-body (loop [representations membersR+ + (let [tuple_body (loop [representations membersR+ tupleV tupleV] (case representations #.Nil @@ -256,17 +256,17 @@ (#.Cons headR tailR) (let [[leftV rightV] (:coerce [Any Any] tupleV)] (format (headR leftV) " " (recur tailR rightV)))))] - (format "[" tuple-body "]")))))) + (format "[" tuple_body "]")))))) (def: representation (Parser Representation) (<>.rec (function (_ representation) ($_ <>.either - primitive-representation - (special-representation representation) - (variant-representation representation) - (tuple-representation representation) + primitive_representation + (special_representation representation) + (variant_representation representation) + (tuple_representation representation) (do <>.monad [[funcT inputsT+] (<type>.apply (<>.and <type>.any (<>.many <type>.any)))] @@ -291,7 +291,7 @@ (#try.Success (representation value)) (#try.Failure _) - (exception.throw ..cannot-represent-value type))) + (exception.throw ..cannot_represent_value type))) (syntax: #export (private {definition <code>.identifier}) (let [[module _] definition] diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index a295d83e8..85bd050c0 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -11,7 +11,7 @@ ["." product] [collection ["." list ("#\." functor)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:)]] @@ -26,13 +26,13 @@ (def: (simple default) (-> Code (Parser Input)) ($_ <>.and - <c>.local-identifier + <c>.local_identifier (<>\wrap default))) (def: complex (Parser Input) (<c>.record ($_ <>.and - <c>.local-identifier + <c>.local_identifier <c>.any))) (def: (input default) @@ -51,9 +51,9 @@ (-> Code (Parser Declaration)) (<c>.form ($_ <>.and <c>.any - <c>.local-identifier - <c>.local-identifier - <c>.local-identifier + <c>.local_identifier + <c>.local_identifier + <c>.local_identifier (<>.some (..input default))))) (template [<any> <end> <and> <run> <extension> <name>] @@ -66,15 +66,15 @@ parsers (` (.$_ <and> (~+ parsers)))) - g!name (code.local-identifier extension) - g!phase (code.local-identifier phase) - g!archive (code.local-identifier archive)] - (with-gensyms [g!handler g!inputs g!error] + g!name (code.local_identifier extension) + g!phase (code.local_identifier phase) + g!archive (code.local_identifier archive)] + (with_gensyms [g!handler g!inputs g!error] (wrap (list (` (<extension> (~ name) (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) (.case ((~! <run>) (~ g!parser) (~ g!inputs)) (#.Right [(~+ (list\map (|>> product.left - code.local-identifier) + code.local_identifier) inputs))]) (~ body) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 4f8ce6736..8386da339 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -26,7 +26,7 @@ [syntax (#+ syntax:)] ["." code] ["." template]] - ["." meta (#+ with-gensyms) + ["." meta (#+ with_gensyms) ["." annotation]] [target [jvm @@ -82,13 +82,13 @@ [char reflection.char] ) -(def: (get-static-field class field) +(def: (get_static_field class field) (-> Text Text Code) (` ("jvm member get static" (~ (code.text class)) (~ (code.text field))))) -(def: (get-virtual-field class field object) +(def: (get_virtual_field class field object) (-> Text Text Code Code) (` ("jvm member get virtual" (~ (code.text class)) @@ -105,7 +105,7 @@ [type.float box.float] [type.double box.double] [type.char box.char]) - (dictionary.from-list type.hash))) + (dictionary.from_list type.hash))) (template [<name> <pre> <post>] [(def: (<name> unboxed boxed raw) @@ -132,41 +132,41 @@ "jvm object cast" (: <to>)))] - [byte-to-long "jvm conversion byte-to-long" ..Byte ..Long] + [byte_to_long "jvm conversion byte-to-long" ..Byte ..Long] - [short-to-long "jvm conversion short-to-long" ..Short ..Long] + [short_to_long "jvm conversion short-to-long" ..Short ..Long] - [double-to-int "jvm conversion double-to-int" ..Double ..Integer] - [double-to-long "jvm conversion double-to-long" ..Double ..Long] - [double-to-float "jvm conversion double-to-float" ..Double ..Float] + [double_to_int "jvm conversion double-to-int" ..Double ..Integer] + [double_to_long "jvm conversion double-to-long" ..Double ..Long] + [double_to_float "jvm conversion double-to-float" ..Double ..Float] - [float-to-int "jvm conversion float-to-int" ..Float ..Integer] - [float-to-long "jvm conversion float-to-long" ..Float ..Long] - [float-to-double "jvm conversion float-to-double" ..Float ..Double] + [float_to_int "jvm conversion float-to-int" ..Float ..Integer] + [float_to_long "jvm conversion float-to-long" ..Float ..Long] + [float_to_double "jvm conversion float-to-double" ..Float ..Double] - [int-to-byte "jvm conversion int-to-byte" ..Integer ..Byte] - [int-to-short "jvm conversion int-to-short" ..Integer ..Short] - [int-to-long "jvm conversion int-to-long" ..Integer ..Long] - [int-to-float "jvm conversion int-to-float" ..Integer ..Float] - [int-to-double "jvm conversion int-to-double" ..Integer ..Double] - [int-to-char "jvm conversion int-to-char" ..Integer ..Character] - - [long-to-byte "jvm conversion long-to-byte" ..Long ..Byte] - [long-to-short "jvm conversion long-to-short" ..Long ..Short] - [long-to-int "jvm conversion long-to-int" ..Long ..Integer] - [long-to-float "jvm conversion long-to-float" ..Long ..Float] - [long-to-double "jvm conversion long-to-double" ..Long ..Double] - - [char-to-byte "jvm conversion char-to-byte" ..Character ..Byte] - [char-to-short "jvm conversion char-to-short" ..Character ..Short] - [char-to-int "jvm conversion char-to-int" ..Character ..Integer] - [char-to-long "jvm conversion char-to-long" ..Character ..Long] + [int_to_byte "jvm conversion int-to-byte" ..Integer ..Byte] + [int_to_short "jvm conversion int-to-short" ..Integer ..Short] + [int_to_long "jvm conversion int-to-long" ..Integer ..Long] + [int_to_float "jvm conversion int-to-float" ..Integer ..Float] + [int_to_double "jvm conversion int-to-double" ..Integer ..Double] + [int_to_char "jvm conversion int-to-char" ..Integer ..Character] + + [long_to_byte "jvm conversion long-to-byte" ..Long ..Byte] + [long_to_short "jvm conversion long-to-short" ..Long ..Short] + [long_to_int "jvm conversion long-to-int" ..Long ..Integer] + [long_to_float "jvm conversion long-to-float" ..Long ..Float] + [long_to_double "jvm conversion long-to-double" ..Long ..Double] + + [char_to_byte "jvm conversion char-to-byte" ..Character ..Byte] + [char_to_short "jvm conversion char-to-short" ..Character ..Short] + [char_to_int "jvm conversion char-to-int" ..Character ..Integer] + [char_to_long "jvm conversion char-to-long" ..Character ..Long] ) -(def: constructor-method-name "<init>") -(def: member-separator "::") +(def: constructor_method_name "<init>") +(def: member_separator "::") -(type: Primitive-Mode +(type: Primitive_Mode #ManualPrM #AutoPrM) @@ -186,36 +186,36 @@ #AbstractIM #DefaultIM) -(type: Class-Kind +(type: Class_Kind #Class #Interface) (type: StackFrame (primitive "java/lang/StackTraceElement")) (type: StackTrace (array.Array StackFrame)) -(type: Annotation-Parameter +(type: Annotation_Parameter [Text Code]) (type: Annotation - {#ann-name Text - #ann-params (List Annotation-Parameter)}) + {#ann_name Text + #ann_params (List Annotation_Parameter)}) -(type: Member-Declaration - {#member-name Text - #member-privacy Privacy - #member-anns (List Annotation)}) +(type: Member_Declaration + {#member_name Text + #member_privacy Privacy + #member_anns (List Annotation)}) (type: FieldDecl (#ConstantField (Type Value) Code) (#VariableField StateModifier (Type Value))) (type: MethodDecl - {#method-tvars (List (Type Var)) - #method-inputs (List (Type Value)) - #method-output (Type Return) - #method-exs (List (Type Class))}) + {#method_tvars (List (Type Var)) + #method_inputs (List (Type Value)) + #method_output (Type Return) + #method_exs (List (Type Class))}) -(type: Method-Definition +(type: Method_Definition (#ConstructorMethod [Bit (List (Type Var)) Text @@ -254,47 +254,47 @@ (Type Return) (List (Type Class))])) -(type: Partial-Call - {#pc-method Name - #pc-args (List Code)}) +(type: Partial_Call + {#pc_method Name + #pc_args (List Code)}) (type: ImportMethodKind #StaticIMK #VirtualIMK) (type: ImportMethodCommons - {#import-member-mode Primitive-Mode - #import-member-alias Text - #import-member-kind ImportMethodKind - #import-member-tvars (List (Type Var)) - #import-member-args (List [Bit (Type Value)]) - #import-member-maybe? Bit - #import-member-try? Bit - #import-member-io? Bit}) + {#import_member_mode Primitive_Mode + #import_member_alias Text + #import_member_kind ImportMethodKind + #import_member_tvars (List (Type Var)) + #import_member_args (List [Bit (Type Value)]) + #import_member_maybe? Bit + #import_member_try? Bit + #import_member_io? Bit}) (type: ImportConstructorDecl {}) (type: ImportMethodDecl - {#import-method-name Text - #import-method-return (Type Return)}) + {#import_method_name Text + #import_method_return (Type Return)}) (type: ImportFieldDecl - {#import-field-mode Primitive-Mode - #import-field-name Text - #import-field-static? Bit - #import-field-maybe? Bit - #import-field-setter? Bit - #import-field-type (Type Value)}) - -(type: Import-Member-Declaration + {#import_field_mode Primitive_Mode + #import_field_name Text + #import_field_static? Bit + #import_field_maybe? Bit + #import_field_setter? Bit + #import_field_type (Type Value)}) + +(type: Import_Member_Declaration (#EnumDecl (List Text)) (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl]) (#MethodDecl [ImportMethodCommons ImportMethodDecl]) (#FieldAccessDecl ImportFieldDecl)) -(def: (primitive-type mode type) - (-> Primitive-Mode (Type Primitive) Code) +(def: (primitive_type mode type) + (-> Primitive_Mode (Type Primitive) Code) (case mode #ManualPrM (cond (\ type.equivalence = type.boolean type) (` ..Boolean) @@ -328,7 +328,7 @@ ## else (undefined)))) -(def: (parameter-type type) +(def: (parameter_type type) (-> (Type Parameter) Code) (`` (<| (~~ (template [<when> <binding> <then>] [(case (<when> type) @@ -340,16 +340,16 @@ [parser.var? name (code.identifier ["" name])] [parser.wildcard? _ (` .Any)] [parser.lower? _ (` .Any)] - [parser.upper? limit (parameter-type limit)] + [parser.upper? limit (parameter_type limit)] [parser.class? [name parameters] (` (.primitive (~ (code.text name)) - [(~+ (list\map parameter-type parameters))]))])) + [(~+ (list\map parameter_type parameters))]))])) ## else (undefined) ))) -(def: (value-type mode type) - (-> Primitive-Mode (Type Value) Code) +(def: (value_type mode type) + (-> Primitive_Mode (Type Value) Code) (`` (<| (~~ (template [<when> <binding> <then>] [(case (<when> type) (#.Some <binding>) @@ -357,57 +357,57 @@ #.None)] - [parser.parameter? type (parameter-type type)] - [parser.primitive? type (primitive-type mode type)] + [parser.parameter? type (parameter_type type)] + [parser.primitive? type (primitive_type mode type)] [parser.array? elementT (case (parser.primitive? elementT) (#.Some elementT) (` (#.Primitive (~ (code.text (..reflection (type.array elementT)))) #.Nil)) #.None - (` (#.Primitive (~ (code.text array.type-name)) - (#.Cons (~ (value-type mode elementT)) #.Nil))))])) + (` (#.Primitive (~ (code.text array.type_name)) + (#.Cons (~ (value_type mode elementT)) #.Nil))))])) (undefined) ))) -(def: declaration-type$ +(def: declaration_type$ (-> (Type Declaration) Code) (|>> ..signature code.text)) -(def: (make-get-const-parser class-name field-name) +(def: (make_get_const_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad - [#let [dotted-name (format "::" field-name)] - _ (<c>.this! (code.identifier ["" dotted-name]))] - (wrap (get-static-field class-name field-name)))) + [#let [dotted_name (format "::" field_name)] + _ (<c>.this! (code.identifier ["" dotted_name]))] + (wrap (get_static_field class_name field_name)))) -(def: (make-get-var-parser class-name field-name) +(def: (make_get_var_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad - [#let [dotted-name (format "::" field-name)] - _ (<c>.this! (code.identifier ["" dotted-name]))] - (wrap (get-virtual-field class-name field-name (' _jvm_this))))) + [#let [dotted_name (format "::" field_name)] + _ (<c>.this! (code.identifier ["" dotted_name]))] + (wrap (get_virtual_field class_name field_name (' _jvm_this))))) -(def: (make-put-var-parser class-name field-name) +(def: (make_put_var_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad - [#let [dotted-name (format "::" field-name)] + [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) - (<c>.form ($_ <>.and (<c>.this! (' :=)) (<c>.this! (code.identifier ["" dotted-name])) <c>.any)))] - (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) + (<c>.form ($_ <>.and (<c>.this! (' :=)) (<c>.this! (code.identifier ["" dotted_name])) <c>.any)))] + (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) -(def: (pre-walk-replace f input) +(def: (pre_walk_replace f input) (-> (-> Code Code) Code Code) (case (f input) (^template [<tag>] [[meta (<tag> parts)] - [meta (<tag> (list\map (pre-walk-replace f) parts))]]) + [meta (<tag> (list\map (pre_walk_replace f) parts))]]) ([#.Form] [#.Tuple]) [meta (#.Record pairs)] [meta (#.Record (list\map (: (-> [Code Code] [Code Code]) (function (_ [key val]) - [(pre-walk-replace f key) (pre-walk-replace f val)])) + [(pre_walk_replace f key) (pre_walk_replace f val)])) pairs))] ast' @@ -423,81 +423,81 @@ ast )) -(def: (field->parser class-name [[field-name _ _] field]) - (-> Text [Member-Declaration FieldDecl] (Parser Code)) +(def: (field->parser class_name [[field_name _ _] field]) + (-> Text [Member_Declaration FieldDecl] (Parser Code)) (case field (#ConstantField _) - (make-get-const-parser class-name field-name) + (make_get_const_parser class_name field_name) (#VariableField _) - (<>.either (make-get-var-parser class-name field-name) - (make-put-var-parser class-name field-name)))) + (<>.either (make_get_var_parser class_name field_name) + (make_put_var_parser class_name field_name)))) -(def: (decorate-input [class value]) +(def: (decorate_input [class value]) (-> [(Type Value) Code] Code) (` [(~ (code.text (..signature class))) (~ value)])) -(def: (make-constructor-parser class-name arguments) +(def: (make_constructor_parser class_name arguments) (-> Text (List Argument) (Parser Code)) (do <>.monad [args (: (Parser (List Code)) (<c>.form (<>.after (<c>.this! (' ::new!)) (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] - (wrap (` ("jvm member invoke constructor" (~ (code.text class-name)) + (wrap (` ("jvm member invoke constructor" (~ (code.text class_name)) (~+ (|> args (list.zip/2 (list\map product.right arguments)) - (list\map ..decorate-input)))))))) + (list\map ..decorate_input)))))))) -(def: (make-static-method-parser class-name method-name arguments) +(def: (make_static_method_parser class_name method_name arguments) (-> Text Text (List Argument) (Parser Code)) (do <>.monad - [#let [dotted-name (format "::" method-name "!")] + [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted-name])) + (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted_name])) (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] - (wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name)) + (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) (~+ (|> args (list.zip/2 (list\map product.right arguments)) - (list\map ..decorate-input)))))))) + (list\map ..decorate_input)))))))) -(template [<name> <jvm-op>] - [(def: (<name> class-name method-name arguments) +(template [<name> <jvm_op>] + [(def: (<name> class_name method_name arguments) (-> Text Text (List Argument) (Parser Code)) (do <>.monad - [#let [dotted-name (format "::" method-name "!")] + [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted-name])) + (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted_name])) (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))] - (wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name)) + (wrap (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) (~' _jvm_this) (~+ (|> args (list.zip/2 (list\map product.right arguments)) - (list\map ..decorate-input))))))))] + (list\map ..decorate_input))))))))] - [make-special-method-parser "jvm member invoke special"] - [make-virtual-method-parser "jvm member invoke virtual"] + [make_special_method_parser "jvm member invoke special"] + [make_virtual_method_parser "jvm member invoke virtual"] ) -(def: (method->parser class-name [[method-name _ _] meth-def]) - (-> Text [Member-Declaration Method-Definition] (Parser Code)) - (case meth-def - (#ConstructorMethod strict? type-vars self-name args constructor-args return-expr exs) - (make-constructor-parser class-name args) +(def: (method->parser class_name [[method_name _ _] meth_def]) + (-> Text [Member_Declaration Method_Definition] (Parser Code)) + (case meth_def + (#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs) + (make_constructor_parser class_name args) - (#StaticMethod strict? type-vars args return-type return-expr exs) - (make-static-method-parser class-name method-name args) + (#StaticMethod strict? type_vars args return_type return_expr exs) + (make_static_method_parser class_name method_name args) - (^or (#VirtualMethod final? strict? type-vars self-name args return-type return-expr exs) - (#OverridenMethod strict? owner-class type-vars self-name args return-type return-expr exs)) - (make-special-method-parser class-name method-name args) + (^or (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs) + (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs)) + (make_special_method_parser class_name method_name args) - (#AbstractMethod type-vars args return-type exs) - (make-virtual-method-parser class-name method-name args) + (#AbstractMethod type_vars args return_type exs) + (make_virtual_method_parser class_name method_name args) - (#NativeMethod type-vars args return-type exs) - (make-virtual-method-parser class-name method-name args))) + (#NativeMethod type_vars args return_type exs) + (make_virtual_method_parser class_name method_name args))) -(def: privacy-modifier^ +(def: privacy_modifier^ (Parser Privacy) (let [(^open ".") <>.monad] ($_ <>.or @@ -506,7 +506,7 @@ (<c>.this! (' #protected)) (wrap [])))) -(def: inheritance-modifier^ +(def: inheritance_modifier^ (Parser InheritanceModifier) (let [(^open ".") <>.monad] ($_ <>.or @@ -514,62 +514,62 @@ (<c>.this! (' #abstract)) (wrap [])))) -(exception: #export (class-names-cannot-contain-periods {name Text}) +(exception: #export (class_names_cannot_contain_periods {name Text}) (exception.report ["Name" (%.text name)])) -(exception: #export (class-name-cannot-be-a-type-variable {name Text} - {type-vars (List (Type Var))}) +(exception: #export (class_name_cannot_be_a_type_variable {name Text} + {type_vars (List (Type Var))}) (exception.report ["Name" (%.text name)] - ["Type Variables" (exception.enumerate parser.name type-vars)])) + ["Type Variables" (exception.enumerate parser.name type_vars)])) (def: (assert exception payload test) (All [e] (-> (Exception e) e Bit (Parser Any))) (<>.assert (exception.construct exception payload) test)) -(def: (assert-valid-class-name type-vars name) +(def: (assert_valid_class_name type_vars name) (-> (List (Type Var)) External (Parser Any)) (do <>.monad - [_ (..assert ..class-names-cannot-contain-periods [name] - (not (text.contains? name.external-separator name)))] - (..assert ..class-name-cannot-be-a-type-variable [name type-vars] + [_ (..assert ..class_names_cannot_contain_periods [name] + (not (text.contains? name.external_separator name)))] + (..assert ..class_name_cannot_be_a_type_variable [name type_vars] (not (list.member? text.equivalence - (list\map parser.name type-vars) + (list\map parser.name type_vars) name))))) -(def: (valid-class-name type-vars) +(def: (valid_class_name type_vars) (-> (List (Type Var)) (Parser External)) (do <>.monad - [name <c>.local-identifier - _ (assert-valid-class-name type-vars name)] + [name <c>.local_identifier + _ (assert_valid_class_name type_vars name)] (wrap name))) -(def: (class^' parameter^ type-vars) +(def: (class^' parameter^ type_vars) (-> (-> (List (Type Var)) (Parser (Type Parameter))) (-> (List (Type Var)) (Parser (Type Class)))) (do <>.monad [[name parameters] (: (Parser [External (List (Type Parameter))]) ($_ <>.either - (<>.and (valid-class-name type-vars) + (<>.and (valid_class_name type_vars) (<>\wrap (list))) - (<c>.form (<>.and <c>.local-identifier - (<>.some (parameter^ type-vars))))))] + (<c>.form (<>.and <c>.local_identifier + (<>.some (parameter^ type_vars))))))] (wrap (type.class (name.sanitize name) parameters)))) -(exception: #export (unexpected-type-variable {name Text} - {type-vars (List (Type Var))}) +(exception: #export (unexpected_type_variable {name Text} + {type_vars (List (Type Var))}) (exception.report ["Unexpected Type Variable" (%.text name)] - ["Expected Type Variables" (exception.enumerate parser.name type-vars)])) + ["Expected Type Variables" (exception.enumerate parser.name type_vars)])) -(def: (variable^ type-vars) +(def: (variable^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) (do <>.monad - [name <c>.local-identifier - _ (..assert ..unexpected-type-variable [name type-vars] - (list.member? text.equivalence (list\map parser.name type-vars) name))] + [name <c>.local_identifier + _ (..assert ..unexpected_type_variable [name type_vars] + (list.member? text.equivalence (list\map parser.name type_vars) name))] (wrap (type.var name)))) (def: wildcard^ @@ -590,13 +590,13 @@ [lower^ > type.lower] ) -(def: (parameter^ type-vars) +(def: (parameter^ type_vars) (-> (List (Type Var)) (Parser (Type Parameter))) (<>.rec (function (_ recur^) - (let [class^ (..class^' parameter^ type-vars)] + (let [class^ (..class^' parameter^ type_vars)] ($_ <>.either - (..variable^ type-vars) + (..variable^ type_vars) ..wildcard^ (upper^ class^) (lower^ class^) @@ -629,13 +629,13 @@ (|>> <c>.tuple (\ <>.monad map type.array))) -(def: (type^ type-vars) +(def: (type^ type_vars) (-> (List (Type Var)) (Parser (Type Value))) (<>.rec (function (_ type^) ($_ <>.either ..primitive^ - (..parameter^ type-vars) + (..parameter^ type_vars) (..array^ type^) )))) @@ -645,14 +645,14 @@ [_ (<c>.identifier! ["" (reflection.reflection reflection.void)])] (wrap type.void))) -(def: (return^ type-vars) +(def: (return^ type_vars) (-> (List (Type Var)) (Parser (Type Return))) (<>.either ..void^ - (..type^ type-vars))) + (..type^ type_vars))) (def: var^ (Parser (Type Var)) - (\ <>.monad map type.var <c>.local-identifier)) + (\ <>.monad map type.var <c>.local_identifier)) (def: vars^ (Parser (List (Type Var))) @@ -662,28 +662,28 @@ (Parser (Type Declaration)) (do <>.monad [[name variables] (: (Parser [External (List (Type Var))]) - (<>.either (<>.and (valid-class-name (list)) + (<>.either (<>.and (valid_class_name (list)) (<>\wrap (list))) - (<c>.form (<>.and (valid-class-name (list)) + (<c>.form (<>.and (valid_class_name (list)) (<>.some var^))) ))] (wrap (type.declaration name variables)))) -(def: (class^ type-vars) +(def: (class^ type_vars) (-> (List (Type Var)) (Parser (Type Class))) - (class^' parameter^ type-vars)) + (class^' parameter^ type_vars)) -(def: annotation-parameters^ - (Parser (List Annotation-Parameter)) - (<c>.record (<>.some (<>.and <c>.local-tag <c>.any)))) +(def: annotation_parameters^ + (Parser (List Annotation_Parameter)) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any)))) (def: annotation^ (Parser Annotation) (<>.either (do <>.monad - [ann-name <c>.local-identifier] - (wrap [ann-name (list)])) - (<c>.form (<>.and <c>.local-identifier - annotation-parameters^)))) + [ann_name <c>.local_identifier] + (wrap [ann_name (list)])) + (<c>.form (<>.and <c>.local_identifier + annotation_parameters^)))) (def: annotations^' (Parser (List Annotation)) @@ -697,199 +697,199 @@ [anns?? (<>.maybe ..annotations^')] (wrap (maybe.default (list) anns??)))) -(def: (throws-decl^ type-vars) +(def: (throws_decl^ type_vars) (-> (List (Type Var)) (Parser (List (Type Class)))) (<| (<>.default (list)) (do <>.monad [_ (<c>.this! (' #throws))] - (<c>.tuple (<>.some (..class^ type-vars)))))) + (<c>.tuple (<>.some (..class^ type_vars)))))) -(def: (method-decl^ type-vars) - (-> (List (Type Var)) (Parser [Member-Declaration MethodDecl])) +(def: (method_decl^ type_vars) + (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl])) (<c>.form (do <>.monad [tvars (<>.default (list) ..vars^) - name <c>.local-identifier + name <c>.local_identifier anns ..annotations^ - inputs (<c>.tuple (<>.some (..type^ type-vars))) - output (..return^ type-vars) - exs (throws-decl^ type-vars)] - (wrap [[name #PublicP anns] {#method-tvars tvars - #method-inputs inputs - #method-output output - #method-exs exs}])))) - -(def: state-modifier^ + inputs (<c>.tuple (<>.some (..type^ type_vars))) + output (..return^ type_vars) + exs (throws_decl^ type_vars)] + (wrap [[name #PublicP anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) + +(def: state_modifier^ (Parser StateModifier) ($_ <>.or (<c>.this! (' #volatile)) (<c>.this! (' #final)) (\ <>.monad wrap []))) -(def: (field-decl^ type-vars) - (-> (List (Type Var)) (Parser [Member-Declaration FieldDecl])) +(def: (field_decl^ type_vars) + (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl])) (<>.either (<c>.form (do <>.monad [_ (<c>.this! (' #const)) - name <c>.local-identifier + name <c>.local_identifier anns ..annotations^ - type (..type^ type-vars) + type (..type^ type_vars) body <c>.any] (wrap [[name #PublicP anns] (#ConstantField [type body])]))) (<c>.form (do <>.monad - [pm privacy-modifier^ - sm state-modifier^ - name <c>.local-identifier + [pm privacy_modifier^ + sm state_modifier^ + name <c>.local_identifier anns ..annotations^ - type (..type^ type-vars)] + type (..type^ type_vars)] (wrap [[name pm anns] (#VariableField [sm type])]))))) -(def: (argument^ type-vars) +(def: (argument^ type_vars) (-> (List (Type Var)) (Parser Argument)) - (<c>.record (<>.and <c>.local-identifier - (..type^ type-vars)))) + (<c>.record (<>.and <c>.local_identifier + (..type^ type_vars)))) -(def: (arguments^ type-vars) +(def: (arguments^ type_vars) (-> (List (Type Var)) (Parser (List Argument))) - (<>.some (..argument^ type-vars))) + (<>.some (..argument^ type_vars))) -(def: (constructor-arg^ type-vars) +(def: (constructor_arg^ type_vars) (-> (List (Type Var)) (Parser (Typed Code))) - (<c>.record (<>.and (..type^ type-vars) <c>.any))) + (<c>.record (<>.and (..type^ type_vars) <c>.any))) -(def: (constructor-args^ type-vars) +(def: (constructor_args^ type_vars) (-> (List (Type Var)) (Parser (List (Typed Code)))) - (<c>.tuple (<>.some (..constructor-arg^ type-vars)))) + (<c>.tuple (<>.some (..constructor_arg^ type_vars)))) -(def: (constructor-method^ class-vars) - (List (Type Var)) (Parser [Member-Declaration Method-Definition]) +(def: (constructor_method^ class_vars) + (List (Type Var)) (Parser [Member_Declaration Method_Definition]) (<c>.form (do <>.monad - [pm privacy-modifier^ - strict-fp? (<>.parses? (<c>.this! (' #strict))) - method-vars (<>.default (list) ..vars^) - #let [total-vars (list\compose class-vars method-vars)] - [_ self-name arguments] (<c>.form ($_ <>.and + [pm privacy_modifier^ + strict_fp? (<>.parses? (<c>.this! (' #strict))) + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose class_vars method_vars)] + [_ self_name arguments] (<c>.form ($_ <>.and (<c>.this! (' new)) - <c>.local-identifier - (..arguments^ total-vars))) - constructor-args (..constructor-args^ total-vars) - exs (throws-decl^ total-vars) + <c>.local_identifier + (..arguments^ total_vars))) + constructor_args (..constructor_args^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^ body <c>.any] - (wrap [{#member-name constructor-method-name - #member-privacy pm - #member-anns annotations} - (#ConstructorMethod strict-fp? method-vars self-name arguments constructor-args body exs)])))) + (wrap [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)])))) -(def: (virtual-method-def^ class-vars) - (-> (List (Type Var)) (Parser [Member-Declaration Method-Definition])) +(def: (virtual_method_def^ class_vars) + (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) (<c>.form (do <>.monad - [pm privacy-modifier^ - strict-fp? (<>.parses? (<c>.this! (' #strict))) + [pm privacy_modifier^ + strict_fp? (<>.parses? (<c>.this! (' #strict))) final? (<>.parses? (<c>.this! (' #final))) - method-vars (<>.default (list) ..vars^) - #let [total-vars (list\compose class-vars method-vars)] - [name self-name arguments] (<c>.form ($_ <>.and - <c>.local-identifier - <c>.local-identifier - (..arguments^ total-vars))) - return-type (..return^ total-vars) - exs (throws-decl^ total-vars) + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose class_vars method_vars)] + [name self_name arguments] (<c>.form ($_ <>.and + <c>.local_identifier + <c>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^ body <c>.any] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#VirtualMethod final? strict-fp? method-vars self-name arguments return-type body exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)])))) -(def: overriden-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: overriden_method_def^ + (Parser [Member_Declaration Method_Definition]) (<c>.form (do <>.monad - [strict-fp? (<>.parses? (<c>.this! (' #strict))) - owner-class ..declaration^ - method-vars (<>.default (list) ..vars^) - #let [total-vars (list\compose (product.right (parser.declaration owner-class)) - method-vars)] - [name self-name arguments] (<c>.form ($_ <>.and - <c>.local-identifier - <c>.local-identifier - (..arguments^ total-vars))) - return-type (..return^ total-vars) - exs (throws-decl^ total-vars) + [strict_fp? (<>.parses? (<c>.this! (' #strict))) + owner_class ..declaration^ + method_vars (<>.default (list) ..vars^) + #let [total_vars (list\compose (product.right (parser.declaration owner_class)) + method_vars)] + [name self_name arguments] (<c>.form ($_ <>.and + <c>.local_identifier + <c>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^ body <c>.any] - (wrap [{#member-name name - #member-privacy #PublicP - #member-anns annotations} - (#OverridenMethod strict-fp? owner-class method-vars self-name arguments return-type body exs)])))) + (wrap [{#member_name name + #member_privacy #PublicP + #member_anns annotations} + (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)])))) -(def: static-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: static_method_def^ + (Parser [Member_Declaration Method_Definition]) (<c>.form (do <>.monad - [pm privacy-modifier^ - strict-fp? (<>.parses? (<c>.this! (' #strict))) + [pm privacy_modifier^ + strict_fp? (<>.parses? (<c>.this! (' #strict))) _ (<c>.this! (' #static)) - method-vars (<>.default (list) ..vars^) - #let [total-vars method-vars] - [name arguments] (<c>.form (<>.and <c>.local-identifier - (..arguments^ total-vars))) - return-type (..return^ total-vars) - exs (throws-decl^ total-vars) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<c>.form (<>.and <c>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^ body <c>.any] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#StaticMethod strict-fp? method-vars arguments return-type body exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arguments return_type body exs)])))) -(def: abstract-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: abstract_method_def^ + (Parser [Member_Declaration Method_Definition]) (<c>.form (do <>.monad - [pm privacy-modifier^ + [pm privacy_modifier^ _ (<c>.this! (' #abstract)) - method-vars (<>.default (list) ..vars^) - #let [total-vars method-vars] - [name arguments] (<c>.form (<>.and <c>.local-identifier - (..arguments^ total-vars))) - return-type (..return^ total-vars) - exs (throws-decl^ total-vars) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<c>.form (<>.and <c>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#AbstractMethod method-vars arguments return-type exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arguments return_type exs)])))) -(def: native-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: native_method_def^ + (Parser [Member_Declaration Method_Definition]) (<c>.form (do <>.monad - [pm privacy-modifier^ + [pm privacy_modifier^ _ (<c>.this! (' #native)) - method-vars (<>.default (list) ..vars^) - #let [total-vars method-vars] - [name arguments] (<c>.form (<>.and <c>.local-identifier - (..arguments^ total-vars))) - return-type (..return^ total-vars) - exs (throws-decl^ total-vars) + method_vars (<>.default (list) ..vars^) + #let [total_vars method_vars] + [name arguments] (<c>.form (<>.and <c>.local_identifier + (..arguments^ total_vars))) + return_type (..return^ total_vars) + exs (throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#NativeMethod method-vars arguments return-type exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arguments return_type exs)])))) -(def: (method-def^ class-vars) - (-> (List (Type Var)) (Parser [Member-Declaration Method-Definition])) +(def: (method_def^ class_vars) + (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) ($_ <>.either - (..constructor-method^ class-vars) - (..virtual-method-def^ class-vars) - ..overriden-method-def^ - ..static-method-def^ - ..abstract-method-def^ - ..native-method-def^)) - -(def: partial-call^ - (Parser Partial-Call) + (..constructor_method^ class_vars) + (..virtual_method_def^ class_vars) + ..overriden_method_def^ + ..static_method_def^ + ..abstract_method_def^ + ..native_method_def^)) + +(def: partial_call^ + (Parser Partial_Call) (<c>.form (<>.and <c>.identifier (<>.some <c>.any)))) -(def: class-kind^ - (Parser Class-Kind) +(def: class_kind^ + (Parser Class_Kind) (<>.either (do <>.monad [_ (<c>.this! (' #class))] (wrap #Class)) @@ -898,52 +898,52 @@ (wrap #Interface)) )) -(def: import-member-alias^ +(def: import_member_alias^ (Parser (Maybe Text)) (<>.maybe (do <>.monad [_ (<c>.this! (' #as))] - <c>.local-identifier))) + <c>.local_identifier))) -(def: (import-member-args^ type-vars) +(def: (import_member_args^ type_vars) (-> (List (Type Var)) (Parser (List [Bit (Type Value)]))) (<c>.tuple (<>.some (<>.and (<>.parses? (<c>.tag! ["" "?"])) - (..type^ type-vars))))) + (..type^ type_vars))))) -(def: import-member-return-flags^ +(def: import_member_return_flags^ (Parser [Bit Bit Bit]) ($_ <>.and (<>.parses? (<c>.this! (' #io))) (<>.parses? (<c>.this! (' #try))) (<>.parses? (<c>.this! (' #?))))) -(def: primitive-mode^ - (Parser Primitive-Mode) +(def: primitive_mode^ + (Parser Primitive_Mode) (<>.or (<c>.tag! ["" "manual"]) (<c>.tag! ["" "auto"]))) -(def: (import-member-decl^ owner-vars) - (-> (List (Type Var)) (Parser Import-Member-Declaration)) +(def: (import_member_decl^ owner_vars) + (-> (List (Type Var)) (Parser Import_Member_Declaration)) ($_ <>.either (<c>.form (do <>.monad [_ (<c>.this! (' #enum)) - enum-members (<>.some <c>.local-identifier)] - (wrap (#EnumDecl enum-members)))) + enum_members (<>.some <c>.local_identifier)] + (wrap (#EnumDecl enum_members)))) (<c>.form (do <>.monad [tvars (<>.default (list) ..vars^) _ (<c>.identifier! ["" "new"]) - ?alias import-member-alias^ - #let [total-vars (list\compose owner-vars tvars)] - ?prim-mode (<>.maybe primitive-mode^) - args (..import-member-args^ total-vars) - [io? try? maybe?] import-member-return-flags^] - (wrap (#ConstructorDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) - #import-member-alias (maybe.default "new" ?alias) - #import-member-kind #VirtualIMK - #import-member-tvars tvars - #import-member-args args - #import-member-maybe? maybe? - #import-member-try? try? - #import-member-io? io?} + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} {}])) )) (<c>.form (do <>.monad @@ -951,39 +951,39 @@ (<>.or (<c>.tag! ["" "static"]) (wrap []))) tvars (<>.default (list) ..vars^) - name <c>.local-identifier - ?alias import-member-alias^ - #let [total-vars (list\compose owner-vars tvars)] - ?prim-mode (<>.maybe primitive-mode^) - args (..import-member-args^ total-vars) - [io? try? maybe?] import-member-return-flags^ - return (..return^ total-vars)] - (wrap (#MethodDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) - #import-member-alias (maybe.default name ?alias) - #import-member-kind kind - #import-member-tvars tvars - #import-member-args args - #import-member-maybe? maybe? - #import-member-try? try? - #import-member-io? io?} - {#import-method-name name - #import-method-return return}])))) + name <c>.local_identifier + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..return^ total_vars)] + (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {#import_method_name name + #import_method_return return}])))) (<c>.form (do <>.monad [static? (<>.parses? (<c>.this! (' #static))) - name <c>.local-identifier - ?prim-mode (<>.maybe primitive-mode^) - gtype (..type^ owner-vars) + name <c>.local_identifier + ?prim_mode (<>.maybe primitive_mode^) + gtype (..type^ owner_vars) maybe? (<>.parses? (<c>.this! (' #?))) setter? (<>.parses? (<c>.this! (' #!)))] - (wrap (#FieldAccessDecl {#import-field-mode (maybe.default #AutoPrM ?prim-mode) - #import-field-name name - #import-field-static? static? - #import-field-maybe? maybe? - #import-field-setter? setter? - #import-field-type gtype})))) + (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) -(def: (privacy-modifier$ pm) +(def: (privacy_modifier$ pm) (-> Privacy Code) (case pm #PublicP (code.text "public") @@ -991,20 +991,20 @@ #ProtectedP (code.text "protected") #DefaultP (code.text "default"))) -(def: (inheritance-modifier$ im) +(def: (inheritance_modifier$ im) (-> InheritanceModifier Code) (case im #FinalIM (code.text "final") #AbstractIM (code.text "abstract") #DefaultIM (code.text "default"))) -(def: (annotation-parameter$ [name value]) - (-> Annotation-Parameter Code) +(def: (annotation_parameter$ [name value]) + (-> Annotation_Parameter Code) (` [(~ (code.text name)) (~ value)])) (def: (annotation$ [name params]) (-> Annotation Code) - (` ((~ (code.text name)) (~+ (list\map annotation-parameter$ params))))) + (` ((~ (code.text name)) (~+ (list\map annotation_parameter$ params))))) (template [<name> <category>] [(def: <name> @@ -1021,27 +1021,27 @@ (def: var$' (-> (Type Var) Code) - (|>> ..signature code.local-identifier)) + (|>> ..signature code.local_identifier)) -(def: (method-decl$ [[name pm anns] method-decl]) - (-> [Member-Declaration MethodDecl] Code) - (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] +(def: (method_decl$ [[name pm anns] method_decl]) + (-> [Member_Declaration MethodDecl] Code) + (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl] (` ((~ (code.text name)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ method-tvars))] - [(~+ (list\map class$ method-exs))] - [(~+ (list\map value$ method-inputs))] - (~ (return$ method-output)))))) + [(~+ (list\map var$ method_tvars))] + [(~+ (list\map class$ method_exs))] + [(~+ (list\map value$ method_inputs))] + (~ (return$ method_output)))))) -(def: (state-modifier$ sm) +(def: (state_modifier$ sm) (-> StateModifier Code) (case sm #VolatileSM (' "volatile") #FinalSM (' "final") #DefaultSM (' "default"))) -(def: (field-decl$ [[name pm anns] field]) - (-> [Member-Declaration FieldDecl] Code) +(def: (field_decl$ [[name pm anns] field]) + (-> [Member_Declaration FieldDecl] Code) (case field (#ConstantField class value) (` ("constant" (~ (code.text name)) @@ -1052,8 +1052,8 @@ (#VariableField sm class) (` ("variable" (~ (code.text name)) - (~ (privacy-modifier$ pm)) - (~ (state-modifier$ sm)) + (~ (privacy_modifier$ pm)) + (~ (state_modifier$ sm)) [(~+ (list\map annotation$ anns))] (~ (value$ class)) )) @@ -1063,101 +1063,101 @@ (-> Argument Code) (` [(~ (code.text name)) (~ (value$ type))])) -(def: (constructor-arg$ [class term]) +(def: (constructor_arg$ [class term]) (-> (Typed Code) Code) (` [(~ (value$ class)) (~ term)])) -(def: (method-def$ replacer super-class [[name pm anns] method-def]) - (-> (-> Code Code) (Type Class) [Member-Declaration Method-Definition] Code) - (case method-def - (#ConstructorMethod strict-fp? type-vars self-name arguments constructor-args body exs) +(def: (method_def$ replacer super_class [[name pm anns] method_def]) + (-> (-> Code Code) (Type Class) [Member_Declaration Method_Definition] Code) + (case method_def + (#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs) (` ("init" - (~ (privacy-modifier$ pm)) - (~ (code.bit strict-fp?)) + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] + [(~+ (list\map var$ type_vars))] [(~+ (list\map class$ exs))] - (~ (code.text self-name)) + (~ (code.text self_name)) [(~+ (list\map argument$ arguments))] - [(~+ (list\map constructor-arg$ constructor-args))] - (~ (pre-walk-replace replacer body)) + [(~+ (list\map constructor_arg$ constructor_args))] + (~ (pre_walk_replace replacer body)) )) - (#VirtualMethod final? strict-fp? type-vars self-name arguments return-type body exs) + (#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs) (` ("virtual" (~ (code.text name)) - (~ (privacy-modifier$ pm)) + (~ (privacy_modifier$ pm)) (~ (code.bit final?)) - (~ (code.bit strict-fp?)) + (~ (code.bit strict_fp?)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] - (~ (code.text self-name)) + [(~+ (list\map var$ type_vars))] + (~ (code.text self_name)) [(~+ (list\map argument$ arguments))] - (~ (return$ return-type)) + (~ (return$ return_type)) [(~+ (list\map class$ exs))] - (~ (pre-walk-replace replacer body)))) + (~ (pre_walk_replace replacer body)))) - (#OverridenMethod strict-fp? declaration type-vars self-name arguments return-type body exs) - (let [super-replacer (parser->replacer (<c>.form (do <>.monad + (#OverridenMethod strict_fp? declaration type_vars self_name arguments return_type body exs) + (let [super_replacer (parser_>replacer (<c>.form (do <>.monad [_ (<c>.this! (' ::super!)) args (<c>.tuple (<>.exactly (list.size arguments) <c>.any))] (wrap (` ("jvm member invoke special" - (~ (code.text (product.left (parser.read-class super-class)))) + (~ (code.text (product.left (parser.read_class super_class)))) (~ (code.text name)) (~' _jvm_this) (~+ (|> args (list.zip/2 (list\map product.right arguments)) - (list\map ..decorate-input)))))))))] + (list\map ..decorate_input)))))))))] (` ("override" (~ (declaration$ declaration)) (~ (code.text name)) - (~ (code.bit strict-fp?)) + (~ (code.bit strict_fp?)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] - (~ (code.text self-name)) + [(~+ (list\map var$ type_vars))] + (~ (code.text self_name)) [(~+ (list\map argument$ arguments))] - (~ (return$ return-type)) + (~ (return$ return_type)) [(~+ (list\map class$ exs))] (~ (|> body - (pre-walk-replace replacer) - (pre-walk-replace super-replacer))) + (pre_walk_replace replacer) + (pre_walk_replace super_replacer))) ))) - (#StaticMethod strict-fp? type-vars arguments return-type body exs) + (#StaticMethod strict_fp? type_vars arguments return_type body exs) (` ("static" (~ (code.text name)) - (~ (privacy-modifier$ pm)) - (~ (code.bit strict-fp?)) + (~ (privacy_modifier$ pm)) + (~ (code.bit strict_fp?)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] + [(~+ (list\map var$ type_vars))] [(~+ (list\map class$ exs))] [(~+ (list\map argument$ arguments))] - (~ (return$ return-type)) - (~ (pre-walk-replace replacer body)))) + (~ (return$ return_type)) + (~ (pre_walk_replace replacer body)))) - (#AbstractMethod type-vars arguments return-type exs) + (#AbstractMethod type_vars arguments return_type exs) (` ("abstract" (~ (code.text name)) - (~ (privacy-modifier$ pm)) + (~ (privacy_modifier$ pm)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] + [(~+ (list\map var$ type_vars))] [(~+ (list\map class$ exs))] [(~+ (list\map argument$ arguments))] - (~ (return$ return-type)))) + (~ (return$ return_type)))) - (#NativeMethod type-vars arguments return-type exs) + (#NativeMethod type_vars arguments return_type exs) (` ("native" (~ (code.text name)) - (~ (privacy-modifier$ pm)) + (~ (privacy_modifier$ pm)) [(~+ (list\map annotation$ anns))] - [(~+ (list\map var$ type-vars))] + [(~+ (list\map var$ type_vars))] [(~+ (list\map class$ exs))] [(~+ (list\map argument$ arguments))] - (~ (return$ return-type)))) + (~ (return$ return_type)))) )) -(def: (complete-call$ g!obj [method args]) - (-> Code Partial-Call Code) +(def: (complete_call$ g!obj [method args]) + (-> Code Partial_Call Code) (` ((~ (code.identifier method)) (~+ args) (~ g!obj)))) (def: $Object @@ -1166,15 +1166,15 @@ (syntax: #export (class: {#let [! <>.monad]} - {im inheritance-modifier^} - {[full-class-name class-vars] (\ ! map parser.declaration ..declaration^)} + {im inheritance_modifier^} + {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)} {super (<>.default $Object - (class^ class-vars))} + (class^ class_vars))} {interfaces (<>.default (list) - (<c>.tuple (<>.some (class^ class-vars))))} + (<c>.tuple (<>.some (class^ class_vars))))} {annotations ..annotations^} - {fields (<>.some (..field-decl^ class-vars))} - {methods (<>.some (..method-def^ class-vars))}) + {fields (<>.some (..field_decl^ class_vars))} + {methods (<>.some (..method_def^ class_vars))}) {#.doc (doc "Allows defining JVM classes in Lux code." "For example:" (class: #final (TestClass A) [Runnable] @@ -1206,48 +1206,48 @@ "(::resolve! container [value]) for calling the 'resolve' method." )} (do meta.monad - [current-module meta.current-module-name - #let [fully-qualified-class-name (name.qualify current-module full-class-name) - field-parsers (list\map (field->parser fully-qualified-class-name) fields) - method-parsers (list\map (method->parser fully-qualified-class-name) methods) - replacer (parser->replacer (list\fold <>.either + [current_module meta.current_module_name + #let [fully_qualified_class_name (name.qualify current_module full_class_name) + field_parsers (list\map (field_>parser fully_qualified_class_name) fields) + method_parsers (list\map (method_>parser fully_qualified_class_name) methods) + replacer (parser_>replacer (list\fold <>.either (<>.fail "") - (list\compose field-parsers method-parsers)))]] + (list\compose field_parsers method_parsers)))]] (wrap (list (` ("jvm class" - (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) + (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars))) (~ (class$ super)) [(~+ (list\map class$ interfaces))] - (~ (inheritance-modifier$ im)) + (~ (inheritance_modifier$ im)) [(~+ (list\map annotation$ annotations))] - [(~+ (list\map field-decl$ fields))] - [(~+ (list\map (method-def$ replacer super) methods))])))))) + [(~+ (list\map field_decl$ fields))] + [(~+ (list\map (method_def$ replacer super) methods))])))))) (syntax: #export (interface: {#let [! <>.monad]} - {[full-class-name class-vars] (\ ! map parser.declaration ..declaration^)} + {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)} {supers (<>.default (list) - (<c>.tuple (<>.some (class^ class-vars))))} + (<c>.tuple (<>.some (class^ class_vars))))} {annotations ..annotations^} - {members (<>.some (..method-decl^ class-vars))}) + {members (<>.some (..method_decl^ class_vars))}) {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} (do meta.monad - [current-module meta.current-module-name] + [current_module meta.current_module_name] (wrap (list (` ("jvm class interface" - (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) + (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars))) [(~+ (list\map class$ supers))] [(~+ (list\map annotation$ annotations))] - (~+ (list\map method-decl$ members)))))))) + (~+ (list\map method_decl$ members)))))))) (syntax: #export (object - {class-vars ..vars^} + {class_vars ..vars^} {super (<>.default $Object - (class^ class-vars))} + (class^ class_vars))} {interfaces (<>.default (list) - (<c>.tuple (<>.some (class^ class-vars))))} - {constructor-args (..constructor-args^ class-vars)} - {methods (<>.some ..overriden-method-def^)}) + (<c>.tuple (<>.some (class^ class_vars))))} + {constructor_args (..constructor_args^ class_vars)} + {methods (<>.some ..overriden_method_def^)}) {#.doc (doc "Allows defining anonymous classes." "The 1st tuple corresponds to class-level type-variables." "The 2nd tuple corresponds to parent interfaces." @@ -1256,15 +1256,15 @@ (object [] [Runnable] [] (Runnable [] (run self) void - (exec (do-something some-value) + (exec (do_something some_value) []))) )} (wrap (list (` ("jvm class anonymous" - [(~+ (list\map var$ class-vars))] + [(~+ (list\map var$ class_vars))] (~ (class$ super)) [(~+ (list\map class$ interfaces))] - [(~+ (list\map constructor-arg$ constructor-args))] - [(~+ (list\map (method-def$ function.identity super) methods))]))))) + [(~+ (list\map constructor_arg$ constructor_args))] + [(~+ (list\map (method_def$ function.identity super) methods))]))))) (syntax: #export (null) {#.doc (doc "Null object reference." @@ -1286,11 +1286,11 @@ #.None) (= (??? "YOLO") (#.Some "YOLO")))} - (with-gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))))))) + (with_gensyms [g!temp] + (wrap (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm object null?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1299,21 +1299,21 @@ (!!! (??? (: java/lang/Thread (null))))) (= "foo" (!!! (??? "foo"))))} - (with-gensyms [g!value] - (wrap (list (` ({(#.Some (~ g!value)) - (~ g!value) + (with_gensyms [g!value] + (wrap (list (` ({(#.Some (~ g!value)) + (~ g!value) - #.None - ("jvm object null")} - (~ expr))))))) + #.None + ("jvm object null")} + (~ expr))))))) (syntax: #export (try expression) - {#.doc (doc (case (try (risky-computation input)) + {#.doc (doc (case (try (risky_computation input)) (#.Right success) - (do-something success) + (do_something success) (#.Left error) - (recover-from-failure error)))} + (recover_from_failure error)))} (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) (syntax: #export (check {class (..type^ (list))} @@ -1321,165 +1321,165 @@ {#.doc (doc "Checks whether an object is an instance of a particular class." "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." (case (check String "YOLO") - (#.Some value-as-string) + (#.Some value_as_string) #.None))} - (with-gensyms [g!_ g!unchecked] - (let [class-name (..reflection class) - class-type (` (.primitive (~ (code.text class-name)))) - check-type (` (.Maybe (~ class-type))) - check-code (` (if ("jvm object instance?" (~ (code.text class-name)) (~ g!unchecked)) - (#.Some (.:coerce (~ class-type) - (~ g!unchecked))) - #.None))] - (case unchecked - (#.Some unchecked) - (wrap (list (` (: (~ check-type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check-code)))))) - - #.None - (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check-type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check-code)))))) - )))) + (with_gensyms [g!_ g!unchecked] + (let [class_name (..reflection class) + class_type (` (.primitive (~ (code.text class_name)))) + check_type (` (.Maybe (~ class_type))) + check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked)) + (#.Some (.:coerce (~ class_type) + (~ g!unchecked))) + #.None))] + (case unchecked + (#.Some unchecked) + (wrap (list (` (: (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) + + #.None + (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) + )))) (syntax: #export (synchronized lock body) {#.doc (doc "Evaluates body, while holding a lock on a given object." - (synchronized object-to-be-locked - (exec (do-something ___) - (do-something-else ___) - (finish-the-computation ___))))} + (synchronized object_to_be_locked + (exec (do_something ___) + (do_something_else ___) + (finish_the_computation ___))))} (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) -(syntax: #export (do-to obj {methods (<>.some partial-call^)}) +(syntax: #export (do_to obj {methods (<>.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." - (do-to object - (ClassName::method1 arg0 arg1 arg2) - (ClassName::method2 arg3 arg4 arg5)))} - (with-gensyms [g!obj] - (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list\map (complete-call$ g!obj) methods)) - (~ g!obj)))))))) - -(def: (class-import$ declaration) + (do_to object + (ClassName::method1 arg0 arg1 arg2) + (ClassName::method2 arg3 arg4 arg5)))} + (with_gensyms [g!obj] + (wrap (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list\map (complete_call$ g!obj) methods)) + (~ g!obj)))))))) + +(def: (class_import$ declaration) (-> (Type Declaration) Code) - (let [[full-name params] (parser.declaration declaration) - def-name (..internal full-name) + (let [[full_name params] (parser.declaration declaration) + def_name (..internal full_name) params' (list\map ..var$' params)] - (` (def: (~ (code.identifier ["" def-name])) - {#..jvm-class (~ (code.text (..internal full-name)))} + (` (def: (~ (code.identifier ["" def_name])) + {#..jvm_class (~ (code.text (..internal full_name)))} .Type (All [(~+ params')] - (primitive (~ (code.text full-name)) + (primitive (~ (code.text full_name)) [(~+ params')])))))) -(def: (member-type-vars class-tvars member) - (-> (List (Type Var)) Import-Member-Declaration (List (Type Var))) +(def: (member_type_vars class_tvars member) + (_> (List (Type Var)) Import_Member_Declaration (List (Type Var))) (case member (#ConstructorDecl [commons _]) - (list\compose class-tvars (get@ #import-member-tvars commons)) + (list\compose class_tvars (get@ #import_member_tvars commons)) (#MethodDecl [commons _]) - (case (get@ #import-member-kind commons) + (case (get@ #import_member_kind commons) #StaticIMK - (get@ #import-member-tvars commons) + (get@ #import_member_tvars commons) _ - (list\compose class-tvars (get@ #import-member-tvars commons))) + (list\compose class_tvars (get@ #import_member_tvars commons))) _ - class-tvars)) + class_tvars)) -(def: (member-def-arg-bindings vars member) - (-> (List (Type Var)) Import-Member-Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)])) +(def: (member_def_arg_bindings vars member) + (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) - (let [(^slots [#import-member-tvars #import-member-args]) commons] + (let [(^slots [#import_member_tvars #import_member_args]) commons] (do {! meta.monad} - [arg-inputs (monad.map ! + [arg_inputs (monad.map ! (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) - (with-gensyms [arg-name] - (wrap [maybe? arg-name])))) - import-member-args) - #let [input-jvm-types (list\map product.right import-member-args) - arg-types (list\map (: (-> [Bit (Type Value)] Code) + (with_gensyms [arg_name] + (wrap [maybe? arg_name])))) + import_member_args) + #let [input_jvm_types (list\map product.right import_member_args) + arg_types (list\map (: (-> [Bit (Type Value)] Code) (function (_ [maybe? arg]) - (let [arg-type (value-type (get@ #import-member-mode commons) arg)] + (let [arg_type (value_type (get@ #import_member_mode commons) arg)] (if maybe? - (` (Maybe (~ arg-type))) - arg-type)))) - import-member-args)]] - (wrap [arg-inputs input-jvm-types arg-types]))) + (` (Maybe (~ arg_type))) + arg_type)))) + import_member_args)]] + (wrap [arg_inputs input_jvm_types arg_types]))) _ (\ meta.monad wrap [(list) (list) (list)]))) -(def: (decorate-return-maybe member never-null? unboxed return-term) - (-> Import-Member-Declaration Bit (Type Value) Code Code) +(def: (decorate_return_maybe member never_null? unboxed return_term) + (-> Import_Member_Declaration Bit (Type Value) Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) - (cond (or never-null? + (cond (or never_null? (dictionary.key? ..boxes unboxed)) - return-term + return_term - (get@ #import-member-maybe? commons) - (` (??? (~ return-term))) + (get@ #import_member_maybe? commons) + (` (??? (~ return_term))) ## else (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] - (` (let [(~ g!temp) (~ return-term)] + (` (let [(~ g!temp) (~ return_term)] (if (not (..null? (:coerce (primitive "java.lang.Object") (~ g!temp)))) (~ g!temp) (error! "Cannot produce null references from method calls.")))))) _ - return-term)) + return_term)) -(template [<name> <tag> <term-trans>] - [(def: (<name> member return-term) - (-> Import-Member-Declaration Code Code) +(template [<name> <tag> <term_trans>] + [(def: (<name> member return_term) + (-> Import_Member_Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ <tag> commons) - <term-trans> - return-term) + <term_trans> + return_term) _ - return-term))] + return_term))] - [decorate-return-try #import-member-try? (` (..try (~ return-term)))] - [decorate-return-io #import-member-io? (` ((~! io.io) (~ return-term)))] + [decorate_return_try #import_member_try? (` (..try (~ return_term)))] + [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] ) (def: $String (type.class "java.lang.String" (list))) (template [<input?> <name> <unbox/box> <special+>] [(def: (<name> mode [unboxed raw]) - (-> Primitive-Mode [(Type Value) Code] Code) + (-> Primitive_Mode [(Type Value) Code] Code) (let [[unboxed refined post] (: [(Type Value) Code (List Code)] (case mode #ManualPrM [unboxed raw (list)] #AutoPrM - (with-expansions [<special+>' (template.splice <special+>) - <cond-cases> (template [<old> <new> <pre> <post>] + (with_expansions [<special+>' (template.splice <special+>) + <cond_cases> (template [<old> <new> <pre> <post>] [(\ type.equivalence = <old> unboxed) - (with-expansions [<post>' (template.splice <post>)] - [<new> - (` (.|> (~ raw) (~+ <pre>))) - (list <post>')])] + (with_expansions [<post>' (template.splice <post>)] + [<new> + (` (.|> (~ raw) (~+ <pre>))) + (list <post>')])] <special+>')] - (cond <cond-cases> - ## else - [unboxed - (if <input?> - (` ("jvm object cast" (~ raw))) - raw) - (list)])))) + (cond <cond_cases> + ## else + [unboxed + (if <input?> + (` ("jvm object cast" (~ raw))) + raw) + (list)])))) unboxed/boxed (case (dictionary.get unboxed ..boxes) (#.Some boxed) (<unbox/box> unboxed boxed refined) @@ -1493,19 +1493,19 @@ _ (` (.|> (~ unboxed/boxed) (~+ post))))))] - [#1 auto-convert-input ..unbox + [#1 auto_convert_input ..unbox [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []] - [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-byte)) []] - [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-short)) []] - [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-int)) []] + [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []] + [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []] + [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long_to_int)) []] [type.long type.long (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []] - [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double-to-float)) []] + [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double_to_float)) []] [type.double type.double (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []] [..$String ..$String (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text (..reflection ..$String))))))) []] [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []] [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []] [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]]] - [#0 auto-convert-output ..box + [#0 auto_convert_output ..box [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]] [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]] @@ -1519,167 +1519,167 @@ [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]]] ) -(def: (un-quote quoted) +(def: (un_quote quoted) (-> Code Code) (` ((~' ~) (~ quoted)))) -(def: (jvm-invoke-inputs mode classes inputs) - (-> Primitive-Mode (List (Type Value)) (List [Bit Code]) (List Code)) +(def: (jvm_invoke_inputs mode classes inputs) + (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs (list\map (function (_ [maybe? input]) (if maybe? - (` ((~! !!!) (~ (un-quote input)))) - (un-quote input)))) + (` ((~! !!!) (~ (un_quote input)))) + (un_quote input)))) (list.zip/2 classes) - (list\map (auto-convert-input mode)))) + (list\map (auto_convert_input mode)))) -(def: (member-def-interop vars kind class [arg-function-inputs input-jvm-types arg-types] member method-prefix) - (-> (List (Type Var)) Class-Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import-Member-Declaration Text (Meta (List Code))) - (let [[full-name class-tvars] (parser.declaration class)] +(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix) + (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text (Meta (List Code))) + (let [[full_name class_tvars] (parser.declaration class)] (case member - (#EnumDecl enum-members) + (#EnumDecl enum_members) (do meta.monad - [#let [enum-type (: Code - (case class-tvars + [#let [enum_type (: Code + (case class_tvars #.Nil - (` (primitive (~ (code.text full-name)))) + (` (primitive (~ (code.text full_name)))) _ - (let [=class-tvars (list\map ..var$' class-tvars)] - (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) - getter-interop (: (-> Text Code) + (let [=class_tvars (list\map ..var$' class_tvars)] + (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)])))))) + getter_interop (: (-> Text Code) (function (_ name) - (let [getter-name (code.identifier ["" (format method-prefix member-separator name)])] - (` (def: (~ getter-name) - (~ enum-type) - (~ (get-static-field full-name name)))))))]] - (wrap (list\map getter-interop enum-members))) + (let [getter_name (code.identifier ["" (format method_prefix member_separator name)])] + (` (def: (~ getter_name) + (~ enum_type) + (~ (get_static_field full_name name)))))))]] + (wrap (list\map getter_interop enum_members))) (#ConstructorDecl [commons _]) (do meta.monad - [#let [classT (type.class full-name (list)) - def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - jvm-interop (|> [classT + [#let [classT (type.class full_name (list)) + def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))]) + jvm_interop (|> [classT (` ("jvm member invoke constructor" - [(~+ (list\map ..var$ class-tvars))] - (~ (code.text full-name)) - [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))] - (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs) - (list.zip/2 input-jvm-types) - (list\map ..decorate-input)))))] - (auto-convert-output (get@ #import-member-mode commons)) - (decorate-return-maybe member true classT) - (decorate-return-try member) - (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs))) - ((~' wrap) (.list (.` (~ jvm-interop))))))))) + [(~+ (list\map ..var$ class_tvars))] + (~ (code.text full_name)) + [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] + (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) + (list.zip/2 input_jvm_types) + (list\map ..decorate_input)))))] + (auto_convert_output (get@ #import_member_mode commons)) + (decorate_return_maybe member true classT) + (decorate_return_try member) + (decorate_return_io member))]] + (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) + ((~' wrap) (.list (.` (~ jvm_interop))))))))) (#MethodDecl [commons method]) - (with-gensyms [g!obj] - (do meta.monad - [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - (^slots [#import-member-kind]) commons - (^slots [#import-method-name]) method - [jvm-op object-ast] (: [Text (List Code)] - (case import-member-kind - #StaticIMK - ["jvm member invoke static" - (list)] - - #VirtualIMK - (case kind - #Class - ["jvm member invoke virtual" - (list g!obj)] - - #Interface - ["jvm member invoke interface" - (list g!obj)] - ))) - method-return (get@ #import-method-return method) - callC (: Code - (` ((~ (code.text jvm-op)) - [(~+ (list\map ..var$ class-tvars))] - (~ (code.text full-name)) - (~ (code.text import-method-name)) - [(~+ (list\map ..var$ (get@ #import-member-tvars commons)))] - (~+ (|> object-ast - (list\map ..un-quote) - (list.zip/2 (list (type.class full-name (list)))) - (list\map (auto-convert-input (get@ #import-member-mode commons))))) - (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs) - (list.zip/2 input-jvm-types) - (list\map ..decorate-input)))))) - jvm-interop (: Code - (case (type.void? method-return) - (#.Left method-return) - (|> [method-return - callC] - (auto-convert-output (get@ #import-member-mode commons)) - (decorate-return-maybe member false method-return) - (decorate-return-try member) - (decorate-return-io member)) - - - (#.Right method-return) - (|> callC - (decorate-return-try member) - (decorate-return-io member))))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast)) - ((~' wrap) (.list (.` (~ jvm-interop)))))))))) + (with_gensyms [g!obj] + (do meta.monad + [#let [def_name (code.identifier ["" (format method_prefix member_separator (get@ #import_member_alias commons))]) + (^slots [#import_member_kind]) commons + (^slots [#import_method_name]) method + [jvm_op object_ast] (: [Text (List Code)] + (case import_member_kind + #StaticIMK + ["jvm member invoke static" + (list)] + + #VirtualIMK + (case kind + #Class + ["jvm member invoke virtual" + (list g!obj)] + + #Interface + ["jvm member invoke interface" + (list g!obj)] + ))) + method_return (get@ #import_method_return method) + callC (: Code + (` ((~ (code.text jvm_op)) + [(~+ (list\map ..var$ class_tvars))] + (~ (code.text full_name)) + (~ (code.text import_method_name)) + [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] + (~+ (|> object_ast + (list\map ..un_quote) + (list.zip/2 (list (type.class full_name (list)))) + (list\map (auto_convert_input (get@ #import_member_mode commons))))) + (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) + (list.zip/2 input_jvm_types) + (list\map ..decorate_input)))))) + jvm_interop (: Code + (case (type.void? method_return) + (#.Left method_return) + (|> [method_return + callC] + (auto_convert_output (get@ #import_member_mode commons)) + (decorate_return_maybe member false method_return) + (decorate_return_try member) + (decorate_return_io member)) + + + (#.Right method_return) + (|> callC + (decorate_return_try member) + (decorate_return_io member))))]] + (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) + ((~' wrap) (.list (.` (~ jvm_interop)))))))))) (#FieldAccessDecl fad) (do meta.monad [#let [(^open ".") fad - getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)]) - setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])] - getter-interop (with-gensyms [g!obj] - (let [getter-call (if import-field-static? - (` ((~ getter-name))) - (` ((~ getter-name) (~ g!obj)))) - getter-body (<| (auto-convert-output import-field-mode) - [import-field-type - (if import-field-static? - (get-static-field full-name import-field-name) - (get-virtual-field full-name import-field-name (un-quote g!obj)))]) - getter-body (if import-field-maybe? - (` ((~! ???) (~ getter-body))) - getter-body) - getter-body (if import-field-setter? - (` ((~! io.io) (~ getter-body))) - getter-body)] - (wrap (` ((~! syntax:) (~ getter-call) - ((~' wrap) (.list (.` (~ getter-body))))))))) - setter-interop (: (Meta (List Code)) - (if import-field-setter? - (with-gensyms [g!obj g!value] - (let [setter-call (if import-field-static? - (` ((~ setter-name) (~ g!value))) - (` ((~ setter-name) (~ g!value) (~ g!obj)))) - setter-value (|> [import-field-type (un-quote g!value)] - (auto-convert-input import-field-mode)) - setter-value (if import-field-maybe? - (` ((~! !!!) (~ setter-value))) - setter-value) - setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield") - ":" full-name ":" import-field-name) - g!obj+ (: (List Code) - (if import-field-static? - (list) - (list (un-quote g!obj))))] - (wrap (list (` ((~! syntax:) (~ setter-call) - ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter-command)) (~+ g!obj+) (~ setter-value)))))))))))) + getter_name (code.identifier ["" (format method_prefix member_separator import_field_name)]) + setter_name (code.identifier ["" (format method_prefix member_separator import_field_name "!")])] + getter_interop (with_gensyms [g!obj] + (let [getter_call (if import_field_static? + (` ((~ getter_name))) + (` ((~ getter_name) (~ g!obj)))) + getter_body (<| (auto_convert_output import_field_mode) + [import_field_type + (if import_field_static? + (get_static_field full_name import_field_name) + (get_virtual_field full_name import_field_name (un_quote g!obj)))]) + getter_body (if import_field_maybe? + (` ((~! ???) (~ getter_body))) + getter_body) + getter_body (if import_field_setter? + (` ((~! io.io) (~ getter_body))) + getter_body)] + (wrap (` ((~! syntax:) (~ getter_call) + ((~' wrap) (.list (.` (~ getter_body))))))))) + setter_interop (: (Meta (List Code)) + (if import_field_setter? + (with_gensyms [g!obj g!value] + (let [setter_call (if import_field_static? + (` ((~ setter_name) (~ g!value))) + (` ((~ setter_name) (~ g!value) (~ g!obj)))) + setter_value (|> [import_field_type (un_quote g!value)] + (auto_convert_input import_field_mode)) + setter_value (if import_field_maybe? + (` ((~! !!!) (~ setter_value))) + setter_value) + setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield") + ":" full_name ":" import_field_name) + g!obj+ (: (List Code) + (if import_field_static? + (list) + (list (un_quote g!obj))))] + (wrap (list (` ((~! syntax:) (~ setter_call) + ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) (wrap (list))))] - (wrap (list& getter-interop setter-interop))) + (wrap (list& getter_interop setter_interop))) ))) -(def: (member-import$ vars kind class member) - (-> (List (Type Var)) Class-Kind (Type Declaration) Import-Member-Declaration (Meta (List Code))) - (let [[full-name _] (parser.declaration class) - method-prefix (..internal full-name)] +(def: (member_import$ vars kind class member) + (-> (List (Type Var)) Class_Kind (Type Declaration) Import_Member_Declaration (Meta (List Code))) + (let [[full_name _] (parser.declaration class) + method_prefix (..internal full_name)] (do meta.monad - [=args (member-def-arg-bindings vars member)] - (member-def-interop vars kind class =args member method-prefix)))) + [=args (member_def_arg_bindings vars member)] + (member_def_interop vars kind class =args member method_prefix)))) (def: interface? (All [a] (-> (primitive "java.lang.Class" [a]) Bit)) @@ -1688,28 +1688,28 @@ (: ..Boolean) (:coerce Bit))) -(def: load-class +(def: load_class (-> External (Try (primitive "java.lang.Class" [Any]))) (|>> (:coerce (primitive "java.lang.String")) ["Ljava/lang/String;"] ("jvm member invoke static" [] "java.lang.Class" "forName" []) ..try)) -(def: (class-kind declaration) - (-> (Type Declaration) (Meta Class-Kind)) - (let [[class-name _] (parser.declaration declaration)] - (case (load-class class-name) +(def: (class_kind declaration) + (-> (Type Declaration) (Meta Class_Kind)) + (let [[class_name _] (parser.declaration declaration)] + (case (load_class class_name) (#.Right class) (\ meta.monad wrap (if (interface? class) #Interface #Class)) (#.Left _) - (meta.fail (format "Unknown class: " class-name))))) + (meta.fail (format "Unknown class: " class_name))))) (syntax: #export (import: {declaration ..declaration^} - {members (<>.some (..import-member-decl^ class-type-vars))}) + {members (<>.some (..import_member_decl^ class_type_vars))}) {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." (import: java/lang/Object @@ -1725,7 +1725,7 @@ (import: java/lang/String (new [[byte]]) (#static valueOf [char] java/lang/String) - (#static valueOf #as int-valueOf [int] java/lang/String)) + (#static valueOf #as int_valueOf [int] java/lang/String)) (import: (java/util/List e) (size [] int) @@ -1751,14 +1751,14 @@ "Also, the names of the imported members will look like Class::member" (java/lang/Object::new []) - (java/lang/Object::equals [other-object] my-object) - (java/util/List::size [] my-list) + (java/lang/Object::equals [other_object] my_object) + (java/util/List::size [] my_list) java/lang/Character$UnicodeScript::LATIN )} (do {! meta.monad} - [kind (class-kind declaration) - =members (monad.map ! (member-import$ class-type-vars kind declaration) members)] - (wrap (list& (class-import$ declaration) (list\join =members))))) + [kind (class_kind declaration) + =members (monad.map ! (member_import$ class_type_vars kind declaration) members)] + (wrap (list& (class_import$ declaration) (list\join =members))))) (syntax: #export (array {type (..type^ (list))} size) @@ -1769,9 +1769,9 @@ (.:coerce (.primitive (~ (code.text box.long)))) "jvm object cast" "jvm conversion long-to-int"))] - (`` (cond (~~ (template [<primitive> <array-op>] + (`` (cond (~~ (template [<primitive> <array_op>] [(\ type.equivalence = <primitive> type) - (wrap (list (` (<array-op> (~ g!size)))))] + (wrap (list (` (<array_op> (~ g!size)))))] [type.boolean "jvm array new boolean"] [type.byte "jvm array new byte"] @@ -1782,116 +1782,116 @@ [type.double "jvm array new double"] [type.char "jvm array new char"])) ## else - (wrap (list (` (: (~ (value-type #ManualPrM (type.array type))) + (wrap (list (` (: (~ (value_type #ManualPrM (type.array type))) ("jvm array new object" (~ g!size)))))))))) -(exception: #export (cannot-convert-to-jvm-type {type .Type}) +(exception: #export (cannot_convert_to_jvm_type {type .Type}) (exception.report ["Lux Type" (%.type type)])) -(with-expansions [<failure> (as-is (meta.fail (exception.construct ..cannot-convert-to-jvm-type [type])))] - (def: (lux-type->jvm-type type) - (-> .Type (Meta (Type Value))) - (if (lux-type\= Any type) - (\ meta.monad wrap $Object) - (case type - (#.Primitive name params) - (`` (cond (~~ (template [<type>] - [(text\= (..reflection <type>) name) - (case params - #.Nil - (\ meta.monad wrap <type>) - - _ - <failure>)] - - [type.boolean] - [type.byte] - [type.short] - [type.int] - [type.long] - [type.float] - [type.double] - [type.char])) - - (~~ (template [<type>] - [(text\= (..reflection (type.array <type>)) name) - (case params - #.Nil - (\ meta.monad wrap (type.array <type>)) - - _ - <failure>)] - - [type.boolean] - [type.byte] - [type.short] - [type.int] - [type.long] - [type.float] - [type.double] - [type.char])) - - (text\= array.type-name name) - (case params - (#.Cons elementLT #.Nil) - (\ meta.monad map type.array - (lux-type->jvm-type elementLT)) - - _ - <failure>) - - (text.starts-with? descriptor.array-prefix name) - (case params - #.Nil - (let [[_ unprefixed] (maybe.assume (text.split-with descriptor.array-prefix name))] - (\ meta.monad map type.array - (lux-type->jvm-type (#.Primitive unprefixed (list))))) - - _ - <failure>) - - ## else - (\ meta.monad map (type.class name) - (: (Meta (List (Type Parameter))) - (monad.map meta.monad - (function (_ paramLT) - (do meta.monad - [paramJT (lux-type->jvm-type paramLT)] - (case (parser.parameter? paramJT) - (#.Some paramJT) - (wrap paramJT) - - #.None - <failure>))) - params))))) - - (#.Apply A F) - (case (lux-type.apply (list A) F) - #.None - <failure> - - (#.Some type') - (lux-type->jvm-type type')) - - (#.Named _ type') - (lux-type->jvm-type type') - - _ - <failure>)))) - -(syntax: #export (array-length array) +(with_expansions [<failure> (as_is (meta.fail (exception.construct ..cannot_convert_to_jvm_type [type])))] + (def: (lux_type->jvm_type type) + (-> .Type (Meta (Type Value))) + (if (lux_type\= Any type) + (\ meta.monad wrap $Object) + (case type + (#.Primitive name params) + (`` (cond (~~ (template [<type>] + [(text\= (..reflection <type>) name) + (case params + #.Nil + (\ meta.monad wrap <type>) + + _ + <failure>)] + + [type.boolean] + [type.byte] + [type.short] + [type.int] + [type.long] + [type.float] + [type.double] + [type.char])) + + (~~ (template [<type>] + [(text\= (..reflection (type.array <type>)) name) + (case params + #.Nil + (\ meta.monad wrap (type.array <type>)) + + _ + <failure>)] + + [type.boolean] + [type.byte] + [type.short] + [type.int] + [type.long] + [type.float] + [type.double] + [type.char])) + + (text\= array.type_name name) + (case params + (#.Cons elementLT #.Nil) + (\ meta.monad map type.array + (lux_type->jvm_type elementLT)) + + _ + <failure>) + + (text.starts_with? descriptor.array_prefix name) + (case params + #.Nil + (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))] + (\ meta.monad map type.array + (lux_type->jvm_type (#.Primitive unprefixed (list))))) + + _ + <failure>) + + ## else + (\ meta.monad map (type.class name) + (: (Meta (List (Type Parameter))) + (monad.map meta.monad + (function (_ paramLT) + (do meta.monad + [paramJT (lux_type->jvm_type paramLT)] + (case (parser.parameter? paramJT) + (#.Some paramJT) + (wrap paramJT) + + #.None + <failure>))) + params))))) + + (#.Apply A F) + (case (lux_type.apply (list A) F) + #.None + <failure> + + (#.Some type') + (lux_type->jvm_type type')) + + (#.Named _ type') + (lux_type->jvm_type type') + + _ + <failure>)))) + +(syntax: #export (array_length array) {#.doc (doc "Gives the length of an array." - (array-length my-array))} + (array_length my_array))} (case array - [_ (#.Identifier array-name)] + [_ (#.Identifier array_name)] (do meta.monad - [array-type (meta.find-type array-name) - array-jvm-type (lux-type->jvm-type array-type) + [array_type (meta.find_type array_name) + array_jvm_type (lux_type->jvm_type array_type) #let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>] [(\ type.equivalence = (type.array <primitive>) - array-jvm-type) + array_jvm_type) <extension>] [type.boolean "jvm array length boolean"] @@ -1912,18 +1912,18 @@ (.:coerce .Nat)))))) _ - (with-gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array-length (~ g!array))))))))) + (with_gensyms [g!array] + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_length (~ g!array))))))))) -(syntax: #export (array-read idx array) +(syntax: #export (array_read idx array) {#.doc (doc "Loads an element from an array." - (array-read 10 my-array))} + (array_read 10 my_array))} (case array - [_ (#.Identifier array-name)] + [_ (#.Identifier array_name)] (do meta.monad - [array-type (meta.find-type array-name) - array-jvm-type (lux-type->jvm-type array-type) + [array_type (meta.find_type array_name) + array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) (.:coerce (.primitive (~ (code.text box.long)))) @@ -1932,7 +1932,7 @@ (`` (cond (~~ (template [<primitive> <extension> <box>] [(\ type.equivalence = (type.array <primitive>) - array-jvm-type) + array_jvm_type) (wrap (list (` (.|> (<extension> (~ g!idx) (~ array)) "jvm object cast" (.: (.primitive (~ (code.text <box>))))))))] @@ -1950,18 +1950,18 @@ (wrap (list (` ("jvm array read object" (~ g!idx) (~ array)))))))) _ - (with-gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array-read (~ idx) (~ g!array))))))))) + (with_gensyms [g!array] + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_read (~ idx) (~ g!array))))))))) -(syntax: #export (array-write idx value array) +(syntax: #export (array_write idx value array) {#.doc (doc "Stores an element into an array." - (array-write 10 my-object my-array))} + (array_write 10 my_object my_array))} (case array - [_ (#.Identifier array-name)] + [_ (#.Identifier array_name)] (do meta.monad - [array-type (meta.find-type array-name) - array-jvm-type (lux-type->jvm-type array-type) + [array_type (meta.find_type array_name) + array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) (.:coerce (.primitive (~ (code.text box.long)))) @@ -1970,7 +1970,7 @@ (`` (cond (~~ (template [<primitive> <extension> <box>] [(\ type.equivalence = (type.array <primitive>) - array-jvm-type) + array_jvm_type) (let [g!value (` (.|> (~ value) (.:coerce (.primitive (~ (code.text <box>)))) "jvm object cast"))] @@ -1989,14 +1989,14 @@ (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))) _ - (with-gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array-write (~ idx) (~ value) (~ g!array))))))))) + (with_gensyms [g!array] + (wrap (list (` (let [(~ g!array) (~ array)] + (..array_write (~ idx) (~ value) (~ g!array))))))))) -(syntax: #export (class-for {type (..type^ (list))}) +(syntax: #export (class_for {type (..type^ (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." - (class-for java/lang/String))} + (class_for java/lang/String))} (wrap (list (` ("jvm object class" (~ (code.text (..reflection type)))))))) (syntax: #export (type {type (..type^ (list))}) - (wrap (list (value-type #ManualPrM type)))) + (wrap (list (value_type #ManualPrM type)))) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 8bc8cbea0..461a99a77 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -23,7 +23,7 @@ [macro ["." code] [syntax (#+ syntax:)]] - ["." meta (#+ with-gensyms) + ["." meta (#+ with_gensyms) ["." annotation]]]) (template [<name> <op> <from> <to>] @@ -34,43 +34,43 @@ (-> (primitive <from>) (primitive <to>)) (<op> value))] - [byte-to-long "jvm convert byte-to-long" "java.lang.Byte" "java.lang.Long"] + [byte_to_long "jvm convert byte-to-long" "java.lang.Byte" "java.lang.Long"] - [short-to-long "jvm convert short-to-long" "java.lang.Short" "java.lang.Long"] + [short_to_long "jvm convert short-to-long" "java.lang.Short" "java.lang.Long"] - [double-to-int "jvm convert double-to-int" "java.lang.Double" "java.lang.Integer"] - [double-to-long "jvm convert double-to-long" "java.lang.Double" "java.lang.Long"] - [double-to-float "jvm convert double-to-float" "java.lang.Double" "java.lang.Float"] + [double_to_int "jvm convert double-to-int" "java.lang.Double" "java.lang.Integer"] + [double_to_long "jvm convert double-to-long" "java.lang.Double" "java.lang.Long"] + [double_to_float "jvm convert double-to-float" "java.lang.Double" "java.lang.Float"] - [float-to-int "jvm convert float-to-int" "java.lang.Float" "java.lang.Integer"] - [float-to-long "jvm convert float-to-long" "java.lang.Float" "java.lang.Long"] - [float-to-double "jvm convert float-to-double" "java.lang.Float" "java.lang.Double"] + [float_to_int "jvm convert float-to-int" "java.lang.Float" "java.lang.Integer"] + [float_to_long "jvm convert float-to-long" "java.lang.Float" "java.lang.Long"] + [float_to_double "jvm convert float-to-double" "java.lang.Float" "java.lang.Double"] - [int-to-byte "jvm convert int-to-byte" "java.lang.Integer" "java.lang.Byte"] - [int-to-short "jvm convert int-to-short" "java.lang.Integer" "java.lang.Short"] - [int-to-long "jvm convert int-to-long" "java.lang.Integer" "java.lang.Long"] - [int-to-float "jvm convert int-to-float" "java.lang.Integer" "java.lang.Float"] - [int-to-double "jvm convert int-to-double" "java.lang.Integer" "java.lang.Double"] - [int-to-char "jvm convert int-to-char" "java.lang.Integer" "java.lang.Character"] - - [long-to-byte "jvm convert long-to-byte" "java.lang.Long" "java.lang.Byte"] - [long-to-short "jvm convert long-to-short" "java.lang.Long" "java.lang.Short"] - [long-to-int "jvm convert long-to-int" "java.lang.Long" "java.lang.Integer"] - [long-to-float "jvm convert long-to-float" "java.lang.Long" "java.lang.Float"] - [long-to-double "jvm convert long-to-double" "java.lang.Long" "java.lang.Double"] - - [char-to-byte "jvm convert char-to-byte" "java.lang.Character" "java.lang.Byte"] - [char-to-short "jvm convert char-to-short" "java.lang.Character" "java.lang.Short"] - [char-to-int "jvm convert char-to-int" "java.lang.Character" "java.lang.Integer"] - [char-to-long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"] + [int_to_byte "jvm convert int-to-byte" "java.lang.Integer" "java.lang.Byte"] + [int_to_short "jvm convert int-to-short" "java.lang.Integer" "java.lang.Short"] + [int_to_long "jvm convert int-to-long" "java.lang.Integer" "java.lang.Long"] + [int_to_float "jvm convert int-to-float" "java.lang.Integer" "java.lang.Float"] + [int_to_double "jvm convert int-to-double" "java.lang.Integer" "java.lang.Double"] + [int_to_char "jvm convert int-to-char" "java.lang.Integer" "java.lang.Character"] + + [long_to_byte "jvm convert long-to-byte" "java.lang.Long" "java.lang.Byte"] + [long_to_short "jvm convert long-to-short" "java.lang.Long" "java.lang.Short"] + [long_to_int "jvm convert long-to-int" "java.lang.Long" "java.lang.Integer"] + [long_to_float "jvm convert long-to-float" "java.lang.Long" "java.lang.Float"] + [long_to_double "jvm convert long-to-double" "java.lang.Long" "java.lang.Double"] + + [char_to_byte "jvm convert char-to-byte" "java.lang.Character" "java.lang.Byte"] + [char_to_short "jvm convert char-to-short" "java.lang.Character" "java.lang.Short"] + [char_to_int "jvm convert char-to-int" "java.lang.Character" "java.lang.Integer"] + [char_to_long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"] ) ## [Utils] -(def: constructor-method-name "<init>") -(def: member-separator "::") +(def: constructor_method_name "<init>") +(def: member_separator "::") ## Types -(type: JVM-Code Text) +(type: JVM_Code Text) (type: BoundKind #UpperBound @@ -82,10 +82,10 @@ (#GenericArray GenericType) (#GenericWildcard (Maybe [BoundKind GenericType]))) -(type: Type-Parameter +(type: Type_Parameter [Text (List GenericType)]) -(type: Primitive-Mode +(type: Primitive_Mode #ManualPrM #AutoPrM) @@ -105,129 +105,129 @@ #AbstractIM #DefaultIM) -(type: Class-Kind +(type: Class_Kind #Class #Interface) -(type: Class-Declaration - {#class-name Text - #class-params (List Type-Parameter)}) +(type: Class_Declaration + {#class_name Text + #class_params (List Type_Parameter)}) (type: StackFrame (primitive "java/lang/StackTraceElement")) (type: StackTrace (Array StackFrame)) -(type: Super-Class-Decl - {#super-class-name Text - #super-class-params (List GenericType)}) +(type: Super_Class_Decl + {#super_class_name Text + #super_class_params (List GenericType)}) (type: AnnotationParam [Text Code]) (type: Annotation - {#ann-name Text - #ann-params (List AnnotationParam)}) + {#ann_name Text + #ann_params (List AnnotationParam)}) -(type: Member-Declaration - {#member-name Text - #member-privacy PrivacyModifier - #member-anns (List Annotation)}) +(type: Member_Declaration + {#member_name Text + #member_privacy PrivacyModifier + #member_anns (List Annotation)}) (type: FieldDecl (#ConstantField GenericType Code) (#VariableField StateModifier GenericType)) (type: MethodDecl - {#method-tvars (List Type-Parameter) - #method-inputs (List GenericType) - #method-output GenericType - #method-exs (List GenericType)}) + {#method_tvars (List Type_Parameter) + #method_inputs (List GenericType) + #method_output GenericType + #method_exs (List GenericType)}) (type: ArgDecl - {#arg-name Text - #arg-type GenericType}) + {#arg_name Text + #arg_type GenericType}) (type: ConstructorArg [GenericType Code]) -(type: Method-Definition +(type: Method_Definition (#ConstructorMethod [Bit - (List Type-Parameter) + (List Type_Parameter) (List ArgDecl) (List ConstructorArg) Code (List GenericType)]) (#VirtualMethod [Bit Bit - (List Type-Parameter) + (List Type_Parameter) Text (List ArgDecl) GenericType Code (List GenericType)]) (#OverridenMethod [Bit - Class-Declaration - (List Type-Parameter) + Class_Declaration + (List Type_Parameter) Text (List ArgDecl) GenericType Code (List GenericType)]) (#StaticMethod [Bit - (List Type-Parameter) + (List Type_Parameter) (List ArgDecl) GenericType Code (List GenericType)]) - (#AbstractMethod [(List Type-Parameter) + (#AbstractMethod [(List Type_Parameter) (List ArgDecl) GenericType (List GenericType)]) - (#NativeMethod [(List Type-Parameter) + (#NativeMethod [(List Type_Parameter) (List ArgDecl) GenericType (List GenericType)])) -(type: Partial-Call - {#pc-method Name - #pc-args (List Code)}) +(type: Partial_Call + {#pc_method Name + #pc_args (List Code)}) (type: ImportMethodKind #StaticIMK #VirtualIMK) (type: ImportMethodCommons - {#import-member-mode Primitive-Mode - #import-member-alias Text - #import-member-kind ImportMethodKind - #import-member-tvars (List Type-Parameter) - #import-member-args (List [Bit GenericType]) - #import-member-maybe? Bit - #import-member-try? Bit - #import-member-io? Bit}) + {#import_member_mode Primitive_Mode + #import_member_alias Text + #import_member_kind ImportMethodKind + #import_member_tvars (List Type_Parameter) + #import_member_args (List [Bit GenericType]) + #import_member_maybe? Bit + #import_member_try? Bit + #import_member_io? Bit}) (type: ImportConstructorDecl {}) (type: ImportMethodDecl - {#import-method-name Text - #import-method-return GenericType}) + {#import_method_name Text + #import_method_return GenericType}) (type: ImportFieldDecl - {#import-field-mode Primitive-Mode - #import-field-name Text - #import-field-static? Bit - #import-field-maybe? Bit - #import-field-setter? Bit - #import-field-type GenericType}) - -(type: Import-Member-Declaration + {#import_field_mode Primitive_Mode + #import_field_name Text + #import_field_static? Bit + #import_field_maybe? Bit + #import_field_setter? Bit + #import_field_type GenericType}) + +(type: Import_Member_Declaration (#EnumDecl (List Text)) (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl]) (#MethodDecl [ImportMethodCommons ImportMethodDecl]) (#FieldAccessDecl ImportFieldDecl)) ## Utils -(def: (manual-primitive-to-type class) +(def: (manual_primitive_to_type class) (-> Text (Maybe Code)) (case class (^template [<prim> <type>] @@ -246,7 +246,7 @@ _ #.None)) -(def: (auto-primitive-to-type class) +(def: (auto_primitive_to_type class) (-> Text (Maybe Code)) (case class (^template [<prim> <type>] @@ -266,82 +266,82 @@ (def: sanitize (-> Text Text) - (text.replace-all "/" ".")) + (text.replace_all "/" ".")) -(def: (generic-class->type' mode type-params in-array? name+params +(def: (generic_class->type' mode type_params in_array? name+params class->type') - (-> Primitive-Mode (List Type-Parameter) Bit [Text (List GenericType)] - (-> Primitive-Mode (List Type-Parameter) Bit GenericType Code) + (-> Primitive_Mode (List Type_Parameter) Bit [Text (List GenericType)] + (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code) Code) - (case [name+params mode in-array?] + (case [name+params mode in_array?] (^multi [[prim #.Nil] #ManualPrM #0] - [(manual-primitive-to-type prim) (#.Some output)]) + [(manual_primitive_to_type prim) (#.Some output)]) output (^multi [[prim #.Nil] #AutoPrM #0] - [(auto-primitive-to-type prim) (#.Some output)]) + [(auto_primitive_to_type prim) (#.Some output)]) output [[name params] _ _] (let [name (sanitize name) - =params (list\map (class->type' mode type-params in-array?) params)] + =params (list\map (class->type' mode type_params in_array?) params)] (` (primitive (~ (code.text name)) [(~+ =params)]))))) -(def: (class->type' mode type-params in-array? class) - (-> Primitive-Mode (List Type-Parameter) Bit GenericType Code) +(def: (class->type' mode type_params in_array? class) + (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code) (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) (and (text\= name pname) (not (list.empty? pbounds)))) - type-params) + type_params) #.None (code.identifier ["" name]) (#.Some [pname pbounds]) - (class->type' mode type-params in-array? (maybe.assume (list.head pbounds)))) + (class->type' mode type_params in_array? (maybe.assume (list.head pbounds)))) (#GenericClass name+params) - (generic-class->type' mode type-params in-array? name+params + (generic_class->type' mode type_params in_array? name+params class->type') (#GenericArray param) - (let [=param (class->type' mode type-params #1 param)] + (let [=param (class->type' mode type_params #1 param)] (` ((~! array.Array) (~ =param)))) (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _]))) (` .Any) - (#GenericWildcard (#.Some [#UpperBound upper-bound])) - (class->type' mode type-params in-array? upper-bound) + (#GenericWildcard (#.Some [#UpperBound upper_bound])) + (class->type' mode type_params in_array? upper_bound) )) -(def: (class->type mode type-params class) - (-> Primitive-Mode (List Type-Parameter) GenericType Code) - (class->type' mode type-params #0 class)) +(def: (class->type mode type_params class) + (-> Primitive_Mode (List Type_Parameter) GenericType Code) + (class->type' mode type_params #0 class)) -(def: (type-param-type$ [name bounds]) - (-> Type-Parameter Code) +(def: (type_param_type$ [name bounds]) + (-> Type_Parameter Code) (code.identifier ["" name])) -(def: (class-decl-type$ (^slots [#class-name #class-params])) - (-> Class-Declaration Code) - (let [=params (list\map (: (-> Type-Parameter Code) +(def: (class_decl_type$ (^slots [#class_name #class_params])) + (-> Class_Declaration Code) + (let [=params (list\map (: (-> Type_Parameter Code) (function (_ [pname pbounds]) (case pbounds #.Nil (code.identifier ["" pname]) (#.Cons bound1 _) - (class->type #ManualPrM class-params bound1)))) - class-params)] - (` (primitive (~ (code.text (sanitize class-name))) + (class->type #ManualPrM class_params bound1)))) + class_params)] + (` (primitive (~ (code.text (sanitize class_name))) [(~+ =params)])))) -(def: type-var-class Text "java.lang.Object") +(def: type_var_class Text "java.lang.Object") -(def: (simple-class$ env class) - (-> (List Type-Parameter) GenericType Text) +(def: (simple_class$ env class) + (-> (List Type_Parameter) GenericType Text) (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) @@ -349,16 +349,16 @@ (not (list.empty? pbounds)))) env) #.None - type-var-class + type_var_class (#.Some [pname pbounds]) - (simple-class$ env (maybe.assume (list.head pbounds)))) + (simple_class$ env (maybe.assume (list.head pbounds)))) (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _]))) - type-var-class + type_var_class - (#GenericWildcard (#.Some [#UpperBound upper-bound])) - (simple-class$ env upper-bound) + (#GenericWildcard (#.Some [#UpperBound upper_bound])) + (simple_class$ env upper_bound) (#GenericClass name env) (sanitize name) @@ -366,7 +366,7 @@ (#GenericArray param') (case param' (#GenericArray param) - (format "[" (simple-class$ env param)) + (format "[" (simple_class$ env param)) (^template [<prim> <class>] [(#GenericClass <prim> #.Nil) @@ -381,44 +381,44 @@ ["char" "[C"]) param - (format "[L" (simple-class$ env param) ";")) + (format "[L" (simple_class$ env param) ";")) )) -(def: (make-get-const-parser class-name field-name) +(def: (make_get_const_parser class_name field_name) (-> Text Text (Parser Code)) (do p.monad - [#let [dotted-name (format "::" field-name)] - _ (s.this! (code.identifier ["" dotted-name]))] - (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name)))))))) + [#let [dotted_name (format "::" field_name)] + _ (s.this! (code.identifier ["" dotted_name]))] + (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name)))))))) -(def: (make-get-var-parser class-name field-name) +(def: (make_get_var_parser class_name field_name) (-> Text Text (Parser Code)) (do p.monad - [#let [dotted-name (format "::" field-name)] - _ (s.this! (code.identifier ["" dotted-name]))] - (wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this))))) + [#let [dotted_name (format "::" field_name)] + _ (s.this! (code.identifier ["" dotted_name]))] + (wrap (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this))))) -(def: (make-put-var-parser class-name field-name) +(def: (make_put_var_parser class_name field_name) (-> Text Text (Parser Code)) (do p.monad - [#let [dotted-name (format "::" field-name)] + [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) - (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))] - (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value)))))) + (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted_name])) s.any)))] + (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) -(def: (pre-walk-replace f input) +(def: (pre_walk_replace f input) (-> (-> Code Code) Code Code) (case (f input) (^template [<tag>] [[meta (<tag> parts)] - [meta (<tag> (list\map (pre-walk-replace f) parts))]]) + [meta (<tag> (list\map (pre_walk_replace f) parts))]]) ([#.Form] [#.Tuple]) [meta (#.Record pairs)] [meta (#.Record (list\map (: (-> [Code Code] [Code Code]) (function (_ [key val]) - [(pre-walk-replace f key) (pre-walk-replace f val)])) + [(pre_walk_replace f key) (pre_walk_replace f val)])) pairs))] ast' @@ -434,74 +434,74 @@ ast )) -(def: (field->parser class-name [[field-name _ _] field]) - (-> Text [Member-Declaration FieldDecl] (Parser Code)) +(def: (field->parser class_name [[field_name _ _] field]) + (-> Text [Member_Declaration FieldDecl] (Parser Code)) (case field (#ConstantField _) - (make-get-const-parser class-name field-name) + (make_get_const_parser class_name field_name) (#VariableField _) - (p.either (make-get-var-parser class-name field-name) - (make-put-var-parser class-name field-name)))) + (p.either (make_get_var_parser class_name field_name) + (make_put_var_parser class_name field_name)))) -(def: (make-constructor-parser params class-name arg-decls) - (-> (List Type-Parameter) Text (List ArgDecl) (Parser Code)) +(def: (make_constructor_parser params class_name arg_decls) + (-> (List Type_Parameter) Text (List ArgDecl) (Parser Code)) (do p.monad [args (: (Parser (List Code)) (s.form (p.after (s.this! (' ::new!)) - (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] - (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) + (s.tuple (p.exactly (list.size arg_decls) s.any))))) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] + (wrap (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls')))) (~+ args)))))) -(def: (make-static-method-parser params class-name method-name arg-decls) - (-> (List Type-Parameter) Text Text (List ArgDecl) (Parser Code)) +(def: (make_static_method_parser params class_name method_name arg_decls) + (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code)) (do p.monad - [#let [dotted-name (format "::" method-name "!")] + [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (s.form (p.after (s.this! (code.identifier ["" dotted-name])) - (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] - (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) + (s.form (p.after (s.this! (code.identifier ["" dotted_name])) + (s.tuple (p.exactly (list.size arg_decls) s.any))))) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] + (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) (~+ args)))))) -(template [<name> <jvm-op>] - [(def: (<name> params class-name method-name arg-decls) - (-> (List Type-Parameter) Text Text (List ArgDecl) (Parser Code)) +(template [<name> <jvm_op>] + [(def: (<name> params class_name method_name arg_decls) + (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code)) (do p.monad - [#let [dotted-name (format "::" method-name "!")] + [#let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) - (s.form (p.after (s.this! (code.identifier ["" dotted-name])) - (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] - (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) + (s.form (p.after (s.this! (code.identifier ["" dotted_name])) + (s.tuple (p.exactly (list.size arg_decls) s.any))))) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] + (wrap (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) (~' _jvm_this) (~+ args))))))] - [make-special-method-parser "jvm invokespecial"] - [make-virtual-method-parser "jvm invokevirtual"] + [make_special_method_parser "jvm invokespecial"] + [make_virtual_method_parser "jvm invokevirtual"] ) -(def: (method->parser params class-name [[method-name _ _] meth-def]) - (-> (List Type-Parameter) Text [Member-Declaration Method-Definition] (Parser Code)) - (case meth-def - (#ConstructorMethod strict? type-vars args constructor-args return-expr exs) - (make-constructor-parser params class-name args) +(def: (method->parser params class_name [[method_name _ _] meth_def]) + (-> (List Type_Parameter) Text [Member_Declaration Method_Definition] (Parser Code)) + (case meth_def + (#ConstructorMethod strict? type_vars args constructor_args return_expr exs) + (make_constructor_parser params class_name args) - (#StaticMethod strict? type-vars args return-type return-expr exs) - (make-static-method-parser params class-name method-name args) + (#StaticMethod strict? type_vars args return_type return_expr exs) + (make_static_method_parser params class_name method_name args) - (^or (#VirtualMethod final? strict? type-vars self-name args return-type return-expr exs) - (#OverridenMethod strict? owner-class type-vars self-name args return-type return-expr exs)) - (make-special-method-parser params class-name method-name args) + (^or (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs) + (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs)) + (make_special_method_parser params class_name method_name args) - (#AbstractMethod type-vars args return-type exs) - (make-virtual-method-parser params class-name method-name args) + (#AbstractMethod type_vars args return_type exs) + (make_virtual_method_parser params class_name method_name args) - (#NativeMethod type-vars args return-type exs) - (make-virtual-method-parser params class-name method-name args))) + (#NativeMethod type_vars args return_type exs) + (make_virtual_method_parser params class_name method_name args))) ## Parsers -(def: privacy-modifier^ +(def: privacy_modifier^ (Parser PrivacyModifier) (let [(^open ".") p.monad] ($_ p.or @@ -510,7 +510,7 @@ (s.this! (' #protected)) (wrap [])))) -(def: inheritance-modifier^ +(def: inheritance_modifier^ (Parser InheritanceModifier) (let [(^open ".") p.monad] ($_ p.or @@ -518,18 +518,18 @@ (s.this! (' #abstract)) (wrap [])))) -(def: bound-kind^ +(def: bound_kind^ (Parser BoundKind) (p.or (s.this! (' <)) (s.this! (' >)))) -(def: (assert-no-periods name) +(def: (assert_no_periods name) (-> Text (Parser Any)) (p.assert "Names in class declarations cannot contain periods." (not (text.contains? "." name)))) -(def: (generic-type^ type-vars) - (-> (List Type-Parameter) (Parser GenericType)) +(def: (generic_type^ type_vars) + (-> (List Type_Parameter) (Parser GenericType)) (p.rec (function (_ recur^) ($_ p.either @@ -538,13 +538,13 @@ (wrap (#GenericWildcard #.None))) (s.tuple (do p.monad [_ (s.this! (' ?)) - bound-kind bound-kind^ + bound_kind bound_kind^ bound recur^] - (wrap (#GenericWildcard (#.Some [bound-kind bound]))))) + (wrap (#GenericWildcard (#.Some [bound_kind bound]))))) (do p.monad - [name s.local-identifier - _ (assert-no-periods name)] - (if (list.member? text.equivalence (list\map product.left type-vars) name) + [name s.local_identifier + _ (assert_no_periods name)] + (if (list.member? text.equivalence (list\map product.left type_vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) (s.tuple (do p.monad @@ -565,68 +565,68 @@ _ (wrap (#GenericArray component))))) (s.form (do p.monad - [name s.local-identifier - _ (assert-no-periods name) + [name s.local_identifier + _ (assert_no_periods name) params (p.some recur^) _ (p.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list\map product.left type-vars) name)))] + (not (list.member? text.equivalence (list\map product.left type_vars) name)))] (wrap (#GenericClass name params)))) )))) -(def: type-param^ - (Parser Type-Parameter) +(def: type_param^ + (Parser Type_Parameter) (p.either (do p.monad - [param-name s.local-identifier] - (wrap [param-name (list)])) + [param_name s.local_identifier] + (wrap [param_name (list)])) (s.tuple (do p.monad - [param-name s.local-identifier + [param_name s.local_identifier _ (s.this! (' <)) - bounds (p.many (..generic-type^ (list)))] - (wrap [param-name bounds]))))) + bounds (p.many (..generic_type^ (list)))] + (wrap [param_name bounds]))))) -(def: type-params^ - (Parser (List Type-Parameter)) - (|> ..type-param^ +(def: type_params^ + (Parser (List Type_Parameter)) + (|> ..type_param^ p.some s.tuple (p.default (list)))) -(def: class-decl^ - (Parser Class-Declaration) +(def: class_decl^ + (Parser Class_Declaration) (p.either (do p.monad - [name s.local-identifier - _ (assert-no-periods name)] + [name s.local_identifier + _ (assert_no_periods name)] (wrap [name (list)])) (s.form (do p.monad - [name s.local-identifier - _ (assert-no-periods name) - params (p.some ..type-param^)] + [name s.local_identifier + _ (assert_no_periods name) + params (p.some ..type_param^)] (wrap [name params]))) )) -(def: (super-class-decl^ type-vars) - (-> (List Type-Parameter) (Parser Super-Class-Decl)) +(def: (super_class_decl^ type_vars) + (-> (List Type_Parameter) (Parser Super_Class_Decl)) (p.either (do p.monad - [name s.local-identifier - _ (assert-no-periods name)] + [name s.local_identifier + _ (assert_no_periods name)] (wrap [name (list)])) (s.form (do p.monad - [name s.local-identifier - _ (assert-no-periods name) - params (p.some (..generic-type^ type-vars))] + [name s.local_identifier + _ (assert_no_periods name) + params (p.some (..generic_type^ type_vars))] (wrap [name params]))))) -(def: annotation-params^ +(def: annotation_params^ (Parser (List AnnotationParam)) - (s.record (p.some (p.and s.local-tag s.any)))) + (s.record (p.some (p.and s.local_tag s.any)))) (def: annotation^ (Parser Annotation) (p.either (do p.monad - [ann-name s.local-identifier] - (wrap [ann-name (list)])) - (s.form (p.and s.local-identifier - annotation-params^)))) + [ann_name s.local_identifier] + (wrap [ann_name (list)])) + (s.form (p.and s.local_identifier + annotation_params^)))) (def: annotations^' (Parser (List Annotation)) @@ -640,207 +640,207 @@ [anns?? (p.maybe ..annotations^')] (wrap (maybe.default (list) anns??)))) -(def: (throws-decl'^ type-vars) - (-> (List Type-Parameter) (Parser (List GenericType))) +(def: (throws_decl'^ type_vars) + (-> (List Type_Parameter) (Parser (List GenericType))) (do p.monad [_ (s.this! (' #throws))] - (s.tuple (p.some (..generic-type^ type-vars))))) + (s.tuple (p.some (..generic_type^ type_vars))))) -(def: (throws-decl^ type-vars) - (-> (List Type-Parameter) (Parser (List GenericType))) +(def: (throws_decl^ type_vars) + (-> (List Type_Parameter) (Parser (List GenericType))) (do p.monad - [exs? (p.maybe (throws-decl'^ type-vars))] + [exs? (p.maybe (throws_decl'^ type_vars))] (wrap (maybe.default (list) exs?)))) -(def: (method-decl^ type-vars) - (-> (List Type-Parameter) (Parser [Member-Declaration MethodDecl])) +(def: (method_decl^ type_vars) + (-> (List Type_Parameter) (Parser [Member_Declaration MethodDecl])) (s.form (do p.monad - [tvars ..type-params^ - name s.local-identifier + [tvars ..type_params^ + name s.local_identifier anns ..annotations^ - inputs (s.tuple (p.some (..generic-type^ type-vars))) - output (..generic-type^ type-vars) - exs (..throws-decl^ type-vars)] - (wrap [[name #PublicPM anns] {#method-tvars tvars - #method-inputs inputs - #method-output output - #method-exs exs}])))) - -(def: state-modifier^ + inputs (s.tuple (p.some (..generic_type^ type_vars))) + output (..generic_type^ type_vars) + exs (..throws_decl^ type_vars)] + (wrap [[name #PublicPM anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) + +(def: state_modifier^ (Parser StateModifier) ($_ p.or (s.this! (' #volatile)) (s.this! (' #final)) (\ p.monad wrap []))) -(def: (field-decl^ type-vars) - (-> (List Type-Parameter) (Parser [Member-Declaration FieldDecl])) +(def: (field_decl^ type_vars) + (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl])) (p.either (s.form (do p.monad [_ (s.this! (' #const)) - name s.local-identifier + name s.local_identifier anns ..annotations^ - type (..generic-type^ type-vars) + type (..generic_type^ type_vars) body s.any] (wrap [[name #PublicPM anns] (#ConstantField [type body])]))) (s.form (do p.monad - [pm privacy-modifier^ - sm state-modifier^ - name s.local-identifier + [pm privacy_modifier^ + sm state_modifier^ + name s.local_identifier anns ..annotations^ - type (..generic-type^ type-vars)] + type (..generic_type^ type_vars)] (wrap [[name pm anns] (#VariableField [sm type])]))))) -(def: (arg-decl^ type-vars) - (-> (List Type-Parameter) (Parser ArgDecl)) - (s.record (p.and s.local-identifier - (..generic-type^ type-vars)))) +(def: (arg_decl^ type_vars) + (-> (List Type_Parameter) (Parser ArgDecl)) + (s.record (p.and s.local_identifier + (..generic_type^ type_vars)))) -(def: (arg-decls^ type-vars) - (-> (List Type-Parameter) (Parser (List ArgDecl))) - (p.some (arg-decl^ type-vars))) +(def: (arg_decls^ type_vars) + (-> (List Type_Parameter) (Parser (List ArgDecl))) + (p.some (arg_decl^ type_vars))) -(def: (constructor-arg^ type-vars) - (-> (List Type-Parameter) (Parser ConstructorArg)) - (s.record (p.and (..generic-type^ type-vars) s.any))) +(def: (constructor_arg^ type_vars) + (-> (List Type_Parameter) (Parser ConstructorArg)) + (s.record (p.and (..generic_type^ type_vars) s.any))) -(def: (constructor-args^ type-vars) - (-> (List Type-Parameter) (Parser (List ConstructorArg))) - (s.tuple (p.some (constructor-arg^ type-vars)))) +(def: (constructor_args^ type_vars) + (-> (List Type_Parameter) (Parser (List ConstructorArg))) + (s.tuple (p.some (constructor_arg^ type_vars)))) -(def: (constructor-method^ class-vars) - (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition])) +(def: (constructor_method^ class_vars) + (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) (s.form (do p.monad - [pm privacy-modifier^ - strict-fp? (p.parses? (s.this! (' #strict))) - method-vars ..type-params^ - #let [total-vars (list\compose class-vars method-vars)] - [_ arg-decls] (s.form (p.and (s.this! (' new)) - (..arg-decls^ total-vars))) - constructor-args (..constructor-args^ total-vars) - exs (..throws-decl^ total-vars) + [pm privacy_modifier^ + strict_fp? (p.parses? (s.this! (' #strict))) + method_vars ..type_params^ + #let [total_vars (list\compose class_vars method_vars)] + [_ arg_decls] (s.form (p.and (s.this! (' new)) + (..arg_decls^ total_vars))) + constructor_args (..constructor_args^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^ body s.any] - (wrap [{#member-name constructor-method-name - #member-privacy pm - #member-anns annotations} - (#ConstructorMethod strict-fp? method-vars arg-decls constructor-args body exs)])))) + (wrap [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)])))) -(def: (virtual-method-def^ class-vars) - (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition])) +(def: (virtual_method_def^ class_vars) + (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) (s.form (do p.monad - [pm privacy-modifier^ - strict-fp? (p.parses? (s.this! (' #strict))) + [pm privacy_modifier^ + strict_fp? (p.parses? (s.this! (' #strict))) final? (p.parses? (s.this! (' #final))) - method-vars ..type-params^ - #let [total-vars (list\compose class-vars method-vars)] - [name this-name arg-decls] (s.form ($_ p.and - s.local-identifier - s.local-identifier - (..arg-decls^ total-vars))) - return-type (..generic-type^ total-vars) - exs (..throws-decl^ total-vars) + method_vars ..type_params^ + #let [total_vars (list\compose class_vars method_vars)] + [name this_name arg_decls] (s.form ($_ p.and + s.local_identifier + s.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^ body s.any] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#VirtualMethod final? strict-fp? - method-vars - this-name arg-decls return-type + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? + method_vars + this_name arg_decls return_type body exs)])))) -(def: overriden-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: overriden_method_def^ + (Parser [Member_Declaration Method_Definition]) (s.form (do p.monad - [strict-fp? (p.parses? (s.this! (' #strict))) - owner-class ..class-decl^ - method-vars ..type-params^ - #let [total-vars (list\compose (product.right owner-class) method-vars)] - [name this-name arg-decls] (s.form ($_ p.and - s.local-identifier - s.local-identifier - (..arg-decls^ total-vars))) - return-type (..generic-type^ total-vars) - exs (..throws-decl^ total-vars) + [strict_fp? (p.parses? (s.this! (' #strict))) + owner_class ..class_decl^ + method_vars ..type_params^ + #let [total_vars (list\compose (product.right owner_class) method_vars)] + [name this_name arg_decls] (s.form ($_ p.and + s.local_identifier + s.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^ body s.any] - (wrap [{#member-name name - #member-privacy #PublicPM - #member-anns annotations} - (#OverridenMethod strict-fp? - owner-class method-vars - this-name arg-decls return-type + (wrap [{#member_name name + #member_privacy #PublicPM + #member_anns annotations} + (#OverridenMethod strict_fp? + owner_class method_vars + this_name arg_decls return_type body exs)])))) -(def: static-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: static_method_def^ + (Parser [Member_Declaration Method_Definition]) (s.form (do p.monad - [pm privacy-modifier^ - strict-fp? (p.parses? (s.this! (' #strict))) + [pm privacy_modifier^ + strict_fp? (p.parses? (s.this! (' #strict))) _ (s.this! (' #static)) - method-vars ..type-params^ - #let [total-vars method-vars] - [name arg-decls] (s.form (p.and s.local-identifier - (..arg-decls^ total-vars))) - return-type (..generic-type^ total-vars) - exs (..throws-decl^ total-vars) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (s.form (p.and s.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^ body s.any] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#StaticMethod strict-fp? method-vars arg-decls return-type body exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)])))) -(def: abstract-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: abstract_method_def^ + (Parser [Member_Declaration Method_Definition]) (s.form (do p.monad - [pm privacy-modifier^ + [pm privacy_modifier^ _ (s.this! (' #abstract)) - method-vars ..type-params^ - #let [total-vars method-vars] - [name arg-decls] (s.form (p.and s.local-identifier - (..arg-decls^ total-vars))) - return-type (..generic-type^ total-vars) - exs (..throws-decl^ total-vars) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (s.form (p.and s.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#AbstractMethod method-vars arg-decls return-type exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arg_decls return_type exs)])))) -(def: native-method-def^ - (Parser [Member-Declaration Method-Definition]) +(def: native_method_def^ + (Parser [Member_Declaration Method_Definition]) (s.form (do p.monad - [pm privacy-modifier^ + [pm privacy_modifier^ _ (s.this! (' #native)) - method-vars ..type-params^ - #let [total-vars method-vars] - [name arg-decls] (s.form (p.and s.local-identifier - (..arg-decls^ total-vars))) - return-type (..generic-type^ total-vars) - exs (..throws-decl^ total-vars) + method_vars ..type_params^ + #let [total_vars method_vars] + [name arg_decls] (s.form (p.and s.local_identifier + (..arg_decls^ total_vars))) + return_type (..generic_type^ total_vars) + exs (..throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member-name name - #member-privacy pm - #member-anns annotations} - (#NativeMethod method-vars arg-decls return-type exs)])))) + (wrap [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arg_decls return_type exs)])))) -(def: (method-def^ class-vars) - (-> (List Type-Parameter) (Parser [Member-Declaration Method-Definition])) +(def: (method_def^ class_vars) + (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) ($_ p.either - (..constructor-method^ class-vars) - (..virtual-method-def^ class-vars) - ..overriden-method-def^ - ..static-method-def^ - ..abstract-method-def^ - ..native-method-def^)) - -(def: partial-call^ - (Parser Partial-Call) + (..constructor_method^ class_vars) + (..virtual_method_def^ class_vars) + ..overriden_method_def^ + ..static_method_def^ + ..abstract_method_def^ + ..native_method_def^)) + +(def: partial_call^ + (Parser Partial_Call) (s.form (p.and s.identifier (p.some s.any)))) -(def: class-kind^ - (Parser Class-Kind) +(def: class_kind^ + (Parser Class_Kind) (p.either (do p.monad [_ (s.this! (' #class))] (wrap #Class)) @@ -849,334 +849,334 @@ (wrap #Interface)) )) -(def: import-member-alias^ +(def: import_member_alias^ (Parser (Maybe Text)) (p.maybe (do p.monad [_ (s.this! (' #as))] - s.local-identifier))) + s.local_identifier))) -(def: (import-member-args^ type-vars) - (-> (List Type-Parameter) (Parser (List [Bit GenericType]))) - (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (..generic-type^ type-vars))))) +(def: (import_member_args^ type_vars) + (-> (List Type_Parameter) (Parser (List [Bit GenericType]))) + (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (..generic_type^ type_vars))))) -(def: import-member-return-flags^ +(def: import_member_return_flags^ (Parser [Bit Bit Bit]) ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?))))) -(def: primitive-mode^ - (Parser Primitive-Mode) +(def: primitive_mode^ + (Parser Primitive_Mode) (p.or (s.this! (' #manual)) (s.this! (' #auto)))) -(def: (import-member-decl^ owner-vars) - (-> (List Type-Parameter) (Parser Import-Member-Declaration)) +(def: (import_member_decl^ owner_vars) + (-> (List Type_Parameter) (Parser Import_Member_Declaration)) ($_ p.either (s.form (do p.monad [_ (s.this! (' #enum)) - enum-members (p.some s.local-identifier)] - (wrap (#EnumDecl enum-members)))) + enum_members (p.some s.local_identifier)] + (wrap (#EnumDecl enum_members)))) (s.form (do p.monad - [tvars ..type-params^ + [tvars ..type_params^ _ (s.this! (' new)) - ?alias import-member-alias^ - #let [total-vars (list\compose owner-vars tvars)] - ?prim-mode (p.maybe primitive-mode^) - args (..import-member-args^ total-vars) - [io? try? maybe?] import-member-return-flags^] - (wrap (#ConstructorDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) - #import-member-alias (maybe.default "new" ?alias) - #import-member-kind #VirtualIMK - #import-member-tvars tvars - #import-member-args args - #import-member-maybe? maybe? - #import-member-try? try? - #import-member-io? io?} + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (p.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} {}])) )) (s.form (do p.monad [kind (: (Parser ImportMethodKind) (p.or (s.this! (' #static)) (wrap []))) - tvars ..type-params^ - name s.local-identifier - ?alias import-member-alias^ - #let [total-vars (list\compose owner-vars tvars)] - ?prim-mode (p.maybe primitive-mode^) - args (..import-member-args^ total-vars) - [io? try? maybe?] import-member-return-flags^ - return (..generic-type^ total-vars)] - (wrap (#MethodDecl [{#import-member-mode (maybe.default #AutoPrM ?prim-mode) - #import-member-alias (maybe.default name ?alias) - #import-member-kind kind - #import-member-tvars tvars - #import-member-args args - #import-member-maybe? maybe? - #import-member-try? try? - #import-member-io? io?} - {#import-method-name name - #import-method-return return + tvars ..type_params^ + name s.local_identifier + ?alias import_member_alias^ + #let [total_vars (list\compose owner_vars tvars)] + ?prim_mode (p.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..generic_type^ total_vars)] + (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {#import_method_name name + #import_method_return return }])))) (s.form (do p.monad [static? (p.parses? (s.this! (' #static))) - name s.local-identifier - ?prim-mode (p.maybe primitive-mode^) - gtype (..generic-type^ owner-vars) + name s.local_identifier + ?prim_mode (p.maybe primitive_mode^) + gtype (..generic_type^ owner_vars) maybe? (p.parses? (s.this! (' #?))) setter? (p.parses? (s.this! (' #!)))] - (wrap (#FieldAccessDecl {#import-field-mode (maybe.default #AutoPrM ?prim-mode) - #import-field-name name - #import-field-static? static? - #import-field-maybe? maybe? - #import-field-setter? setter? - #import-field-type gtype})))) + (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) (def: bundle - (-> (List Type-Parameter) (Parser [Text (List Import-Member-Declaration)])) - (|>> ..import-member-decl^ + (-> (List Type_Parameter) (Parser [Text (List Import_Member_Declaration)])) + (|>> ..import_member_decl^ p.some (p.and s.text) s.tuple)) ## Generators -(def: with-parens - (-> JVM-Code JVM-Code) +(def: with_parens + (-> JVM_Code JVM_Code) (text.enclose ["(" ")"])) -(def: with-brackets - (-> JVM-Code JVM-Code) +(def: with_brackets + (-> JVM_Code JVM_Code) (text.enclose ["[" "]"])) (def: spaced - (-> (List JVM-Code) JVM-Code) - (text.join-with " ")) + (-> (List JVM_Code) JVM_Code) + (text.join_with " ")) -(def: (privacy-modifier$ pm) - (-> PrivacyModifier JVM-Code) +(def: (privacy_modifier$ pm) + (-> PrivacyModifier JVM_Code) (case pm #PublicPM "public" #PrivatePM "private" #ProtectedPM "protected" #DefaultPM "default")) -(def: (inheritance-modifier$ im) - (-> InheritanceModifier JVM-Code) +(def: (inheritance_modifier$ im) + (-> InheritanceModifier JVM_Code) (case im #FinalIM "final" #AbstractIM "abstract" #DefaultIM "default")) -(def: (annotation-param$ [name value]) - (-> AnnotationParam JVM-Code) +(def: (annotation_param$ [name value]) + (-> AnnotationParam JVM_Code) (format name "=" (code.format value))) (def: (annotation$ [name params]) - (-> Annotation JVM-Code) - (format "(" name " " "{" (text.join-with text.tab (list\map annotation-param$ params)) "}" ")")) + (-> Annotation JVM_Code) + (format "(" name " " "{" (text.join_with text.tab (list\map annotation_param$ params)) "}" ")")) -(def: (bound-kind$ kind) - (-> BoundKind JVM-Code) +(def: (bound_kind$ kind) + (-> BoundKind JVM_Code) (case kind #UpperBound "<" #LowerBound ">")) -(def: (generic-type$ gtype) - (-> GenericType JVM-Code) +(def: (generic_type$ gtype) + (-> GenericType JVM_Code) (case gtype (#GenericTypeVar name) name (#GenericClass name params) - (format "(" (sanitize name) " " (spaced (list\map generic-type$ params)) ")") + (format "(" (sanitize name) " " (spaced (list\map generic_type$ params)) ")") (#GenericArray param) - (format "(" array.type-name " " (generic-type$ param) ")") + (format "(" array.type_name " " (generic_type$ param) ")") (#GenericWildcard #.None) "?" - (#GenericWildcard (#.Some [bound-kind bound])) - (format (bound-kind$ bound-kind) (generic-type$ bound)))) + (#GenericWildcard (#.Some [bound_kind bound])) + (format (bound_kind$ bound_kind) (generic_type$ bound)))) -(def: (type-param$ [name bounds]) - (-> Type-Parameter JVM-Code) - (format "(" name " " (spaced (list\map generic-type$ bounds)) ")")) +(def: (type_param$ [name bounds]) + (-> Type_Parameter JVM_Code) + (format "(" name " " (spaced (list\map generic_type$ bounds)) ")")) -(def: (class-decl$ (^open ".")) - (-> Class-Declaration JVM-Code) - (format "(" (sanitize class-name) " " (spaced (list\map type-param$ class-params)) ")")) +(def: (class_decl$ (^open ".")) + (-> Class_Declaration JVM_Code) + (format "(" (sanitize class_name) " " (spaced (list\map type_param$ class_params)) ")")) -(def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) - (-> Super-Class-Decl JVM-Code) - (format "(" (sanitize super-class-name) " " (spaced (list\map generic-type$ super-class-params)) ")")) +(def: (super_class_decl$ (^slots [#super_class_name #super_class_params])) + (-> Super_Class_Decl JVM_Code) + (format "(" (sanitize super_class_name) " " (spaced (list\map generic_type$ super_class_params)) ")")) -(def: (method-decl$ [[name pm anns] method-decl]) - (-> [Member-Declaration MethodDecl] JVM-Code) - (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] - (with-parens +(def: (method_decl$ [[name pm anns] method_decl]) + (-> [Member_Declaration MethodDecl] JVM_Code) + (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl] + (with_parens (spaced (list name - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ method-tvars))) - (with-brackets (spaced (list\map generic-type$ method-exs))) - (with-brackets (spaced (list\map generic-type$ method-inputs))) - (generic-type$ method-output)) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ method_tvars))) + (with_brackets (spaced (list\map generic_type$ method_exs))) + (with_brackets (spaced (list\map generic_type$ method_inputs))) + (generic_type$ method_output)) )))) -(def: (state-modifier$ sm) - (-> StateModifier JVM-Code) +(def: (state_modifier$ sm) + (-> StateModifier JVM_Code) (case sm #VolatileSM "volatile" #FinalSM "final" #DefaultSM "default")) -(def: (field-decl$ [[name pm anns] field]) - (-> [Member-Declaration FieldDecl] JVM-Code) +(def: (field_decl$ [[name pm anns] field]) + (-> [Member_Declaration FieldDecl] JVM_Code) (case field (#ConstantField class value) - (with-parens + (with_parens (spaced (list "constant" name - (with-brackets (spaced (list\map annotation$ anns))) - (generic-type$ class) + (with_brackets (spaced (list\map annotation$ anns))) + (generic_type$ class) (code.format value)) )) (#VariableField sm class) - (with-parens + (with_parens (spaced (list "variable" name - (privacy-modifier$ pm) - (state-modifier$ sm) - (with-brackets (spaced (list\map annotation$ anns))) - (generic-type$ class)) + (privacy_modifier$ pm) + (state_modifier$ sm) + (with_brackets (spaced (list\map annotation$ anns))) + (generic_type$ class)) )) )) -(def: (arg-decl$ [name type]) - (-> ArgDecl JVM-Code) - (with-parens - (spaced (list name (generic-type$ type))))) - -(def: (constructor-arg$ [class term]) - (-> ConstructorArg JVM-Code) - (with-brackets - (spaced (list (generic-type$ class) (code.format term))))) - -(def: (method-def$ replacer super-class [[name pm anns] method-def]) - (-> (-> Code Code) Super-Class-Decl [Member-Declaration Method-Definition] JVM-Code) - (case method-def - (#ConstructorMethod strict-fp? type-vars arg-decls constructor-args body exs) - (with-parens +(def: (arg_decl$ [name type]) + (-> ArgDecl JVM_Code) + (with_parens + (spaced (list name (generic_type$ type))))) + +(def: (constructor_arg$ [class term]) + (-> ConstructorArg JVM_Code) + (with_brackets + (spaced (list (generic_type$ class) (code.format term))))) + +(def: (method_def$ replacer super_class [[name pm anns] method_def]) + (-> (-> Code Code) Super_Class_Decl [Member_Declaration Method_Definition] JVM_Code) + (case method_def + (#ConstructorMethod strict_fp? type_vars arg_decls constructor_args body exs) + (with_parens (spaced (list "init" - (privacy-modifier$ pm) - (bit\encode strict-fp?) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (with-brackets (spaced (list\map constructor-arg$ constructor-args))) - (code.format (pre-walk-replace replacer body)) + (privacy_modifier$ pm) + (bit\encode strict_fp?) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (with_brackets (spaced (list\map constructor_arg$ constructor_args))) + (code.format (pre_walk_replace replacer body)) ))) - (#VirtualMethod final? strict-fp? type-vars this-name arg-decls return-type body exs) - (with-parens + (#VirtualMethod final? strict_fp? type_vars this_name arg_decls return_type body exs) + (with_parens (spaced (list "virtual" name - (privacy-modifier$ pm) + (privacy_modifier$ pm) (bit\encode final?) - (bit\encode strict-fp?) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (generic-type$ return-type) - (code.format (pre-walk-replace replacer (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] + (bit\encode strict_fp?) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (generic_type$ return_type) + (code.format (pre_walk_replace replacer (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)] (~ body)))))))) - (#OverridenMethod strict-fp? class-decl type-vars this-name arg-decls return-type body exs) - (let [super-replacer (parser->replacer (s.form (do p.monad + (#OverridenMethod strict_fp? class_decl type_vars this_name arg_decls return_type body exs) + (let [super_replacer (parser->replacer (s.form (do p.monad [_ (s.this! (' ::super!)) - args (s.tuple (p.exactly (list.size arg-decls) s.any)) - #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ (list))) - arg-decls))]] + args (s.tuple (p.exactly (list.size arg_decls) s.any)) + #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) + arg_decls))]] (wrap (`' ((~ (code.text (format "jvm invokespecial" - ":" (get@ #super-class-name super-class) + ":" (get@ #super_class_name super_class) ":" name - ":" (text.join-with "," arg-decls')))) + ":" (text.join_with "," arg_decls')))) (~' _jvm_this) (~+ args)))))))] - (with-parens + (with_parens (spaced (list "override" - (class-decl$ class-decl) + (class_decl$ class_decl) name - (bit\encode strict-fp?) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (generic-type$ return-type) - (|> (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] + (bit\encode strict_fp?) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (generic_type$ return_type) + (|> (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)] (~ body))) - (pre-walk-replace replacer) - (pre-walk-replace super-replacer) + (pre_walk_replace replacer) + (pre_walk_replace super_replacer) (code.format)) )))) - (#StaticMethod strict-fp? type-vars arg-decls return-type body exs) - (with-parens + (#StaticMethod strict_fp? type_vars arg_decls return_type body exs) + (with_parens (spaced (list "static" name - (privacy-modifier$ pm) - (bit\encode strict-fp?) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (generic-type$ return-type) - (code.format (pre-walk-replace replacer body))))) - - (#AbstractMethod type-vars arg-decls return-type exs) - (with-parens + (privacy_modifier$ pm) + (bit\encode strict_fp?) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (generic_type$ return_type) + (code.format (pre_walk_replace replacer body))))) + + (#AbstractMethod type_vars arg_decls return_type exs) + (with_parens (spaced (list "abstract" name - (privacy-modifier$ pm) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (generic-type$ return-type)))) - - (#NativeMethod type-vars arg-decls return-type exs) - (with-parens + (privacy_modifier$ pm) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (generic_type$ return_type)))) + + (#NativeMethod type_vars arg_decls return_type exs) + (with_parens (spaced (list "native" name - (privacy-modifier$ pm) - (with-brackets (spaced (list\map annotation$ anns))) - (with-brackets (spaced (list\map type-param$ type-vars))) - (with-brackets (spaced (list\map generic-type$ exs))) - (with-brackets (spaced (list\map arg-decl$ arg-decls))) - (generic-type$ return-type)))) + (privacy_modifier$ pm) + (with_brackets (spaced (list\map annotation$ anns))) + (with_brackets (spaced (list\map type_param$ type_vars))) + (with_brackets (spaced (list\map generic_type$ exs))) + (with_brackets (spaced (list\map arg_decl$ arg_decls))) + (generic_type$ return_type)))) )) -(def: (complete-call$ g!obj [method args]) - (-> Code Partial-Call Code) +(def: (complete_call$ g!obj [method args]) + (-> Code Partial_Call Code) (` ((~ (code.identifier method)) (~+ args) (~ g!obj)))) ## [Syntax] -(def: object-super-class - Super-Class-Decl - {#super-class-name "java/lang/Object" - #super-class-params (list)}) +(def: object_super_class + Super_Class_Decl + {#super_class_name "java/lang/Object" + #super_class_params (list)}) (syntax: #export (class: - {im inheritance-modifier^} - {class-decl ..class-decl^} - {#let [full-class-name (product.left class-decl)]} - {#let [class-vars (product.right class-decl)]} - {super (p.default object-super-class - (..super-class-decl^ class-vars))} + {im inheritance_modifier^} + {class_decl ..class_decl^} + {#let [full_class_name (product.left class_decl)]} + {#let [class_vars (product.right class_decl)]} + {super (p.default object_super_class + (..super_class_decl^ class_vars))} {interfaces (p.default (list) - (s.tuple (p.some (..super-class-decl^ class-vars))))} + (s.tuple (p.some (..super_class_decl^ class_vars))))} {annotations ..annotations^} - {fields (p.some (..field-decl^ class-vars))} - {methods (p.some (..method-def^ class-vars))}) + {fields (p.some (..field_decl^ class_vars))} + {methods (p.some (..method_def^ class_vars))}) {#.doc (doc "Allows defining JVM classes in Lux code." "For example:" (class: #final (TestClass A) [Runnable] @@ -1208,49 +1208,49 @@ "(::resolve! container [value]) for calling the 'resolve' method." )} (do meta.monad - [current-module meta.current-module-name - #let [fully-qualified-class-name (format (sanitize current-module) "." full-class-name) - field-parsers (list\map (field->parser fully-qualified-class-name) fields) - method-parsers (list\map (method->parser (product.right class-decl) fully-qualified-class-name) methods) + [current_module meta.current_module_name + #let [fully_qualified_class_name (format (sanitize current_module) "." full_class_name) + field_parsers (list\map (field->parser fully_qualified_class_name) fields) + method_parsers (list\map (method->parser (product.right class_decl) fully_qualified_class_name) methods) replacer (parser->replacer (list\fold p.either (p.fail "") - (list\compose field-parsers method-parsers))) - def-code (format "jvm class:" - (spaced (list (class-decl$ class-decl) - (super-class-decl$ super) - (with-brackets (spaced (list\map super-class-decl$ interfaces))) - (inheritance-modifier$ im) - (with-brackets (spaced (list\map annotation$ annotations))) - (with-brackets (spaced (list\map field-decl$ fields))) - (with-brackets (spaced (list\map (method-def$ replacer super) methods))))))]] - (wrap (list (` ((~ (code.text def-code)))))))) + (list\compose field_parsers method_parsers))) + def_code (format "jvm class:" + (spaced (list (class_decl$ class_decl) + (super_class_decl$ super) + (with_brackets (spaced (list\map super_class_decl$ interfaces))) + (inheritance_modifier$ im) + (with_brackets (spaced (list\map annotation$ annotations))) + (with_brackets (spaced (list\map field_decl$ fields))) + (with_brackets (spaced (list\map (method_def$ replacer super) methods))))))]] + (wrap (list (` ((~ (code.text def_code)))))))) (syntax: #export (interface: - {class-decl ..class-decl^} - {#let [class-vars (product.right class-decl)]} + {class_decl ..class_decl^} + {#let [class_vars (product.right class_decl)]} {supers (p.default (list) - (s.tuple (p.some (..super-class-decl^ class-vars))))} + (s.tuple (p.some (..super_class_decl^ class_vars))))} {annotations ..annotations^} - {members (p.some (..method-decl^ class-vars))}) + {members (p.some (..method_decl^ class_vars))}) {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (let [def-code (format "jvm interface:" - (spaced (list (class-decl$ class-decl) - (with-brackets (spaced (list\map super-class-decl$ supers))) - (with-brackets (spaced (list\map annotation$ annotations))) - (spaced (list\map method-decl$ members)))))] - (wrap (list (` ((~ (code.text def-code)))))) + (let [def_code (format "jvm interface:" + (spaced (list (class_decl$ class_decl) + (with_brackets (spaced (list\map super_class_decl$ supers))) + (with_brackets (spaced (list\map annotation$ annotations))) + (spaced (list\map method_decl$ members)))))] + (wrap (list (` ((~ (code.text def_code)))))) )) (syntax: #export (object - {class-vars (s.tuple (p.some ..type-param^))} - {super (p.default object-super-class - (..super-class-decl^ class-vars))} + {class_vars (s.tuple (p.some ..type_param^))} + {super (p.default object_super_class + (..super_class_decl^ class_vars))} {interfaces (p.default (list) - (s.tuple (p.some (..super-class-decl^ class-vars))))} - {constructor-args (..constructor-args^ class-vars)} - {methods (p.some ..overriden-method-def^)}) + (s.tuple (p.some (..super_class_decl^ class_vars))))} + {constructor_args (..constructor_args^ class_vars)} + {methods (p.some ..overriden_method_def^)}) {#.doc (doc "Allows defining anonymous classes." "The 1st tuple corresponds to class-level type-variables." "The 2nd tuple corresponds to parent interfaces." @@ -1259,15 +1259,15 @@ (object [] [Runnable] [] (Runnable [] (run self) void - (exec (do-something some-value) + (exec (do_something some_value) []))) )} - (let [def-code (format "jvm anon-class:" - (spaced (list (super-class-decl$ super) - (with-brackets (spaced (list\map super-class-decl$ interfaces))) - (with-brackets (spaced (list\map constructor-arg$ constructor-args))) - (with-brackets (spaced (list\map (method-def$ function.identity super) methods))))))] - (wrap (list (` ((~ (code.text def-code)))))))) + (let [def_code (format "jvm anon-class:" + (spaced (list (super_class_decl$ super) + (with_brackets (spaced (list\map super_class_decl$ interfaces))) + (with_brackets (spaced (list\map constructor_arg$ constructor_args))) + (with_brackets (spaced (list\map (method_def$ function.identity super) methods))))))] + (wrap (list (` ((~ (code.text def_code)))))))) (syntax: #export (null) {#.doc (doc "Null object reference." @@ -1289,7 +1289,7 @@ #.None) (= (??? "YOLO") (#.Some "YOLO")))} - (with-gensyms [g!temp] + (with_gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ expr)] (if ("jvm object null?" (~ g!temp)) #.None @@ -1302,7 +1302,7 @@ (!!! (??? (: java/lang/Thread (null))))) (= "foo" (!!! (??? "foo"))))} - (with-gensyms [g!value] + (with_gensyms [g!value] (wrap (list (` ({(#.Some (~ g!value)) (~ g!value) @@ -1311,158 +1311,158 @@ (~ expr))))))) (syntax: #export (try expression) - {#.doc (doc (case (try (risky-computation input)) + {#.doc (doc (case (try (risky_computation input)) (#.Right success) - (do-something success) + (do_something success) (#.Left error) - (recover-from-failure error)))} + (recover_from_failure error)))} (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) -(syntax: #export (check {class (..generic-type^ (list))} +(syntax: #export (check {class (..generic_type^ (list))} {unchecked (p.maybe s.any)}) {#.doc (doc "Checks whether an object is an instance of a particular class." "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes." (case (check String "YOLO") - (#.Some value-as-string) + (#.Some value_as_string) #.None))} - (with-gensyms [g!_ g!unchecked] - (let [class-name (simple-class$ (list) class) - class-type (` (.primitive (~ (code.text class-name)))) - check-type (` (.Maybe (~ class-type))) - check-code (` (if ((~ (code.text (format "jvm instanceof" ":" class-name))) (~ g!unchecked)) - (#.Some (.:coerce (~ class-type) + (with_gensyms [g!_ g!unchecked] + (let [class_name (simple_class$ (list) class) + class_type (` (.primitive (~ (code.text class_name)))) + check_type (` (.Maybe (~ class_type))) + check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked)) + (#.Some (.:coerce (~ class_type) (~ g!unchecked))) #.None))] (case unchecked (#.Some unchecked) - (wrap (list (` (: (~ check-type) + (wrap (list (` (: (~ check_type) (let [(~ g!unchecked) (~ unchecked)] - (~ check-code)))))) + (~ check_code)))))) #.None - (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check-type)) + (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) (function ((~ g!_) (~ g!unchecked)) - (~ check-code)))))) + (~ check_code)))))) )))) (syntax: #export (synchronized lock body) {#.doc (doc "Evaluates body, while holding a lock on a given object." - (synchronized object-to-be-locked - (exec (do-something ___) - (do-something-else ___) - (finish-the-computation ___))))} + (synchronized object_to_be_locked + (exec (do_something ___) + (do_something_else ___) + (finish_the_computation ___))))} (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) -(syntax: #export (do-to obj {methods (p.some partial-call^)}) +(syntax: #export (do_to obj {methods (p.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." - (do-to object + (do_to object (ClassName::method1 arg0 arg1 arg2) (ClassName::method2 arg3 arg4 arg5)))} - (with-gensyms [g!obj] + (with_gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list\map (complete-call$ g!obj) methods)) + (exec (~+ (list\map (complete_call$ g!obj) methods)) (~ g!obj)))))))) -(def: (class-import$ [full-name params]) - (-> Class-Declaration Code) - (let [params' (list\map (|>> product.left code.local-identifier) params)] - (` (def: (~ (code.identifier ["" full-name])) - {#..jvm-class (~ (code.text full-name))} +(def: (class_import$ [full_name params]) + (-> Class_Declaration Code) + (let [params' (list\map (|>> product.left code.local_identifier) params)] + (` (def: (~ (code.identifier ["" full_name])) + {#..jvm_class (~ (code.text full_name))} Type (All [(~+ params')] - (primitive (~ (code.text (sanitize full-name))) + (primitive (~ (code.text (sanitize full_name))) [(~+ params')])))))) -(def: (member-type-vars class-tvars member) - (-> (List Type-Parameter) Import-Member-Declaration (List Type-Parameter)) +(def: (member_type_vars class_tvars member) + (-> (List Type_Parameter) Import_Member_Declaration (List Type_Parameter)) (case member (#ConstructorDecl [commons _]) - (list\compose class-tvars (get@ #import-member-tvars commons)) + (list\compose class_tvars (get@ #import_member_tvars commons)) (#MethodDecl [commons _]) - (case (get@ #import-member-kind commons) + (case (get@ #import_member_kind commons) #StaticIMK - (get@ #import-member-tvars commons) + (get@ #import_member_tvars commons) _ - (list\compose class-tvars (get@ #import-member-tvars commons))) + (list\compose class_tvars (get@ #import_member_tvars commons))) _ - class-tvars)) + class_tvars)) -(def: (member-def-arg-bindings type-params class member) - (-> (List Type-Parameter) Class-Declaration Import-Member-Declaration (Meta [(List [Bit Code]) (List Text) (List Code)])) +(def: (member_def_arg_bindings type_params class member) + (-> (List Type_Parameter) Class_Declaration Import_Member_Declaration (Meta [(List [Bit Code]) (List Text) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) - (let [(^slots [#import-member-tvars #import-member-args]) commons] + (let [(^slots [#import_member_tvars #import_member_args]) commons] (do {! meta.monad} - [arg-inputs (monad.map ! + [arg_inputs (monad.map ! (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) - (with-gensyms [arg-name] - (wrap [maybe? arg-name])))) - import-member-args) - #let [arg-classes (: (List Text) - (list\map (|>> product.right (simple-class$ (list\compose type-params import-member-tvars))) - import-member-args)) - arg-types (list\map (: (-> [Bit GenericType] Code) + (with_gensyms [arg_name] + (wrap [maybe? arg_name])))) + import_member_args) + #let [arg_classes (: (List Text) + (list\map (|>> product.right (simple_class$ (list\compose type_params import_member_tvars))) + import_member_args)) + arg_types (list\map (: (-> [Bit GenericType] Code) (function (_ [maybe? arg]) - (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] + (let [arg_type (class->type (get@ #import_member_mode commons) type_params arg)] (if maybe? - (` (Maybe (~ arg-type))) - arg-type)))) - import-member-args)]] - (wrap [arg-inputs arg-classes arg-types]))) + (` (Maybe (~ arg_type))) + arg_type)))) + import_member_args)]] + (wrap [arg_inputs arg_classes arg_types]))) _ (\ meta.monad wrap [(list) (list) (list)]))) -(def: (decorate-return-maybe member return-term) - (-> Import-Member-Declaration Code Code) +(def: (decorate_return_maybe member return_term) + (-> Import_Member_Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) - (if (get@ #import-member-maybe? commons) - (` (??? (~ return-term))) + (if (get@ #import_member_maybe? commons) + (` (??? (~ return_term))) (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] - (` (let [(~ g!temp) (~ return-term)] + (` (let [(~ g!temp) (~ return_term)] (if (not (..null? (:coerce (primitive "java.lang.Object") (~ g!temp)))) (~ g!temp) (error! "Cannot produce null references from method calls.")))))) _ - return-term)) + return_term)) -(template [<name> <tag> <term-trans>] - [(def: (<name> member return-term) - (-> Import-Member-Declaration Code Code) +(template [<name> <tag> <term_trans>] + [(def: (<name> member return_term) + (-> Import_Member_Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ <tag> commons) - <term-trans> - return-term) + <term_trans> + return_term) _ - return-term))] + return_term))] - [decorate-return-try #import-member-try? (` (..try (~ return-term)))] - [decorate-return-io #import-member-io? (` ((~! io.io) (~ return-term)))] + [decorate_return_try #import_member_try? (` (..try (~ return_term)))] + [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] ) -(def: (free-type-param? [name bounds]) - (-> Type-Parameter Bit) +(def: (free_type_param? [name bounds]) + (-> Type_Parameter Bit) (case bounds #.Nil #1 _ #0)) -(def: (type-param->type-arg [name _]) - (-> Type-Parameter Code) +(def: (type_param->type_arg [name _]) + (-> Type_Parameter Code) (code.identifier ["" name])) (template [<name> <byte> <short> <int> <float>] [(def: (<name> mode [class expression]) - (-> Primitive-Mode [Text Code] Code) + (-> Primitive_Mode [Text Code] Code) (case mode #ManualPrM expression @@ -1475,78 +1475,78 @@ "float" (` (<float> (~ expression))) _ expression)))] - [auto-convert-input long-to-byte long-to-short long-to-int double-to-float] - [auto-convert-output byte-to-long short-to-long int-to-long float-to-double] + [auto_convert_input long_to_byte long_to_short long_to_int double_to_float] + [auto_convert_output byte_to_long short_to_long int_to_long float_to_double] ) -(def: (un-quote quoted) +(def: (un_quote quoted) (-> Code Code) (` ((~' ~) (~ quoted)))) -(def: (jvm-extension-inputs mode classes inputs) - (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code)) +(def: (jvm_extension_inputs mode classes inputs) + (-> Primitive_Mode (List Text) (List [Bit Code]) (List Code)) (|> inputs (list\map (function (_ [maybe? input]) (if maybe? - (` ((~! !!!) (~ (un-quote input)))) - (un-quote input)))) + (` ((~! !!!) (~ (un_quote input)))) + (un_quote input)))) (list.zip/2 classes) - (list\map (auto-convert-input mode)))) + (list\map (auto_convert_input mode)))) -(def: (import-name format class member) +(def: (import_name format class member) (-> Text Text Text Text) (|> format - (text.replace-all "#" class) - (text.replace-all "." member))) - -(def: (member-def-interop type-params kind class [arg-function-inputs arg-classes arg-types] member method-prefix import-format) - (-> (List Type-Parameter) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text Text (Meta (List Code))) - (let [[full-name class-tvars] class - full-name (sanitize full-name) - all-params (|> (member-type-vars class-tvars member) - (list.filter free-type-param?) - (list\map type-param->type-arg))] + (text.replace_all "#" class) + (text.replace_all "." member))) + +(def: (member_def_interop type_params kind class [arg_function_inputs arg_classes arg_types] member method_prefix import_format) + (-> (List Type_Parameter) Class_Kind Class_Declaration [(List [Bit Code]) (List Text) (List Code)] Import_Member_Declaration Text Text (Meta (List Code))) + (let [[full_name class_tvars] class + full_name (sanitize full_name) + all_params (|> (member_type_vars class_tvars member) + (list.filter free_type_param?) + (list\map type_param->type_arg))] (case member - (#EnumDecl enum-members) + (#EnumDecl enum_members) (do {! meta.monad} - [#let [enum-type (: Code - (case class-tvars + [#let [enum_type (: Code + (case class_tvars #.Nil - (` (primitive (~ (code.text full-name)))) + (` (primitive (~ (code.text full_name)))) _ - (let [=class-tvars (|> class-tvars - (list.filter free-type-param?) - (list\map type-param->type-arg))] - (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) - getter-interop (: (-> Text Code) + (let [=class_tvars (|> class_tvars + (list.filter free_type_param?) + (list\map type_param->type_arg))] + (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)])))))) + getter_interop (: (-> Text Code) (function (_ name) - (let [getter-name (code.identifier ["" (..import-name import-format method-prefix name)])] - (` (def: (~ getter-name) - (~ enum-type) - ((~ (code.text (format "jvm getstatic" ":" full-name ":" name)))))))))]] - (wrap (list\map getter-interop enum-members))) + (let [getter_name (code.identifier ["" (..import_name import_format method_prefix name)])] + (` (def: (~ getter_name) + (~ enum_type) + ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]] + (wrap (list\map getter_interop enum_members))) (#ConstructorDecl [commons _]) (do meta.monad - [#let [def-name (code.identifier ["" (..import-name import-format method-prefix (get@ #import-member-alias commons))]) - jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))) - jvm-interop (|> (` ((~ jvm-extension) - (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs)))) - (decorate-return-maybe member) - (decorate-return-try member) - (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs))) - ((~' wrap) (.list (.` (~ jvm-interop))))))))) + [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))]) + jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes))) + jvm_interop (|> (` ((~ jvm_extension) + (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs)))) + (decorate_return_maybe member) + (decorate_return_try member) + (decorate_return_io member))]] + (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) + ((~' wrap) (.list (.` (~ jvm_interop))))))))) (#MethodDecl [commons method]) - (with-gensyms [g!obj] + (with_gensyms [g!obj] (do meta.monad - [#let [def-name (code.identifier ["" (..import-name import-format method-prefix (get@ #import-member-alias commons))]) - (^slots [#import-member-kind]) commons - (^slots [#import-method-name]) method - [jvm-op object-ast] (: [Text (List Code)] - (case import-member-kind + [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))]) + (^slots [#import_member_kind]) commons + (^slots [#import_method_name]) method + [jvm_op object_ast] (: [Text (List Code)] + (case import_member_kind #StaticIMK ["invokestatic" (list)] @@ -1561,103 +1561,103 @@ ["invokeinterface" (list g!obj)] ))) - jvm-extension (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes))) - jvm-interop (|> [(simple-class$ (list) (get@ #import-method-return method)) - (` ((~ jvm-extension) (~+ (list\map un-quote object-ast)) - (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))] - (auto-convert-output (get@ #import-member-mode commons)) - (decorate-return-maybe member) - (decorate-return-try member) - (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast)) - ((~' wrap) (.list (.` (~ jvm-interop)))))))))) + jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" import_method_name ":" (text.join_with "," arg_classes))) + jvm_interop (|> [(simple_class$ (list) (get@ #import_method_return method)) + (` ((~ jvm_extension) (~+ (list\map un_quote object_ast)) + (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))] + (auto_convert_output (get@ #import_member_mode commons)) + (decorate_return_maybe member) + (decorate_return_try member) + (decorate_return_io member))]] + (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) + ((~' wrap) (.list (.` (~ jvm_interop)))))))))) (#FieldAccessDecl fad) (do meta.monad [#let [(^open ".") fad - base-gtype (class->type import-field-mode type-params import-field-type) - classC (class-decl-type$ class) - typeC (if import-field-maybe? - (` (Maybe (~ base-gtype))) - base-gtype) - tvar-asts (: (List Code) - (|> class-tvars - (list.filter free-type-param?) - (list\map type-param->type-arg))) - getter-name (code.identifier ["" (..import-name import-format method-prefix import-field-name)]) - setter-name (code.identifier ["" (..import-name import-format method-prefix (format import-field-name "!"))])] - getter-interop (with-gensyms [g!obj] - (let [getter-call (if import-field-static? - (` ((~ getter-name))) - (` ((~ getter-name) (~ g!obj)))) - getter-body (<| (auto-convert-output import-field-mode) - [(simple-class$ (list) import-field-type) - (if import-field-static? - (let [jvm-extension (code.text (format "jvm getstatic" ":" full-name ":" import-field-name))] - (` ((~ jvm-extension)))) - (let [jvm-extension (code.text (format "jvm getfield" ":" full-name ":" import-field-name))] - (` ((~ jvm-extension) (~ (un-quote g!obj))))))]) - getter-body (if import-field-maybe? - (` ((~! ???) (~ getter-body))) - getter-body) - getter-body (if import-field-setter? - (` ((~! io.io) (~ getter-body))) - getter-body)] - (wrap (` ((~! syntax:) (~ getter-call) - ((~' wrap) (.list (.` (~ getter-body))))))))) - setter-interop (: (Meta (List Code)) - (if import-field-setter? - (with-gensyms [g!obj g!value] - (let [setter-call (if import-field-static? - (` ((~ setter-name) (~ g!value))) - (` ((~ setter-name) (~ g!value) (~ g!obj)))) - setter-value (auto-convert-input import-field-mode - [(simple-class$ (list) import-field-type) (un-quote g!value)]) - setter-value (if import-field-maybe? - (` ((~! !!!) (~ setter-value))) - setter-value) - setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield") - ":" full-name ":" import-field-name) + base_gtype (class->type import_field_mode type_params import_field_type) + classC (class_decl_type$ class) + typeC (if import_field_maybe? + (` (Maybe (~ base_gtype))) + base_gtype) + tvar_asts (: (List Code) + (|> class_tvars + (list.filter free_type_param?) + (list\map type_param->type_arg))) + getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)]) + setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])] + getter_interop (with_gensyms [g!obj] + (let [getter_call (if import_field_static? + (` ((~ getter_name))) + (` ((~ getter_name) (~ g!obj)))) + getter_body (<| (auto_convert_output import_field_mode) + [(simple_class$ (list) import_field_type) + (if import_field_static? + (let [jvm_extension (code.text (format "jvm getstatic" ":" full_name ":" import_field_name))] + (` ((~ jvm_extension)))) + (let [jvm_extension (code.text (format "jvm getfield" ":" full_name ":" import_field_name))] + (` ((~ jvm_extension) (~ (un_quote g!obj))))))]) + getter_body (if import_field_maybe? + (` ((~! ???) (~ getter_body))) + getter_body) + getter_body (if import_field_setter? + (` ((~! io.io) (~ getter_body))) + getter_body)] + (wrap (` ((~! syntax:) (~ getter_call) + ((~' wrap) (.list (.` (~ getter_body))))))))) + setter_interop (: (Meta (List Code)) + (if import_field_setter? + (with_gensyms [g!obj g!value] + (let [setter_call (if import_field_static? + (` ((~ setter_name) (~ g!value))) + (` ((~ setter_name) (~ g!value) (~ g!obj)))) + setter_value (auto_convert_input import_field_mode + [(simple_class$ (list) import_field_type) (un_quote g!value)]) + setter_value (if import_field_maybe? + (` ((~! !!!) (~ setter_value))) + setter_value) + setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield") + ":" full_name ":" import_field_name) g!obj+ (: (List Code) - (if import-field-static? + (if import_field_static? (list) - (list (un-quote g!obj))))] - (wrap (list (` ((~! syntax:) (~ setter-call) - ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter-command)) (~+ g!obj+) (~ setter-value)))))))))))) + (list (un_quote g!obj))))] + (wrap (list (` ((~! syntax:) (~ setter_call) + ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) (wrap (list))))] - (wrap (list& getter-interop setter-interop))) + (wrap (list& getter_interop setter_interop))) ))) -(def: (member-import$ type-params kind class [import-format member]) - (-> (List Type-Parameter) Class-Kind Class-Declaration [Text Import-Member-Declaration] (Meta (List Code))) - (let [[method-prefix _] class] +(def: (member_import$ type_params kind class [import_format member]) + (-> (List Type_Parameter) Class_Kind Class_Declaration [Text Import_Member_Declaration] (Meta (List Code))) + (let [[method_prefix _] class] (do meta.monad - [=args (member-def-arg-bindings type-params class member)] - (member-def-interop type-params kind class =args member method-prefix import-format)))) + [=args (member_def_arg_bindings type_params class member)] + (member_def_interop type_params kind class =args member method_prefix import_format)))) (def: (interface? class) (All [a] (-> (primitive "java.lang.Class" [a]) Bit)) ("jvm invokevirtual:java.lang.Class:isInterface:" class)) -(def: (load-class class-name) +(def: (load_class class_name) (-> Text (Try (primitive "java.lang.Class" [Any]))) - (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class-name))) + (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name))) -(def: (class-kind [class-name _]) - (-> Class-Declaration (Meta Class-Kind)) - (let [class-name (sanitize class-name)] - (case (load-class class-name) +(def: (class_kind [class_name _]) + (-> Class_Declaration (Meta Class_Kind)) + (let [class_name (sanitize class_name)] + (case (load_class class_name) (#.Right class) (\ meta.monad wrap (if (interface? class) #Interface #Class)) (#.Left _) - (meta.fail (format "Unknown class: " class-name))))) + (meta.fail (format "Unknown class: " class_name))))) (syntax: #export (import: - {class-decl ..class-decl^} - {bundles (p.some (..bundle (product.right class-decl)))}) + {class_decl ..class_decl^} + {bundles (p.some (..bundle (product.right class_decl)))}) {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." (import: java/lang/Object @@ -1675,7 +1675,7 @@ ["#::." (new [[byte]]) (#static valueOf [char] java/lang/String) - (#static valueOf #as int-valueOf [int] java/lang/String)]) + (#static valueOf #as int_valueOf [int] java/lang/String)]) (import: (java/util/List e) ["#::." @@ -1705,27 +1705,27 @@ "Also, the names of the imported members will look like Class::member" (java/lang/Object::new []) - (java/lang/Object::equals [other-object] my-object) - (java/util/List::size [] my-list) + (java/lang/Object::equals [other_object] my_object) + (java/util/List::size [] my_list) java/lang/Character$UnicodeScript::LATIN )} (do {! meta.monad} - [kind (class-kind class-decl) + [kind (class_kind class_decl) =members (|> bundles - (list\map (function (_ [import-format members]) - (list\map (|>> [import-format]) members))) + (list\map (function (_ [import_format members]) + (list\map (|>> [import_format]) members))) list.concat - (monad.map ! (member-import$ (product.right class-decl) kind class-decl)))] - (wrap (list& (class-import$ class-decl) (list\join =members))))) + (monad.map ! (member_import$ (product.right class_decl) kind class_decl)))] + (wrap (list& (class_import$ class_decl) (list\join =members))))) -(syntax: #export (array {type (..generic-type^ (list))} +(syntax: #export (array {type (..generic_type^ (list))} size) {#.doc (doc "Create an array of the given type, with the given size." (array Object 10))} (case type - (^template [<type> <array-op>] + (^template [<type> <array_op>] [(^ (#GenericClass <type> (list))) - (wrap (list (` (<array-op> (~ size)))))]) + (wrap (list (` (<array_op> (~ size)))))]) (["boolean" "jvm znewarray"] ["byte" "jvm bnewarray"] ["short" "jvm snewarray"] @@ -1736,14 +1736,14 @@ ["char" "jvm cnewarray"]) _ - (wrap (list (` ("jvm anewarray" (~ (code.text (generic-type$ type))) (~ size))))))) + (wrap (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size))))))) -(syntax: #export (array-length array) +(syntax: #export (array_length array) {#.doc (doc "Gives the length of an array." - (array-length my-array))} + (array_length my_array))} (wrap (list (` ("jvm arraylength" (~ array)))))) -(def: (type->class-name type) +(def: (type->class_name type) (-> Type (Meta Text)) (if (type\= Any type) (\ meta.monad wrap "java.lang.Object") @@ -1757,26 +1757,26 @@ (meta.fail (format "Cannot apply type: " (type.format F) " to " (type.format A))) (#.Some type') - (type->class-name type')) + (type->class_name type')) (#.Named _ type') - (type->class-name type') + (type->class_name type') _ (meta.fail (format "Cannot convert to JvmType: " (type.format type)))))) -(syntax: #export (array-read idx array) +(syntax: #export (array_read idx array) {#.doc (doc "Loads an element from an array." - (array-read 10 my-array))} + (array_read 10 my_array))} (case array - [_ (#.Identifier array-name)] + [_ (#.Identifier array_name)] (do meta.monad - [array-type (meta.find-type array-name) - array-jvm-type (type->class-name array-type)] - (case array-jvm-type - (^template [<type> <array-op>] + [array_type (meta.find_type array_name) + array_jvm_type (type->class_name array_type)] + (case array_jvm_type + (^template [<type> <array_op>] [<type> - (wrap (list (` (<array-op> (~ array) (~ idx)))))]) + (wrap (list (` (<array_op> (~ array) (~ idx)))))]) (["[Z" "jvm zaload"] ["[B" "jvm baload"] ["[S" "jvm saload"] @@ -1790,22 +1790,22 @@ (wrap (list (` ("jvm aaload" (~ array) (~ idx))))))) _ - (with-gensyms [g!array] + (with_gensyms [g!array] (wrap (list (` (let [(~ g!array) (~ array)] - (..array-read (~ idx) (~ g!array))))))))) + (..array_read (~ idx) (~ g!array))))))))) -(syntax: #export (array-write idx value array) +(syntax: #export (array_write idx value array) {#.doc (doc "Stores an element into an array." - (array-write 10 my-object my-array))} + (array_write 10 my_object my_array))} (case array - [_ (#.Identifier array-name)] + [_ (#.Identifier array_name)] (do meta.monad - [array-type (meta.find-type array-name) - array-jvm-type (type->class-name array-type)] - (case array-jvm-type - (^template [<type> <array-op>] + [array_type (meta.find_type array_name) + array_jvm_type (type->class_name array_type)] + (case array_jvm_type + (^template [<type> <array_op>] [<type> - (wrap (list (` (<array-op> (~ array) (~ idx) (~ value)))))]) + (wrap (list (` (<array_op> (~ array) (~ idx) (~ value)))))]) (["[Z" "jvm zastore"] ["[B" "jvm bastore"] ["[S" "jvm sastore"] @@ -1819,14 +1819,14 @@ (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) _ - (with-gensyms [g!array] + (with_gensyms [g!array] (wrap (list (` (let [(~ g!array) (~ array)] - (..array-write (~ idx) (~ value) (~ g!array))))))))) + (..array_write (~ idx) (~ value) (~ g!array))))))))) -(syntax: #export (class-for {type (..generic-type^ (list))}) +(syntax: #export (class_for {type (..generic_type^ (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." - (class-for java/lang/String))} - (wrap (list (` ("jvm object class" (~ (code.text (simple-class$ (list) type)))))))) + (class_for java/lang/String))} + (wrap (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type)))))))) -(syntax: #export (type {type (..generic-type^ (list))}) +(syntax: #export (type {type (..generic_type^ (list))}) (wrap (list (class->type #ManualPrM (list) type)))) diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux index b8a6b1ec8..45d29b66d 100644 --- a/stdlib/source/lux/locale.lux +++ b/stdlib/source/lux/locale.lux @@ -17,17 +17,17 @@ (abstract: #export Locale Text - (def: territory-separator "_") - (def: encoding-separator ".") + (def: territory_separator "_") + (def: encoding_separator ".") (def: #export (locale language territory encoding) (-> Language (Maybe Territory) (Maybe Encoding) Locale) (:abstraction (format (language.code language) (|> territory - (maybe\map (|>> territory.long-code (format ..territory-separator))) + (maybe\map (|>> territory.long_code (format ..territory_separator))) (maybe.default "")) (|> encoding - (maybe\map (|>> encoding.name (format ..encoding-separator))) + (maybe\map (|>> encoding.name (format ..encoding_separator))) (maybe.default ""))))) (def: #export code diff --git a/stdlib/source/lux/locale/language.lux b/stdlib/source/lux/locale/language.lux index d26581619..81b9b1ee3 100644 --- a/stdlib/source/lux/locale/language.lux +++ b/stdlib/source/lux/locale/language.lux @@ -39,7 +39,7 @@ ["mis" "uncoded languages" uncoded []] ["mul" "multiple languages" multiple []] ["und" "undetermined" undetermined []] - ["zxx" "no linguistic content; not applicable" not-applicable []] + ["zxx" "no linguistic content; not applicable" not_applicable []] ["aar" "Afar" afar []] ["abk" "Abkhazian" abkhazian []] @@ -47,7 +47,7 @@ ["ach" "Acoli" acoli []] ["ada" "Adangme" adangme []] ["ady" "Adyghe; Adygei" adyghe []] - ["afa" "Afro-Asiatic languages" afro-asiatic []] + ["afa" "Afro-Asiatic languages" afro_asiatic []] ["afh" "Afrihili" afrihili []] ["afr" "Afrikaans" afrikaans []] ["ain" "Ainu" ainu []] @@ -55,13 +55,13 @@ ["akk" "Akkadian" akkadian []] ["ale" "Aleut" aleut []] ["alg" "Algonquian languages" algonquian []] - ["alt" "Southern Altai" southern-altai []] + ["alt" "Southern Altai" southern_altai []] ["amh" "Amharic" amharic []] - ["ang" "Old English (ca.450–1100)" old-english []] + ["ang" "Old English (ca.450–1100)" old_english []] ["anp" "Angika" angika []] ["apa" "Apache languages" apache []] ["ara" "Arabic" arabic []] - ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official-aramaic [[imperial-aramaic]]] + ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official_aramaic [[imperial_aramaic]]] ["arg" "Aragonese" aragonese []] ["arn" "Mapudungun; Mapuche" mapudungun []] ["arp" "Arapaho" arapaho []] @@ -108,8 +108,8 @@ ["byn" "Blin; Bilin" blin [[bilin]]] ["cad" "Caddo" caddo []] - ["cai" "Central American Indian languages" central-american-indian []] - ["car" "Galibi Carib" galibi-carib []] + ["cai" "Central American Indian languages" central_american_indian []] + ["car" "Galibi Carib" galibi_carib []] ["cat" "Catalan; Valencian" catalan [[valencian]]] ["cau" "Caucasian languages" caucasian []] ["ceb" "Cebuano" cebuano []] @@ -125,7 +125,7 @@ ["cho" "Choctaw" choctaw []] ["chp" "Chipewyan; Dene Suline" chipewyan []] ["chr" "Cherokee" cherokee []] - ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church-slavic [[old-slavonic] [church-slavonic] [old-bulgarian] [old-church-slavonic]]] + ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church_slavic [[old_slavonic] [church_slavonic] [old_bulgarian] [old_church_slavonic]]] ["chv" "Chuvash" chuvash []] ["chy" "Cheyenne" cheyenne []] ["cmc" "Chamic languages" chamic []] @@ -133,12 +133,12 @@ ["cop" "Coptic" coptic []] ["cor" "Cornish" cornish []] ["cos" "Corsican" corsican []] - ["cpe" "Creoles and pidgins, English based" creoles-and-pidgins/english []] - ["cpf" "Creoles and pidgins, French-based" creoles-and-pidgins/french []] - ["cpp" "Creoles and pidgins, Portuguese-based" creoles-and-pidgins/portuguese []] + ["cpe" "Creoles and pidgins, English based" creoles_and_pidgins/english []] + ["cpf" "Creoles and pidgins, French-based" creoles_and_pidgins/french []] + ["cpp" "Creoles and pidgins, Portuguese-based" creoles_and_pidgins/portuguese []] ["cre" "Cree" cree []] ["crh" "Crimean Tatar; Crimean Turkish" crimean []] - ["crp" "Creoles and pidgins" creoles-and-pidgins []] + ["crp" "Creoles and pidgins" creoles_and_pidgins []] ["csb" "Kashubian" kashubian []] ["cus" "Cushitic languages" cushitic []] ["cym" "Welsh" welsh []] @@ -146,7 +146,7 @@ ["dak" "Dakota" dakota []] ["dan" "Danish" danish []] ["dar" "Dargwa" dargwa []] - ["day" "Land Dayak languages" land-dayak []] + ["day" "Land Dayak languages" land_dayak []] ["del" "Delaware" delaware []] ["den" "Slave (Athapascan)" slavey []] ["deu" "German" german []] @@ -155,9 +155,9 @@ ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]] ["doi" "Dogri" dogri []] ["dra" "Dravidian languages" dravidian []] - ["dsb" "Lower Sorbian" lower-sorbian []] + ["dsb" "Lower Sorbian" lower_sorbian []] ["dua" "Duala" duala []] - ["dum" "Middle Dutch (ca. 1050–1350)" middle-dutch []] + ["dum" "Middle Dutch (ca. 1050–1350)" middle_dutch []] ["dyu" "Dyula" dyula []] ["dzo" "Dzongkha" dzongkha []] @@ -167,7 +167,7 @@ ["ell" "Modern Greek (1453–)" greek []] ["elx" "Elamite" elamite []] ["eng" "English" english []] - ["enm" "Middle English (1100–1500)" middle-english []] + ["enm" "Middle English (1100–1500)" middle_english []] ["epo" "Esperanto" esperanto []] ["est" "Estonian" estonian []] ["eus" "Basque" basque []] @@ -181,14 +181,14 @@ ["fij" "Fijian" fijian []] ["fil" "Filipino; Pilipino" filipino []] ["fin" "Finnish" finnish []] - ["fiu" "Finno-Ugrian languages" finno-ugrian []] + ["fiu" "Finno-Ugrian languages" finno_ugrian []] ["fon" "Fon" fon []] ["fra" "French" french []] - ["frm" "Middle French (ca. 1400–1600)" middle-french []] - ["fro" "Old French (ca. 842–1400)" old-french []] - ["frr" "Northern Frisian" northern-frisian []] - ["frs" "Eastern Frisian" eastern-frisian []] - ["fry" "Western Frisian" western-frisian []] + ["frm" "Middle French (ca. 1400–1600)" middle_french []] + ["fro" "Old French (ca. 842–1400)" old_french []] + ["frr" "Northern Frisian" northern_frisian []] + ["frs" "Eastern Frisian" eastern_frisian []] + ["fry" "Western Frisian" western_frisian []] ["ful" "Fulah" fulah []] ["fur" "Friulian" friulian []] @@ -202,15 +202,15 @@ ["gle" "Irish" irish []] ["glg" "Galician" galician []] ["glv" "Manx" manx []] - ["gmh" "Middle High German (ca. 1050–1500)" middle-high-german []] - ["goh" "Old High German (ca. 750–1050)" old-high-german []] + ["gmh" "Middle High German (ca. 1050–1500)" middle_high_german []] + ["goh" "Old High German (ca. 750–1050)" old_high_german []] ["gon" "Gondi" gondi []] ["gor" "Gorontalo" gorontalo []] ["got" "Gothic" gothic []] ["grb" "Grebo" grebo []] - ["grc" "Ancient Greek (to 1453)" ancient-greek []] + ["grc" "Ancient Greek (to 1453)" ancient_greek []] ["grn" "Guarani" guarani []] - ["gsw" "Swiss German; Alemannic; Alsatian" swiss-german [[alemannic] [alsatian]]] + ["gsw" "Swiss German; Alemannic; Alsatian" swiss_german [[alemannic] [alsatian]]] ["guj" "Gujarati" gujarati []] ["gwi" "Gwich'in" gwich'in []] @@ -225,9 +225,9 @@ ["hin" "Hindi" hindi []] ["hit" "Hittite" hittite []] ["hmn" "Hmong; Mong" hmong []] - ["hmo" "Hiri Motu" hiri-motu []] + ["hmo" "Hiri Motu" hiri_motu []] ["hrv" "Croatian" croatian []] - ["hsb" "Upper Sorbian" upper-sorbian []] + ["hsb" "Upper Sorbian" upper_sorbian []] ["hun" "Hungarian" hungarian []] ["hup" "Hupa" hupa []] ["hye" "Armenian" armenian []] @@ -235,7 +235,7 @@ ["iba" "Iban" iban []] ["ibo" "Igbo" igbo []] ["ido" "Ido" ido []] - ["iii" "Sichuan Yi; Nuosu" sichuan-yi [[nuosu]]] + ["iii" "Sichuan Yi; Nuosu" sichuan_yi [[nuosu]]] ["ijo" "Ijo languages" ijo []] ["iku" "Inuktitut" inuktitut []] ["ile" "Interlingue; Occidental" interlingue []] @@ -243,7 +243,7 @@ ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []] ["inc" "Indic languages" indic []] ["ind" "Indonesian" indonesian []] - ["ine" "Indo-European languages" indo-european []] + ["ine" "Indo-European languages" indo_european []] ["inh" "Ingush" ingush []] ["ipk" "Inupiaq" inupiaq []] ["ira" "Iranian languages" iranian []] @@ -254,10 +254,10 @@ ["jav" "Javanese" javanese []] ["jbo" "Lojban" lojban []] ["jpn" "Japanese" japanese []] - ["jpr" "Judeo-Persian" judeo-persian []] - ["jrb" "Judeo-Arabic" judeo-arabic []] + ["jpr" "Judeo-Persian" judeo_persian []] + ["jrb" "Judeo-Arabic" judeo_arabic []] - ["kaa" "Kara-Kalpak" kara-kalpak []] + ["kaa" "Kara-Kalpak" kara_kalpak []] ["kab" "Kabyle" kabyle []] ["kac" "Kachin; Jingpho" kachin [[jingpho]]] ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]] @@ -272,7 +272,7 @@ ["kbd" "Kabardian" kabardian []] ["kha" "Khasi" khasi []] ["khi" "Khoisan languages" khoisan []] - ["khm" "Central Khmer" central-khmer []] + ["khm" "Central Khmer" central_khmer []] ["kho" "Khotanese; Sakan" khotanese [[sakan]]] ["kik" "Kikuyu; Gikuyu" gikuyu []] ["kin" "Kinyarwanda" kinyarwanda []] @@ -284,7 +284,7 @@ ["kor" "Korean" korean []] ["kos" "Kosraean" kosraean []] ["kpe" "Kpelle" kpelle []] - ["krc" "Karachay-Balkar" karachay-balkar []] + ["krc" "Karachay-Balkar" karachay_balkar []] ["krl" "Karelian" karelian []] ["kro" "Kru languages" kru []] ["kru" "Kurukh" kurukh []] @@ -306,8 +306,8 @@ ["lol" "Mongo" mongo []] ["loz" "Lozi" lozi []] ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []] - ["lua" "Luba-Lulua" luba-lulua []] - ["lub" "Luba-Katanga" luba-katanga []] + ["lua" "Luba-Lulua" luba_lulua []] + ["lub" "Luba-Katanga" luba_katanga []] ["lug" "Ganda" ganda []] ["lui" "Luiseno" luiseno []] ["lun" "Lunda" lunda []] @@ -327,11 +327,11 @@ ["mdf" "Moksha" moksha []] ["mdr" "Mandar" mandar []] ["men" "Mende" mende []] - ["mga" "Middle Irish (900–1200)" middle-irish []] + ["mga" "Middle Irish (900–1200)" middle_irish []] ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]] ["min" "Minangkabau" minangkabau []] ["mkd" "Macedonian" macedonian []] - ["mkh" "Mon-Khmer languages" mon-khmer []] + ["mkh" "Mon-Khmer languages" mon_khmer []] ["mlg" "Malagasy" malagasy []] ["mlt" "Maltese" maltese []] ["mnc" "Manchu" manchu []] @@ -351,29 +351,29 @@ ["myv" "Erzya" erzya []] ["nah" "Nahuatl languages" nahuatl []] - ["nai" "North American Indian languages" north-american-indian []] + ["nai" "North American Indian languages" north_american_indian []] ["nap" "Neapolitan" neapolitan []] ["nau" "Nauru" nauru []] ["nav" "Navajo; Navaho" navajo []] - ["nbl" "South Ndebele" south-ndebele []] - ["nde" "North Ndebele" north-ndebele []] + ["nbl" "South Ndebele" south_ndebele []] + ["nde" "North Ndebele" north_ndebele []] ["ndo" "Ndonga" ndonga []] - ["nds" "Low German; Low Saxon" low-german []] + ["nds" "Low German; Low Saxon" low_german []] ["nep" "Nepali" nepali []] - ["new" "Nepal Bhasa; Newari" newari [[nepal-bhasa]]] + ["new" "Nepal Bhasa; Newari" newari [[nepal_bhasa]]] ["nia" "Nias" nias []] - ["nic" "Niger-Kordofanian languages" niger-kordofanian []] + ["nic" "Niger-Kordofanian languages" niger_kordofanian []] ["niu" "Niuean" niuean []] ["nld" "Dutch; Flemish" dutch [[flemish]]] ["nno" "Norwegian Nynorsk" nynorsk []] ["nob" "Norwegian Bokmål" bokmal []] ["nog" "Nogai" nogai []] - ["non" "Old Norse" old-norse []] + ["non" "Old Norse" old_norse []] ["nor" "Norwegian" norwegian []] ["nqo" "N'Ko" n'ko []] - ["nso" "Pedi; Sepedi; Northern Sotho" northern-sotho [[pedi] [sepedi]]] + ["nso" "Pedi; Sepedi; Northern Sotho" northern_sotho [[pedi] [sepedi]]] ["nub" "Nubian languages" nubian []] - ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old-newari [[classical-newari] [classical-nepal-bhasa]]] + ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old_newari [[classical_newari] [classical_nepal_bhasa]]] ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]] ["nym" "Nyamwezi" nyamwezi []] ["nyn" "Nyankole" nyankole []] @@ -386,7 +386,7 @@ ["orm" "Oromo" oromo []] ["osa" "Osage" osage []] ["oss" "Ossetian; Ossetic" ossetic []] - ["ota" "Ottoman Turkish (1500–1928)" ottoman-turkish []] + ["ota" "Ottoman Turkish (1500–1928)" ottoman_turkish []] ["oto" "Otomian languages" otomian []] ["paa" "Papuan languages" papuan []] @@ -396,7 +396,7 @@ ["pan" "Panjabi; Punjabi" punjabi []] ["pap" "Papiamento" papiamento []] ["pau" "Palauan" palauan []] - ["peo" "Old Persian (ca. 600–400 B.C.)" old-persian []] + ["peo" "Old Persian (ca. 600–400 B.C.)" old_persian []] ["phi" "Philippine languages" philippine []] ["phn" "Phoenician" phoenician []] ["pli" "Pali" pali []] @@ -404,28 +404,28 @@ ["pon" "Pohnpeian" pohnpeian []] ["por" "Portuguese" portuguese []] ["pra" "Prakrit languages" prakrit []] - ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old-provencal []] + ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old_provencal []] ["pus" "Pushto; Pashto" pashto []] ["que" "Quechua" quechua []] ["raj" "Rajasthani" rajasthani []] ["rap" "Rapanui" rapanui []] - ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook-islands-maori]]] + ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook_islands_maori]]] ["roa" "Romance languages" romance []] ["roh" "Romansh" romansh []] ["rom" "Romany" romany []] ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]] ["run" "Rundi" rundi []] - ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo-romanian]]] + ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo_romanian]]] ["rus" "Russian" russian []] ["sad" "Sandawe" sandawe []] ["sag" "Sango" sango []] ["sah" "Yakut" yakut []] - ["sai" "South American Indian (Other)" south-american-indian []] + ["sai" "South American Indian (Other)" south_american_indian []] ["sal" "Salishan languages" salishan []] - ["sam" "Samaritan Aramaic" samaritan-aramaic []] + ["sam" "Samaritan Aramaic" samaritan_aramaic []] ["san" "Sanskrit" sanskrit []] ["sas" "Sasak" sasak []] ["sat" "Santali" santali []] @@ -433,37 +433,37 @@ ["sco" "Scots" scots []] ["sel" "Selkup" selkup []] ["sem" "Semitic languages" semitic []] - ["sga" "Old Irish (to 900)" old-irish []] + ["sga" "Old Irish (to 900)" old_irish []] ["sgn" "Sign Languages" sign []] ["shn" "Shan" shan []] ["sid" "Sidamo" sidamo []] ["sin" "Sinhala; Sinhalese" sinhalese []] ["sio" "Siouan languages" siouan []] - ["sit" "Sino-Tibetan languages" sino-tibetan []] + ["sit" "Sino-Tibetan languages" sino_tibetan []] ["sla" "Slavic languages" slavic []] ["slk" "Slovak" slovak []] ["slv" "Slovenian" slovenian []] - ["sma" "Southern Sami" southern-sami []] - ["sme" "Northern Sami" northern-sami []] + ["sma" "Southern Sami" southern_sami []] + ["sme" "Northern Sami" northern_sami []] ["smi" "Sami languages" sami []] ["smj" "Lule Sami" lule []] ["smn" "Inari Sami" inari []] ["smo" "Samoan" samoan []] - ["sms" "Skolt Sami" skolt-sami []] + ["sms" "Skolt Sami" skolt_sami []] ["sna" "Shona" shona []] ["snd" "Sindhi" sindhi []] ["snk" "Soninke" soninke []] ["sog" "Sogdian" sogdian []] ["som" "Somali" somali []] ["son" "Songhai languages" songhai []] - ["sot" "Southern Sotho" southern-sotho []] + ["sot" "Southern Sotho" southern_sotho []] ["spa" "Spanish; Castilian" spanish [[castilian]]] ["sqi" "Albanian" albanian []] ["srd" "Sardinian" sardinian []] - ["srn" "Sranan Tongo" sranan-tongo []] + ["srn" "Sranan Tongo" sranan_tongo []] ["srp" "Serbian" serbian []] ["srr" "Serer" serer []] - ["ssa" "Nilo-Saharan languages" nilo-saharan []] + ["ssa" "Nilo-Saharan languages" nilo_saharan []] ["ssw" "Swati" swati []] ["suk" "Sukuma" sukuma []] ["sun" "Sundanese" sundanese []] @@ -471,7 +471,7 @@ ["sux" "Sumerian" sumerian []] ["swa" "Swahili" swahili []] ["swe" "Swedish" swedish []] - ["syc" "Classical Syriac" classical-syriac []] + ["syc" "Classical Syriac" classical_syriac []] ["syr" "Syriac" syriac []] ["tah" "Tahitian" tahitian []] @@ -494,7 +494,7 @@ ["tmh" "Tamashek" tamashek []] ["tog" "Tonga (Nyasa)" tonga []] ["ton" "Tonga (Tonga Islands)" tongan []] - ["tpi" "Tok Pisin" tok-pisin []] + ["tpi" "Tok Pisin" tok_pisin []] ["tsi" "Tsimshian" tsimshian []] ["tsn" "Tswana" tswana []] ["tso" "Tsonga" tsonga []] @@ -541,7 +541,7 @@ ["zap" "Zapotec" zapotec []] ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []] ["zen" "Zenaga" zenaga []] - ["zgh" "Standard Moroccan Tamazight" standard-moroccan-tamazight []] + ["zgh" "Standard Moroccan Tamazight" standard_moroccan_tamazight []] ["zha" "Zhuang; Chuang" zhuang []] ["zho" "Chinese" chinese []] ["znd" "Zande languages" zande []] diff --git a/stdlib/source/lux/locale/territory.lux b/stdlib/source/lux/locale/territory.lux index 76ecdf965..134856659 100644 --- a/stdlib/source/lux/locale/territory.lux +++ b/stdlib/source/lux/locale/territory.lux @@ -24,9 +24,9 @@ (get@ <field>)))] [name #name Text] - [short-code #short Text] - [long-code #long Text] - [numeric-code #code Nat] + [short_code #short Text] + [long_code #long Text] + [numeric_code #code Nat] ) (template [<short> <long> <number> <name> <main> <neighbor>+] @@ -43,10 +43,10 @@ (~~ (template.splice <neighbor>+))))] ["AF" "AFG" 004 "Afghanistan" afghanistan []] - ["AX" "ALA" 248 "Åland Islands" aland-islands []] + ["AX" "ALA" 248 "Åland Islands" aland_islands []] ["AL" "ALB" 008 "Albania" albania []] ["DZ" "DZA" 012 "Algeria" algeria []] - ["AS" "ASM" 016 "American Samoa" american-samoa []] + ["AS" "ASM" 016 "American Samoa" american_samoa []] ["AD" "AND" 020 "Andorra" andorra []] ["AO" "AGO" 024 "Angola" angola []] ["AI" "AIA" 660 "Anguilla" anguilla []] @@ -58,7 +58,7 @@ ["AU" "AUS" 036 "Australia" australia []] ["AT" "AUT" 040 "Austria" austria []] ["AZ" "AZE" 031 "Azerbaijan" azerbaijan []] - ["BS" "BHS" 044 "The Bahamas" the-bahamas []] + ["BS" "BHS" 044 "The Bahamas" the_bahamas []] ["BH" "BHR" 048 "Bahrain" bahrain []] ["BD" "BGD" 050 "Bangladesh" bangladesh []] ["BB" "BRB" 052 "Barbados" barbados []] @@ -69,61 +69,61 @@ ["BM" "BMU" 060 "Bermuda" bermuda []] ["BT" "BTN" 064 "Bhutan" bhutan []] ["BO" "BOL" 068 "Bolivia" bolivia []] - ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint-eustatius] [saba]]] + ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint_eustatius] [saba]]] ["BA" "BIH" 070 "Bosnia and Herzegovina" bosnia [[herzegovina]]] ["BW" "BWA" 072 "Botswana" botswana []] - ["BV" "BVT" 074 "Bouvet Island" bouvet-island []] + ["BV" "BVT" 074 "Bouvet Island" bouvet_island []] ["BR" "BRA" 076 "Brazil" brazil []] - ["IO" "IOT" 086 "British Indian Ocean Territory" british-indian-ocean-territory []] - ["BN" "BRN" 096 "Brunei Darussalam" brunei-darussalam []] + ["IO" "IOT" 086 "British Indian Ocean Territory" british_indian_ocean_territory []] + ["BN" "BRN" 096 "Brunei Darussalam" brunei_darussalam []] ["BG" "BGR" 100 "Bulgaria" bulgaria []] - ["BF" "BFA" 854 "Burkina Faso" burkina-faso []] + ["BF" "BFA" 854 "Burkina Faso" burkina_faso []] ["BI" "BDI" 108 "Burundi" burundi []] - ["CV" "CPV" 132 "Cape Verde" cape-verde []] + ["CV" "CPV" 132 "Cape Verde" cape_verde []] ["KH" "KHM" 116 "Cambodia" cambodia []] ["CM" "CMR" 120 "Cameroon" cameroon []] ["CA" "CAN" 124 "Canada" canada []] - ["KY" "CYM" 136 "Cayman Islands" cayman-islands []] - ["CF" "CAF" 140 "Central African Republic" central-african-republic []] + ["KY" "CYM" 136 "Cayman Islands" cayman_islands []] + ["CF" "CAF" 140 "Central African Republic" central_african_republic []] ["TD" "TCD" 148 "Chad" chad []] ["CL" "CHL" 152 "Chile" chile []] ["CN" "CHN" 156 "China" china []] - ["CX" "CXR" 162 "Christmas Island" christmas-island []] - ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos-islands []] + ["CX" "CXR" 162 "Christmas Island" christmas_island []] + ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos_islands []] ["CO" "COL" 170 "Colombia" colombia []] ["KM" "COM" 174 "Comoros" comoros []] ["CG" "COG" 178 "Congo" congo []] - ["CD" "COD" 180 "Democratic Republic of the Congo" democratic-republic-of-the-congo []] - ["CK" "COK" 184 "Cook Islands" cook-islands []] - ["CR" "CRI" 188 "Costa Rica" costa-rica []] - ["CI" "CIV" 384 "Ivory Coast" ivory-coast []] + ["CD" "COD" 180 "Democratic Republic of the Congo" democratic_republic_of_the_congo []] + ["CK" "COK" 184 "Cook Islands" cook_islands []] + ["CR" "CRI" 188 "Costa Rica" costa_rica []] + ["CI" "CIV" 384 "Ivory Coast" ivory_coast []] ["HR" "HRV" 191 "Croatia" croatia []] ["CU" "CUB" 192 "Cuba" cuba []] ["CW" "CUW" 531 "Curacao" curacao []] ["CY" "CYP" 196 "Cyprus" cyprus []] - ["CZ" "CZE" 203 "Czech Republic" czech-republic []] + ["CZ" "CZE" 203 "Czech Republic" czech_republic []] ["DK" "DNK" 208 "Denmark" denmark []] ["DJ" "DJI" 262 "Djibouti" djibouti []] ["DM" "DMA" 212 "Dominica" dominica []] - ["DO" "DOM" 214 "Dominican Republic" dominican-republic []] + ["DO" "DOM" 214 "Dominican Republic" dominican_republic []] ["EC" "ECU" 218 "Ecuador" ecuador []] ["EG" "EGY" 818 "Egypt" egypt []] - ["SV" "SLV" 222 "El Salvador" el-salvador []] - ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial-guinea []] + ["SV" "SLV" 222 "El Salvador" el_salvador []] + ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial_guinea []] ["ER" "ERI" 232 "Eritrea" eritrea []] ["EE" "EST" 233 "Estonia" estonia []] ["SZ" "SWZ" 748 "Eswatini" eswatini []] ["ET" "ETH" 231 "Ethiopia" ethiopia []] - ["FK" "FLK" 238 "Falkland Islands" falkland-islands []] - ["FO" "FRO" 234 "Faroe Islands" faroe-islands []] + ["FK" "FLK" 238 "Falkland Islands" falkland_islands []] + ["FO" "FRO" 234 "Faroe Islands" faroe_islands []] ["FJ" "FJI" 242 "Fiji" fiji []] ["FI" "FIN" 246 "Finland" finland []] ["FR" "FRA" 250 "France" france []] - ["GF" "GUF" 254 "French Guiana" french-guiana []] - ["PF" "PYF" 258 "French Polynesia" french-polynesia []] - ["TF" "ATF" 260 "French Southern Territories" french-southern-territories []] + ["GF" "GUF" 254 "French Guiana" french_guiana []] + ["PF" "PYF" 258 "French Polynesia" french_polynesia []] + ["TF" "ATF" 260 "French Southern Territories" french_southern_territories []] ["GA" "GAB" 266 "Gabon" gabon []] - ["GM" "GMB" 270 "The Gambia" the-gambia []] + ["GM" "GMB" 270 "The Gambia" the_gambia []] ["GE" "GEO" 268 "Georgia" georgia []] ["DE" "DEU" 276 "Germany" germany []] ["GH" "GHA" 288 "Ghana" ghana []] @@ -136,13 +136,13 @@ ["GT" "GTM" 320 "Guatemala" guatemala []] ["GG" "GGY" 831 "Guernsey" guernsey []] ["GN" "GIN" 324 "Guinea" guinea []] - ["GW" "GNB" 624 "Guinea-Bissau" guinea-bissau []] + ["GW" "GNB" 624 "Guinea-Bissau" guinea_bissau []] ["GY" "GUY" 328 "Guyana" guyana []] ["HT" "HTI" 332 "Haiti" haiti []] - ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard-island [[mcdonald-islands]]] - ["VA" "VAT" 336 "Vatican City" vatican-city []] + ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard_island [[mcdonald_islands]]] + ["VA" "VAT" 336 "Vatican City" vatican_city []] ["HN" "HND" 340 "Honduras" honduras []] - ["HK" "HKG" 344 "Hong Kong" hong-kong []] + ["HK" "HKG" 344 "Hong Kong" hong_kong []] ["HU" "HUN" 348 "Hungary" hungary []] ["IS" "ISL" 352 "Iceland" iceland []] ["IN" "IND" 356 "India" india []] @@ -150,7 +150,7 @@ ["IR" "IRN" 364 "Iran" iran []] ["IQ" "IRQ" 368 "Iraq" iraq []] ["IE" "IRL" 372 "Ireland" ireland []] - ["IM" "IMN" 833 "Isle of Man" isle-of-man []] + ["IM" "IMN" 833 "Isle of Man" isle_of_man []] ["IL" "ISR" 376 "Israel" israel []] ["IT" "ITA" 380 "Italy" italy []] ["JM" "JAM" 388 "Jamaica" jamaica []] @@ -160,8 +160,8 @@ ["KZ" "KAZ" 398 "Kazakhstan" kazakhstan []] ["KE" "KEN" 404 "Kenya" kenya []] ["KI" "KIR" 296 "Kiribati" kiribati []] - ["KP" "PRK" 408 "North Korea" north-korea []] - ["KR" "KOR" 410 "South Korea" south-korea []] + ["KP" "PRK" 408 "North Korea" north_korea []] + ["KR" "KOR" 410 "South Korea" south_korea []] ["KW" "KWT" 414 "Kuwait" kuwait []] ["KG" "KGZ" 417 "Kyrgyzstan" kyrgyzstan []] ["LA" "LAO" 418 "Laos" laos []] @@ -181,7 +181,7 @@ ["MV" "MDV" 462 "Maldives" maldives []] ["ML" "MLI" 466 "Mali" mali []] ["MT" "MLT" 470 "Malta" malta []] - ["MH" "MHL" 584 "Marshall Islands" marshall-islands []] + ["MH" "MHL" 584 "Marshall Islands" marshall_islands []] ["MQ" "MTQ" 474 "Martinique" martinique []] ["MR" "MRT" 478 "Mauritania" mauritania []] ["MU" "MUS" 480 "Mauritius" mauritius []] @@ -200,62 +200,62 @@ ["NR" "NRU" 520 "Nauru" nauru []] ["NP" "NPL" 524 "Nepal" nepal []] ["NL" "NLD" 528 "Netherlands" netherlands []] - ["NC" "NCL" 540 "New Caledonia" new-caledonia []] - ["NZ" "NZL" 554 "New Zealand" new-zealand []] + ["NC" "NCL" 540 "New Caledonia" new_caledonia []] + ["NZ" "NZL" 554 "New Zealand" new_zealand []] ["NI" "NIC" 558 "Nicaragua" nicaragua []] ["NE" "NER" 562 "Niger" niger []] ["NG" "NGA" 566 "Nigeria" nigeria []] ["NU" "NIU" 570 "Niue" niue []] - ["NF" "NFK" 574 "Norfolk Island" norfolk-island []] - ["MP" "MNP" 580 "Northern Mariana Islands" northern-mariana-islands []] + ["NF" "NFK" 574 "Norfolk Island" norfolk_island []] + ["MP" "MNP" 580 "Northern Mariana Islands" northern_mariana_islands []] ["NO" "NOR" 578 "Norway" norway []] ["OM" "OMN" 512 "Oman" oman []] ["PK" "PAK" 586 "Pakistan" pakistan []] ["PW" "PLW" 585 "Palau" palau []] ["PS" "PSE" 275 "Palestine" palestine []] ["PA" "PAN" 591 "Panama" panama []] - ["PG" "PNG" 598 "Papua New Guinea" papua-new-guinea []] + ["PG" "PNG" 598 "Papua New Guinea" papua_new_guinea []] ["PY" "PRY" 600 "Paraguay" paraguay []] ["PE" "PER" 604 "Peru" peru []] ["PH" "PHL" 608 "Philippines" philippines []] - ["PN" "PCN" 612 "Pitcairn Islands" pitcairn-islands []] + ["PN" "PCN" 612 "Pitcairn Islands" pitcairn_islands []] ["PL" "POL" 616 "Poland" poland []] ["PT" "PRT" 620 "Portugal" portugal []] - ["PR" "PRI" 630 "Puerto Rico" puerto-rico []] + ["PR" "PRI" 630 "Puerto Rico" puerto_rico []] ["QA" "QAT" 634 "Qatar" qatar []] ["RE" "REU" 638 "Reunion" reunion []] ["RO" "ROU" 642 "Romania" romania []] ["RU" "RUS" 643 "Russia" russia []] ["RW" "RWA" 646 "Rwanda" rwanda []] - ["BL" "BLM" 652 "Saint Barthélemy" saint-barthelemy []] - ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint-helena [[ascension] [tristan-da-cunha]]] - ["KN" "KNA" 659 "Saint Kitts and Nevis" saint-kitts [[nevis]]] - ["LC" "LCA" 662 "Saint Lucia" saint-lucia []] - ["MF" "MAF" 663 "Saint Martin" saint-martin []] - ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint-pierre [[miquelon]]] - ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint-vincent [[the-grenadines]]] + ["BL" "BLM" 652 "Saint Barthélemy" saint_barthelemy []] + ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint_helena [[ascension] [tristan_da_cunha]]] + ["KN" "KNA" 659 "Saint Kitts and Nevis" saint_kitts [[nevis]]] + ["LC" "LCA" 662 "Saint Lucia" saint_lucia []] + ["MF" "MAF" 663 "Saint Martin" saint_martin []] + ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint_pierre [[miquelon]]] + ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint_vincent [[the_grenadines]]] ["WS" "WSM" 882 "Samoa" samoa []] - ["SM" "SMR" 674 "San Marino" san-marino []] - ["ST" "STP" 678 "Sao Tome and Principe" sao-tome [[principe]]] - ["SA" "SAU" 682 "Saudi Arabia" saudi-arabia []] + ["SM" "SMR" 674 "San Marino" san_marino []] + ["ST" "STP" 678 "Sao Tome and Principe" sao_tome [[principe]]] + ["SA" "SAU" 682 "Saudi Arabia" saudi_arabia []] ["SN" "SEN" 686 "Senegal" senegal []] ["RS" "SRB" 688 "Serbia" serbia []] ["SC" "SYC" 690 "Seychelles" seychelles []] - ["SL" "SLE" 694 "Sierra Leone" sierra-leone []] + ["SL" "SLE" 694 "Sierra Leone" sierra_leone []] ["SG" "SGP" 702 "Singapore" singapore []] - ["SX" "SXM" 534 "Sint Maarten" sint-maarten []] + ["SX" "SXM" 534 "Sint Maarten" sint_maarten []] ["SK" "SVK" 703 "Slovakia" slovakia []] ["SI" "SVN" 705 "Slovenia" slovenia []] - ["SB" "SLB" 090 "Solomon Islands" solomon-islands []] + ["SB" "SLB" 090 "Solomon Islands" solomon_islands []] ["SO" "SOM" 706 "Somalia" somalia []] - ["ZA" "ZAF" 710 "South Africa" south-africa []] - ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south-georgia [[south-sandwich-islands]]] - ["SS" "SSD" 728 "South Sudan" south-sudan []] + ["ZA" "ZAF" 710 "South Africa" south_africa []] + ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south_georgia [[south_sandwich_islands]]] + ["SS" "SSD" 728 "South Sudan" south_sudan []] ["ES" "ESP" 724 "Spain" spain []] - ["LK" "LKA" 144 "Sri Lanka" sri-lanka []] + ["LK" "LKA" 144 "Sri Lanka" sri_lanka []] ["SD" "SDN" 729 "Sudan" sudan []] ["SR" "SUR" 740 "Suriname" suriname []] - ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan-mayen]]] + ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan_mayen]]] ["SE" "SWE" 752 "Sweden" sweden []] ["CH" "CHE" 756 "Switzerland" switzerland []] ["SY" "SYR" 760 "Syria" syria []] @@ -263,7 +263,7 @@ ["TJ" "TJK" 762 "Tajikistan" tajikistan []] ["TZ" "TZA" 834 "Tanzania" tanzania []] ["TH" "THA" 764 "Thailand" thailand []] - ["TL" "TLS" 626 "East Timor" east-timor []] + ["TL" "TLS" 626 "East Timor" east_timor []] ["TG" "TGO" 768 "Togo" togo []] ["TK" "TKL" 772 "Tokelau" tokelau []] ["TO" "TON" 776 "Tonga" tonga []] @@ -271,23 +271,23 @@ ["TN" "TUN" 788 "Tunisia" tunisia []] ["TR" "TUR" 792 "Turkey" turkey []] ["TM" "TKM" 795 "Turkmenistan" turkmenistan []] - ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos-islands]]] + ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos_islands]]] ["TV" "TUV" 798 "Tuvalu" tuvalu []] ["UG" "UGA" 800 "Uganda" uganda []] ["UA" "UKR" 804 "Ukraine" ukraine []] - ["AE" "ARE" 784 "United Arab Emirates" united-arab-emirates []] - ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united-kingdom [[northern-ireland]]] - ["US" "USA" 840 "United States of America" united-states-of-america []] - ["UM" "UMI" 581 "United States Minor Outlying Islands" united-states-minor-outlying-islands []] + ["AE" "ARE" 784 "United Arab Emirates" united_arab_emirates []] + ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united_kingdom [[northern_ireland]]] + ["US" "USA" 840 "United States of America" united_states_of_america []] + ["UM" "UMI" 581 "United States Minor Outlying Islands" united_states_minor_outlying_islands []] ["UY" "URY" 858 "Uruguay" uruguay []] ["UZ" "UZB" 860 "Uzbekistan" uzbekistan []] ["VU" "VUT" 548 "Vanuatu" vanuatu []] ["VE" "VEN" 862 "Venezuela" venezuela []] ["VN" "VNM" 704 "Vietnam" vietnam []] - ["VG" "VGB" 092 "British Virgin Islands" british-virgin-islands []] - ["VI" "VIR" 850 "United States Virgin Islands" united-states-virgin-islands []] + ["VG" "VGB" 092 "British Virgin Islands" british_virgin_islands []] + ["VI" "VIR" 850 "United States Virgin Islands" united_states_virgin_islands []] ["WF" "WLF" 876 "Wallis and Futuna" wallis [[futuna]]] - ["EH" "ESH" 732 "Western Sahara" western-sahara []] + ["EH" "ESH" 732 "Western Sahara" western_sahara []] ["YE" "YEM" 887 "Yemen" yemen []] ["ZM" "ZMB" 894 "Zambia" zambia []] ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index f6fa8d331..f20bc1eab 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -57,8 +57,8 @@ (-> Text Code) [location.dummy (<tag> ["" name])])] - [local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."] - [local-tag #.Tag "Produces a local tag (a tag with no module prefix)."]) + [local_identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."] + [local_tag #.Tag "Produces a local tag (a tag with no module prefix)."]) (structure: #export equivalence (Equivalence Code) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 84d4e8873..1475bf2b4 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -15,7 +15,7 @@ [collection ["." list ("#\." fold functor)] ["." dictionary]]] - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [macro ["." code] [syntax (#+ syntax:) @@ -26,13 +26,13 @@ ["." type]]) (syntax: #export (poly: {export |export|.parser} - {name s.local-identifier} + {name s.local_identifier} body) - (with-gensyms [g!_ g!type g!output] + (with_gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] (wrap (.list (` ((~! syntax:) (~+ (|export|.write export)) ((~ g!name) {(~ g!type) (~! s.identifier)}) ((~! do) (~! meta.monad) - [(~ g!type) ((~! meta.find-type-def) (~ g!type))] + [(~ g!type) ((~! meta.find_type_def) (~ g!type))] (case (: (.Either .Text .Code) ((~! <type>.run) ((~! p.rec) (function ((~ g!_) (~ g!name)) @@ -44,50 +44,50 @@ (#.Right (~ g!output)) ((~' wrap) (.list (~ g!output)))))))))))) -(def: (common-poly-name? poly-func) +(def: (common_poly_name? poly_func) (-> Text Bit) - (text.contains? "?" poly-func)) + (text.contains? "?" poly_func)) -(def: (derivation-name poly args) +(def: (derivation_name poly args) (-> Text (List Text) (Maybe Text)) - (if (common-poly-name? poly) - (#.Some (list\fold (text.replace-once "?") poly args)) + (if (common_poly_name? poly) + (#.Some (list\fold (text.replace_once "?") poly args)) #.None)) (syntax: #export (derived: {export |export|.parser} - {?name (p.maybe s.local-identifier)} - {[poly-func poly-args] (s.form (p.and s.identifier (p.many s.identifier)))} - {?custom-impl (p.maybe s.any)}) + {?name (p.maybe s.local_identifier)} + {[poly_func poly_args] (s.form (p.and s.identifier (p.many s.identifier)))} + {?custom_impl (p.maybe s.any)}) (do {! meta.monad} - [poly-args (monad.map ! meta.normalize poly-args) + [poly_args (monad.map ! meta.normalize poly_args) name (case ?name (#.Some name) (wrap name) (^multi #.None - [(derivation-name (product.right poly-func) (list\map product.right poly-args)) - (#.Some derived-name)]) - (wrap derived-name) + [(derivation_name (product.right poly_func) (list\map product.right poly_args)) + (#.Some derived_name)]) + (wrap derived_name) _ (p.fail "derived: was given no explicit name, and cannot generate one from given information.")) - #let [impl (case ?custom-impl - (#.Some custom-impl) - custom-impl + #let [impl (case ?custom_impl + (#.Some custom_impl) + custom_impl #.None - (` ((~ (code.identifier poly-func)) (~+ (list\map code.identifier poly-args)))))]] + (` ((~ (code.identifier poly_func)) (~+ (list\map code.identifier poly_args)))))]] (wrap (.list (` (def: (~+ (|export|.write export)) (~ (code.identifier ["" name])) {#.struct? #1} (~ impl))))))) -(def: #export (to-code env type) +(def: #export (to_code env type) (-> Env Type Code) (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (list (~+ (list\map (to-code env) params))))) + (list (~+ (list\map (to_code env) params))))) (^template [<tag>] [(<tag> idx) @@ -95,35 +95,35 @@ ([#.Var] [#.Ex]) (#.Parameter idx) - (let [idx (<type>.adjusted-idx env idx)] + (let [idx (<type>.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.get idx env) maybe.assume product.left (to-code env)) + (|> (dictionary.get idx env) maybe.assume product.left (to_code env)) (` (.$ (~ (code.nat (dec idx))))))) (#.Apply (#.Named ["lux" "Nothing"] _) (#.Parameter idx)) - (let [idx (<type>.adjusted-idx env idx)] + (let [idx (<type>.adjusted_idx env idx)] (if (n.= 0 idx) - (|> (dictionary.get idx env) maybe.assume product.left (to-code env)) + (|> (dictionary.get idx env) maybe.assume product.left (to_code env)) (undefined))) (^template [<tag>] [(<tag> left right) - (` (<tag> (~ (to-code env left)) - (~ (to-code env right))))]) + (` (<tag> (~ (to_code env left)) + (~ (to_code env right))))]) ([#.Function] [#.Apply]) (^template [<macro> <tag> <flattener>] [(<tag> left right) - (` (<macro> (~+ (list\map (to-code env) (<flattener> type)))))]) - ([| #.Sum type.flatten-variant] - [& #.Product type.flatten-tuple]) + (` (<macro> (~+ (list\map (to_code env) (<flattener> type)))))]) + ([| #.Sum type.flatten_variant] + [& #.Product type.flatten_tuple]) - (#.Named name sub-type) + (#.Named name sub_type) (code.identifier name) (^template [<tag>] [(<tag> scope body) - (` (<tag> (list (~+ (list\map (to-code env) scope))) - (~ (to-code env body))))]) + (` (<tag> (list (~+ (list\map (to_code env) scope))) + (~ (to_code env body))))]) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 3c11a2a43..d5506100c 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -16,11 +16,11 @@ ["." frac]] [collection ["." list ("#\." functor)]]] - ["." meta (#+ with-gensyms)]] + ["." meta (#+ with_gensyms)]] [// ["." code]]) -(def: (self-documenting binding parser) +(def: (self_documenting binding parser) (All [a] (-> Code (Parser a) (Parser a))) (function (_ tokens) (case (parser tokens) @@ -29,32 +29,32 @@ (#try.Failure error) (#try.Failure ($_ text\compose - "Failed to parse: " (code.format binding) text.new-line + "Failed to parse: " (code.format binding) text.new_line error))))) -(def: (join-pairs pairs) +(def: (join_pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs #.Nil #.Nil - (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) + (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) (macro: #export (syntax: tokens) {#.doc (doc "A more advanced way to define macros than 'macro:'." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Meta monad, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." - (syntax: #export (object {#let [imports (class-imports *compiler*)]} - {#let [class-vars (list)]} - {super (opt (super-class-decl^ imports class-vars))} - {interfaces (tuple (some (super-class-decl^ imports class-vars)))} - {constructor-args (constructor-args^ imports class-vars)} - {methods (some (overriden-method-def^ imports))}) - (let [def-code ($_ text\compose "anon-class:" - (spaced (list (super-class-decl$ (maybe.default object-super-class super)) - (with-brackets (spaced (list\map super-class-decl$ interfaces))) - (with-brackets (spaced (list\map constructor-arg$ constructor-args))) - (with-brackets (spaced (list\map (method-def$ id) methods))))))] - (wrap (list (` ((~ (code.text def-code)))))))))} + (syntax: #export (object {#let [imports (class_imports *compiler*)]} + {#let [class_vars (list)]} + {super (opt (super_class_decl^ imports class_vars))} + {interfaces (tuple (some (super_class_decl^ imports class_vars)))} + {constructor_args (constructor_args^ imports class_vars)} + {methods (some (overriden_method_def^ imports))}) + (let [def_code ($_ text\compose "anon-class:" + (spaced (list (super_class_decl$ (maybe.default object_super_class super)) + (with_brackets (spaced (list\map super_class_decl$ interfaces))) + (with_brackets (spaced (list\map constructor_arg$ constructor_args))) + (with_brackets (spaced (list\map (method_def$ id) methods))))))] + (wrap (list (` ((~ (code.text def_code)))))))))} (let [[exported? tokens] (: [Bit (List Code)] (case tokens (^ (list& [_ (#.Tag ["" "export"])] tokens')) @@ -69,15 +69,15 @@ (#.Some name args (` {}) body) (^ (list [_ (#.Form (list& [_ (#.Identifier ["" name])] args))] - meta-data + meta_data body)) - (#.Some name args meta-data body) + (#.Some name args meta_data body) _ #.None))] (case ?parts (#.Some [name args meta body]) - (with-gensyms [g!tokens g!body g!error] + (with_gensyms [g!tokens g!body g!error] (do {! meta.monad} [vars+parsers (monad.map ! (: (-> Code (Meta [Code Code])) @@ -90,37 +90,37 @@ _ (wrap [var - (` ((~! ..self-documenting) (' (~ var)) + (` ((~! ..self_documenting) (' (~ var)) (~ parser)))])) - [_ (#.Identifier var-name)] + [_ (#.Identifier var_name)] (wrap [arg - (` ((~! ..self-documenting) (' (~ arg)) + (` ((~! ..self_documenting) (' (~ arg)) (~! </>.any)))]) _ (meta.fail "Syntax pattern expects records or identifiers.")))) args) - this-module meta.current-module-name + this_module meta.current_module_name #let [g!state (code.identifier ["" "*compiler*"]) - error-msg (code.text (meta.wrong-syntax-error [this-module name])) - export-ast (: (List Code) + error_msg (code.text (meta.wrong_syntax_error [this_module name])) + export_ast (: (List Code) (if exported? (list (' #export)) (list)))]] - (wrap (list (` (macro: (~+ export-ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) + (wrap (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) (~ meta) ({(#.Right (~ g!body)) ((~ g!body) (~ g!state)) (#.Left (~ g!error)) - (#.Left ((~! text.join-with) (~! text.new-line) (list (~ error-msg) (~ g!error))))} + (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))} ((~! </>.run) (: ((~! </>.Parser) (Meta (List Code))) ((~! do) (~! <>.monad) - [(~+ (..join-pairs vars+parsers))] + [(~+ (..join_pairs vars+parsers))] ((~' wrap) (~ body)))) (~ g!tokens))))))))) _ - (meta.fail (meta.wrong-syntax-error (name-of ..syntax:)))))) + (meta.fail (meta.wrong_syntax_error (name_of ..syntax:)))))) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index 2a1469c2d..c29361ee4 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -3,19 +3,19 @@ [lux #*]) (type: #export Declaration - {#declaration-name Text - #declaration-args (List Text)}) + {#declaration_name Text + #declaration_args (List Text)}) (type: #export Annotations (List [Name Code])) -(def: #export empty-annotations +(def: #export empty_annotations Annotations (list)) -(type: #export Typed-Input - {#input-binding Code - #input-type Code}) +(type: #export Typed_Input + {#input_binding Code + #input_type Code}) -(type: #export Type-Var +(type: #export Type_Var Text) diff --git a/stdlib/source/lux/macro/syntax/common/definition.lux b/stdlib/source/lux/macro/syntax/common/definition.lux index 851fd29b1..eca7eac02 100644 --- a/stdlib/source/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/lux/macro/syntax/common/definition.lux @@ -47,21 +47,21 @@ (def: extension "lux def") -(def: (write-tag [module short]) +(def: (write_tag [module short]) (-> Name Code) (` [(~ (code.text module)) (~ (code.text short))])) -(def: (write-annotations value) +(def: (write_annotations value) (-> Annotations Code) (case value #.Nil (` #.Nil) (#.Cons [name value] tail) - (` (#.Cons [(~ (..write-tag name)) + (` (#.Cons [(~ (..write_tag name)) (~ value)] - (~ (write-annotations tail)))))) + (~ (write_annotations tail)))))) (def: dummy Code @@ -72,29 +72,29 @@ (def: #export (write (^slots [#name #value #anns #export?])) (-> Definition Code) (` ((~ (code.text ..extension)) - (~ (code.local-identifier name)) + (~ (code.local_identifier name)) (~ (case value (#.Left check) (//check.write check) (#.Right value) value)) - [(~ ..dummy) (#.Record (~ (..write-annotations anns)))] + [(~ ..dummy) (#.Record (~ (..write_annotations anns)))] (~ (code.bit export?))))) -(def: tag-parser +(def: tag_parser (Parser Name) (<code>.tuple (<>.and <code>.text <code>.text))) -(def: annotations-parser +(def: annotations_parser (Parser Annotations) (<>.rec (function (_ recur) ($_ <>.or - (<code>.tag! (name-of #.Nil)) + (<code>.tag! (name_of #.Nil)) (<code>.form (do <>.monad - [_ (<code>.tag! (name-of #.Cons)) - [head tail] (<>.and (<code>.tuple (<>.and tag-parser <code>.any)) + [_ (<code>.tag! (name_of #.Cons)) + [head tail] (<>.and (<code>.tuple (<>.and tag_parser <code>.any)) recur)] (wrap [head tail]))) )))) @@ -104,26 +104,26 @@ (-> Lux (Parser Definition)) (do {! <>.monad} [raw <code>.any - me-raw (|> raw - meta.expand-all + me_raw (|> raw + meta.expand_all (meta.run compiler) <>.lift)] - (<| (<code>.local me-raw) + (<| (<code>.local me_raw) <code>.form (<>.after (<code>.text! ..extension)) ($_ <>.and - <code>.local-identifier + <code>.local_identifier (<>.or //check.parser <code>.any) (<| <code>.tuple (<>.after <code>.any) <code>.form (<>.after (<code>.this! (` #.Record))) - ..annotations-parser) + ..annotations_parser) <code>.bit )))) -(exception: #export (lacks-type! {definition Definition}) +(exception: #export (lacks_type! {definition Definition}) (exception.report ["Definition" (%.code (..write definition))])) @@ -137,5 +137,5 @@ (wrap []) (#.Right _) - (<>.lift (exception.throw ..lacks-type! [definition])))] + (<>.lift (exception.throw ..lacks_type! [definition])))] (wrap definition))) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 689e166d0..98e1165a5 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -20,25 +20,25 @@ quux (foo bar baz))} (Parser //.Declaration) - (p.either (p.and s.local-identifier + (p.either (p.and s.local_identifier (p\wrap (list))) - (s.form (p.and s.local-identifier - (p.some s.local-identifier))))) + (s.form (p.and s.local_identifier + (p.some s.local_identifier))))) (def: #export annotations {#.doc "Reader for the common annotations syntax used by def: statements."} (Parser //.Annotations) (s.record (p.some (p.and s.tag s.any)))) -(def: (flat-list^ _) +(def: (flat_list^ _) (-> Any (Parser (List Code))) (p.either (do p.monad - [_ (s.tag! (name-of #.Nil))] + [_ (s.tag! (name_of #.Nil))] (wrap (list))) (s.form (do p.monad - [_ (s.tag! (name-of #.Cons)) + [_ (s.tag! (name_of #.Cons)) [head tail] (s.tuple (p.and s.any s.any)) - tail (s.local (list tail) (flat-list^ []))] + tail (s.local (list tail) (flat_list^ []))] (wrap (#.Cons head tail)))))) (template [<name> <type> <tag> <then>] @@ -48,34 +48,34 @@ (p.after s.any) s.form (do p.monad - [_ (s.tag! (name-of <tag>))] + [_ (s.tag! (name_of <tag>))] <then>)))] - [tuple-meta^ (List Code) #.Tuple (flat-list^ [])] - [text-meta^ Text #.Text s.text] + [tuple_meta^ (List Code) #.Tuple (flat_list^ [])] + [text_meta^ Text #.Text s.text] ) -(def: (find-definition-args meta-data) +(def: (find_definition_args meta_data) (-> (List [Name Code]) (List Text)) (<| (maybe.default (list)) (: (Maybe (List Text))) - (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta-data) + (case (list.find (|>> product.left (name\= ["lux" "func-args"])) meta_data) (^multi (#.Some [_ value]) - [(p.run tuple-meta^ (list value)) + [(p.run tuple_meta^ (list value)) (#.Right [_ args])] - [(p.run (p.some text-meta^) args) + [(p.run (p.some text_meta^) args) (#.Right [_ args])]) (#.Some args) _ #.None))) -(def: #export typed-input +(def: #export typed_input {#.doc "Reader for the common typed-argument syntax used by many macros."} - (Parser //.Typed-Input) + (Parser //.Typed_Input) (s.record (p.and s.any s.any))) -(def: #export type-variables +(def: #export type_variables {#.doc "Reader for the common type var/param used by many macros."} (Parser (List Text)) - (p.some s.local-identifier)) + (p.some s.local_identifier)) diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 8c77cffbc..9e946e139 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -13,20 +13,20 @@ (def: #export (declaration declaration) (-> //.Declaration Code) - (` ((~ (code.local-identifier (get@ #//.declaration-name declaration))) - (~+ (list\map code.local-identifier - (get@ #//.declaration-args declaration)))))) + (` ((~ (code.local_identifier (get@ #//.declaration_name declaration))) + (~+ (list\map code.local_identifier + (get@ #//.declaration_args declaration)))))) (def: #export annotations (-> //.Annotations Code) (|>> (list\map (product.both code.tag function.identity)) code.record)) -(def: #export (typed-input value) - (-> //.Typed-Input Code) - (code.record (list [(get@ #//.input-binding value) - (get@ #//.input-type value)]))) +(def: #export (typed_input value) + (-> //.Typed_Input Code) + (code.record (list [(get@ #//.input_binding value) + (get@ #//.input_type value)]))) -(def: #export type-variables - (-> (List //.Type-Var) (List Code)) - (list\map code.local-identifier)) +(def: #export type_variables + (-> (List //.Type_Var) (List Code)) + (list\map code.local_identifier)) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 12b3d9261..c250a3456 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -26,42 +26,42 @@ (syntax: #export (count {parts (<code>.tuple (<>.some <code>.any))}) (wrap (list (code.nat (list.size parts))))) -(syntax: #export (with-locals {locals (<code>.tuple (<>.some <code>.local-identifier))} +(syntax: #export (with_locals {locals (<code>.tuple (<>.some <code>.local_identifier))} body) (do {! meta.monad} [g!locals (|> locals (list\map meta.gensym) (monad.seq !))] - (wrap (list (` (.with-expansions [(~+ (|> (list.zip/2 locals g!locals) + (wrap (list (` (.with_expansions [(~+ (|> (list.zip/2 locals g!locals) (list\map (function (_ [name identifier]) - (list (code.local-identifier name) (as-is identifier)))) + (list (code.local_identifier name) (as_is identifier)))) list\join))] (~ body))))))) -(def: (name-side module-side? parser) +(def: (name_side module_side? parser) (-> Bit (Parser Name) (Parser Text)) (do <>.monad [[module short] parser] - (wrap (if module-side? + (wrap (if module_side? (case module "" short _ module) short)))) -(def: (snippet module-side?) +(def: (snippet module_side?) (-> Bit (Parser Text)) - (let [full-identifier (..name-side module-side? <code>.identifier) - full-tag (..name-side module-side? <code>.tag)] + (let [full_identifier (..name_side module_side? <code>.identifier) + full_tag (..name_side module_side? <code>.tag)] ($_ <>.either <code>.text - (if module-side? - full-identifier - (<>.either <code>.local-identifier - full-identifier)) - (if module-side? - full-tag - (<>.either <code>.local-tag - full-tag)) + (if module_side? + full_identifier + (<>.either <code>.local_identifier + full_identifier)) + (if module_side? + full_tag + (<>.either <code>.local_tag + full_tag)) (<>\map bit\encode <code>.bit) (<>\map nat\encode <code>.nat) (<>\map int\encode <code>.int) @@ -69,24 +69,24 @@ (<>\map frac\encode <code>.frac) ))) -(def: (part module-side?) +(def: (part module_side?) (-> Bit (Parser (List Text))) - (<code>.tuple (<>.many (..snippet module-side?)))) + (<code>.tuple (<>.many (..snippet module_side?)))) (syntax: #export (text {simple (..part false)}) - (wrap (list (|> simple (text.join-with "") code.text)))) + (wrap (list (|> simple (text.join_with "") code.text)))) (template [<name> <simple> <complex>] [(syntax: #export (<name> {name (<>.or (<>.and (..part true) (..part false)) (..part false))}) (case name (#.Left [simple complex]) - (wrap (list (<complex> [(text.join-with "" simple) - (text.join-with "" complex)]))) + (wrap (list (<complex> [(text.join_with "" simple) + (text.join_with "" complex)]))) (#.Right simple) - (wrap (list (|> simple (text.join-with "") <simple>)))))] + (wrap (list (|> simple (text.join_with "") <simple>)))))] - [identifier code.local-identifier code.identifier] - [tag code.local-tag code.tag] + [identifier code.local_identifier code.identifier] + [tag code.local_tag code.tag] ) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 51b9300e9..fac508ca5 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -17,7 +17,7 @@ ) (for {@.old - (as-is (template [<name> <method>] + (as_is (template [<name> <method>] [(def: #export (<name> input) (-> Frac Frac) (<method> input))] @@ -41,7 +41,7 @@ ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) @.jvm - (as-is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast")) + (as_is (template: (!double value) (|> value (:coerce (primitive "java.lang.Double")) "jvm object cast")) (template: (!frac value) (|> value "jvm object cast" (: (primitive "java.lang.Double")) (:coerce Frac))) (template [<name> <method>] [(def: #export <name> @@ -75,7 +75,7 @@ !frac))) @.js - (as-is (template [<name> <method>] + (as_is (template [<name> <method>] [(def: #export <name> (-> Frac Frac) (|>> ("js apply" ("js constant" <method>)) (:coerce Frac)))] diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux index 9e9445538..bd8629525 100644 --- a/stdlib/source/lux/math/infix.lux +++ b/stdlib/source/lux/math/infix.lux @@ -40,29 +40,29 @@ (<code>.tuple ($_ <>.either (do <>.monad [_ (<code>.this! (' #and)) - init-subject infix^ - init-op <code>.any - init-param infix^ + init_subject infix^ + init_op <code>.any + init_param infix^ steps (<>.some (<>.and <code>.any infix^))] (wrap (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]]) [param [(#Binary _subject _op _param) (` and) (#Binary subject op param)]]) - [init-param [init-subject init-op init-param]] + [init_param [init_subject init_op init_param]] steps)))) (do <>.monad - [init-subject infix^ - init-op <code>.any - init-param infix^ + [init_subject infix^ + init_op <code>.any + init_param infix^ steps (<>.some (<>.and <code>.any infix^))] (wrap (list\fold (function (_ [op param] [_subject _op _param]) [(#Binary _subject _op _param) op param]) - [init-subject init-op init-param] + [init_subject init_op init_param] steps))) )) ))) -(def: (to-prefix infix) +(def: (to_prefix infix) (-> Infix Code) (case infix (#Const value) @@ -72,10 +72,10 @@ (code.form parts) (#Unary op subject) - (` ((~ op) (~ (to-prefix subject)))) + (` ((~ op) (~ (to_prefix subject)))) (#Binary left op right) - (` ((~ op) (~ (to-prefix right)) (~ (to-prefix left)))) + (` ((~ op) (~ (to_prefix right)) (~ (to_prefix left)))) )) (syntax: #export (infix {expr infix^}) @@ -91,4 +91,4 @@ "If you want your binary function to work well with it." "Then take the argument to the right (y) as your first argument," "and take the argument to the left (x) as your second argument.")} - (wrap (list (..to-prefix expr)))) + (wrap (list (..to_prefix expr)))) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 59343163e..780fe9898 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -41,16 +41,16 @@ (&.and (membership elem base) (&.not (membership elem sub))))) -(def: #export (from-predicate predicate) +(def: #export (from_predicate predicate) (All [a] (-> (Predicate a) (Fuzzy a))) (function (_ elem) (if (predicate elem) &.true &.false))) -(def: #export (from-set set) +(def: #export (from_set set) (All [a] (-> (Set a) (Fuzzy a))) - (from-predicate (set.member? set))) + (from_predicate (set.member? set))) (def: (ascending from to) (-> Rev Rev (Fuzzy Rev)) @@ -94,12 +94,12 @@ _ (undefined))) -(def: #export (trapezoid bottom middle-bottom middle-top top) +(def: #export (trapezoid bottom middle_bottom middle_top top) (-> Rev Rev Rev Rev (Fuzzy Rev)) - (case (list.sort r.< (list bottom middle-bottom middle-top top)) - (^ (list bottom middle-bottom middle-top top)) - (intersection (ascending bottom middle-bottom) - (descending middle-top top)) + (case (list.sort r.< (list bottom middle_bottom middle_top top)) + (^ (list bottom middle_bottom middle_top top)) + (intersection (ascending bottom middle_bottom) + (descending middle_top top)) _ (undefined))) @@ -112,7 +112,7 @@ (|> membership (r.- treshold) (r.* &.true)) &.false)))) -(def: #export (to-predicate treshold set) +(def: #export (to_predicate treshold set) (All [a] (-> Rev (Fuzzy a) (Predicate a))) (function (_ elem) (r.> treshold (set elem)))) @@ -120,11 +120,11 @@ (type: #export (Fuzzy2 a) (-> a [Rev Rev])) -(def: #export (type-2 lower upper) +(def: #export (type_2 lower upper) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy2 a))) (function (_ elem) - (let [l-rev (lower elem) - u-rev (upper elem)] - [(r.min l-rev - u-rev) - u-rev]))) + (let [l_rev (lower elem) + u_rev (upper elem)] + [(r.min l_rev + u_rev) + u_rev]))) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index 71e3a57a1..a5777768c 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -34,11 +34,11 @@ (:abstraction {#modulus modulus #remainder (i.mod (/.divisor modulus) value)})) - (def: #export un-modular + (def: #export un_modular (All [m] (-> (Mod m) [(Modulus m) Int])) (|>> :representation)) - (exception: #export [m] (incorrect-modulus {modulus (Modulus m)} + (exception: #export [m] (incorrect_modulus {modulus (Modulus m)} {parsed Int}) (exception.report ["Expected" (i\encode (/.divisor modulus))] @@ -50,7 +50,7 @@ (def: intL (Parser Int) (<>.codec i.decimal - (<text>.and (<text>.one-of "-+") (<text>.many <text>.decimal)))) + (<text>.and (<text>.one_of "-+") (<text>.many <text>.decimal)))) (structure: #export (codec expected) (All [m] (-> (Modulus m) (Codec Text (Mod m)))) @@ -65,11 +65,11 @@ (def: decode (<text>.run (do <>.monad [[remainder _ actual] ($_ <>.and intL (<text>.this ..separator) intL) - _ (<>.assert (exception.construct ..incorrect-modulus [expected actual]) + _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) (i.= (/.divisor expected) actual))] (wrap (..modular expected remainder)))))) - (exception: #export [rm sm] (unequal-moduli {reference (Modulus rm)} + (exception: #export [rm sm] (unequal_moduli {reference (Modulus rm)} {subject (Modulus sm)}) (exception.report ["Reference" (i\encode (/.divisor reference))] @@ -77,13 +77,13 @@ (def: #export (equalize reference subject) (All [r s] (-> (Mod r) (Mod s) (Try (Mod r)))) - (let [[reference-modulus reference] (:representation reference) - [subject-modulus subject] (:representation subject)] - (if (i.= (/.divisor reference-modulus) - (/.divisor subject-modulus)) - (#try.Success (:abstraction {#modulus reference-modulus + (let [[reference_modulus reference] (:representation reference) + [subject_modulus subject] (:representation subject)] + (if (i.= (/.divisor reference_modulus) + (/.divisor subject_modulus)) + (#try.Success (:abstraction {#modulus reference_modulus #remainder subject})) - (exception.throw ..unequal-moduli [reference-modulus subject-modulus])))) + (exception.throw ..unequal_moduli [reference_modulus subject_modulus])))) (template [<name> <op>] [(def: #export (<name> reference subject) @@ -140,8 +140,8 @@ (All [m] (-> (Mod m) (Maybe (Mod m)))) (let [[modulus value] (:representation modular) [vk mk gcd] (gcd+ value (/.divisor modulus)) - co-prime? (i.= +1 gcd)] - (if co-prime? + co_prime? (i.= +1 gcd)] + (if co_prime? (#.Some (..modular modulus vk)) #.None))) ) diff --git a/stdlib/source/lux/math/modulus.lux b/stdlib/source/lux/math/modulus.lux index d3bb9f6f6..6b38d96ff 100644 --- a/stdlib/source/lux/math/modulus.lux +++ b/stdlib/source/lux/math/modulus.lux @@ -17,7 +17,7 @@ [syntax (#+ syntax:)] ["." code]]]) -(exception: #export zero-cannot-be-a-modulus) +(exception: #export zero_cannot_be_a_modulus) (abstract: #export (Modulus m) Int @@ -28,7 +28,7 @@ (def: #export (modulus value) (Ex [m] (-> Int (Try (Modulus m)))) (if (i.= +0 value) - (exception.throw ..zero-cannot-be-a-modulus []) + (exception.throw ..zero_cannot_be_a_modulus []) (#try.Success (:abstraction value)))) (def: #export divisor diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index aa13297c4..cc0cc1def 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -123,7 +123,7 @@ (let [[prng left] (prng []) [prng right] (prng [])] [prng (|> left - (i64.left-shift 32) + (i64.left_shift 32) ("lux i64 +" right))]))) (template [<name> <type> <cast>] @@ -138,36 +138,36 @@ (def: #export frac (Random Frac) - (\ ..monad map (|>> .i64 f.from-bits) ..nat)) + (\ ..monad map (|>> .i64 f.from_bits) ..nat)) -(def: #export safe-frac +(def: #export safe_frac (Random Frac) - (let [mantissa-range (.int (i64.left-shift 53 1)) - mantissa-max (i.frac (dec mantissa-range))] + (let [mantissa_range (.int (i64.left_shift 53 1)) + mantissa_max (i.frac (dec mantissa_range))] (\ ..monad map - (|>> (i.% mantissa-range) + (|>> (i.% mantissa_range) i.frac - (f./ mantissa-max)) + (f./ mantissa_max)) ..int))) (def: #export (char set) (-> unicode.Set (Random Char)) (let [[start end] (unicode.range set) size (n.- start end) - in-range (: (-> Char Char) + in_range (: (-> Char Char) (|>> (n.% size) (n.+ start)))] (|> ..nat - (\ ..monad map in-range) + (\ ..monad map in_range) (..filter (unicode.member? set))))) -(def: #export (text char-gen size) +(def: #export (text char_gen size) (-> (Random Char) Nat (Random Text)) (if (n.= 0 size) (\ ..monad wrap "") (do ..monad - [x char-gen - xs (text char-gen (dec size))] - (wrap (text\compose (text.from-code x) xs))))) + [x char_gen + xs (text char_gen (dec size))] + (wrap (text\compose (text.from_code x) xs))))) (template [<name> <set>] [(def: #export <name> @@ -177,9 +177,9 @@ [unicode unicode.character] [ascii unicode.ascii] [ascii/alpha unicode.ascii/alpha] - [ascii/alpha-num unicode.ascii/alpha-num] - [ascii/upper-alpha unicode.ascii/upper-alpha] - [ascii/lower-alpha unicode.ascii/lower-alpha] + [ascii/alpha_num unicode.ascii/alpha_num] + [ascii/upper_alpha unicode.ascii/upper_alpha] + [ascii/lower_alpha unicode.ascii/lower_alpha] ) (template [<name> <type> <ctor> <gen>] @@ -191,7 +191,7 @@ (wrap (<ctor> left right))))] [ratio r.Ratio r.ratio ..nat] - [complex c.Complex c.complex ..safe-frac] + [complex c.Complex c.complex ..safe_frac] ) (def: #export (and left right) @@ -231,23 +231,23 @@ (let [gen' (gen (rec gen))] (gen' state)))) -(def: #export (maybe value-gen) +(def: #export (maybe value_gen) (All [a] (-> (Random a) (Random (Maybe a)))) (do {! ..monad} [some? bit] (if some? (do ! - [value value-gen] + [value value_gen] (wrap (#.Some value))) (wrap #.None)))) (template [<name> <type> <zero> <plus>] - [(def: #export (<name> size value-gen) + [(def: #export (<name> size value_gen) (All [a] (-> Nat (Random a) (Random (<type> a)))) (if (n.> 0 size) (do ..monad - [x value-gen - xs (<name> (dec size) value-gen)] + [x value_gen + xs (<name> (dec size) value_gen)] (wrap (<plus> x xs))) (\ ..monad wrap <zero>)))] @@ -256,40 +256,40 @@ ) (template [<name> <type> <ctor>] - [(def: #export (<name> size value-gen) + [(def: #export (<name> size value_gen) (All [a] (-> Nat (Random a) (Random (<type> a)))) (do ..monad - [values (list size value-gen)] + [values (list size value_gen)] (wrap (|> values <ctor>))))] - [array Array array.from-list] - [queue Queue queue.from-list] + [array Array array.from_list] + [queue Queue queue.from_list] [stack Stack (list\fold stack.push stack.empty)] ) -(def: #export (set Hash<a> size value-gen) +(def: #export (set Hash<a> size value_gen) (All [a] (-> (Hash a) Nat (Random a) (Random (Set a)))) (if (n.> 0 size) (do {! ..monad} - [xs (set Hash<a> (dec size) value-gen)] + [xs (set Hash<a> (dec size) value_gen)] (loop [_ []] (do ! - [x value-gen + [x value_gen #let [xs+ (set.add x xs)]] (if (n.= size (set.size xs+)) (wrap xs+) (recur []))))) (\ ..monad wrap (set.new Hash<a>)))) -(def: #export (dictionary Hash<a> size key-gen value-gen) +(def: #export (dictionary Hash<a> size key_gen value_gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v)))) (if (n.> 0 size) (do {! ..monad} - [kv (dictionary Hash<a> (dec size) key-gen value-gen)] + [kv (dictionary Hash<a> (dec size) key_gen value_gen)] (loop [_ []] (do ! - [k key-gen - v value-gen + [k key_gen + v value_gen #let [kv+ (dictionary.put k v kv)]] (if (n.= size (dictionary.size kv+)) (wrap kv+) @@ -298,7 +298,7 @@ (def: #export instant (Random Instant) - (\ ..monad map instant.from-millis ..int)) + (\ ..monad map instant.from_millis ..int)) (def: #export date (Random Date) @@ -306,7 +306,7 @@ (def: #export duration (Random Duration) - (\ ..monad map duration.from-millis ..int)) + (\ ..monad map duration.from_millis ..int)) (def: #export month (Random Month) @@ -346,42 +346,42 @@ [(recur (update state)) (return state)]))) -(def: #export (pcg-32 [increase seed]) +(def: #export (pcg_32 [increase seed]) {#.doc (doc "An implementation of the PCG32 algorithm." "For more information, please see: http://www.pcg-random.org/")} (-> [(I64 Any) (I64 Any)] PRNG) (let [magic 6364136223846793005] (function (_ _) - [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg-32) - (let [rot (|> seed .i64 (i64.logic-right-shift 59))] + [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg_32) + (let [rot (|> seed .i64 (i64.logic_right_shift 59))] (|> seed - (i64.logic-right-shift 18) + (i64.logic_right_shift 18) (i64.xor seed) - (i64.logic-right-shift 27) - (i64.rotate-right rot) + (i64.logic_right_shift 27) + (i64.rotate_right rot) .i64))]))) -(def: #export (xoroshiro-128+ [s0 s1]) +(def: #export (xoroshiro_128+ [s0 s1]) {#.doc (doc "An implementation of the Xoroshiro128+ algorithm." "For more information, please see: http://xoroshiro.di.unimi.it/")} (-> [(I64 Any) (I64 Any)] PRNG) (function (_ _) [(let [s01 (i64.xor s0 s1)] - (xoroshiro-128+ [(|> s0 - (i64.rotate-left 55) + (xoroshiro_128+ [(|> s0 + (i64.rotate_left 55) (i64.xor s01) - (i64.xor (i64.left-shift 14 s01))) - (i64.rotate-left 36 s01)])) + (i64.xor (i64.left_shift 14 s01))) + (i64.rotate_left 36 s01)])) ("lux i64 +" s0 s1)])) ## https://en.wikipedia.org/wiki/Xorshift#Initialization ## http://xorshift.di.unimi.it/splitmix64.c -(def: #export split-mix-64 +(def: #export split_mix_64 {#.doc (doc "An implementation of the SplitMix64 algorithm.")} (-> Nat PRNG) (let [twist (: (-> Nat Nat Nat) (function (_ shift value) - (i64.xor (i64.logic-right-shift shift value) value))) + (i64.xor (i64.logic_right_shift shift value) value))) mix n.*] (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15")) (|>> (twist 30) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 8becc186c..95f64650d 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -124,7 +124,7 @@ (function (_ _) (#try.Failure msg))) -(def: #export (find-module name) +(def: #export (find_module name) (-> Text (Meta Module)) (function (_ compiler) (case (get name (get@ #.modules compiler)) @@ -134,23 +134,23 @@ _ (#try.Failure ($_ text\compose "Unknown module: " name))))) -(def: #export current-module-name +(def: #export current_module_name (Meta Text) (function (_ compiler) - (case (get@ #.current-module compiler) - (#.Some current-module) - (#try.Success [compiler current-module]) + (case (get@ #.current_module compiler) + (#.Some current_module) + (#try.Success [compiler current_module]) _ (#try.Failure "No current module.")))) -(def: #export current-module +(def: #export current_module (Meta Module) (do ..monad - [this-module-name current-module-name] - (find-module this-module-name))) + [this_module_name current_module_name] + (find_module this_module_name))) -(def: (macro-type? type) +(def: (macro_type? type) (-> Type Bit) (case type (#.Named ["lux" "Macro"] (#.Primitive "#Macro" #.Nil)) @@ -166,13 +166,13 @@ (case name ["" name] (do ..monad - [module-name current-module-name] - (wrap [module-name name])) + [module_name current_module_name] + (wrap [module_name name])) _ (\ ..monad wrap name))) -(def: (find-macro' modules this-module module name) +(def: (find_macro' modules this_module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) (do maybe.monad @@ -182,36 +182,36 @@ (get@ #.definitions) (get name)))] (case definition - (#.Left [r-module r-name]) - (find-macro' modules this-module r-module r-name) + (#.Left [r_module r_name]) + (find_macro' modules this_module r_module r_name) - (#.Right [exported? def-type def-anns def-value]) - (if (macro-type? def-type) - (#.Some (:coerce Macro def-value)) + (#.Right [exported? def_type def_anns def_value]) + (if (macro_type? def_type) + (#.Some (:coerce Macro def_value)) #.None)))) -(def: #export (find-macro full-name) +(def: #export (find_macro full_name) (-> Name (Meta (Maybe Macro))) (do ..monad - [[module name] (normalize full-name)] + [[module name] (normalize full_name)] (: (Meta (Maybe Macro)) (function (_ compiler) - (let [macro (case (..current-module-name compiler) + (let [macro (case (..current_module_name compiler) (#try.Failure error) #.None - (#try.Success [_ this-module]) - (find-macro' (get@ #.modules compiler) this-module module name))] + (#try.Success [_ this_module]) + (find_macro' (get@ #.modules compiler) this_module module name))] (#try.Success [compiler macro])))))) -(def: #export (expand-once syntax) +(def: #export (expand_once syntax) {#.doc (doc "Given code that requires applying a macro, does it once and returns the result." "Otherwise, returns the code as-is.")} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) ((:coerce Macro' macro) args) @@ -229,7 +229,7 @@ (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) (do ..monad @@ -243,34 +243,34 @@ _ (\ ..monad wrap (list syntax)))) -(def: #export (expand-all syntax) +(def: #export (expand_all syntax) {#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} (-> Code (Meta (List Code))) (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do ..monad - [?macro (find-macro name)] + [?macro (find_macro name)] (case ?macro (#.Some macro) (do ..monad [expansion ((:coerce Macro' macro) args) - expansion' (monad.map ..monad expand-all expansion)] + expansion' (monad.map ..monad expand_all expansion)] (wrap (list\join expansion'))) #.None (do ..monad - [parts' (monad.map ..monad expand-all (list& (code.identifier name) args))] + [parts' (monad.map ..monad expand_all (list& (code.identifier name) args))] (wrap (list (code.form (list\join parts'))))))) [_ (#.Form (#.Cons [harg targs]))] (do ..monad - [harg+ (expand-all harg) - targs+ (monad.map ..monad expand-all targs)] + [harg+ (expand_all harg) + targs+ (monad.map ..monad expand_all targs)] (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) [_ (#.Tuple members)] (do ..monad - [members' (monad.map ..monad expand-all members)] + [members' (monad.map ..monad expand_all members)] (wrap (list (code.tuple (list\join members'))))) _ @@ -293,7 +293,7 @@ ($_ text\compose "__gensym__" prefix) [""] code.identifier)))) -(def: (get-local-identifier ast) +(def: (get_local_identifier ast) (-> Code (Meta Text)) (case ast [_ (#.Identifier [_ name])] @@ -302,15 +302,15 @@ _ (fail (text\compose "Code is not a local identifier: " (code.format ast))))) -(def: #export wrong-syntax-error +(def: #export wrong_syntax_error (-> Name Text) (|>> name\encode (text\compose "Wrong syntax for "))) -(macro: #export (with-gensyms tokens) +(macro: #export (with_gensyms tokens) {#.doc (doc "Creates new identifiers and offers them to the body expression." (syntax: #export (synchronized lock body) - (with-gensyms [g!lock g!body g!_] + (with_gensyms [g!lock g!body g!_] (wrap (list (` (let [(~ g!lock) (~ lock) (~ g!_) ("jvm monitorenter" (~ g!lock)) (~ g!body) (~ body) @@ -320,18 +320,18 @@ (case tokens (^ (list [_ (#.Tuple identifiers)] body)) (do {! ..monad} - [identifier-names (monad.map ! get-local-identifier identifiers) - #let [identifier-defs (list\join (list\map (: (-> Text (List Code)) + [identifier_names (monad.map ! get_local_identifier identifiers) + #let [identifier_defs (list\join (list\map (: (-> Text (List Code)) (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) - identifier-names))]] + identifier_names))]] (wrap (list (` ((~! do) (~! ..monad) - [(~+ identifier-defs)] + [(~+ identifier_defs)] (~ body)))))) _ - (fail (..wrong-syntax-error (name-of ..with-gensyms))))) + (fail (..wrong_syntax_error (name_of ..with_gensyms))))) -(def: #export (expand-1 token) +(def: #export (expand_1 token) {#.doc "Works just like expand, except that it ensures that the output is a single Code token."} (-> Code (Meta Code)) (do ..monad @@ -343,7 +343,7 @@ _ (fail "Macro expanded to more than 1 element.")))) -(def: #export (module-exists? module) +(def: #export (module_exists? module) (-> Text (Meta Bit)) (function (_ compiler) (#try.Success [compiler (case (get module (get@ #.modules compiler)) @@ -353,14 +353,14 @@ #.None #0)]))) -(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-type-var idx bindings) +(def: (find_type_var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #.Nil @@ -369,16 +369,16 @@ (#.Cons [var bound] bindings') (if (n.= idx var) bound - (find-type-var idx bindings')))) + (find_type_var idx bindings')))) -(def: (clean-type type) +(def: (clean_type type) (-> Type (Meta Type)) (case type (#.Var var) (function (_ compiler) (case (|> compiler - (get@ [#.type-context #.var-bindings]) - (find-type-var var)) + (get@ [#.type_context #.var_bindings]) + (find_type_var var)) (^or #.None (#.Some (#.Var _))) (#try.Success [compiler type]) @@ -388,7 +388,7 @@ _ (\ ..monad wrap type))) -(def: #export (find-var-type name) +(def: #export (find_var_type name) {#.doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) (function (_ compiler) @@ -401,19 +401,19 @@ (list.any? test (: (List [Text [Type Any]]) (get@ [#.captured #.mappings] env))))) (get@ #.scopes compiler)) - [_ [type _]] (try-both (list.find test) + [_ [type _]] (try_both (list.find test) (: (List [Text [Type Any]]) (get@ [#.locals #.mappings] scope)) (: (List [Text [Type Any]]) (get@ [#.captured #.mappings] scope)))] (wrap type)) - (#.Some var-type) - ((clean-type var-type) compiler) + (#.Some var_type) + ((clean_type var_type) compiler) #.None (#try.Failure ($_ text\compose "Unknown variable: " name)))))) -(def: #export (find-def name) +(def: #export (find_def name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Name (Meta Global)) (do ..monad @@ -421,81 +421,81 @@ (function (_ compiler) (case (: (Maybe Global) (do maybe.monad - [#let [[v-prefix v-name] name] - (^slots [#.definitions]) (get v-prefix (get@ #.modules compiler))] - (get v-name definitions))) + [#let [[v_prefix v_name] name] + (^slots [#.definitions]) (get v_prefix (get@ #.modules compiler))] + (get v_name definitions))) (#.Some definition) (#try.Success [compiler definition]) _ - (let [current-module (|> compiler (get@ #.current-module) (maybe.default "???")) - separator ($_ text\compose text.new-line " ")] + (let [current_module (|> compiler (get@ #.current_module) (maybe.default "???")) + separator ($_ text\compose text.new_line " ")] (#try.Failure ($_ text\compose - "Unknown definition: " (name\encode name) text.new-line - " Current module: " current-module text.new-line - (case (get current-module (get@ #.modules compiler)) - (#.Some this-module) + "Unknown definition: " (name\encode name) text.new_line + " Current module: " current_module text.new_line + (case (get current_module (get@ #.modules compiler)) + (#.Some this_module) ($_ text\compose - " Imports: " (|> this-module (get@ #.imports) (text.join-with separator)) text.new-line - " Aliases: " (|> this-module (get@ #.module-aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join-with separator)) text.new-line) + " Imports: " (|> this_module (get@ #.imports) (text.join_with separator)) text.new_line + " Aliases: " (|> this_module (get@ #.module_aliases) (list\map (function (_ [alias real]) ($_ text\compose alias " => " real))) (text.join_with separator)) text.new_line) _ "") - " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join-with separator)) text.new-line))))))) + " All Known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line))))))) -(def: #export (find-export name) +(def: #export (find_export name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Definition)) (do ..monad - [definition (..find-def name)] + [definition (..find_def name)] (case definition - (#.Left de-aliased) + (#.Left de_aliased) (fail ($_ text\compose "Aliases are not considered exports: " (name\encode name))) (#.Right definition) - (let [[exported? def-type def-data def-value] definition] + (let [[exported? def_type def_data def_value] definition] (if exported? (wrap definition) (fail ($_ text\compose "Definition is not an export: " (name\encode name)))))))) -(def: #export (find-def-type name) +(def: #export (find_def_type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Type)) (do ..monad - [definition (find-def name)] + [definition (find_def name)] (case definition - (#.Left de-aliased) - (find-def-type de-aliased) + (#.Left de_aliased) + (find_def_type de_aliased) - (#.Right [exported? def-type def-data def-value]) - (clean-type def-type)))) + (#.Right [exported? def_type def_data def_value]) + (clean_type def_type)))) -(def: #export (find-type name) +(def: #export (find_type name) {#.doc "Looks-up the type of either a local variable or a definition."} (-> Name (Meta Type)) (do ..monad [#let [[_ _name] name]] (case name ["" _name] - (either (find-var-type _name) - (find-def-type name)) + (either (find_var_type _name) + (find_def_type name)) _ - (find-def-type name)))) + (find_def_type name)))) -(def: #export (find-type-def name) +(def: #export (find_type_def name) {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."} (-> Name (Meta Type)) (do ..monad - [definition (find-def name)] + [definition (find_def name)] (case definition - (#.Left de-aliased) - (find-type-def de-aliased) + (#.Left de_aliased) + (find_type_def de_aliased) - (#.Right [exported? def-type def-data def-value]) - (wrap (:coerce Type def-value))))) + (#.Right [exported? def_type def_data def_value]) + (wrap (:coerce Type def_value))))) (def: #export (globals module) {#.doc "The entire list of globals in a module (including the non-exported/private ones)."} @@ -514,22 +514,22 @@ (\ ..monad map (list.all (function (_ [name global]) (case global - (#.Left de-aliased) + (#.Left de_aliased) #.None (#.Right definition) (#.Some [name definition])))) (..globals module))) -(def: #export (exports module-name) +(def: #export (exports module_name) {#.doc "All the exported definitions in a module."} (-> Text (Meta (List [Text Definition]))) (do ..monad - [constants (..definitions module-name)] + [constants (..definitions module_name)] (wrap (do list.monad - [[name [exported? def-type def-data def-value]] constants] + [[name [exported? def_type def_data def_value]] constants] (if exported? - (wrap [name [exported? def-type def-data def-value]]) + (wrap [name [exported? def_type def_data def_value]]) (list)))))) (def: #export modules @@ -541,12 +541,12 @@ [compiler] #try.Success))) -(def: #export (tags-of type-name) +(def: #export (tags_of type_name) {#.doc "All the tags associated with a type definition."} (-> Name (Meta (Maybe (List Name)))) (do ..monad - [#let [[module name] type-name] - module (find-module module)] + [#let [[module name] type_name] + module (find_module module)] (case (get name (get@ #.types module)) (#.Some [tags _]) (wrap (#.Some tags)) @@ -560,7 +560,7 @@ (function (_ compiler) (#try.Success [compiler (get@ #.location compiler)]))) -(def: #export expected-type +(def: #export expected_type {#.doc "The expected type of the current expression being analyzed."} (Meta Type) (function (_ compiler) @@ -571,62 +571,62 @@ #.None (#try.Failure "Not expecting any type.")))) -(def: #export (imported-modules module-name) +(def: #export (imported_modules module_name) {#.doc "All the modules imported by a specified module."} (-> Text (Meta (List Text))) (do ..monad - [(^slots [#.imports]) (..find-module module-name)] + [(^slots [#.imports]) (..find_module module_name)] (wrap imports))) -(def: #export (imported-by? import module) +(def: #export (imported_by? import module) (-> Text Text (Meta Bit)) (do ..monad - [(^slots [#.imports]) (..find-module module)] + [(^slots [#.imports]) (..find_module module)] (wrap (list.any? (text\= import) imports)))) (def: #export (imported? import) (-> Text (Meta Bit)) (let [(^open ".") ..monad] - (|> ..current-module-name - (map ..find-module) join + (|> ..current_module_name + (map ..find_module) join (map (|>> (get@ #.imports) (list.any? (text\= import))))))) -(def: #export (resolve-tag tag) +(def: #export (resolve_tag tag) {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} (-> Name (Meta [Nat (List Name) Type])) (do ..monad [#let [[module name] tag] - =module (..find-module module) - this-module-name ..current-module-name + =module (..find_module module) + this_module_name ..current_module_name imported! (..imported? module)] (case (get name (get@ #.tags =module)) - (#.Some [idx tag-list exported? type]) - (if (or (text\= this-module-name module) + (#.Some [idx tag_list exported? type]) + (if (or (text\= this_module_name module) (and imported! exported?)) - (wrap [idx tag-list type]) - (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this-module-name))) + (wrap [idx tag_list type]) + (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) _ (..fail ($_ text\compose - "Unknown tag: " (name\encode tag) text.new-line + "Unknown tag: " (name\encode tag) text.new_line " Known tags: " (|> =module (get@ #.tags) - (list\map (|>> product.left [module] name\encode (text.prefix text.new-line))) - (text.join-with "")) + (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) + (text.join_with "")) ))))) -(def: #export (tag-lists module) +(def: #export (tag_lists module) {#.doc "All the tag-lists defined in a module, with their associated types."} (-> Text (Meta (List [(List Name) Type]))) (do ..monad - [=module (..find-module module) - this-module-name ..current-module-name] + [=module (..find_module module) + this_module_name ..current_module_name] (wrap (|> (get@ #.types =module) - (list.filter (function (_ [type-name [tag-list exported? type]]) + (list.filter (function (_ [type_name [tag_list exported? type]]) (or exported? - (text\= this-module-name module)))) - (list\map (function (_ [type-name [tag-list exported? type]]) - [tag-list type])))))) + (text\= this_module_name module)))) + (list\map (function (_ [type_name [tag_list exported? type]]) + [tag_list type])))))) (def: #export locals {#.doc "All the local variables currently in scope, separated in different scopes."} @@ -643,28 +643,28 @@ [name type]))) scopes)])))) -(def: #export (un-alias def-name) +(def: #export (un_alias def_name) {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [constant (..find-def def-name)] + [constant (..find_def def_name)] (wrap (case constant - (#.Left real-def-name) - real-def-name + (#.Left real_def_name) + real_def_name (#.Right _) - def-name)))) + def_name)))) -(def: #export get-compiler +(def: #export get_compiler {#.doc "Obtains the current state of the compiler."} (Meta Lux) (function (_ compiler) (#try.Success [compiler compiler]))) -(def: #export type-context - (Meta Type-Context) +(def: #export type_context + (Meta Type_Context) (function (_ compiler) - (#try.Success [compiler (get@ #.type-context compiler)]))) + (#try.Success [compiler (get@ #.type_context compiler)]))) (template [<macro> <func>] [(macro: #export (<macro> tokens) @@ -690,7 +690,7 @@ (do ..monad [location ..location output (<func> token) - #let [_ (log! ($_ text\compose (name\encode (name-of <macro>)) " @ " (location.format location))) + #let [_ (log! ($_ text\compose (name\encode (name_of <macro>)) " @ " (location.format location))) _ (list\map (|>> code.format log!) output) _ (log! "")]] @@ -699,11 +699,11 @@ output))) #.None - (fail (..wrong-syntax-error (name-of <macro>)))))] + (fail (..wrong_syntax_error (name_of <macro>)))))] - [log-expand! expand] - [log-expand-all! expand-all] - [log-expand-once! expand-once] + [log_expand! expand] + [log_expand_all! expand_all] + [log_expand_once! expand_once] ) (def: #export (lift result) diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux index 17fef0c8f..3f0527f74 100644 --- a/stdlib/source/lux/meta/annotation.lux +++ b/stdlib/source/lux/meta/annotation.lux @@ -56,7 +56,7 @@ (def: #export documentation (-> Annotation (Maybe Text)) - (..text (name-of #.doc))) + (..text (name_of #.doc))) (def: #export (flagged? flag) (-> Name Annotation Bit) @@ -65,18 +65,18 @@ (template [<name> <tag>] [(def: #export <name> (-> Annotation Bit) - (..flagged? (name-of <tag>)))] + (..flagged? (name_of <tag>)))] [structure? #.struct?] - [recursive-type? #.type-rec?] + [recursive_type? #.type-rec?] [signature? #.sig?] ) -(def: (parse-text input) +(def: (parse_text input) (-> Code (Maybe Text)) (case input - [_ (#.Text actual-value)] - (#.Some actual-value) + [_ (#.Text actual_value)] + (#.Some actual_value) _ #.None)) @@ -86,9 +86,9 @@ (-> Annotation (List Text)) (maybe.default (list) (do {! maybe.monad} - [args (..tuple (name-of <tag>) ann)] - (monad.map ! ..parse-text args))))] + [args (..tuple (name_of <tag>) ann)] + (monad.map ! ..parse_text args))))] - [function-arguments #.func-args] - [type-arguments #.type-args] + [function_arguments #.func-args] + [type_arguments #.type-args] ) diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index 687a6d632..ae3591668 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -20,8 +20,8 @@ (def: nest (-> Text Text) - (|>> (format text.new-line) - (text.replace-all text.new-line (format text.new-line text.tab)))) + (|>> (format text.new_line) + (text.replace_all text.new_line (format text.new_line text.tab)))) (abstract: #export (Code brand) Text @@ -68,13 +68,13 @@ (def: #export (number value) (-> Frac Literal) (:abstraction - (.cond (f.not-a-number? value) + (.cond (f.not_a_number? value) "NaN" - (f.= f.positive-infinity value) + (f.= f.positive_infinity value) "Infinity" - (f.= f.negative-infinity value) + (f.= f.negative_infinity value) "-Infinity" ## else @@ -83,35 +83,35 @@ (def: sanitize (-> Text Text) (`` (|>> (~~ (template [<replace> <find>] - [(text.replace-all <find> <replace>)] + [(text.replace_all <find> <replace>)] ["\\" "\"] ["\t" text.tab] - ["\v" text.vertical-tab] + ["\v" text.vertical_tab] ["\0" text.null] - ["\b" text.back-space] - ["\f" text.form-feed] - ["\n" text.new-line] - ["\r" text.carriage-return] - [(format "\" text.double-quote) - text.double-quote] + ["\b" text.back_space] + ["\f" text.form_feed] + ["\n" text.new_line] + ["\r" text.carriage_return] + [(format "\" text.double_quote) + text.double_quote] )) ))) (def: #export string (-> Text Literal) (|>> ..sanitize - (text.enclose [text.double-quote text.double-quote]) + (text.enclose [text.double_quote text.double_quote]) :abstraction)) - (def: argument-separator ", ") - (def: field-separator ": ") - (def: statement-suffix ";") + (def: argument_separator ", ") + (def: field_separator ": ") + (def: statement_suffix ";") (def: #export array (-> (List Expression) Computation) (|>> (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..element :abstraction)) @@ -119,9 +119,9 @@ (-> Text Var) (|>> :abstraction)) - (def: #export (at index array-or-object) + (def: #export (at index array_or_object) (-> Expression Expression Access) - (:abstraction (format (:representation array-or-object) (..element (:representation index))))) + (:abstraction (format (:representation array_or_object) (..element (:representation index))))) (def: #export (the field object) (-> Text Expression Access) @@ -131,7 +131,7 @@ (-> Expression (List Expression) Computation) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression (format (:representation function)) :abstraction)) @@ -143,27 +143,27 @@ (def: #export object (-> (List [Text Expression]) Computation) (|>> (list\map (.function (_ [key val]) - (format (:representation (..string key)) ..field-separator (:representation val)))) - (text.join-with ..argument-separator) + (format (:representation (..string key)) ..field_separator (:representation val)))) + (text.join_with ..argument_separator) (text.enclose ["{" "}"]) ..expression :abstraction)) (def: #export (, pre post) (-> Expression Expression Computation) - (|> (format (:representation pre) ..argument-separator (:representation post)) + (|> (format (:representation pre) ..argument_separator (:representation post)) ..expression :abstraction)) (def: #export (then pre post) (-> Statement Statement Statement) (:abstraction (format (:representation pre) - text.new-line + text.new_line (:representation post)))) (def: block (-> Statement Text) - (let [close (format text.new-line "}")] + (let [close (format text.new_line "}")] (|>> :representation ..nest (text.enclose ["{" @@ -176,7 +176,7 @@ (format "function " (:representation name) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression) " ") :abstraction)) @@ -195,7 +195,7 @@ (format "function" (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression) " ") ..expression @@ -220,15 +220,15 @@ [/ "/"] [% "%"] - [left-shift "<<"] - [arithmetic-right-shift ">>"] - [logic-right-shift ">>>"] + [left_shift "<<"] + [arithmetic_right_shift ">>"] + [logic_right_shift ">>>"] [or "||"] [and "&&"] - [bit-xor "^"] - [bit-or "|"] - [bit-and "&"] + [bit_xor "^"] + [bit_or "|"] + [bit_and "&"] ) (template [<name> <prefix>] @@ -237,7 +237,7 @@ (|>> :representation (text.prefix <prefix>) ..expression :abstraction))] [not "!"] - [bit-not "~"] + [bit_not "~"] [negate "-"] ) @@ -247,7 +247,7 @@ (-> <input> Computation) (:abstraction (..expression (format (<format> value) "|0"))))] - [to-i32 Expression :representation] + [to_i32 Expression :representation] [i32 Int %.int] ) @@ -265,7 +265,7 @@ ..expression :abstraction)) - (def: #export type-of + (def: #export type_of (-> Expression Computation) (|>> :representation (format "typeof ") @@ -277,26 +277,26 @@ (|> (format "new " (:representation constructor) (|> inputs (list\map ..code) - (text.join-with ..argument-separator) + (text.join_with ..argument_separator) ..expression)) ..expression :abstraction)) (def: #export statement (-> Expression Statement) - (|>> :representation (text.suffix ..statement-suffix) :abstraction)) + (|>> :representation (text.suffix ..statement_suffix) :abstraction)) - (def: #export use-strict + (def: #export use_strict Statement - (:abstraction (format text.double-quote "use strict" text.double-quote ..statement-suffix))) + (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) (def: #export (declare name) (-> Var Statement) - (:abstraction (format "var " (:representation name) ..statement-suffix))) + (:abstraction (format "var " (:representation name) ..statement_suffix))) (def: #export (define name value) (-> Var Expression Statement) - (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement-suffix))) + (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) (def: #export (set' name value) (-> Location Expression Expression) @@ -304,15 +304,15 @@ (def: #export (set name value) (-> Location Expression Statement) - (:abstraction (format (:representation name) " = " (:representation value) ..statement-suffix))) + (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) (def: #export (throw message) (-> Expression Statement) - (:abstraction (format "throw " (:representation message) ..statement-suffix))) + (:abstraction (format "throw " (:representation message) ..statement_suffix))) (def: #export (return value) (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement-suffix))) + (:abstraction (format "return " (:representation value) ..statement_suffix))) (def: #export (delete' value) (-> Location Expression) @@ -320,7 +320,7 @@ (def: #export (delete value) (-> Location Statement) - (:abstraction (format (:representation (delete' value)) ..statement-suffix))) + (:abstraction (format (:representation (delete' value)) ..statement_suffix))) (def: #export (if test then! else!) (-> Expression Statement Statement Statement) @@ -339,10 +339,10 @@ (:abstraction (format "while(" (:representation test) ") " (..block body)))) - (def: #export (do-while test body) + (def: #export (do_while test body) (-> Expression Statement Loop) (:abstraction (format "do " (..block body) - " while(" (:representation test) ")" ..statement-suffix))) + " while(" (:representation test) ")" ..statement_suffix))) (def: #export (try body [exception catch]) (-> Statement [Var Statement] Statement) @@ -355,7 +355,7 @@ (-> Var Expression Expression Expression Statement Loop) (:abstraction (format "for(" (:representation (..define var init)) " " (:representation condition) - ..statement-suffix " " (:representation update) + ..statement_suffix " " (:representation update) ")" (..block iteration)))) @@ -363,21 +363,21 @@ (-> Text Label) (|>> :abstraction)) - (def: #export (with-label label loop) + (def: #export (with_label label loop) (-> Label Loop Statement) (:abstraction (format (:representation label) ": " (:representation loop)))) (template [<keyword> <0> <1>] [(def: #export <0> Statement - (:abstraction (format <keyword> ..statement-suffix))) + (:abstraction (format <keyword> ..statement_suffix))) (def: #export (<1> label) (-> Label Statement) - (:abstraction (format <keyword> " " (:representation label) ..statement-suffix)))] + (:abstraction (format <keyword> " " (:representation label) ..statement_suffix)))] - ["break" break break-at] - ["continue" continue continue-at] + ["break" break break_at] + ["continue" continue continue_at] ) (template [<name> <js>] @@ -402,10 +402,10 @@ (list\map (.function (_ [when then]) (format (|> when (list\map (|>> :representation (text.enclose ["case " ":"]))) - (text.join-with text.new-line)) + (text.join_with text.new_line)) (..nest (:representation then))))) - (text.join-with text.new-line)) - text.new-line + (text.join_with text.new_line)) + text.new_line (case default (#.Some default) (format "default:" @@ -435,7 +435,7 @@ (~~ (template.splice <function>+))))] [apply/1 [_0] [Expression] - [[not-a-number? "isNaN"]]] + [[not_a_number? "isNaN"]]] [apply/2 [_0 _1] [Expression Expression] []] diff --git a/stdlib/source/lux/target/jvm.lux b/stdlib/source/lux/target/jvm.lux index 4998f0f05..3cc306cd9 100644 --- a/stdlib/source/lux/target/jvm.lux +++ b/stdlib/source/lux/target/jvm.lux @@ -43,7 +43,7 @@ (#LDC Literal)) -(type: #export Int-Arithmetic +(type: #export Int_Arithmetic #IADD #ISUB #IMUL @@ -51,7 +51,7 @@ #IREM #INEG) -(type: #export Long-Arithmetic +(type: #export Long_Arithmetic #LADD #LSUB #LMUL @@ -59,7 +59,7 @@ #LREM #LNEG) -(type: #export Float-Arithmetic +(type: #export Float_Arithmetic #FADD #FSUB #FMUL @@ -67,7 +67,7 @@ #FREM #FNEG) -(type: #export Double-Arithmetic +(type: #export Double_Arithmetic #DADD #DSUB #DMUL @@ -76,12 +76,12 @@ #DNEG) (type: #export Arithmetic - (#Int-Arithmetic Int-Arithmetic) - (#Long-Arithmetic Long-Arithmetic) - (#Float-Arithmetic Float-Arithmetic) - (#Double-Arithmetic Double-Arithmetic)) + (#Int_Arithmetic Int_Arithmetic) + (#Long_Arithmetic Long_Arithmetic) + (#Float_Arithmetic Float_Arithmetic) + (#Double_Arithmetic Double_Arithmetic)) -(type: #export Int-Bitwise +(type: #export Int_Bitwise #IOR #IXOR #IAND @@ -89,7 +89,7 @@ #ISHR #IUSHR) -(type: #export Long-Bitwise +(type: #export Long_Bitwise #LOR #LXOR #LAND @@ -98,8 +98,8 @@ #LUSHR) (type: #export Bitwise - (#Int-Bitwise Int-Bitwise) - (#Long-Bitwise Long-Bitwise)) + (#Int_Bitwise Int_Bitwise) + (#Long_Bitwise Long_Bitwise)) (type: #export Conversion #I2B @@ -170,33 +170,33 @@ (type: #export Register Nat) -(type: #export Local-Int +(type: #export Local_Int (#ILOAD Register) (#ISTORE Register)) -(type: #export Local-Long +(type: #export Local_Long (#LLOAD Register) (#LSTORE Register)) -(type: #export Local-Float +(type: #export Local_Float (#FLOAD Register) (#FSTORE Register)) -(type: #export Local-Double +(type: #export Local_Double (#DLOAD Register) (#DSTORE Register)) -(type: #export Local-Object +(type: #export Local_Object (#ALOAD Register) (#ASTORE Register)) (type: #export Local - (#Local-Int Local-Int) + (#Local_Int Local_Int) (#IINC Register) - (#Local-Long Local-Long) - (#Local-Float Local-Float) - (#Local-Double Local-Double) - (#Local-Object Local-Object)) + (#Local_Long Local_Long) + (#Local_Float Local_Float) + (#Local_Double Local_Double) + (#Local_Object Local_Object)) (type: #export Stack #DUP diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 68297f17b..0f5c9ddc7 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -28,7 +28,7 @@ #length U4 #info about}) -(def: #export (info-equivalence Equivalence<about>) +(def: #export (info_equivalence Equivalence<about>) (All [about] (-> (Equivalence about) (Equivalence (Info about)))) @@ -37,7 +37,7 @@ //unsigned.equivalence Equivalence<about>)) -(def: (info-writer writer) +(def: (info_writer writer) (All [about] (-> (Writer about) (Writer (Info about)))) @@ -48,7 +48,7 @@ [($_ n.+ nameS lengthS infoS) (|>> nameT lengthT infoT)]))) -(with-expansions [<Code> (as-is (/code.Code Attribute))] +(with_expansions [<Code> (as_is (/code.Code Attribute))] (type: #export #rec Attribute (#Constant (Info (Constant Any))) (#Code (Info <Code>))) @@ -62,10 +62,10 @@ (equivalence.rec (function (_ equivalence) ($_ sum.equivalence - (info-equivalence /constant.equivalence) - (info-equivalence (/code.equivalence equivalence)))))) + (info_equivalence /constant.equivalence) + (info_equivalence (/code.equivalence equivalence)))))) -(def: common-attribute-length +(def: common_attribute_length ($_ n.+ ## u2 attribute_name_index; //unsigned.bytes/2 @@ -78,7 +78,7 @@ (case attribute (^template [<tag>] [(<tag> [name length info]) - (|> length //unsigned.value (n.+ ..common-attribute-length))]) + (|> length //unsigned.value (n.+ ..common_attribute_length))]) ([#Constant] [#Code]))) ## TODO: Inline ASAP @@ -115,7 +115,7 @@ (Writer Attribute) (case value (#Constant attribute) - ((info-writer /constant.writer) attribute) + ((info_writer /constant.writer) attribute) (#Code attribute) - ((info-writer (/code.writer writer)) attribute))) + ((info_writer (/code.writer writer)) attribute))) diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index 29d027b4d..328214859 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -24,7 +24,7 @@ (type: #export (Code Attribute) {#limit Limit #code Binary - #exception-table (Row Exception) + #exception_table (Row Exception) #attributes (Row Attribute)}) (def: #export (length length code) @@ -41,7 +41,7 @@ ///unsigned.bytes/2 ## exception_table[exception_table_length]; (|> code - (get@ #exception-table) + (get@ #exception_table) row.size (n.* /exception.length)) ## u2 attributes_count; @@ -52,14 +52,14 @@ (row\map length) (row\fold n.+ 0)))) -(def: #export (equivalence attribute-equivalence) +(def: #export (equivalence attribute_equivalence) (All [attribute] (-> (Equivalence attribute) (Equivalence (Code attribute)))) ($_ product.equivalence ///limit.equivalence binary.equivalence (row.equivalence /exception.equivalence) - (row.equivalence attribute-equivalence) + (row.equivalence attribute_equivalence) )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 @@ -74,7 +74,7 @@ (binaryF.binary/32 (get@ #code code)) ## u2 exception_table_length; ## exception_table[exception_table_length]; - ((binaryF.row/16 /exception.writer) (get@ #exception-table code)) + ((binaryF.row/16 /exception.writer) (get@ #exception_table code)) ## u2 attributes_count; ## attribute_info attributes[attributes_count]; ((binaryF.row/16 writer) (get@ #attributes code)) diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index af843c6cf..700f3b27e 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -27,8 +27,8 @@ ["." template]]] ["." / #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] - ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#\." monoid)] + ["#." jump (#+ Jump Big_Jump)] + ["_" instruction (#+ Primitive_Array_Type Instruction Estimator) ("#\." monoid)] ["#." environment (#+ Environment) [limit ["/." registry (#+ Register Registry)] @@ -54,64 +54,64 @@ (type: #export Resolver (Dictionary Label [Stack (Maybe Address)])) (type: #export Tracker - {#program-counter Address + {#program_counter Address #next Label #known Resolver}) (def: fresh Tracker - {#program-counter /address.start + {#program_counter /address.start #next 0 #known (dictionary.new n.hash)}) (type: #export Relative (-> Resolver (Try [(Row Exception) Instruction]))) -(def: no-exceptions +(def: no_exceptions (Row Exception) row.empty) -(def: relative-identity +(def: relative_identity Relative - (function.constant (#try.Success [..no-exceptions _.empty]))) + (function.constant (#try.Success [..no_exceptions _.empty]))) -(structure: relative-monoid +(structure: relative_monoid (Monoid Relative) - (def: identity ..relative-identity) + (def: identity ..relative_identity) (def: (compose left right) - (cond (is? ..relative-identity left) + (cond (is? ..relative_identity left) right - (is? ..relative-identity right) + (is? ..relative_identity right) left ## else (function (_ resolver) (do try.monad - [[left-exceptions left-instruction] (left resolver) - [right-exceptions right-instruction] (right resolver)] - (wrap [(\ row.monoid compose left-exceptions right-exceptions) - (_\compose left-instruction right-instruction)])))))) + [[left_exceptions left_instruction] (left resolver) + [right_exceptions right_instruction] (right resolver)] + (wrap [(\ row.monoid compose left_exceptions right_exceptions) + (_\compose left_instruction right_instruction)])))))) (type: #export (Bytecode a) (State' Try [Pool Environment Tracker] (Writer Relative a))) -(def: #export new-label +(def: #export new_label (Bytecode Label) (function (_ [pool environment tracker]) (#try.Success [[pool environment (update@ #next inc tracker)] - [..relative-identity + [..relative_identity (get@ #next tracker)]]))) -(exception: #export (label-has-already-been-set {label Label}) +(exception: #export (label_has_already_been_set {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (mismatched-environments {instruction Name} +(exception: #export (mismatched_environments {instruction Name} {label Label} {address Address} {expected Stack} @@ -123,20 +123,20 @@ ["Expected" (/stack.format expected)] ["Actual" (/stack.format actual)])) -(with-expansions [<success> (as-is (wrap [[pool +(with_expansions [<success> (as_is (wrap [[pool environment (update@ #known (dictionary.put label [actual (#.Some @here)]) tracker)] - [..relative-identity + [..relative_identity []]]))] - (def: #export (set-label label) + (def: #export (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (case (dictionary.get label (get@ #known tracker)) (#.Some [expected (#.Some address)]) - (exception.throw ..label-has-already-been-set [label]) + (exception.throw ..label_has_already_been_set [label]) (#.Some [expected #.None]) (do try.monad @@ -154,7 +154,7 @@ (def: #export monad (Monad Bytecode) (<| (:coerce (Monad Bytecode)) - (writer.with ..relative-monoid) + (writer.with ..relative_monoid) (: (Monad (State' Try [Pool Environment Tracker]))) state.with (: (Monad Try)) @@ -188,11 +188,11 @@ (/environment.consumes consumption) (monad.bind ! (/environment.produces production)) (monad.bind ! (/environment.has registry))) - program-counter' (step estimator (get@ #program-counter tracker))] + program_counter' (step estimator (get@ #program_counter tracker))] (wrap [[pool environment' - (set@ #program-counter program-counter' tracker)] - [(function.constant (wrap [..no-exceptions (bytecode input)])) + (set@ #program_counter program_counter' tracker)] + [(function.constant (wrap [..no_exceptions (bytecode input)])) []]])))) (template [<name> <frames>] @@ -229,35 +229,35 @@ [nop $0 $0 @_ _.nop] - [aconst-null $0 $1 @_ _.aconst-null] - - [iconst-m1 $0 $1 @_ _.iconst-m1] - [iconst-0 $0 $1 @_ _.iconst-0] - [iconst-1 $0 $1 @_ _.iconst-1] - [iconst-2 $0 $1 @_ _.iconst-2] - [iconst-3 $0 $1 @_ _.iconst-3] - [iconst-4 $0 $1 @_ _.iconst-4] - [iconst-5 $0 $1 @_ _.iconst-5] - - [lconst-0 $0 $2 @_ _.lconst-0] - [lconst-1 $0 $2 @_ _.lconst-1] - - [fconst-0 $0 $1 @_ _.fconst-0] - [fconst-1 $0 $1 @_ _.fconst-1] - [fconst-2 $0 $1 @_ _.fconst-2] + [aconst_null $0 $1 @_ _.aconst_null] + + [iconst_m1 $0 $1 @_ _.iconst_m1] + [iconst_0 $0 $1 @_ _.iconst_0] + [iconst_1 $0 $1 @_ _.iconst_1] + [iconst_2 $0 $1 @_ _.iconst_2] + [iconst_3 $0 $1 @_ _.iconst_3] + [iconst_4 $0 $1 @_ _.iconst_4] + [iconst_5 $0 $1 @_ _.iconst_5] + + [lconst_0 $0 $2 @_ _.lconst_0] + [lconst_1 $0 $2 @_ _.lconst_1] + + [fconst_0 $0 $1 @_ _.fconst_0] + [fconst_1 $0 $1 @_ _.fconst_1] + [fconst_2 $0 $1 @_ _.fconst_2] - [dconst-0 $0 $2 @_ _.dconst-0] - [dconst-1 $0 $2 @_ _.dconst-1] + [dconst_0 $0 $2 @_ _.dconst_0] + [dconst_1 $0 $2 @_ _.dconst_1] [pop $1 $0 @_ _.pop] [pop2 $2 $0 @_ _.pop2] [dup $1 $2 @_ _.dup] - [dup-x1 $2 $3 @_ _.dup-x1] - [dup-x2 $3 $4 @_ _.dup-x2] + [dup_x1 $2 $3 @_ _.dup_x1] + [dup_x2 $3 $4 @_ _.dup_x2] [dup2 $2 $4 @_ _.dup2] - [dup2-x1 $3 $5 @_ _.dup2-x1] - [dup2-x2 $4 $6 @_ _.dup2-x2] + [dup2_x1 $3 $5 @_ _.dup2_x1] + [dup2_x2 $4 $6 @_ _.dup2_x2] [swap $2 $2 @_ _.swap] @@ -270,30 +270,30 @@ [caload $2 $1 @_ _.caload] [saload $2 $1 @_ _.saload] - [iload-0 $0 $1 @0 _.iload-0] - [iload-1 $0 $1 @1 _.iload-1] - [iload-2 $0 $1 @2 _.iload-2] - [iload-3 $0 $1 @3 _.iload-3] + [iload_0 $0 $1 @0 _.iload_0] + [iload_1 $0 $1 @1 _.iload_1] + [iload_2 $0 $1 @2 _.iload_2] + [iload_3 $0 $1 @3 _.iload_3] - [lload-0 $0 $2 @1 _.lload-0] - [lload-1 $0 $2 @2 _.lload-1] - [lload-2 $0 $2 @3 _.lload-2] - [lload-3 $0 $2 @4 _.lload-3] + [lload_0 $0 $2 @1 _.lload_0] + [lload_1 $0 $2 @2 _.lload_1] + [lload_2 $0 $2 @3 _.lload_2] + [lload_3 $0 $2 @4 _.lload_3] - [fload-0 $0 $1 @0 _.fload-0] - [fload-1 $0 $1 @1 _.fload-1] - [fload-2 $0 $1 @2 _.fload-2] - [fload-3 $0 $1 @3 _.fload-3] + [fload_0 $0 $1 @0 _.fload_0] + [fload_1 $0 $1 @1 _.fload_1] + [fload_2 $0 $1 @2 _.fload_2] + [fload_3 $0 $1 @3 _.fload_3] - [dload-0 $0 $2 @1 _.dload-0] - [dload-1 $0 $2 @2 _.dload-1] - [dload-2 $0 $2 @3 _.dload-2] - [dload-3 $0 $2 @4 _.dload-3] + [dload_0 $0 $2 @1 _.dload_0] + [dload_1 $0 $2 @2 _.dload_1] + [dload_2 $0 $2 @3 _.dload_2] + [dload_3 $0 $2 @4 _.dload_3] - [aload-0 $0 $1 @0 _.aload-0] - [aload-1 $0 $1 @1 _.aload-1] - [aload-2 $0 $1 @2 _.aload-2] - [aload-3 $0 $1 @3 _.aload-3] + [aload_0 $0 $1 @0 _.aload_0] + [aload_1 $0 $1 @1 _.aload_1] + [aload_2 $0 $1 @2 _.aload_2] + [aload_3 $0 $1 @3 _.aload_3] [iastore $3 $1 @_ _.iastore] [lastore $4 $1 @_ _.lastore] @@ -304,30 +304,30 @@ [castore $3 $1 @_ _.castore] [sastore $3 $1 @_ _.sastore] - [istore-0 $1 $0 @0 _.istore-0] - [istore-1 $1 $0 @1 _.istore-1] - [istore-2 $1 $0 @2 _.istore-2] - [istore-3 $1 $0 @3 _.istore-3] - - [lstore-0 $2 $0 @1 _.lstore-0] - [lstore-1 $2 $0 @2 _.lstore-1] - [lstore-2 $2 $0 @3 _.lstore-2] - [lstore-3 $2 $0 @4 _.lstore-3] - - [fstore-0 $1 $0 @0 _.fstore-0] - [fstore-1 $1 $0 @1 _.fstore-1] - [fstore-2 $1 $0 @2 _.fstore-2] - [fstore-3 $1 $0 @3 _.fstore-3] - - [dstore-0 $2 $0 @1 _.dstore-0] - [dstore-1 $2 $0 @2 _.dstore-1] - [dstore-2 $2 $0 @3 _.dstore-2] - [dstore-3 $2 $0 @4 _.dstore-3] + [istore_0 $1 $0 @0 _.istore_0] + [istore_1 $1 $0 @1 _.istore_1] + [istore_2 $1 $0 @2 _.istore_2] + [istore_3 $1 $0 @3 _.istore_3] + + [lstore_0 $2 $0 @1 _.lstore_0] + [lstore_1 $2 $0 @2 _.lstore_1] + [lstore_2 $2 $0 @3 _.lstore_2] + [lstore_3 $2 $0 @4 _.lstore_3] + + [fstore_0 $1 $0 @0 _.fstore_0] + [fstore_1 $1 $0 @1 _.fstore_1] + [fstore_2 $1 $0 @2 _.fstore_2] + [fstore_3 $1 $0 @3 _.fstore_3] + + [dstore_0 $2 $0 @1 _.dstore_0] + [dstore_1 $2 $0 @2 _.dstore_1] + [dstore_2 $2 $0 @3 _.dstore_2] + [dstore_3 $2 $0 @4 _.dstore_3] - [astore-0 $1 $0 @0 _.astore-0] - [astore-1 $1 $0 @1 _.astore-1] - [astore-2 $1 $0 @2 _.astore-2] - [astore-3 $1 $0 @3 _.astore-3] + [astore_0 $1 $0 @0 _.astore_0] + [astore_1 $1 $0 @1 _.astore_1] + [astore_2 $1 $0 @2 _.astore_2] + [astore_3 $1 $0 @3 _.astore_3] [iadd $2 $1 @_ _.iadd] [isub $2 $1 @_ _.isub] @@ -410,7 +410,7 @@ (wrap [[pool (/environment.discontinue environment) tracker] - [..relative-identity + [..relative_identity []]])))) (template [<name> <consumption> <instruction>] @@ -442,7 +442,7 @@ (do try.monad [[pool' output] (resource pool)] (wrap [[pool' environment tracker] - [..relative-identity + [..relative_identity output]])))) (def: #export (string value) @@ -454,7 +454,7 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/string [index])))) + (..bytecode $0 $1 @_ _.ldc_w/string [index])))) (import: java/lang/Float ["#::." @@ -464,10 +464,10 @@ ["#::." (#static doubleToRawLongBits #manual [double] int)]) -(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>] +(template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] [(def: #export (<name> value) (-> <type> (Bytecode Any)) - (case (|> value <to-lux>) + (case (|> value <to_lux>) (^template [<special> <instruction>] [<special> (..bytecode $0 $1 @_ <instruction> [])]) <specializations> @@ -481,18 +481,18 @@ (#try.Failure _) (..bytecode $0 $1 @_ <wide> [index])))))] - [int I32 //constant.integer //constant/pool.integer _.ldc-w/integer + [int I32 //constant.integer //constant/pool.integer _.ldc_w/integer (<| .int i32.i64) - ([-1 _.iconst-m1] - [+0 _.iconst-0] - [+1 _.iconst-1] - [+2 _.iconst-2] - [+3 _.iconst-3] - [+4 _.iconst-4] - [+5 _.iconst-5])] + ([-1 _.iconst_m1] + [+0 _.iconst_0] + [+1 _.iconst_1] + [+2 _.iconst_2] + [+3 _.iconst_3] + [+4 _.iconst_4] + [+5 _.iconst_5])] ) -(def: (arbitrary-float value) +(def: (arbitrary_float value) (-> java/lang/Float (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.float (//constant.float value)))] @@ -501,35 +501,35 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/float [index])))) + (..bytecode $0 $1 @_ _.ldc_w/float [index])))) -(def: float-bits +(def: float_bits (-> java/lang/Float Int) (|>> java/lang/Float::floatToRawIntBits - host.int-to-long + host.int_to_long (:coerce Int))) -(def: negative-zero-float-bits - (|> -0.0 host.double-to-float ..float-bits)) +(def: negative_zero_float_bits + (|> -0.0 host.double_to_float ..float_bits)) (def: #export (float value) (-> java/lang/Float (Bytecode Any)) - (if (i.= ..negative-zero-float-bits - (..float-bits value)) - (..arbitrary-float value) - (case (|> value host.float-to-double (:coerce Frac)) + (if (i.= ..negative_zero_float_bits + (..float_bits value)) + (..arbitrary_float value) + (case (|> value host.float_to_double (:coerce Frac)) (^template [<special> <instruction>] [<special> (..bytecode $0 $1 @_ <instruction> [])]) - ([+0.0 _.fconst-0] - [+1.0 _.fconst-1] - [+2.0 _.fconst-2]) + ([+0.0 _.fconst_0] + [+1.0 _.fconst_1] + [+2.0 _.fconst_2]) - _ (..arbitrary-float value)))) + _ (..arbitrary_float value)))) -(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>] +(template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] [(def: #export (<name> value) (-> <type> (Bytecode Any)) - (case (|> value <to-lux>) + (case (|> value <to_lux>) (^template [<special> <instruction>] [<special> (..bytecode $0 $2 @_ <instruction> [])]) <specializations> @@ -538,40 +538,40 @@ [index (..lift (<constant> (<constructor> value)))] (..bytecode $0 $2 @_ <wide> [index]))))] - [long Int //constant.long //constant/pool.long _.ldc2-w/long + [long Int //constant.long //constant/pool.long _.ldc2_w/long (<|) - ([+0 _.lconst-0] - [+1 _.lconst-1])] + ([+0 _.lconst_0] + [+1 _.lconst_1])] ) -(def: (arbitrary-double value) +(def: (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.double (//constant.double value)))] - (..bytecode $0 $2 @_ _.ldc2-w/double [index]))) + (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) -(def: double-bits +(def: double_bits (-> java/lang/Double Int) (|>> java/lang/Double::doubleToRawLongBits (:coerce Int))) -(def: negative-zero-double-bits - (..double-bits -0.0)) +(def: negative_zero_double_bits + (..double_bits -0.0)) (def: #export (double value) (-> java/lang/Double (Bytecode Any)) - (if (i.= ..negative-zero-double-bits - (..double-bits value)) - (..arbitrary-double value) + (if (i.= ..negative_zero_double_bits + (..double_bits value)) + (..arbitrary_double value) (case value (^template [<special> <instruction>] [<special> (..bytecode $0 $2 @_ <instruction> [])]) - ([+0.0 _.dconst-0] - [+1.0 _.dconst-1]) + ([+0.0 _.dconst_0] + [+1.0 _.dconst_1]) - _ (..arbitrary-double value)))) + _ (..arbitrary_double value)))) -(exception: #export (invalid-register {id Nat}) +(exception: #export (invalid_register {id Nat}) (exception.report ["ID" (%.nat id)])) @@ -582,12 +582,12 @@ (\ ..monad wrap register) (#try.Failure error) - (..throw ..invalid-register [id]))) + (..throw ..invalid_register [id]))) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) (-> Nat (Bytecode Any)) - (with-expansions [<specials>' (template.splice <specials>)] + (with_expansions [<specials>' (template.splice <specials>)] (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode $0 <size> <registry> <instruction> [])] @@ -598,36 +598,36 @@ (..bytecode $0 <size> (<for> local) <general> [local]))))))] [/registry.for $1 iload _.iload - [[0 _.iload-0 @0] - [1 _.iload-1 @1] - [2 _.iload-2 @2] - [3 _.iload-3 @3]]] - [/registry.for-wide $2 lload _.lload - [[0 _.lload-0 @1] - [1 _.lload-1 @2] - [2 _.lload-2 @3] - [3 _.lload-3 @4]]] + [[0 _.iload_0 @0] + [1 _.iload_1 @1] + [2 _.iload_2 @2] + [3 _.iload_3 @3]]] + [/registry.for_wide $2 lload _.lload + [[0 _.lload_0 @1] + [1 _.lload_1 @2] + [2 _.lload_2 @3] + [3 _.lload_3 @4]]] [/registry.for $1 fload _.fload - [[0 _.fload-0 @0] - [1 _.fload-1 @1] - [2 _.fload-2 @2] - [3 _.fload-3 @3]]] - [/registry.for-wide $2 dload _.dload - [[0 _.dload-0 @1] - [1 _.dload-1 @2] - [2 _.dload-2 @3] - [3 _.dload-3 @4]]] + [[0 _.fload_0 @0] + [1 _.fload_1 @1] + [2 _.fload_2 @2] + [3 _.fload_3 @3]]] + [/registry.for_wide $2 dload _.dload + [[0 _.dload_0 @1] + [1 _.dload_1 @2] + [2 _.dload_2 @3] + [3 _.dload_3 @4]]] [/registry.for $1 aload _.aload - [[0 _.aload-0 @0] - [1 _.aload-1 @1] - [2 _.aload-2 @2] - [3 _.aload-3 @3]]] + [[0 _.aload_0 @0] + [1 _.aload_1 @1] + [2 _.aload_2 @2] + [3 _.aload_3 @3]]] ) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) (-> Nat (Bytecode Any)) - (with-expansions [<specials>' (template.splice <specials>)] + (with_expansions [<specials>' (template.splice <specials>)] (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode <size> $0 <registry> <instruction> [])] @@ -638,30 +638,30 @@ (..bytecode <size> $0 (<for> local) <general> [local]))))))] [/registry.for $1 istore _.istore - [[0 _.istore-0 @0] - [1 _.istore-1 @1] - [2 _.istore-2 @2] - [3 _.istore-3 @3]]] - [/registry.for-wide $2 lstore _.lstore - [[0 _.lstore-0 @1] - [1 _.lstore-1 @2] - [2 _.lstore-2 @3] - [3 _.lstore-3 @4]]] + [[0 _.istore_0 @0] + [1 _.istore_1 @1] + [2 _.istore_2 @2] + [3 _.istore_3 @3]]] + [/registry.for_wide $2 lstore _.lstore + [[0 _.lstore_0 @1] + [1 _.lstore_1 @2] + [2 _.lstore_2 @3] + [3 _.lstore_3 @4]]] [/registry.for $1 fstore _.fstore - [[0 _.fstore-0 @0] - [1 _.fstore-1 @1] - [2 _.fstore-2 @2] - [3 _.fstore-3 @3]]] - [/registry.for-wide $2 dstore _.dstore - [[0 _.dstore-0 @1] - [1 _.dstore-1 @2] - [2 _.dstore-2 @3] - [3 _.dstore-3 @4]]] + [[0 _.fstore_0 @0] + [1 _.fstore_1 @1] + [2 _.fstore_2 @2] + [3 _.fstore_3 @3]]] + [/registry.for_wide $2 dstore _.dstore + [[0 _.dstore_0 @1] + [1 _.dstore_1 @2] + [2 _.dstore_2 @3] + [3 _.dstore_3 @4]]] [/registry.for $1 astore _.astore - [[0 _.astore-0 @0] - [1 _.astore-1 @1] - [2 _.astore-2 @2] - [3 _.astore-3 @3]]] + [[0 _.astore_0 @0] + [1 _.astore_1 @1] + [2 _.astore_2 @2] + [3 _.astore_3 @3]]] ) (template [<consumption> <production> <name> <instruction> <input>] @@ -669,26 +669,26 @@ (-> <input> (Bytecode Any)) (..bytecode <consumption> <production> @_ <instruction>))] - [$1 $1 newarray _.newarray Primitive-Array-Type] + [$1 $1 newarray _.newarray Primitive_Array_Type] [$0 $1 sipush _.sipush S2] ) -(exception: #export (unknown-label {label Label}) +(exception: #export (unknown_label {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (cannot-do-a-big-jump {label Label} +(exception: #export (cannot_do_a_big_jump {label Label} {@from Address} - {jump Big-Jump}) + {jump Big_Jump}) (exception.report ["Label" (%.nat label)] ["Start" (|> @from /address.value //unsigned.value %.nat)] ["Target" (|> jump //signed.value %.int)])) -(type: Any-Jump (Either Big-Jump Jump)) +(type: Any_Jump (Either Big_Jump Jump)) (def: (jump @from @to) - (-> Address Address (Try Any-Jump)) + (-> Address Address (Try Any_Jump)) (do {! try.monad} [jump (\ ! map //signed.value (/address.jump @from @to))] @@ -701,23 +701,23 @@ (\ ! map (|>> #.Left) (//signed.s4 jump)) (\ ! map (|>> #.Right) (//signed.s2 jump)))))) -(exception: #export (unset-label {label Label}) +(exception: #export (unset_label {label Label}) (exception.report ["Label" (%.nat label)])) -(def: (resolve-label label resolver) +(def: (resolve_label label resolver) (-> Label Resolver (Try [Stack Address])) (case (dictionary.get label resolver) (#.Some [actual (#.Some address)]) (#try.Success [actual address]) (#.Some [actual #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) -(def: (acknowledge-label stack label tracker) +(def: (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) (case (dictionary.get label (get@ #known tracker)) (#.Some _) @@ -731,30 +731,30 @@ (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (do try.monad [environment' (|> environment (/environment.consumes <consumption>)) actual (/environment.stack environment') - program-counter' (step estimator @here)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool environment' (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (do try.monad - [[expected @to] (..resolve-label label resolver) - _ (exception.assert ..mismatched-environments [(name-of <instruction>) label @here expected actual] + [[expected @to] (..resolve_label label resolver) + _ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - (exception.throw ..cannot-do-a-big-jump [label @from jump]) + (exception.throw ..cannot_do_a_big_jump [label @from jump]) (#.Right jump) - (wrap [..no-exceptions (bytecode jump)])))) + (wrap [..no_exceptions (bytecode jump)])))) []]])))))))] [$1 ifeq _.ifeq] @@ -767,63 +767,63 @@ [$1 ifnull _.ifnull] [$1 ifnonnull _.ifnonnull] - [$2 if-icmpeq _.if-icmpeq] - [$2 if-icmpne _.if-icmpne] - [$2 if-icmplt _.if-icmplt] - [$2 if-icmpge _.if-icmpge] - [$2 if-icmpgt _.if-icmpgt] - [$2 if-icmple _.if-icmple] + [$2 if_icmpeq _.if_icmpeq] + [$2 if_icmpne _.if_icmpne] + [$2 if_icmplt _.if_icmplt] + [$2 if_icmpge _.if_icmpge] + [$2 if_icmpgt _.if_icmpgt] + [$2 if_icmple _.if_icmple] - [$2 if-acmpeq _.if-acmpeq] - [$2 if-acmpne _.if-acmpne] + [$2 if_acmpeq _.if_acmpeq] + [$2 if_acmpne _.if_acmpne] ) -(template [<name> <instruction> <on-long-jump> <on-short-jump>] +(template [<name> <instruction> <on_long_jump> <on_short_jump>] [(def: #export (<name> label) (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) (do try.monad [actual (/environment.stack environment) - #let [@here (get@ #program-counter tracker)] - program-counter' (step estimator @here)] + #let [@here (get@ #program_counter tracker)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool (/environment.discontinue environment) (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (case (dictionary.get label resolver) (#.Some [expected (#.Some @to)]) (do try.monad - [_ (exception.assert ..mismatched-environments [(name-of <instruction>) label @here expected actual] + [_ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - <on-long-jump> + <on_long_jump> (#.Right jump) - <on-short-jump>)) + <on_short_jump>)) (#.Some [expected #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) []]]))))))] [goto _.goto - (exception.throw ..cannot-do-a-big-jump [label @from jump]) - (wrap [..no-exceptions (bytecode jump)])] - [goto-w _.goto-w - (wrap [..no-exceptions (bytecode jump)]) - (wrap [..no-exceptions (bytecode (/jump.lift jump))])] + (exception.throw ..cannot_do_a_big_jump [label @from jump]) + (wrap [..no_exceptions (bytecode jump)])] + [goto_w _.goto_w + (wrap [..no_exceptions (bytecode jump)]) + (wrap [..no_exceptions (bytecode (/jump.lift jump))])] ) -(def: (big-jump jump) - (-> Any-Jump Big-Jump) +(def: (big_jump jump) + (-> Any_Jump Big_Jump) (case jump (#.Left big) big @@ -831,9 +831,9 @@ (#.Right small) (/jump.lift small))) -(exception: #export invalid-tableswitch) +(exception: #export invalid_tableswitch) -(def: #export (tableswitch minimum default [at-minimum afterwards]) +(def: #export (tableswitch minimum default [at_minimum afterwards]) (-> S4 Label [Label (List Label)] (Bytecode Any)) (let [[estimator bytecode] _.tableswitch] (function (_ [pool environment tracker]) @@ -841,36 +841,36 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size afterwards)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size afterwards)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards)) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] (case (do {! maybe.monad} [@default (|> default get (monad.bind ! product.right)) - @at-minimum (|> at-minimum get (monad.bind ! product.right)) + @at_minimum (|> at_minimum get (monad.bind ! product.right)) @afterwards (|> afterwards (monad.map ! get) (monad.bind ! (monad.map ! product.right)))] - (wrap [@default @at-minimum @afterwards])) - (#.Some [@default @at-minimum @afterwards]) + (wrap [@default @at_minimum @afterwards])) + (#.Some [@default @at_minimum @afterwards]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) - >at-minimum (\ ! map ..big-jump (..jump @from @at-minimum)) - >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump)) + [>default (\ ! map ..big_jump (..jump @from @default)) + >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum)) + >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)) @afterwards)] - (wrap [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])])) + (wrap [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) #.None - (exception.throw ..invalid-tableswitch [])))) + (exception.throw ..invalid_tableswitch [])))) []]])))))) -(exception: #export invalid-lookupswitch) +(exception: #export invalid_lookupswitch) (def: #export (lookupswitch default cases) (-> Label (List [S4 Label]) (Bytecode Any)) @@ -884,12 +884,12 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size cases)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size cases)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default (list\map product.right cases))) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases))) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) @@ -902,14 +902,14 @@ (wrap [@default @cases])) (#.Some [@default @cases]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) + [>default (\ ! map ..big_jump (..jump @from @default)) >cases (|> @cases - (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump))) + (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) (\ ! map (|>> (list.zip/2 (list\map product.left cases)))))] - (wrap [..no-exceptions (bytecode >default >cases)])) + (wrap [..no_exceptions (bytecode >default >cases)])) #.None - (exception.throw ..invalid-lookupswitch [])))) + (exception.throw ..invalid_lookupswitch [])))) []]])))))) (def: reflection @@ -937,7 +937,7 @@ [register (..register register)] (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))) -(exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)}) +(exception: #export (multiarray_cannot_be_zero_dimensional {class (Type Object)}) (exception.report ["Class" (..reflection class)])) (def: #export (multianewarray class dimensions) @@ -945,12 +945,12 @@ (do ..monad [_ (: (Bytecode Any) (case (|> dimensions //unsigned.value) - 0 (..throw ..multiarray-cannot-be-zero-dimensional [class]) + 0 (..throw ..multiarray_cannot_be_zero_dimensional [class]) _ (wrap []))) index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) -(def: (type-size type) +(def: (type_size type) (-> (Type Return) Nat) (cond (is? type.void type) 0 @@ -972,11 +972,11 @@ {#//constant/pool.name method #//constant/pool.descriptor (type.descriptor type)}) #let [consumption (|> inputs - (list\map ..type-size) + (list\map ..type_size) (list\fold n.+ (if <static?> 0 1)) //unsigned.u1 try.assume) - production (|> output ..type-size //unsigned.u1 try.assume)]] + production (|> output ..type_size //unsigned.u1 try.assume)]] (..bytecode (//unsigned.lift/2 consumption) (//unsigned.lift/2 production) @_ @@ -985,7 +985,7 @@ [#1 invokestatic _.invokestatic //constant/pool.method] [#0 invokevirtual _.invokevirtual //constant/pool.method] [#0 invokespecial _.invokespecial //constant/pool.method] - [#0 invokeinterface _.invokeinterface //constant/pool.interface-method] + [#0 invokeinterface _.invokeinterface //constant/pool.interface_method] ) (template [<consumption> <name> <1> <2>] @@ -1007,7 +1007,7 @@ [$2 putfield _.putfield/1 _.putfield/2] ) -(exception: #export (invalid-range-for-try {start Address} {end Address}) +(exception: #export (invalid_range_for_try {start Address} {end Address}) (exception.report ["Start" (|> start /address.value //unsigned.value %.nat)] ["End" (|> end /address.value //unsigned.value %.nat)])) @@ -1020,15 +1020,15 @@ (#try.Success [[pool environment - (..acknowledge-label /stack.catch @handler tracker)] + (..acknowledge_label /stack.catch @handler tracker)] [(function (_ resolver) (do try.monad - [[_ @start] (..resolve-label @start resolver) - [_ @end] (..resolve-label @end resolver) + [[_ @start] (..resolve_label @start resolver) + [_ @end] (..resolve_label @end resolver) _ (if (/address.after? @start @end) (wrap []) - (exception.throw ..invalid-range-for-try [@start @end])) - [_ @handler] (..resolve-label @handler resolver)] + (exception.throw ..invalid_range_for_try [@start @end])) + [_ @handler] (..resolve_label @handler resolver)] (wrap [(row.row {#//exception.start @start #//exception.end @end #//exception.handler @handler diff --git a/stdlib/source/lux/target/jvm/bytecode/address.lux b/stdlib/source/lux/target/jvm/bytecode/address.lux index 9f003db8d..6a16ab5cd 100644 --- a/stdlib/source/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/lux/target/jvm/bytecode/address.lux @@ -15,7 +15,7 @@ [type abstract]] ["." // #_ - [jump (#+ Big-Jump)] + [jump (#+ Big_Jump)] ["/#" // #_ [encoding ["#." unsigned (#+ U2)] @@ -38,15 +38,15 @@ (///unsigned.+/2 distance) (\ try.functor map (|>> :abstraction)))) - (def: with-sign + (def: with_sign (-> Address (Try S4)) (|>> :representation ///unsigned.value .int ///signed.s4)) (def: #export (jump from to) - (-> Address Address (Try Big-Jump)) + (-> Address Address (Try Big_Jump)) (do try.monad - [from (with-sign from) - to (with-sign to)] + [from (with_sign from) + to (with_sign to)] (///signed.-/4 from to))) (def: #export (after? reference subject) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment.lux b/stdlib/source/lux/target/jvm/bytecode/environment.lux index 7d70bdd81..932fe0e28 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment.lux @@ -61,7 +61,7 @@ (-> Environment Environment) (set@ #..stack #.None)) -(exception: #export (mismatched-stacks {expected Stack} +(exception: #export (mismatched_stacks {expected Stack} {actual Stack}) (exception.report ["Expected" (/stack.format expected)] @@ -73,7 +73,7 @@ (#.Some actual) (if (\ /stack.equivalence = expected actual) (#try.Success [actual environment]) - (exception.throw ..mismatched-stacks [expected actual])) + (exception.throw ..mismatched_stacks [expected actual])) #.None (#try.Success [expected (set@ #..stack (#.Some expected) environment)]))) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux index a0b8b67ab..802b99320 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -81,7 +81,7 @@ :abstraction)))] [for ..normal] - [for-wide ..wide] + [for_wide ..wide] ) ) diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index f72314163..91bba4ec3 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -21,7 +21,7 @@ abstract]] ["." // #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] + ["#." jump (#+ Jump Big_Jump)] [environment [limit [registry (#+ Register)]]] @@ -52,50 +52,50 @@ (def: #export run (-> Instruction Specification) - (function.apply format.no-op)) + (function.apply format.no_op)) (type: Opcode Nat) (template [<name> <size>] [(def: <name> Size (|> <size> ///unsigned.u2 try.assume))] - [opcode-size 1] - [register-size 1] - [byte-size 1] - [index-size 2] - [big-jump-size 4] - [integer-size 4] + [opcode_size 1] + [register_size 1] + [byte_size 1] + [index_size 2] + [big_jump_size 4] + [integer_size 4] ) (def: (nullary' opcode) (-> Opcode Mutation) (function (_ [offset binary]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) offset) (try.assume (binary.write/8 offset opcode binary))])) (def: nullary [Estimator (-> Opcode Instruction)] - [(..fixed ..opcode-size) + [(..fixed ..opcode_size) (function (_ opcode [size mutation]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) size) (|>> mutation ((nullary' opcode)))])]) (template [<name> <size>] [(def: <name> Size - (|> ..opcode-size + (|> ..opcode_size (///unsigned.+/2 <size>) try.assume))] - [size/1 ..register-size] - [size/2 ..index-size] - [size/4 ..big-jump-size] + [size/1 ..register_size] + [size/2 ..index_size] + [size/4 ..big_jump_size] ) (template [<shift> <name> <inputT> <writer> <unwrap>] - [(with-expansions [<private> (template.identifier ["'" <name>])] + [(with_expansions [<private> (template.identifier ["'" <name>])] (def: (<private> opcode input0) (-> Opcode <inputT> Mutation) (function (_ [offset binary]) @@ -103,7 +103,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode-size) offset) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) (<unwrap> input0) binary)))])) @@ -117,11 +117,11 @@ [..size/1 unary/1 U1 binary.write/8 ///unsigned.value] [..size/2 unary/2 U2 binary.write/16 ///unsigned.value] [..size/2 jump/2 Jump binary.write/16 ///signed.value] - [..size/4 jump/4 Big-Jump binary.write/32 ///signed.value] + [..size/4 jump/4 Big_Jump binary.write/32 ///signed.value] ) (template [<shift> <name> <inputT> <writer>] - [(with-expansions [<private> (template.identifier ["'" <name>])] + [(with_expansions [<private> (template.identifier ["'" <name>])] (def: (<private> opcode input0) (-> Opcode <inputT> Mutation) (function (_ [offset binary]) @@ -129,7 +129,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode-size) offset) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) (///signed.value input0) binary)))])) @@ -146,9 +146,9 @@ (def: size/11 Size - (|> ..opcode-size - (///unsigned.+/2 ..register-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..register_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/11' opcode input0 input1) (-> Opcode U1 U1 Mutation) @@ -157,7 +157,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/8 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/8 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/1) offset) @@ -173,9 +173,9 @@ (def: size/21 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/21' opcode input0 input1) (-> Opcode U2 U1 Mutation) @@ -184,7 +184,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -200,10 +200,10 @@ (def: size/211 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (trinary/211' opcode input0 input1 input2) (-> Opcode U2 U1 U1 Mutation) @@ -212,7 +212,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary) _ (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -229,50 +229,50 @@ [(n.+ (///unsigned.value ..size/211) size) (|>> mutation ((trinary/211' opcode input0 input1 input2)))])]) -(abstract: #export Primitive-Array-Type +(abstract: #export Primitive_Array_Type U1 (def: code - (-> Primitive-Array-Type U1) + (-> Primitive_Array_Type U1) (|>> :representation)) (template [<code> <name>] [(def: #export <name> (|> <code> ///unsigned.u1 try.assume :abstraction))] - [04 t-boolean] - [05 t-char] - [06 t-float] - [07 t-double] - [08 t-byte] - [09 t-short] - [10 t-int] - [11 t-long] + [04 t_boolean] + [05 t_char] + [06 t_float] + [07 t_double] + [08 t_byte] + [09 t_short] + [10 t_int] + [11 t_long] )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 -(with-expansions [<constants> (template [<code> <name>] +(with_expansions [<constants> (template [<code> <name>] [[<code> <name> [] []]] - ["01" aconst-null] + ["01" aconst_null] - ["02" iconst-m1] - ["03" iconst-0] - ["04" iconst-1] - ["05" iconst-2] - ["06" iconst-3] - ["07" iconst-4] - ["08" iconst-5] + ["02" iconst_m1] + ["03" iconst_0] + ["04" iconst_1] + ["05" iconst_2] + ["06" iconst_3] + ["07" iconst_4] + ["08" iconst_5] - ["09" lconst-0] - ["0A" lconst-1] + ["09" lconst_0] + ["0A" lconst_1] - ["0B" fconst-0] - ["0C" fconst-1] - ["0D" fconst-2] + ["0B" fconst_0] + ["0C" fconst_1] + ["0D" fconst_2] - ["0E" dconst-0] - ["0F" dconst-1]) - <register-loads> (template [<code> <name>] + ["0E" dconst_0] + ["0F" dconst_1]) + <register_loads> (template [<code> <name>] [[<code> <name> [[register Register]] [register]]] ["15" iload] @@ -280,34 +280,34 @@ ["17" fload] ["18" dload] ["19" aload]) - <simple-register-loads> (template [<code> <name>] + <simple_register_loads> (template [<code> <name>] [[<code> <name> [] []]] - ["1A" iload-0] - ["1B" iload-1] - ["1C" iload-2] - ["1D" iload-3] + ["1A" iload_0] + ["1B" iload_1] + ["1C" iload_2] + ["1D" iload_3] - ["1E" lload-0] - ["1F" lload-1] - ["20" lload-2] - ["21" lload-3] + ["1E" lload_0] + ["1F" lload_1] + ["20" lload_2] + ["21" lload_3] - ["22" fload-0] - ["23" fload-1] - ["24" fload-2] - ["25" fload-3] + ["22" fload_0] + ["23" fload_1] + ["24" fload_2] + ["25" fload_3] - ["26" dload-0] - ["27" dload-1] - ["28" dload-2] - ["29" dload-3] + ["26" dload_0] + ["27" dload_1] + ["28" dload_2] + ["29" dload_3] - ["2A" aload-0] - ["2B" aload-1] - ["2C" aload-2] - ["2D" aload-3]) - <register-stores> (template [<code> <name>] + ["2A" aload_0] + ["2B" aload_1] + ["2C" aload_2] + ["2D" aload_3]) + <register_stores> (template [<code> <name>] [[<code> <name> [[register Register]] [register]]] ["36" istore] @@ -315,34 +315,34 @@ ["38" fstore] ["39" dstore] ["3A" astore]) - <simple-register-stores> (template [<code> <name>] + <simple_register_stores> (template [<code> <name>] [[<code> <name> [] []]] - ["3B" istore-0] - ["3C" istore-1] - ["3D" istore-2] - ["3E" istore-3] - - ["3F" lstore-0] - ["40" lstore-1] - ["41" lstore-2] - ["42" lstore-3] - - ["43" fstore-0] - ["44" fstore-1] - ["45" fstore-2] - ["46" fstore-3] - - ["47" dstore-0] - ["48" dstore-1] - ["49" dstore-2] - ["4A" dstore-3] + ["3B" istore_0] + ["3C" istore_1] + ["3D" istore_2] + ["3E" istore_3] + + ["3F" lstore_0] + ["40" lstore_1] + ["41" lstore_2] + ["42" lstore_3] + + ["43" fstore_0] + ["44" fstore_1] + ["45" fstore_2] + ["46" fstore_3] + + ["47" dstore_0] + ["48" dstore_1] + ["49" dstore_2] + ["4A" dstore_3] - ["4B" astore-0] - ["4C" astore-1] - ["4D" astore-2] - ["4E" astore-3]) - <array-loads> (template [<code> <name>] + ["4B" astore_0] + ["4C" astore_1] + ["4D" astore_2] + ["4E" astore_3]) + <array_loads> (template [<code> <name>] [[<code> <name> [] []]] ["2E" iaload] @@ -353,7 +353,7 @@ ["33" baload] ["34" caload] ["35" saload]) - <array-stores> (template [<code> <name>] + <array_stores> (template [<code> <name>] [[<code> <name> [] []]] ["4f" iastore] @@ -454,15 +454,15 @@ ["9D" ifgt] ["9E" ifle] - ["9F" if-icmpeq] - ["A0" if-icmpne] - ["A1" if-icmplt] - ["A2" if-icmpge] - ["A3" if-icmpgt] - ["A4" if-icmple] + ["9F" if_icmpeq] + ["A0" if_icmpne] + ["A1" if_icmplt] + ["A2" if_icmpge] + ["A3" if_icmpgt] + ["A4" if_icmple] - ["A5" if-acmpeq] - ["A6" if-acmpne] + ["A5" if_acmpeq] + ["A6" if_acmpne] ["A7" goto] ["A8" jsr] @@ -477,23 +477,23 @@ ["B4" getfield/1] ["B4" getfield/2] ["B5" putfield/1] ["B5" putfield/2])] (template [<arity> <definitions>] - [(with-expansions [<definitions>' (template.splice <definitions>)] - (template [<code> <name> <instruction-inputs> <arity-inputs>] - [(with-expansions [<inputs>' (template.splice <instruction-inputs>) - <input-types> (template [<input-name> <input-type>] - [<input-type>] + [(with_expansions [<definitions>' (template.splice <definitions>)] + (template [<code> <name> <instruction_inputs> <arity_inputs>] + [(with_expansions [<inputs>' (template.splice <instruction_inputs>) + <input_types> (template [<input_name> <input_type>] + [<input_type>] <inputs>') - <input-names> (template [<input-name> <input-type>] - [<input-name>] + <input_names> (template [<input_name> <input_type>] + [<input_name>] <inputs>')] (def: #export <name> - [Estimator (-> [<input-types>] Instruction)] + [Estimator (-> [<input_types>] Instruction)] (let [[estimator <arity>'] <arity>] [estimator - (function (_ [<input-names>]) - (`` (<arity>' (hex <code>) (~~ (template.splice <arity-inputs>)))))])))] + (function (_ [<input_names>]) + (`` (<arity>' (hex <code>) (~~ (template.splice <arity_inputs>)))))])))] <definitions>' ))] @@ -504,16 +504,16 @@ ["57" pop [] []] ["58" pop2 [] []] ["59" dup [] []] - ["5A" dup-x1 [] []] - ["5B" dup-x2 [] []] + ["5A" dup_x1 [] []] + ["5B" dup_x2 [] []] ["5C" dup2 [] []] - ["5D" dup2-x1 [] []] - ["5E" dup2-x2 [] []] + ["5D" dup2_x1 [] []] + ["5E" dup2_x2 [] []] ["5F" swap [] []] - <simple-register-loads> - <array-loads> - <simple-register-stores> - <array-stores> + <simple_register_loads> + <array_loads> + <simple_register_stores> + <array_stores> <arithmetic> ["79" lshl [] []] ["7B" lshr [] []] @@ -528,28 +528,28 @@ [..unary/1 [["12" ldc [[index U1]] [index]] - <register-loads> - <register-stores> + <register_loads> + <register_stores> ["A9" ret [[register Register]] [register]] - ["BC" newarray [[type Primitive-Array-Type]] [(..code type)]]]] + ["BC" newarray [[type Primitive_Array_Type]] [(..code type)]]]] [..unary/1' [["10" bipush [[byte S1]] [byte]]]] [..unary/2 - [["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] - ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.value index)]] - ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.value index)]] - ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.value index)]] - ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.value index)]] + [["13" ldc_w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] + ["13" ldc_w/float [[index (Index ///constant.Float)]] [(///index.value index)]] + ["13" ldc_w/string [[index (Index ///constant.String)]] [(///index.value index)]] + ["14" ldc2_w/long [[index (Index ///constant.Long)]] [(///index.value index)]] + ["14" ldc2_w/double [[index (Index ///constant.Double)]] [(///index.value index)]] <fields> ["BB" new [[index (Index Class)]] [(///index.value index)]] ["BD" anewarray [[index (Index Class)]] [(///index.value index)]] ["C0" checkcast [[index (Index Class)]] [(///index.value index)]] ["C1" instanceof [[index (Index Class)]] [(///index.value index)]] - ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]]]] + ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]]] [..unary/2' [["11" sipush [[short S2]] [short]]]] @@ -558,8 +558,8 @@ [<jumps>]] [..jump/4 - [["C8" goto-w [[jump Big-Jump]] [jump]] - ["C9" jsr-w [[jump Big-Jump]] [jump]]]] + [["C8" goto_w [[jump Big_Jump]] [jump]] + ["C9" jsr_w [[jump Big_Jump]] [jump]]]] [..binary/11 [["84" iinc [[register Register] [byte U1]] [register byte]]]] @@ -568,52 +568,52 @@ [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.value index) count]]]] [..trinary/211 - [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] + [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] )) -(def: (switch-padding offset) +(def: (switch_padding offset) (-> Nat Nat) - (let [parameter-start (n.+ (///unsigned.value ..opcode-size) + (let [parameter_start (n.+ (///unsigned.value ..opcode_size) offset)] (n.% 4 - (n.- (n.% 4 parameter-start) + (n.- (n.% 4 parameter_start) 4)))) (def: #export tableswitch [(-> Nat Estimator) - (-> S4 Big-Jump [Big-Jump (List Big-Jump)] Instruction)] + (-> S4 Big_Jump [Big_Jump (List Big_Jump)] Instruction)] (let [estimator (: (-> Nat Estimator) - (function (_ amount-of-afterwards offset) + (function (_ amount_of_afterwards offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (///unsigned.value ..integer-size) - (n.* (///unsigned.value ..big-jump-size) - (inc amount-of-afterwards))) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (///unsigned.value ..integer_size) + (n.* (///unsigned.value ..big_jump_size) + (inc amount_of_afterwards))) ///unsigned.u2 try.assume)))] [estimator - (function (_ minimum default [at-minimum afterwards]) - (let [amount-of-afterwards (list.size afterwards) - estimator (estimator amount-of-afterwards)] + (function (_ minimum default [at_minimum afterwards]) + (let [amount_of_afterwards (list.size afterwards) + estimator (estimator amount_of_afterwards)] (function (_ [size mutation]) - (let [padding (switch-padding size) - tableswitch-size (try.assume + (let [padding (switch_padding size) + tableswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - tableswitch-mutation (: Mutation + tableswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ tableswitch-size offset) + [(n.+ tableswitch_size offset) (try.assume (do {! try.monad} - [amount-of-afterwards (|> amount-of-afterwards .int ///signed.s4) - maximum (///signed.+/4 minimum amount-of-afterwards) + [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) + maximum (///signed.+/4 minimum amount_of_afterwards) _ (binary.write/8 offset (hex "AA") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -623,13 +623,13 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] _ (binary.write/32 offset (///signed.value minimum) binary) - #let [offset (n.+ (///unsigned.value ..integer-size) offset)] + #let [offset (n.+ (///unsigned.value ..integer_size) offset)] _ (binary.write/32 offset (///signed.value maximum) binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) - afterwards (: (List Big-Jump) - (#.Cons at-minimum afterwards))] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + afterwards (: (List Big_Jump) + (#.Cons at_minimum afterwards))] (case afterwards #.Nil (wrap binary) @@ -637,45 +637,45 @@ (#.Cons head tail) (do ! [_ (binary.write/32 offset (///signed.value head) binary)] - (recur (n.+ (///unsigned.value ..big-jump-size) offset) + (recur (n.+ (///unsigned.value ..big_jump_size) offset) tail))))))]))] - [(n.+ tableswitch-size + [(n.+ tableswitch_size size) - (|>> mutation tableswitch-mutation)]))))])) + (|>> mutation tableswitch_mutation)]))))])) (def: #export lookupswitch [(-> Nat Estimator) - (-> Big-Jump (List [S4 Big-Jump]) Instruction)] - (let [case-size (n.+ (///unsigned.value ..integer-size) - (///unsigned.value ..big-jump-size)) + (-> Big_Jump (List [S4 Big_Jump]) Instruction)] + (let [case_size (n.+ (///unsigned.value ..integer_size) + (///unsigned.value ..big_jump_size)) estimator (: (-> Nat Estimator) - (function (_ amount-of-cases offset) + (function (_ amount_of_cases offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (n.* amount-of-cases case-size)) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (n.* amount_of_cases case_size)) ///unsigned.u2 try.assume)))] [estimator (function (_ default cases) - (let [amount-of-cases (list.size cases) - estimator (estimator amount-of-cases)] + (let [amount_of_cases (list.size cases) + estimator (estimator amount_of_cases)] (function (_ [size mutation]) - (let [padding (switch-padding size) - lookupswitch-size (try.assume + (let [padding (switch_padding size) + lookupswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - lookupswitch-mutation (: Mutation + lookupswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ lookupswitch-size offset) + [(n.+ lookupswitch_size offset) (try.assume (do {! try.monad} [_ (binary.write/8 offset (hex "AB") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -685,9 +685,9 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] - _ (binary.write/32 offset amount-of-cases binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] + _ (binary.write/32 offset amount_of_cases binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) cases cases] (case cases #.Nil @@ -696,12 +696,12 @@ (#.Cons [value jump] tail) (do ! [_ (binary.write/32 offset (///signed.value value) binary) - _ (binary.write/32 (n.+ (///unsigned.value ..integer-size) offset) (///signed.value jump) binary)] - (recur (n.+ case-size offset) + _ (binary.write/32 (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)] + (recur (n.+ case_size offset) tail))))))]))] - [(n.+ lookupswitch-size + [(n.+ lookupswitch_size size) - (|>> mutation lookupswitch-mutation)]))))])) + (|>> mutation lookupswitch_mutation)]))))])) (structure: #export monoid (Monoid Instruction) diff --git a/stdlib/source/lux/target/jvm/bytecode/jump.lux b/stdlib/source/lux/target/jvm/bytecode/jump.lux index 79ec9fa9b..4670b07ea 100644 --- a/stdlib/source/lux/target/jvm/bytecode/jump.lux +++ b/stdlib/source/lux/target/jvm/bytecode/jump.lux @@ -19,8 +19,8 @@ (Writer Jump) ///signed.writer/2) -(type: #export Big-Jump S4) +(type: #export Big_Jump S4) (def: #export lift - (-> Jump Big-Jump) + (-> Jump Big_Jump) ///signed.lift/4) diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index 27eded008..ad90c3db5 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -28,9 +28,9 @@ (type: #export #rec Class {#magic Magic - #minor-version Minor - #major-version Major - #constant-pool Pool + #minor_version Minor + #major_version Major + #constant_pool Pool #modifier (Modifier Class) #this (Index //constant.Class) #super (Index //constant.Class) @@ -65,7 +65,7 @@ (row.equivalence //method.equivalence) (row.equivalence //attribute.equivalence))) -(def: (install-classes this super interfaces) +(def: (install_classes this super interfaces) (-> Internal Internal (List Internal) (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) (do {! //constant/pool.monad} @@ -93,20 +93,20 @@ [[pool [@this @super @interfaces] =fields =methods] (<| (state.run' //constant/pool.empty) (do //constant/pool.monad - [classes (install-classes this super interfaces) + [classes (install_classes this super interfaces) =fields (monad.seq //constant/pool.monad fields) =methods (monad.seq //constant/pool.monad methods)] (wrap [classes =fields =methods])))] (wrap {#magic //magic.code - #minor-version //version.default-minor - #major-version version - #constant-pool pool + #minor_version //version.default_minor + #major_version version + #constant_pool pool #modifier modifier #this @this #super @super #interfaces @interfaces - #fields (row.from-list =fields) - #methods (row.from-list =methods) + #fields (row.from_list =fields) + #methods (row.from_list =methods) #attributes attributes}))) (def: #export (writer class) @@ -116,9 +116,9 @@ [(<writer> (get@ <slot> class))] [//magic.writer #magic] - [//version.writer #minor-version] - [//version.writer #major-version] - [//constant/pool.writer #constant-pool] + [//version.writer #minor_version] + [//version.writer #major_version] + [//constant/pool.writer #constant_pool] [//modifier.writer #modifier] [//index.writer #this] [//index.writer #super])) diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index e8f369492..6b953e008 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -34,7 +34,7 @@ (type: #export UTF8 Text) -(def: utf8-writer +(def: utf8_writer (Writer UTF8) binaryF.utf8/16) @@ -49,13 +49,13 @@ (-> (Index UTF8) Class) (|>> :abstraction)) - (def: #export class-equivalence + (def: #export class_equivalence (Equivalence Class) (\ equivalence.functor map ..index //index.equivalence)) - (def: class-writer + (def: class_writer (Writer Class) (|>> :representation //index.writer)) ) @@ -64,7 +64,7 @@ ["#::." (#static floatToRawIntBits #manual [float] int)]) -(structure: #export float-equivalence +(structure: #export float_equivalence (Equivalence java/lang/Float) (def: (= parameter subject) @@ -87,7 +87,7 @@ (All [kind] (-> (Value kind) kind)) (|>> :representation)) - (def: #export (value-equivalence Equivalence<kind>) + (def: #export (value_equivalence Equivalence<kind>) (All [kind] (-> (Equivalence kind) (Equivalence (Value kind)))) @@ -109,28 +109,28 @@ [string String (Index UTF8)] ) - (template [<writer-name> <type> <write> <writer>] - [(def: <writer-name> + (template [<writer_name> <type> <write> <writer>] + [(def: <writer_name> (Writer <type>) (`` (|>> :representation (~~ (template.splice <write>)) (~~ (template.splice <writer>)))))] - [integer-writer Integer [] [binaryF.bits/32]] - [float-writer Float [java/lang/Float::floatToRawIntBits host.int-to-long (:coerce I64)] [i32.i32 binaryF.bits/32]] - [long-writer Long [] [binaryF.bits/64]] - [double-writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] - [string-writer String [] [//index.writer]] + [integer_writer Integer [] [binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits host.int_to_long (:coerce I64)] [i32.i32 binaryF.bits/32]] + [long_writer Long [] [binaryF.bits/64]] + [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string_writer String [] [//index.writer]] ) ) -(type: #export (Name-And-Type of) +(type: #export (Name_And_Type of) {#name (Index UTF8) #descriptor (Index (Descriptor of))}) (type: #export (Reference of) {#class (Index Class) - #name-and-type (Index (Name-And-Type of))}) + #name_and_type (Index (Name_And_Type of))}) (template [<type> <equivalence> <writer>] [(def: #export <equivalence> @@ -145,8 +145,8 @@ //index.writer //index.writer))] - [Name-And-Type name-and-type-equivalence name-and-type-writer] - [Reference reference-equivalence reference-writer] + [Name_And_Type name_and_type_equivalence name_and_type_writer] + [Reference reference_equivalence reference_writer] ) (type: #export Constant @@ -159,8 +159,8 @@ (#String String) (#Field (Reference //category.Value)) (#Method (Reference //category.Method)) - (#Interface-Method (Reference //category.Method)) - (#Name-And-Type (Name-And-Type Any))) + (#Interface_Method (Reference //category.Method)) + (#Name_And_Type (Name_And_Type Any))) (def: #export (size constant) (-> Constant Nat) @@ -182,16 +182,16 @@ [[(<tag> reference) (<tag> sample)] (\ <equivalence> = reference sample)]) ([#UTF8 text.equivalence] - [#Integer (..value-equivalence i32.equivalence)] - [#Long (..value-equivalence int.equivalence)] - [#Float (..value-equivalence float-equivalence)] - [#Double (..value-equivalence frac.equivalence)] - [#Class ..class-equivalence] - [#String (..value-equivalence //index.equivalence)] - [#Field ..reference-equivalence] - [#Method ..reference-equivalence] - [#Interface-Method ..reference-equivalence] - [#Name-And-Type ..name-and-type-equivalence]) + [#Integer (..value_equivalence i32.equivalence)] + [#Long (..value_equivalence int.equivalence)] + [#Float (..value_equivalence float_equivalence)] + [#Double (..value_equivalence frac.equivalence)] + [#Class ..class_equivalence] + [#String (..value_equivalence //index.equivalence)] + [#Field ..reference_equivalence] + [#Method ..reference_equivalence] + [#Interface_Method ..reference_equivalence] + [#Name_And_Type ..name_and_type_equivalence]) _ false))) @@ -199,40 +199,40 @@ ## ## #UTF8 ## text.equivalence ## ## #Long - ## (..value-equivalence int.equivalence) + ## (..value_equivalence int.equivalence) ## ## #Double - ## (..value-equivalence frac.equivalence) + ## (..value_equivalence frac.equivalence) ## ## #Class - ## ..class-equivalence + ## ..class_equivalence ## ## #String - ## (..value-equivalence //index.equivalence) + ## (..value_equivalence //index.equivalence) ## ## #Field - ## ..reference-equivalence + ## ..reference_equivalence ## ## #Method - ## ..reference-equivalence - ## ## #Interface-Method - ## ..reference-equivalence - ## ## #Name-And-Type - ## ..name-and-type-equivalence + ## ..reference_equivalence + ## ## #Interface_Method + ## ..reference_equivalence + ## ## #Name_And_Type + ## ..name_and_type_equivalence ## ) ) (def: #export writer (Writer Constant) - (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 ..utf8-writer] - [#Integer /tag.integer ..integer-writer] - [#Float /tag.float ..float-writer] - [#Long /tag.long ..long-writer] - [#Double /tag.double ..double-writer] - [#Class /tag.class ..class-writer] - [#String /tag.string ..string-writer] - [#Field /tag.field ..reference-writer] - [#Method /tag.method ..reference-writer] - [#Interface-Method /tag.interface-method ..reference-writer] - [#Name-And-Type /tag.name-and-type ..name-and-type-writer] - ## TODO: Method-Handle - ## TODO: Method-Type - ## TODO: Invoke-Dynamic + (with_expansions [<constants> (as_is [#UTF8 /tag.utf8 ..utf8_writer] + [#Integer /tag.integer ..integer_writer] + [#Float /tag.float ..float_writer] + [#Long /tag.long ..long_writer] + [#Double /tag.double ..double_writer] + [#Class /tag.class ..class_writer] + [#String /tag.string ..string_writer] + [#Field /tag.field ..reference_writer] + [#Method /tag.method ..reference_writer] + [#Interface_Method /tag.interface_method ..reference_writer] + [#Name_And_Type /tag.name_and_type ..name_and_type_writer] + ## TODO: Method_Handle + ## TODO: Method_Type + ## TODO: Invoke_Dynamic )] (function (_ value) (case value diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 2bc141e66..700c6ee85 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -23,7 +23,7 @@ abstract] [macro ["." template]]] - ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name-And-Type Reference) + ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference) [// [encoding ["#." name (#+ Internal External)] @@ -51,7 +51,7 @@ (template: (!add <tag> <equivalence> <value>) (function (_ [current pool]) (let [<value>' <value>] - (with-expansions [<try-again> (as-is (recur (.inc idx)))] + (with_expansions [<try_again> (as_is (recur (.inc idx)))] (loop [idx 0] (case (row.nth idx pool) (#try.Success entry) @@ -60,10 +60,10 @@ (if (\ <equivalence> = reference <value>') (#try.Success [[current pool] index]) - <try-again>) + <try_again>) _ - <try-again>) + <try_again>) (#try.Failure _) (let [new (<tag> <value>')] @@ -89,10 +89,10 @@ (Adder <type>) (!add <tag> <equivalence> value))] - [integer Integer #//.Integer (//.value-equivalence i32.equivalence)] - [float Float #//.Float (//.value-equivalence //.float-equivalence)] - [long Long #//.Long (//.value-equivalence int.equivalence)] - [double Double #//.Double (//.value-equivalence frac.equivalence)] + [integer Integer #//.Integer (//.value_equivalence i32.equivalence)] + [float Float #//.Float (//.value_equivalence //.float_equivalence)] + [long Long #//.Long (//.value_equivalence int.equivalence)] + [double Double #//.Double (//.value_equivalence frac.equivalence)] [utf8 UTF8 #//.UTF8 text.equivalence] ) @@ -101,14 +101,14 @@ (do ..monad [@value (utf8 value) #let [value (//.string @value)]] - (!add #//.String (//.value-equivalence //index.equivalence) value))) + (!add #//.String (//.value_equivalence //index.equivalence) value))) (def: #export (class name) (-> Internal (Resource (Index Class))) (do ..monad [@name (utf8 (//name.read name)) #let [value (//.class @name)]] - (!add #//.Class //.class-equivalence value))) + (!add #//.Class //.class_equivalence value))) (def: #export (descriptor value) (All [kind] @@ -121,25 +121,25 @@ {#name UTF8 #descriptor (Descriptor of)}) -(def: #export (name-and-type [name descriptor]) +(def: #export (name_and_type [name descriptor]) (All [of] - (-> (Member of) (Resource (Index (Name-And-Type of))))) + (-> (Member of) (Resource (Index (Name_And_Type of))))) (do ..monad [@name (utf8 name) @descriptor (..descriptor descriptor)] - (!add #//.Name-And-Type //.name-and-type-equivalence {#//.name @name #//.descriptor @descriptor}))) + (!add #//.Name_And_Type //.name_and_type_equivalence {#//.name @name #//.descriptor @descriptor}))) (template [<name> <tag> <of>] [(def: #export (<name> class member) (-> External (Member <of>) (Resource (Index (Reference <of>)))) (do ..monad [@class (..class (//name.internal class)) - @name-and-type (name-and-type member)] - (!add <tag> //.reference-equivalence {#//.class @class #//.name-and-type @name-and-type})))] + @name_and_type (name_and_type member)] + (!add <tag> //.reference_equivalence {#//.class @class #//.name_and_type @name_and_type})))] [field #//.Field Value] [method #//.Method Method] - [interface-method #//.Interface-Method Method] + [interface_method #//.Interface_Method Method] ) (def: #export writer diff --git a/stdlib/source/lux/target/jvm/constant/tag.lux b/stdlib/source/lux/target/jvm/constant/tag.lux index fc2311ab9..a35ff3438 100644 --- a/stdlib/source/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/lux/target/jvm/constant/tag.lux @@ -36,11 +36,11 @@ [08 string] [09 field] [10 method] - [11 interface-method] - [12 name-and-type] - [15 method-handle] - [16 method-type] - [18 invoke-dynamic] + [11 interface_method] + [12 name_and_type] + [15 method_handle] + [16 method_type] + [18 invoke_dynamic] ) (def: #export writer diff --git a/stdlib/source/lux/target/jvm/encoding/name.lux b/stdlib/source/lux/target/jvm/encoding/name.lux index 3d0287b26..606c7439c 100644 --- a/stdlib/source/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/lux/target/jvm/encoding/name.lux @@ -6,8 +6,8 @@ [type abstract]]) -(def: #export internal-separator "/") -(def: #export external-separator ".") +(def: #export internal_separator "/") +(def: #export external_separator ".") (type: #export External Text) @@ -16,8 +16,8 @@ (def: #export internal (-> External Internal) - (|>> (text.replace-all ..external-separator - ..internal-separator) + (|>> (text.replace_all ..external_separator + ..internal_separator) :abstraction)) (def: #export read @@ -27,8 +27,8 @@ (def: #export external (-> Internal External) (|>> :representation - (text.replace-all ..internal-separator - ..external-separator)))) + (text.replace_all ..internal_separator + ..external_separator)))) (def: #export sanitize (-> Text External) @@ -36,4 +36,4 @@ (def: #export (qualify package class) (-> Text External External) - (format (..sanitize package) ..external-separator class)) + (format (..sanitize package) ..external_separator class)) diff --git a/stdlib/source/lux/target/jvm/encoding/signed.lux b/stdlib/source/lux/target/jvm/encoding/signed.lux index cef82ae7e..1cc3fe07f 100644 --- a/stdlib/source/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/lux/target/jvm/encoding/signed.lux @@ -39,14 +39,14 @@ (def: (< reference sample) (i.< (:representation reference) (:representation sample)))) - (exception: #export (value-exceeds-the-scope {value Int} + (exception: #export (value_exceeds_the_scope {value Int} {scope Nat}) (exception.report ["Value" (%.int value)] ["Scope (in bytes)" (%.nat scope)])) (template [<bytes> <name> <size> <constructor> <maximum> <+> <->] - [(with-expansions [<raw> (template.identifier [<name> "'"])] + [(with_expansions [<raw> (template.identifier [<name> "'"])] (abstract: #export <raw> Any) (type: #export <name> (Signed <raw>))) @@ -54,25 +54,25 @@ (def: #export <maximum> <name> - (|> <bytes> (n.* i64.bits-per-byte) dec i64.mask :abstraction)) + (|> <bytes> (n.* i64.bits_per_byte) dec i64.mask :abstraction)) (def: #export <constructor> (-> Int (Try <name>)) - (let [positive (|> <bytes> (n.* i64.bits-per-byte) i64.mask .nat) - negative (|> positive (i64.arithmetic-right-shift 1) i64.not)] + (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask .nat) + negative (|> positive (i64.arithmetic_right_shift 1) i64.not)] (function (_ value) (if (i.= (if (i.< +0 value) (i64.or negative value) (i64.and positive value)) value) (#try.Success (:abstraction value)) - (exception.throw ..value-exceeds-the-scope [value <size>]))))) + (exception.throw ..value_exceeds_the_scope [value <size>]))))) - (template [<abstract-operation> <concrete-operation>] - [(def: #export (<abstract-operation> parameter subject) + (template [<abstract_operation> <concrete_operation>] + [(def: #export (<abstract_operation> parameter subject) (-> <name> <name> (Try <name>)) (<constructor> - (<concrete-operation> (:representation parameter) + (<concrete_operation> (:representation parameter) (:representation subject))))] [<+> i.+] @@ -93,8 +93,8 @@ [lift/4 S2 S4] ) - (template [<writer-name> <type> <writer>] - [(def: #export <writer-name> + (template [<writer_name> <type> <writer>] + [(def: #export <writer_name> (Writer <type>) (|>> :representation <writer>))] diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux index 5abc79468..c145dcdab 100644 --- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux @@ -40,7 +40,7 @@ (n.< (:representation reference) (:representation sample)))) - (exception: #export (value-exceeds-the-maximum {type Name} + (exception: #export (value_exceeds_the_maximum {type Name} {value Nat} {maximum (Unsigned Any)}) (exception.report @@ -48,7 +48,7 @@ ["Value" (%.nat value)] ["Maximum" (%.nat (:representation maximum))])) - (exception: #export [brand] (subtraction-cannot-yield-negative-value + (exception: #export [brand] (subtraction_cannot_yield_negative_value {type Name} {parameter (Unsigned brand)} {subject (Unsigned brand)}) @@ -58,7 +58,7 @@ ["Subject" (%.nat (:representation subject))])) (template [<bytes> <name> <size> <constructor> <maximum> <+> <-> <max>] - [(with-expansions [<raw> (template.identifier [<name> "'"])] + [(with_expansions [<raw> (template.identifier [<name> "'"])] (abstract: #export <raw> Any) (type: #export <name> (Unsigned <raw>))) @@ -66,13 +66,13 @@ (def: #export <maximum> <name> - (|> <bytes> (n.* i64.bits-per-byte) i64.mask :abstraction)) + (|> <bytes> (n.* i64.bits_per_byte) i64.mask :abstraction)) (def: #export (<constructor> value) (-> Nat (Try <name>)) (if (n.<= (:representation <maximum>) value) (#try.Success (:abstraction value)) - (exception.throw ..value-exceeds-the-maximum [(name-of <name>) value <maximum>]))) + (exception.throw ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]))) (def: #export (<+> parameter subject) (-> <name> <name> (Try <name>)) @@ -86,7 +86,7 @@ subject' (:representation subject)] (if (n.<= subject' parameter') (#try.Success (:abstraction (n.- parameter' subject'))) - (exception.throw ..subtraction-cannot-yield-negative-value [(name-of <name>) parameter subject])))) + (exception.throw ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject])))) (def: #export (<max> left right) (-> <name> <name> <name>) @@ -107,8 +107,8 @@ [lift/4 U2 U4] ) - (template [<writer-name> <type> <writer>] - [(def: #export <writer-name> + (template [<writer_name> <type> <writer>] + [(def: #export <writer_name> (Writer <type>) (|>> :representation <writer>))] diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index 8f9f47e4f..acda83ca9 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -16,21 +16,21 @@ [collection ["." array] ["." dictionary (#+ Dictionary)]]] - ["." host (#+ import: object do-to)]]) + ["." host (#+ import: object do_to)]]) (type: #export Library (Atom (Dictionary Text Binary))) -(exception: #export (already-stored {class Text}) +(exception: #export (already_stored {class Text}) (exception.report ["Class" class])) -(exception: #export (unknown {class Text} {known-classes (List Text)}) +(exception: #export (unknown {class Text} {known_classes (List Text)}) (exception.report ["Class" class] - ["Known classes" (exception.enumerate (|>>) known-classes)])) + ["Known classes" (exception.enumerate (|>>) known_classes)])) -(exception: #export (cannot-define {class Text} {error Text}) +(exception: #export (cannot_define {class Text} {error Text}) (exception.report ["Class" class] ["Error" error])) @@ -62,46 +62,46 @@ (loadClass [java/lang/String] #io #try (java/lang/Class java/lang/Object))]) -(with-expansions [<elemT> (as-is (java/lang/Class java/lang/Object))] +(with_expansions [<elemT> (as_is (java/lang/Class java/lang/Object))] (def: java/lang/ClassLoader::defineClass java/lang/reflect/Method (let [signature (|> (host.array <elemT> 4) - (host.array-write 0 (:coerce <elemT> - (host.class-for java/lang/String))) - (host.array-write 1 (java/lang/Object::getClass (host.array byte 0))) - (host.array-write 2 (:coerce <elemT> + (host.array_write 0 (:coerce <elemT> + (host.class_for java/lang/String))) + (host.array_write 1 (java/lang/Object::getClass (host.array byte 0))) + (host.array_write 2 (:coerce <elemT> (java/lang/Integer::TYPE))) - (host.array-write 3 (:coerce <elemT> + (host.array_write 3 (:coerce <elemT> (java/lang/Integer::TYPE))))] - (do-to (java/lang/Class::getDeclaredMethod "defineClass" + (do_to (java/lang/Class::getDeclaredMethod "defineClass" signature - (host.class-for java/lang/ClassLoader)) + (host.class_for java/lang/ClassLoader)) (java/lang/reflect/AccessibleObject::setAccessible true))))) -(def: #export (define class-name bytecode loader) +(def: #export (define class_name bytecode loader) (-> Text Binary java/lang/ClassLoader (Try java/lang/Object)) - (let [signature (array.from-list (list (:coerce java/lang/Object - class-name) + (let [signature (array.from_list (list (:coerce java/lang/Object + class_name) (:coerce java/lang/Object bytecode) (:coerce java/lang/Object (|> 0 (:coerce (primitive "java.lang.Long")) - host.long-to-int)) + host.long_to_int)) (:coerce java/lang/Object (|> bytecode binary.size (:coerce (primitive "java.lang.Long")) - host.long-to-int))))] + host.long_to_int))))] (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) -(def: #export (new-library _) +(def: #export (new_library _) (-> Any Library) (atom.atom (dictionary.new text.hash))) (def: #export (memory library) (-> Library java/lang/ClassLoader) - (with-expansions [<cast> (for {@.old + (with_expansions [<cast> (for {@.old (<|) @.jvm @@ -109,29 +109,29 @@ (<| <cast> (object [] java/lang/ClassLoader [] [] - (java/lang/ClassLoader (findClass self {class-name java/lang/String}) + (java/lang/ClassLoader (findClass self {class_name java/lang/String}) (java/lang/Class [? < java/lang/Object]) #throws [java/lang/ClassNotFoundException] - (let [class-name (:coerce Text class-name) + (let [class_name (:coerce Text class_name) classes (|> library atom.read io.run)] - (case (dictionary.get class-name classes) + (case (dictionary.get class_name classes) (#.Some bytecode) - (case (..define class-name bytecode (<| <cast> self)) + (case (..define class_name bytecode (<| <cast> self)) (#try.Success class) (:assume class) (#try.Failure error) - (error! (exception.construct ..cannot-define [class-name error]))) + (error! (exception.construct ..cannot_define [class_name error]))) #.None - (error! (exception.construct ..unknown [class-name (dictionary.keys classes)]))))))))) + (error! (exception.construct ..unknown [class_name (dictionary.keys classes)]))))))))) (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) (do {! io.monad} [library' (atom.read library)] (if (dictionary.key? library' name) - (wrap (exception.throw ..already-stored name)) + (wrap (exception.throw ..already_stored name)) (do ! [_ (atom.update (dictionary.put name bytecode) library)] (wrap (#try.Success [])))))) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index d084d26ee..6219a1c1d 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -39,7 +39,7 @@ ["0010" final] ["0020" synchronized] ["0040" bridge] - ["0080" var-args] + ["0080" var_args] ["0100" native] ["0400" abstract] ["0800" strict] @@ -54,7 +54,7 @@ @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (|> attributes (monad.seq !) - (\ ! map row.from-list)) + (\ ! map row.from_list)) attributes (case code (#.Some code) (do ! @@ -70,7 +70,7 @@ #let [bytecode (|> instruction //bytecode/instruction.run format.instance)] @code (//attribute.code {#//attribute/code.limit (get@ #//bytecode/environment.limit environment) #//attribute/code.code bytecode - #//attribute/code.exception-table exceptions + #//attribute/code.exception_table exceptions #//attribute/code.attributes (row.row)})] (wrap (row.add @code attributes))) diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index 1434a95a4..6037ab372 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -14,7 +14,7 @@ [".F" binary (#+ Writer)]]] [type abstract] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro [syntax (#+ syntax:)] ["." code]]] @@ -77,7 +77,7 @@ ) (syntax: #export (modifiers: ofT {options (<>.many <c>.any)}) - (with-gensyms [g!modifier g!code] + (with_gensyms [g!modifier g!code] (wrap (list (` (template [(~ g!code) (~ g!modifier)] [(def: (~' #export) (~ g!modifier) (..Modifier (~ ofT)) diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux index fbddbac7d..17456f011 100644 --- a/stdlib/source/lux/target/jvm/type.lux +++ b/stdlib/source/lux/target/jvm/type.lux @@ -33,8 +33,8 @@ (type: #export Constraint {#name Text - #super-class (Type Class) - #super-interfaces (List (Type Class))}) + #super_class (Type Class) + #super_interfaces (List (Type Class))}) (template [<name> <style>] [(def: #export (<name> type) @@ -90,13 +90,13 @@ (/descriptor.declaration name) (/reflection.declaration name)])) - (def: #export (as-class type) + (def: #export (as_class type) (-> (Type Declaration) (Type Class)) (:abstraction (let [[signature descriptor reflection] (:representation type)] - [(/signature.as-class signature) - (/descriptor.as-class descriptor) - (/reflection.as-class reflection)]))) + [(/signature.as_class signature) + (/descriptor.as_class descriptor) + (/reflection.as_class reflection)]))) (def: #export wildcard (Type Parameter) @@ -186,11 +186,11 @@ (def: #export (class? type) (-> (Type Value) (Maybe External)) (let [repr (|> type ..descriptor /descriptor.descriptor)] - (if (and (text.starts-with? /descriptor.class-prefix repr) - (text.ends-with? /descriptor.class-suffix repr)) + (if (and (text.starts_with? /descriptor.class_prefix repr) + (text.ends_with? /descriptor.class_suffix repr)) (|> repr - (text.clip (text.size /descriptor.class-prefix) - (n.- (text.size /descriptor.class-suffix) + (text.clip (text.size /descriptor.class_prefix) + (n.- (text.size /descriptor.class_suffix) (text.size repr))) (\ maybe.monad map (|>> //name.internal //name.external))) #.None))) diff --git a/stdlib/source/lux/target/jvm/type/category.lux b/stdlib/source/lux/target/jvm/type/category.lux index cd75fa592..5dfb38ddc 100644 --- a/stdlib/source/lux/target/jvm/type/category.lux +++ b/stdlib/source/lux/target/jvm/type/category.lux @@ -21,7 +21,7 @@ (type: #export Parameter (<| Return' Value' Object' Parameter' Any)) (template [<parents> <child>] - [(with-expansions [<raw> (template.identifier [<child> "'"])] + [(with_expansions [<raw> (template.identifier [<child> "'"])] (abstract: #export <raw> Any) (type: #export <child> (`` (<| Return' Value' (~~ (template.splice <parents>)) <raw>))))] diff --git a/stdlib/source/lux/target/jvm/type/descriptor.lux b/stdlib/source/lux/target/jvm/type/descriptor.lux index 4b7809028..949cf70ea 100644 --- a/stdlib/source/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/lux/target/jvm/type/descriptor.lux @@ -41,21 +41,21 @@ ["C" Primitive char] ) - (def: #export class-prefix "L") - (def: #export class-suffix ";") + (def: #export class_prefix "L") + (def: #export class_suffix ";") (def: #export class (-> External (Descriptor Class)) (|>> ///name.internal ///name.read - (text.enclose [..class-prefix ..class-suffix]) + (text.enclose [..class_prefix ..class_suffix]) :abstraction)) (def: #export (declaration name) (-> External (Descriptor Declaration)) (:transmutation (..class name))) - (def: #export as-class + (def: #export as_class (-> (Descriptor Declaration) (Descriptor Class)) (|>> :transmutation)) @@ -77,13 +77,13 @@ (-> (Descriptor Class) (Descriptor Parameter)) (|>> :transmutation)) - (def: #export array-prefix "[") + (def: #export array_prefix "[") (def: #export array (-> (Descriptor Value) (Descriptor Array)) (|>> :representation - (format ..array-prefix) + (format ..array_prefix) :abstraction)) (def: #export (method [inputs output]) @@ -93,7 +93,7 @@ (:abstraction (format (|> inputs (list\map ..descriptor) - (text.join-with "") + (text.join_with "") (text.enclose ["(" ")"])) (:representation output)))) @@ -103,17 +103,17 @@ (def: (= parameter subject) (text\= (:representation parameter) (:representation subject)))) - (def: #export class-name + (def: #export class_name (-> (Descriptor Object) Internal) - (let [prefix-size (text.size ..class-prefix) - suffix-size (text.size ..class-suffix)] + (let [prefix_size (text.size ..class_prefix) + suffix_size (text.size ..class_suffix)] (function (_ descriptor) (let [repr (:representation descriptor)] - (if (text.starts-with? ..array-prefix repr) + (if (text.starts_with? ..array_prefix repr) (///name.internal repr) (|> repr - (text.clip prefix-size - (n.- suffix-size + (text.clip prefix_size + (n.- suffix_size (text.size repr))) (\ maybe.monad map ///name.internal) maybe.assume)))))) diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index 67fc2aec1..0013866f7 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -62,27 +62,27 @@ "0123456789")) (def: class/head - (format var/head //name.internal-separator)) + (format var/head //name.internal_separator)) (def: class/tail - (format var/tail //name.internal-separator)) + (format var/tail //name.internal_separator)) (template [<type> <name> <head> <tail> <adapter>] [(def: #export <name> (Parser <type>) (\ <>.functor map <adapter> - (<t>.slice (<t>.and! (<t>.one-of! <head>) - (<t>.some! (<t>.one-of! <tail>))))))] + (<t>.slice (<t>.and! (<t>.one_of! <head>) + (<t>.some! (<t>.one_of! <tail>))))))] - [External class-name class/head class/tail (|>> //name.internal //name.external)] - [Text var-name var/head var/tail function.identity] + [External class_name class/head class/tail (|>> //name.internal //name.external)] + [Text var_name var/head var/tail function.identity] ) (def: #export var' (Parser Text) - (|> ..var-name - (<>.after (<t>.this //signature.var-prefix)) - (<>.before (<t>.this //descriptor.class-suffix)))) + (|> ..var_name + (<>.after (<t>.this //signature.var_prefix)) + (<>.before (<t>.this //descriptor.class_suffix)))) (def: #export var (Parser (Type Var)) @@ -93,7 +93,7 @@ (|>> //.signature //signature.signature (<t>.run ..var') - try.to-maybe)) + try.to_maybe)) (def: #export name (-> (Type Var) Text) @@ -108,21 +108,21 @@ (|>> (<>.after (<t>.this <prefix>)) (<>\map <constructor>)))] - [lower //signature.lower-prefix //.lower] - [upper //signature.upper-prefix //.upper] + [lower //signature.lower_prefix //.lower] + [upper //signature.upper_prefix //.upper] ) (def: (class'' parameter) (-> (Parser (Type Parameter)) (Parser [External (List (Type Parameter))])) (|> (do <>.monad - [name ..class-name + [name ..class_name parameters (|> (<>.some parameter) - (<>.after (<t>.this //signature.parameters-start)) - (<>.before (<t>.this //signature.parameters-end)) + (<>.after (<t>.this //signature.parameters_start)) + (<>.before (<t>.this //signature.parameters_end)) (<>.default (list)))] (wrap [name parameters])) - (<>.after (<t>.this //descriptor.class-prefix)) - (<>.before (<t>.this //descriptor.class-suffix)))) + (<>.after (<t>.this //descriptor.class_prefix)) + (<>.before (<t>.this //descriptor.class_suffix)))) (def: class' (-> (Parser (Type Parameter)) (Parser (Type Class))) @@ -144,7 +144,7 @@ (def: #export array' (-> (Parser (Type Value)) (Parser (Type Array))) - (|>> (<>.after (<t>.this //descriptor.array-prefix)) + (|>> (<>.after (<t>.this //descriptor.array_prefix)) (<>\map //.array))) (def: #export class @@ -157,13 +157,13 @@ (|>> //.signature //signature.signature (<t>.run (<>.after (<t>.this <prefix>) ..class)) - try.to-maybe))] + try.to_maybe))] - [lower? //signature.lower-prefix //.lower] - [upper? //signature.upper-prefix //.upper] + [lower? //signature.lower_prefix //.lower] + [upper? //signature.upper_prefix //.upper] ) -(def: #export read-class +(def: #export read_class (-> (Type Class) [External (List (Type Parameter))]) (|>> //.signature //signature.signature @@ -192,8 +192,8 @@ (def: inputs (|> (<>.some ..value) - (<>.after (<t>.this //signature.arguments-start)) - (<>.before (<t>.this //signature.arguments-end)))) + (<>.after (<t>.this //signature.arguments_start)) + (<>.before (<t>.this //signature.arguments_end)))) (def: #export return (Parser (Type Return)) @@ -203,7 +203,7 @@ (def: exception (Parser (Type Class)) (|> (..class' ..parameter) - (<>.after (<t>.this //signature.exception-prefix)))) + (<>.after (<t>.this //signature.exception_prefix)))) (def: #export method (-> (Type Method) @@ -224,11 +224,11 @@ (|>> //.signature //signature.signature (<t>.run <parser>) - try.to-maybe))] + try.to_maybe))] [array? (Type Value) (do <>.monad - [_ (<t>.this //descriptor.array-prefix)] + [_ (<t>.this //descriptor.array_prefix)] ..value)] [class? [External (List (Type Parameter))] (..class'' ..parameter)] @@ -242,13 +242,13 @@ (def: #export declaration (-> (Type Declaration) [External (List (Type Var))]) (let [declaration' (: (Parser [External (List (Type Var))]) - (|> (<>.and ..class-name + (|> (<>.and ..class_name (|> (<>.some ..var) - (<>.after (<t>.this //signature.parameters-start)) - (<>.before (<t>.this //signature.parameters-end)) + (<>.after (<t>.this //signature.parameters_start)) + (<>.before (<t>.this //signature.parameters_end)) (<>.default (list)))) - (<>.after (<t>.this //descriptor.class-prefix)) - (<>.before (<t>.this //descriptor.class-suffix))))] + (<>.after (<t>.this //descriptor.class_prefix)) + (<>.before (<t>.this //descriptor.class_suffix))))] (|>> //.signature //signature.signature (<t>.run declaration') diff --git a/stdlib/source/lux/target/jvm/type/reflection.lux b/stdlib/source/lux/target/jvm/type/reflection.lux index 73d5c2154..17d5a219f 100644 --- a/stdlib/source/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/lux/target/jvm/type/reflection.lux @@ -51,14 +51,14 @@ (-> External (Reflection Declaration)) (:transmutation (..class name))) - (def: #export as-class + (def: #export as_class (-> (Reflection Declaration) (Reflection Class)) (|>> :transmutation)) (def: #export (array element) (-> (Reflection Value) (Reflection Array)) (let [element' (:representation element) - elementR (`` (cond (text.starts-with? //descriptor.array-prefix element') + elementR (`` (cond (text.starts_with? //descriptor.array_prefix element') element' (~~ (template [<primitive> <descriptor>] @@ -77,10 +77,10 @@ (|> element' //descriptor.class //descriptor.descriptor - (text.replace-all //name.internal-separator - //name.external-separator))))] + (text.replace_all //name.internal_separator + //name.external_separator))))] (|> elementR - (format //descriptor.array-prefix) + (format //descriptor.array_prefix) :abstraction))) (template [<name> <category>] diff --git a/stdlib/source/lux/target/jvm/type/signature.lux b/stdlib/source/lux/target/jvm/type/signature.lux index eb4253c7a..8ddef8f4f 100644 --- a/stdlib/source/lux/target/jvm/type/signature.lux +++ b/stdlib/source/lux/target/jvm/type/signature.lux @@ -43,64 +43,64 @@ (def: #export array (-> (Signature Value) (Signature Array)) (|>> :representation - (format //descriptor.array-prefix) + (format //descriptor.array_prefix) :abstraction)) (def: #export wildcard (Signature Parameter) (:abstraction "*")) - (def: #export var-prefix "T") + (def: #export var_prefix "T") (def: #export var (-> Text (Signature Var)) - (|>> (text.enclose [..var-prefix //descriptor.class-suffix]) + (|>> (text.enclose [..var_prefix //descriptor.class_suffix]) :abstraction)) - (def: #export lower-prefix "-") - (def: #export upper-prefix "+") + (def: #export lower_prefix "-") + (def: #export upper_prefix "+") (template [<name> <prefix>] [(def: #export <name> (-> (Signature Class) (Signature Parameter)) (|>> :representation (format <prefix>) :abstraction))] - [lower ..lower-prefix] - [upper ..upper-prefix] + [lower ..lower_prefix] + [upper ..upper_prefix] ) - (def: #export parameters-start "<") - (def: #export parameters-end ">") + (def: #export parameters_start "<") + (def: #export parameters_end ">") (def: #export (class name parameters) (-> External (List (Signature Parameter)) (Signature Class)) (:abstraction - (format //descriptor.class-prefix + (format //descriptor.class_prefix (|> name ///name.internal ///name.read) (case parameters #.Nil "" _ - (format ..parameters-start + (format ..parameters_start (|> parameters (list\map ..signature) - (text.join-with "")) - ..parameters-end)) - //descriptor.class-suffix))) + (text.join_with "")) + ..parameters_end)) + //descriptor.class_suffix))) (def: #export (declaration name variables) (-> External (List (Signature Var)) (Signature Declaration)) (:transmutation (..class name variables))) - (def: #export as-class + (def: #export as_class (-> (Signature Declaration) (Signature Class)) (|>> :transmutation)) - (def: #export arguments-start "(") - (def: #export arguments-end ")") + (def: #export arguments_start "(") + (def: #export arguments_end ")") - (def: #export exception-prefix "^") + (def: #export exception_prefix "^") (def: #export (method [inputs output exceptions]) (-> [(List (Signature Value)) @@ -110,13 +110,13 @@ (:abstraction (format (|> inputs (list\map ..signature) - (text.join-with "") - (text.enclose [..arguments-start - ..arguments-end])) + (text.join_with "") + (text.enclose [..arguments_start + ..arguments_end])) (:representation output) (|> exceptions - (list\map (|>> :representation (format ..exception-prefix))) - (text.join-with ""))))) + (list\map (|>> :representation (format ..exception_prefix))) + (text.join_with ""))))) (structure: #export equivalence (All [category] (Equivalence (Signature category))) diff --git a/stdlib/source/lux/target/jvm/version.lux b/stdlib/source/lux/target/jvm/version.lux index 8d5e40111..66f97351d 100644 --- a/stdlib/source/lux/target/jvm/version.lux +++ b/stdlib/source/lux/target/jvm/version.lux @@ -10,7 +10,7 @@ (type: #export Minor Version) (type: #export Major Version) -(def: #export default-minor +(def: #export default_minor Minor (|> 0 //unsigned.u2 try.assume)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index e2e4d5644..7a392995e 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -37,24 +37,24 @@ (type: #export Counters {#successes Nat #failures Nat - #expected-coverage (Set Name) - #actual-coverage (Set Name)}) + #expected_coverage (Set Name) + #actual_coverage (Set Name)}) -(def: (add-counters parameter subject) +(def: (add_counters parameter subject) (-> Counters Counters Counters) {#successes (n.+ (get@ #successes parameter) (get@ #successes subject)) #failures (n.+ (get@ #failures parameter) (get@ #failures subject)) - #expected-coverage (set.union (get@ #expected-coverage parameter) - (get@ #expected-coverage subject)) - #actual-coverage (set.union (get@ #actual-coverage parameter) - (get@ #actual-coverage subject))}) + #expected_coverage (set.union (get@ #expected_coverage parameter) + (get@ #expected_coverage subject)) + #actual_coverage (set.union (get@ #actual_coverage parameter) + (get@ #actual_coverage subject))}) (def: start Counters {#successes 0 #failures 0 - #expected-coverage (set.new name.hash) - #actual-coverage (set.new name.hash)}) + #expected_coverage (set.new name.hash) + #actual_coverage (set.new name.hash)}) (template [<name> <category>] [(def: <name> Counters (update@ <category> .inc start))] @@ -69,16 +69,16 @@ (type: #export Test (Random Assertion)) -(def: separator text.new-line) +(def: separator text.new_line) (def: #export (and' left right) {#.doc "Sequencing combinator."} (-> Assertion Assertion Assertion) (do promise.monad - [[l-counter l-documentation] left - [r-counter r-documentation] right] - (wrap [(add-counters l-counter r-counter) - (format l-documentation ..separator r-documentation)]))) + [[l_counter l_documentation] left + [r_counter r_documentation] right] + (wrap [(add_counters l_counter r_counter) + (format l_documentation ..separator r_documentation)]))) (def: #export (and left right) {#.doc "Sequencing combinator."} @@ -88,23 +88,23 @@ right right] (wrap (..and' left right)))) -(def: context-prefix text.tab) +(def: context_prefix text.tab) (def: #export (context description) (-> Text Test Test) (random\map (promise\map (function (_ [counters documentation]) [counters (|> documentation - (text.split-all-with ..separator) - (list\map (|>> (format context-prefix))) - (text.join-with ..separator) + (text.split_all_with ..separator) + (list\map (|>> (format context_prefix))) + (text.join_with ..separator) (format description ..separator))])))) -(def: failure-prefix "[Failure] ") -(def: success-prefix "[Success] ") +(def: failure_prefix "[Failure] ") +(def: success_prefix "[Success] ") (def: #export fail (-> Text Test) - (|>> (format ..failure-prefix) + (|>> (format ..failure_prefix) [failure] promise\wrap random\wrap)) @@ -114,8 +114,8 @@ (-> Text Bit Assertion) (<| promise\wrap (if condition - [success (format ..success-prefix message)] - [failure (format ..failure-prefix message)]))) + [success (format ..success_prefix message)] + [failure (format ..failure_prefix message)]))) (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} @@ -126,7 +126,7 @@ (-> Text (Random Bit) Test) (\ random.monad map (..assert message) random)) -(def: pcg-32-magic-inc Nat 12345) +(def: pcg_32_magic_inc Nat 12345) (type: #export Seed {#.doc "The seed value used for random testing (if that feature is used)."} @@ -135,7 +135,7 @@ (def: #export (seed value test) (-> Seed Test Test) (function (_ prng) - (let [[_ result] (random.run (random.pcg-32 [..pcg-32-magic-inc value]) + (let [[_ result] (random.run (random.pcg_32 [..pcg_32_magic_inc value]) test)] [prng result]))) @@ -143,17 +143,17 @@ (-> Counters Bit) (|>> (get@ #failures) (n.> 0))) -(def: (times-failure seed documentation) +(def: (times_failure seed documentation) (-> Seed Text Text) (format documentation ..separator ..separator "Failed with this seed: " (%.nat seed))) -(exception: #export must-try-test-at-least-once) +(exception: #export must_try_test_at_least_once) (def: #export (times amount test) (-> Nat Test Test) (cond (n.= 0 amount) - (fail (exception.construct ..must-try-test-at-least-once [])) + (fail (exception.construct ..must_try_test_at_least_once [])) (n.= 1 amount) test @@ -162,44 +162,44 @@ (do random.monad [seed random.nat] (function (_ prng) - (let [[prng' instance] (random.run (random.pcg-32 [..pcg-32-magic-inc seed]) test)] + (let [[prng' instance] (random.run (random.pcg_32 [..pcg_32_magic_inc seed]) test)] [prng' (do promise.monad [[counters documentation] instance] (if (failed? counters) - (wrap [counters (times-failure seed documentation)]) + (wrap [counters (times_failure seed documentation)]) (product.right (random.run prng' (times (dec amount) test)))))]))))) (def: (tally duration counters) (-> Duration Counters Text) (let [successes (get@ #successes counters) failures (get@ #failures counters) - missing (set.difference (get@ #actual-coverage counters) - (get@ #expected-coverage counters)) - unexpected (set.difference (get@ #expected-coverage counters) - (get@ #actual-coverage counters)) + missing (set.difference (get@ #actual_coverage counters) + (get@ #expected_coverage counters)) + unexpected (set.difference (get@ #expected_coverage counters) + (get@ #actual_coverage counters)) report (: (-> (Set Name) Text) - (|>> set.to-list + (|>> set.to_list (list.sort (\ name.order <)) (exception.enumerate %.name))) - expected-definitions-to-cover (set.size (get@ #expected-coverage counters)) - unexpected-definitions-covered (set.size unexpected) - actual-definitions-covered (n.- unexpected-definitions-covered - (set.size (get@ #actual-coverage counters))) - coverage (case expected-definitions-to-cover + expected_definitions_to_cover (set.size (get@ #expected_coverage counters)) + unexpected_definitions_covered (set.size unexpected) + actual_definitions_covered (n.- unexpected_definitions_covered + (set.size (get@ #actual_coverage counters))) + coverage (case expected_definitions_to_cover 0 "N/A" - expected (let [missing-ratio (f./ (n.frac expected) + expected (let [missing_ratio (f./ (n.frac expected) (n.frac (set.size missing))) - max-percent +100.0 - done-percent (|> +1.0 - (f.- missing-ratio) - (f.* max-percent))] - (if (f.= max-percent done-percent) + max_percent +100.0 + done_percent (|> +1.0 + (f.- missing_ratio) + (f.* max_percent))] + (if (f.= max_percent done_percent) "100%" - (let [raw (|> done-percent + (let [raw (|> done_percent %.frac - (text.replace-once "+" ""))] + (text.replace_once "+" ""))] (|> raw - (text.clip 0 (if (f.>= +10.0 done-percent) + (text.clip 0 (if (f.>= +10.0 done_percent) 5 ## XX.XX 4 ## X.XX )) @@ -210,44 +210,44 @@ ["# Tests" (%.nat (n.+ successes failures))] ["# Successes" (%.nat successes)] ["# Failures" (%.nat failures)] - ["# Expected definitions to cover" (%.nat expected-definitions-to-cover)] - ["# Actual definitions covered" (%.nat actual-definitions-covered)] - ["# Pending definitions to cover" (%.nat (n.- actual-definitions-covered - expected-definitions-to-cover))] - ["# Unexpected definitions covered" (%.nat unexpected-definitions-covered)] + ["# Expected definitions to cover" (%.nat expected_definitions_to_cover)] + ["# Actual definitions covered" (%.nat actual_definitions_covered)] + ["# Pending definitions to cover" (%.nat (n.- actual_definitions_covered + expected_definitions_to_cover))] + ["# Unexpected definitions covered" (%.nat unexpected_definitions_covered)] ["Coverage" coverage] ["Pending definitions to cover" (report missing)] ["Unexpected definitions covered" (report unexpected)]))) -(def: failure-exit-code -1) -(def: success-exit-code +0) +(def: failure_exit_code -1) +(def: success_exit_code +0) (def: #export (run! test) (-> Test (Promise Nothing)) (do promise.monad [pre (promise.future instant.now) - #let [seed (instant.to-millis pre) - prng (random.pcg-32 [..pcg-32-magic-inc seed])] + #let [seed (instant.to_millis pre) + prng (random.pcg_32 [..pcg_32_magic_inc seed])] [counters documentation] (|> test (random.run prng) product.right) post (promise.future instant.now) #let [duration (instant.span pre post) - _ (log! (format documentation text.new-line text.new-line + _ (log! (format documentation text.new_line text.new_line (tally duration counters) - text.new-line))]] + text.new_line))]] (promise.future (\ program.default exit (case (get@ #failures counters) - 0 ..success-exit-code - _ ..failure-exit-code))))) + 0 ..success_exit_code + _ ..failure_exit_code))))) (def: (|cover'| coverage condition) (-> (List Name) Bit Assertion) (let [message (|> coverage (list\map %.name) - (text.join-with " & ")) - coverage (set.from-list name.hash coverage)] + (text.join_with " & ")) + coverage (set.from_list name.hash coverage)] (|> (..assert message condition) (promise\map (function (_ [counters documentation]) - [(update@ #actual-coverage (set.union coverage) counters) + [(update@ #actual_coverage (set.union coverage) counters) documentation]))))) (def: (|cover| coverage condition) @@ -259,22 +259,22 @@ (-> (List Name) Test Test) (let [context (|> coverage (list\map %.name) - (text.join-with " & ")) - coverage (set.from-list name.hash coverage)] + (text.join_with " & ")) + coverage (set.from_list name.hash coverage)] (random\map (promise\map (function (_ [counters documentation]) - [(update@ #actual-coverage (set.union coverage) counters) + [(update@ #actual_coverage (set.union coverage) counters) documentation])) (..context context test)))) -(def: (name-code name) +(def: (name_code name) (-> Name Code) (code.tuple (list (code.text (name.module name)) (code.text (name.short name))))) (syntax: (reference {name <c>.identifier}) (do meta.monad - [_ (meta.find-export name)] - (wrap (list (name-code name))))) + [_ (meta.find_export name)] + (wrap (list (name_code name))))) (template [<macro> <function>] [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} @@ -301,19 +301,19 @@ (.list (~+ coverage))) (~ test))))))) -(def: coverage-separator +(def: coverage_separator Text - (text.from-code 31)) + (text.from_code 31)) (def: (covering' module coverage test) (-> Text Text Test Test) (let [coverage (|> coverage - (text.split-all-with ..coverage-separator) + (text.split_all_with ..coverage_separator) (list\map (|>> [module])) - (set.from-list name.hash))] + (set.from_list name.hash))] (|> (..context module test) (random\map (promise\map (function (_ [counters documentation]) - [(update@ #expected-coverage (set.union coverage) counters) + [(update@ #expected_coverage (set.union coverage) counters) documentation])))))) (syntax: #export (covering {module <c>.identifier} @@ -324,21 +324,21 @@ #let [coverage (|> definitions (list.filter (|>> product.right product.left)) (list\map product.left) - (text.join-with ..coverage-separator))]] + (text.join_with ..coverage_separator))]] (wrap (list (` ((~! ..covering') (~ (code.text module)) (~ (code.text coverage)) (~ test))))))) -(exception: #export (error-during-execution {error Text}) +(exception: #export (error_during_execution {error Text}) (exception.report ["Error" (%.text error)])) -(def: #export (in-parallel tests) +(def: #export (in_parallel tests) (-> (List Test) Test) (do random.monad [seed random.nat - #let [prng (random.pcg-32 [..pcg-32-magic-inc seed]) + #let [prng (random.pcg_32 [..pcg_32_magic_inc seed]) run! (: (-> Test Assertion) (function (_ test) (|> (case (|> test @@ -350,7 +350,7 @@ output (#try.Failure error) - (..assert (exception.construct ..error-during-execution [error]) false)) + (..assert (exception.construct ..error_during_execution [error]) false)) io.io promise.future promise\join)))]] @@ -358,7 +358,7 @@ [assertions (monad.seq ! (list\map run! tests))] (wrap [(|> assertions (list\map product.left) - (list\fold ..add-counters ..start)) + (list\fold ..add_counters ..start)) (|> assertions (list\map product.right) - (text.join-with ..separator))]))))) + (text.join_with ..separator))]))))) diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index 0a2f120fb..ac22d4a3d 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -25,7 +25,7 @@ Nat (.nat (duration.query <singular> <plural>)))] - [milli-seconds duration.milli-second duration.second] + [milli_seconds duration.milli_second duration.second] [seconds duration.second duration.minute] [minutes duration.minute duration.hour] [hours duration.hour duration.day] @@ -33,27 +33,27 @@ (def: limit Nat - (.nat (duration.to-millis duration.day))) + (.nat (duration.to_millis duration.day))) -(exception: #export (time-exceeds-a-day {time Nat}) +(exception: #export (time_exceeds_a_day {time Nat}) (exception.report ["Time (in milli-seconds)" (n\encode time)] ["Maximum (in milli-seconds)" (n\encode (dec limit))])) (def: separator ":") -(def: parse-section +(def: parse_section (Parser Nat) (<>.codec n.decimal (<t>.exactly 2 <t>.decimal))) -(def: parse-millis' +(def: parse_millis' (Parser Nat) - (<>.either (|> (<t>.at-most 3 <t>.decimal) + (<>.either (|> (<t>.at_most 3 <t>.decimal) (<>.codec n.decimal) (<>.after (<t>.this "."))) (\ <>.monad wrap 0))) -(template [<maximum> <parser> <exception> <sub-parser>] +(template [<maximum> <parser> <exception> <sub_parser>] [(exception: #export (<exception> {value Nat}) (exception.report ["Value" (n\encode value)] @@ -63,16 +63,16 @@ (def: <parser> (Parser Nat) (do <>.monad - [value <sub-parser>] + [value <sub_parser>] (if (and (n.>= 0 value) (n.< <maximum> value)) (wrap value) (<>.lift (exception.throw <exception> [value])))))] - [..hours parse-hour invalid-hour ..parse-section] - [..minutes parse-minute invalid-minute ..parse-section] - [..seconds parse-second invalid-second ..parse-section] - [..milli-seconds parse-millis invalid-milli-second ..parse-millis'] + [..hours parse_hour invalid_hour ..parse_section] + [..minutes parse_minute invalid_minute ..parse_section] + [..seconds parse_second invalid_second ..parse_section] + [..milli_seconds parse_millis invalid_milli_second ..parse_millis'] ) (abstract: #export Time @@ -85,13 +85,13 @@ Time (:abstraction 0)) - (def: #export (from-millis milli-seconds) + (def: #export (from_millis milli_seconds) (-> Nat (Try Time)) - (if (n.< ..limit milli-seconds) - (#try.Success (:abstraction milli-seconds)) - (exception.throw ..time-exceeds-a-day [milli-seconds]))) + (if (n.< ..limit milli_seconds) + (#try.Success (:abstraction milli_seconds)) + (exception.throw ..time_exceeds_a_day [milli_seconds]))) - (def: #export to-millis + (def: #export to_millis (-> Time Nat) (|>> :representation)) @@ -124,25 +124,25 @@ (def: #export parser (Parser Time) - (let [to-millis (: (-> Duration Nat) - (|>> duration.to-millis .nat)) - hour (to-millis duration.hour) - minute (to-millis duration.minute) - second (to-millis duration.second) - millis (to-millis duration.milli-second)] + (let [to_millis (: (-> Duration Nat) + (|>> duration.to_millis .nat)) + hour (to_millis duration.hour) + minute (to_millis duration.minute) + second (to_millis duration.second) + millis (to_millis duration.milli_second)] (do {! <>.monad} - [utc-hour ..parse-hour + [utc_hour ..parse_hour _ (<t>.this ..separator) - utc-minute ..parse-minute + utc_minute ..parse_minute _ (<t>.this ..separator) - utc-second ..parse-second - utc-millis ..parse-millis] + utc_second ..parse_second + utc_millis ..parse_millis] (wrap (:abstraction ($_ n.+ - (n.* utc-hour hour) - (n.* utc-minute minute) - (n.* utc-second second) - (n.* utc-millis millis))))))) + (n.* utc_hour hour) + (n.* utc_minute minute) + (n.* utc_second second) + (n.* utc_millis millis))))))) ) (def: (pad value) @@ -151,13 +151,13 @@ (text\compose "0" (n\encode value)) (n\encode value))) -(def: (adjust-negative space duration) +(def: (adjust_negative space duration) (-> Duration Duration Duration) (if (duration.negative? duration) (duration.merge space duration) duration)) -(def: (encode-millis millis) +(def: (encode_millis millis) (-> Nat Text) (cond (n.= 0 millis) "" (n.< 10 millis) ($_ text\compose ".00" (n\encode millis)) @@ -169,41 +169,41 @@ {#hour Nat #minute Nat #second Nat - #milli-second Nat}) + #milli_second Nat}) (def: #export (clock time) (-> Time Clock) - (let [time (|> time ..to-millis .int duration.from-millis) + (let [time (|> time ..to_millis .int duration.from_millis) [hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)] [minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)] [seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]] {#hour (.nat hours) #minute (.nat minutes) #second (.nat seconds) - #milli-second (|> millis - (..adjust-negative duration.second) - duration.to-millis + #milli_second (|> millis + (..adjust_negative duration.second) + duration.to_millis .nat)})) (def: #export (time clock) (-> Clock (Try Time)) (|> ($_ duration.merge - (duration.scale-up (get@ #hour clock) duration.hour) - (duration.scale-up (get@ #minute clock) duration.minute) - (duration.scale-up (get@ #second clock) duration.second) - (duration.from-millis (.int (get@ #milli-second clock)))) - duration.to-millis + (duration.scale_up (get@ #hour clock) duration.hour) + (duration.scale_up (get@ #minute clock) duration.minute) + (duration.scale_up (get@ #second clock) duration.second) + (duration.from_millis (.int (get@ #milli_second clock)))) + duration.to_millis .nat - ..from-millis)) + ..from_millis)) (def: (encode time) (-> Time Text) - (let [(^slots [#hour #minute #second #milli-second]) (..clock time)] + (let [(^slots [#hour #minute #second #milli_second]) (..clock time)] ($_ text\compose (..pad hour) ..separator (..pad minute) ..separator (..pad second) - (..encode-millis milli-second)))) + (..encode_millis milli_second)))) (structure: #export codec {#.doc (doc "Based on ISO 8601." diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 6e7642fe3..375c2a924 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -26,33 +26,33 @@ ["#." year (#+ Year)] ["#." month (#+ Month)]]) -(def: month-by-number +(def: month_by_number (Dictionary Nat Month) (list\fold (function (_ month mapping) (dictionary.put (//month.number month) month mapping)) (dictionary.new n.hash) //month.year)) -(exception: #export there-is-no-year-0) +(exception: #export there_is_no_year_0) -(def: minimum-day 1) +(def: minimum_day 1) -(def: (month-days year month) +(def: (month_days year month) (-> Year Month Nat) (if (//year.leap? year) - (//month.leap-year-days month) + (//month.leap_year_days month) (//month.days month))) -(def: (day-is-within-limits? year month day) +(def: (day_is_within_limits? year month day) (-> Year Month Nat Bit) - (and (n.>= ..minimum-day day) - (n.<= (..month-days year month) day))) + (and (n.>= ..minimum_day day) + (n.<= (..month_days year month) day))) -(exception: #export (invalid-day {year Year} {month Month} {day Nat}) +(exception: #export (invalid_day {year Year} {month Month} {day Nat}) (exception.report ["Value" (n\encode day)] - ["Minimum" (n\encode ..minimum-day)] - ["Maximum" (n\encode (..month-days year month))] + ["Minimum" (n\encode ..minimum_day)] + ["Maximum" (n\encode (..month_days year month))] ["Year" (\ //year.codec encode year)] ["Month" (n\encode (//month.number month))])) @@ -73,13 +73,13 @@ (def: #export (date year month day) (-> Year Month Nat (Try Date)) - (if (..day-is-within-limits? year month day) + (if (..day_is_within_limits? year month day) (#try.Success (:abstraction {#year year #month month #day day})) - (exception.throw ..invalid-day [year month day]))) + (exception.throw ..invalid_day [year month day]))) (template [<name> <type> <field>] [(def: #export <name> @@ -88,7 +88,7 @@ [year Year #year] [month Month #month] - [day-of-month Nat #day] + [day_of_month Nat #day] ) (structure: #export equivalence @@ -130,13 +130,13 @@ (get@ #day sample))))))))) ) -(def: parse-section +(def: parse_section (Parser Nat) (<>.codec n.decimal (<t>.exactly 2 <t>.decimal))) -(def: parse-millis +(def: parse_millis (Parser Nat) - (<>.either (|> (<t>.at-most 3 <t>.decimal) + (<>.either (|> (<t>.at_most 3 <t>.decimal) (<>.codec n.decimal) (<>.after (<t>.this "."))) (\ <>.monad wrap 0))) @@ -151,32 +151,32 @@ (def: <parser> (Parser Nat) (do <>.monad - [value ..parse-section] + [value ..parse_section] (if (and (n.>= <minimum> value) (n.<= <maximum> value)) (wrap value) (<>.lift (exception.throw <exception> [value])))))] - [1 12 parse-month invalid-month] + [1 12 parse_month invalid_month] ) (def: #export parser (Parser Date) (do <>.monad - [utc-year //year.parser + [utc_year //year.parser _ (<t>.this ..separator) - utc-month ..parse-month + utc_month ..parse_month _ (<t>.this ..separator) - #let [month (maybe.assume (dictionary.get utc-month ..month-by-number))] - utc-day ..parse-section] - (<>.lift (..date utc-year month utc-day)))) + #let [month (maybe.assume (dictionary.get utc_month ..month_by_number))] + utc_day ..parse_section] + (<>.lift (..date utc_year month utc_day)))) (def: (encode value) (-> Date Text) ($_ text\compose (\ //year.codec encode (..year value)) ..separator (..pad (|> value ..month //month.number)) - ..separator (..pad (..day-of-month value)))) + ..separator (..pad (..day_of_month value)))) (structure: #export codec {#.doc (doc "Based on ISO 8601." @@ -186,27 +186,27 @@ (def: encode ..encode) (def: decode (<t>.run ..parser))) -(def: days-per-leap +(def: days_per_leap (|> //year.days (n.* 4) (n.+ 1))) -(def: days-per-century - (let [leaps-per-century (n./ //year.leap +(def: days_per_century + (let [leaps_per_century (n./ //year.leap //year.century)] (|> //year.century (n.* //year.days) - (n.+ leaps-per-century) + (n.+ leaps_per_century) (n.- 1)))) -(def: days-per-era - (let [centuries-per-era (n./ //year.century +(def: days_per_era + (let [centuries_per_era (n./ //year.century //year.era)] - (|> centuries-per-era - (n.* ..days-per-century) + (|> centuries_per_era + (n.* ..days_per_century) (n.+ 1)))) -(def: days-since-epoch +(def: days_since_epoch (let [years::70 70 leaps::70 (n./ //year.leap years::70) @@ -214,120 +214,120 @@ (n.* //year.days) (n.+ leaps::70)) ## The epoch is being calculated from March 1st, instead of January 1st. - january-&-february (n.+ (//month.days #//month.January) + january_&_february (n.+ (//month.days #//month.January) (//month.days #//month.February))] (|> 0 ## 1600/01/01 - (n.+ (n.* 4 days-per-era)) + (n.+ (n.* 4 days_per_era)) ## 1900/01/01 - (n.+ (n.* 3 days-per-century)) + (n.+ (n.* 3 days_per_century)) ## 1970/01/01 (n.+ days::70) ## 1970/03/01 - (n.- january-&-february)))) + (n.- january_&_february)))) -(def: first-month-of-civil-year 3) +(def: first_month_of_civil_year 3) -(with-expansions [<pull> +3 +(with_expansions [<pull> +3 <push> +9] - (def: (internal-month civil-month) + (def: (internal_month civil_month) (-> Nat Int) - (if (n.< ..first-month-of-civil-year civil-month) - (i.+ <push> (.int civil-month)) - (i.- <pull> (.int civil-month)))) + (if (n.< ..first_month_of_civil_year civil_month) + (i.+ <push> (.int civil_month)) + (i.- <pull> (.int civil_month)))) - (def: (civil-month internal-month) + (def: (civil_month internal_month) (-> Int Nat) - (.nat (if (i.< +10 internal-month) - (i.+ <pull> internal-month) - (i.- <push> internal-month))))) + (.nat (if (i.< +10 internal_month) + (i.+ <pull> internal_month) + (i.- <push> internal_month))))) -(with-expansions [<up> +153 +(with_expansions [<up> +153 <translation> +2 <down> +5] - (def: day-of-year-from-month + (def: day_of_year_from_month (-> Nat Int) - (|>> ..internal-month + (|>> ..internal_month (i.* <up>) (i.+ <translation>) (i./ <down>))) - (def: month-from-day-of-year + (def: month_from_day_of_year (-> Int Nat) (|>> (i.* <down>) (i.+ <translation>) (i./ <up>) - ..civil-month))) + ..civil_month))) -(def: last-era-leap-day - (.int (dec ..days-per-leap))) +(def: last_era_leap_day + (.int (dec ..days_per_leap))) -(def: last-era-day - (.int (dec ..days-per-era))) +(def: last_era_day + (.int (dec ..days_per_era))) -(def: (civil-year utc-month utc-year) +(def: (civil_year utc_month utc_year) (-> Nat Year Int) (let [## Coercing, because the year is already in external form. - utc-year (:coerce Int utc-year)] - (if (n.< ..first-month-of-civil-year utc-month) - (dec utc-year) - utc-year))) + utc_year (:coerce Int utc_year)] + (if (n.< ..first_month_of_civil_year utc_month) + (dec utc_year) + utc_year))) ## http://howardhinnant.github.io/date_algorithms.html (def: #export (days date) (-> Date Int) - (let [utc-month (|> date ..month //month.number) - civil-year (..civil-year utc-month (..year date)) - era (|> (if (i.< +0 civil-year) + (let [utc_month (|> date ..month //month.number) + civil_year (..civil_year utc_month (..year date)) + era (|> (if (i.< +0 civil_year) (i.- (.int (dec //year.era)) - civil-year) - civil-year) + civil_year) + civil_year) (i./ (.int //year.era))) - year-of-era (i.- (i.* (.int //year.era) + year_of_era (i.- (i.* (.int //year.era) era) - civil-year) - day-of-year (|> utc-month - ..day-of-year-from-month - (i.+ (.int (dec (..day-of-month date))))) - day-of-era (|> day-of-year - (i.+ (i.* (.int //year.days) year-of-era)) - (i.+ (i./ (.int //year.leap) year-of-era)) - (i.- (i./ (.int //year.century) year-of-era)))] - (|> (i.* (.int ..days-per-era) era) - (i.+ day-of-era) - (i.- (.int ..days-since-epoch))))) + civil_year) + day_of_year (|> utc_month + ..day_of_year_from_month + (i.+ (.int (dec (..day_of_month date))))) + day_of_era (|> day_of_year + (i.+ (i.* (.int //year.days) year_of_era)) + (i.+ (i./ (.int //year.leap) year_of_era)) + (i.- (i./ (.int //year.century) year_of_era)))] + (|> (i.* (.int ..days_per_era) era) + (i.+ day_of_era) + (i.- (.int ..days_since_epoch))))) ## http://howardhinnant.github.io/date_algorithms.html -(def: #export (from-days days) +(def: #export (from_days days) (-> Int Date) - (let [days (i.+ (.int ..days-since-epoch) days) + (let [days (i.+ (.int ..days_since_epoch) days) era (|> (if (i.< +0 days) - (i.- ..last-era-day days) + (i.- ..last_era_day days) days) - (i./ (.int ..days-per-era))) - day-of-era (i.- (i.* (.int ..days-per-era) era) days) - year-of-era (|> day-of-era - (i.- (i./ ..last-era-leap-day day-of-era)) - (i.+ (i./ (.int ..days-per-century) day-of-era)) - (i.- (i./ ..last-era-day day-of-era)) + (i./ (.int ..days_per_era))) + day_of_era (i.- (i.* (.int ..days_per_era) era) days) + year_of_era (|> day_of_era + (i.- (i./ ..last_era_leap_day day_of_era)) + (i.+ (i./ (.int ..days_per_century) day_of_era)) + (i.- (i./ ..last_era_day day_of_era)) (i./ (.int //year.days))) year (i.+ (i.* (.int //year.era) era) - year-of-era) - day-of-year (|> day-of-era - (i.- (i.* (.int //year.days) year-of-era)) - (i.- (i./ (.int //year.leap) year-of-era)) - (i.+ (i./ (.int //year.century) year-of-era))) - month (..month-from-day-of-year day-of-year) - day (|> day-of-year - (i.- (..day-of-year-from-month month)) + year_of_era) + day_of_year (|> day_of_era + (i.- (i.* (.int //year.days) year_of_era)) + (i.- (i./ (.int //year.leap) year_of_era)) + (i.+ (i./ (.int //year.century) year_of_era))) + month (..month_from_day_of_year day_of_year) + day (|> day_of_year + (i.- (..day_of_year_from_month month)) (i.+ +1) .nat) - year (if (n.< ..first-month-of-civil-year month) + year (if (n.< ..first_month_of_civil_year month) (inc year) year)] ## Coercing, because the year is already in internal form. (try.assume (..date (:coerce Year year) - (maybe.assume (dictionary.get month ..month-by-number)) + (maybe.assume (dictionary.get month ..month_by_number)) day)))) (structure: #export enum @@ -336,7 +336,7 @@ (def: &order ..order) (def: succ - (|>> ..days inc ..from-days)) + (|>> ..days inc ..from_days)) (def: pred - (|>> ..days dec ..from-days))) + (|>> ..days dec ..from_days))) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 9c5d70d71..aa2aeda01 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -23,11 +23,11 @@ {#.doc "Durations have a resolution of milli-seconds."} - (def: #export from-millis + (def: #export from_millis (-> Int Duration) (|>> :abstraction)) - (def: #export to-millis + (def: #export to_millis (-> Duration Int) (|>> :representation)) @@ -45,8 +45,8 @@ (-> Nat Duration Duration) (|>> :representation (<op> (.int scalar)) :abstraction))] - [i.* scale-up] - [i./ scale-down] + [i.* scale_up] + [i./ scale_down] ) (def: #export inverse @@ -86,26 +86,26 @@ ) (def: #export empty - (..from-millis +0)) + (..from_millis +0)) -(def: #export milli-second - (..from-millis +1)) +(def: #export milli_second + (..from_millis +1)) (template [<name> <scale> <base>] [(def: #export <name> - (..scale-up <scale> <base>))] + (..scale_up <scale> <base>))] - [second 1,000 milli-second] + [second 1,000 milli_second] [minute 60 second] [hour 60 minute] [day 24 hour] [week 7 day] - [normal-year 365 day] + [normal_year 365 day] ) -(def: #export leap-year - (..merge ..day ..normal-year)) +(def: #export leap_year + (..merge ..day ..normal_year)) (structure: #export monoid (Monoid Duration) @@ -116,68 +116,68 @@ (template [<value> <definition>] [(def: <definition> <value>)] - ["D" day-suffix] - ["h" hour-suffix] - ["m" minute-suffix] - ["s" second-suffix] - ["ms" milli-second-suffix] + ["D" day_suffix] + ["h" hour_suffix] + ["m" minute_suffix] + ["s" second_suffix] + ["ms" milli_second_suffix] - ["+" positive-sign] - ["-" negative-sign] + ["+" positive_sign] + ["-" negative_sign] ) (def: (encode duration) (if (\ ..equivalence = ..empty duration) ($_ text\compose - ..positive-sign + ..positive_sign (nat\encode 0) - ..milli-second-suffix) + ..milli_second_suffix) (let [signed? (negative? duration) - [days time-left] [(query day duration) (frame day duration)] + [days time_left] [(query day duration) (frame day duration)] days (if signed? (i.abs days) days) - time-left (if signed? - (..inverse time-left) - time-left) - [hours time-left] [(query hour time-left) (frame hour time-left)] - [minutes time-left] [(query minute time-left) (frame minute time-left)] - [seconds time-left] [(query second time-left) (frame second time-left)] - millis (to-millis time-left)] + time_left (if signed? + (..inverse time_left) + time_left) + [hours time_left] [(query hour time_left) (frame hour time_left)] + [minutes time_left] [(query minute time_left) (frame minute time_left)] + [seconds time_left] [(query second time_left) (frame second time_left)] + millis (to_millis time_left)] ($_ text\compose - (if signed? ..negative-sign ..positive-sign) - (if (i.= +0 days) "" (text\compose (nat\encode (.nat days)) ..day-suffix)) - (if (i.= +0 hours) "" (text\compose (nat\encode (.nat hours)) ..hour-suffix)) - (if (i.= +0 minutes) "" (text\compose (nat\encode (.nat minutes)) ..minute-suffix)) - (if (i.= +0 seconds) "" (text\compose (nat\encode (.nat seconds)) ..second-suffix)) - (if (i.= +0 millis) "" (text\compose (nat\encode (.nat millis)) ..milli-second-suffix)) + (if signed? ..negative_sign ..positive_sign) + (if (i.= +0 days) "" (text\compose (nat\encode (.nat days)) ..day_suffix)) + (if (i.= +0 hours) "" (text\compose (nat\encode (.nat hours)) ..hour_suffix)) + (if (i.= +0 minutes) "" (text\compose (nat\encode (.nat minutes)) ..minute_suffix)) + (if (i.= +0 seconds) "" (text\compose (nat\encode (.nat seconds)) ..second_suffix)) + (if (i.= +0 millis) "" (text\compose (nat\encode (.nat millis)) ..milli_second_suffix)) )))) (def: parser (Parser Duration) (let [section (: (-> Text Text (Parser Nat)) - (function (_ suffix false-suffix) + (function (_ suffix false_suffix) (|> (<t>.many <t>.decimal) (<>.codec nat.decimal) - (<>.before (case false-suffix + (<>.before (case false_suffix "" (<t>.this suffix) - _ (<>.after (<>.not (<t>.this false-suffix)) + _ (<>.after (<>.not (<t>.this false_suffix)) (<t>.this suffix)))) (<>.default 0))))] (do <>.monad - [sign (<>.or (<t>.this ..negative-sign) - (<t>.this ..positive-sign)) - days (section ..day-suffix "") - hours (section hour-suffix "") - minutes (section ..minute-suffix ..milli-second-suffix) - seconds (section ..second-suffix "") - millis (section ..milli-second-suffix "") + [sign (<>.or (<t>.this ..negative_sign) + (<t>.this ..positive_sign)) + days (section ..day_suffix "") + hours (section hour_suffix "") + minutes (section ..minute_suffix ..milli_second_suffix) + seconds (section ..second_suffix "") + millis (section ..milli_second_suffix "") #let [span (|> ..empty - (..merge (..scale-up days ..day)) - (..merge (..scale-up hours ..hour)) - (..merge (..scale-up minutes ..minute)) - (..merge (..scale-up seconds ..second)) - (..merge (..scale-up millis ..milli-second)) + (..merge (..scale_up days ..day)) + (..merge (..scale_up hours ..hour)) + (..merge (..scale_up minutes ..minute)) + (..merge (..scale_up seconds ..second)) + (..merge (..scale_up millis ..milli_second)) )]] (wrap (case sign (#.Left _) (..inverse span) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 195d78e83..823db0687 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -33,29 +33,29 @@ {#.doc "Instant is defined as milliseconds since the epoch."} - (def: #export from-millis + (def: #export from_millis (-> Int Instant) (|>> :abstraction)) - (def: #export to-millis + (def: #export to_millis (-> Instant Int) (|>> :representation)) (def: #export (span from to) (-> Instant Instant Duration) - (duration.from-millis (i.- (:representation from) (:representation to)))) + (duration.from_millis (i.- (:representation from) (:representation to)))) (def: #export (shift duration instant) (-> Duration Instant Instant) - (:abstraction (i.+ (duration.to-millis duration) (:representation instant)))) + (:abstraction (i.+ (duration.to_millis duration) (:representation instant)))) (def: #export (relative instant) (-> Instant Duration) - (|> instant :representation duration.from-millis)) + (|> instant :representation duration.from_millis)) (def: #export (absolute offset) (-> Duration Instant) - (|> offset duration.to-millis :abstraction)) + (|> offset duration.to_millis :abstraction)) (structure: #export equivalence (Equivalence Instant) @@ -85,59 +85,59 @@ (def: #export epoch {#.doc "The instant corresponding to 1970-01-01T00:00:00Z"} Instant - (..from-millis +0)) + (..from_millis +0)) -(def: millis-per-day - (duration.query duration.milli-second duration.day)) +(def: millis_per_day + (duration.query duration.milli_second duration.day)) -(def: (split-date-time instant) +(def: (split_date_time instant) (-> Instant [Date Duration]) - (let [offset (..to-millis instant) + (let [offset (..to_millis instant) bce? (i.< +0 offset) - [days day-time] (if bce? - (let [[days millis] (i./% ..millis-per-day offset)] + [days day_time] (if bce? + (let [[days millis] (i./% ..millis_per_day offset)] (case millis +0 [days millis] - _ [(dec days) (i.+ ..millis-per-day millis)])) - (i./% ..millis-per-day offset))] - [(date.from-days days) - (duration.from-millis day-time)])) + _ [(dec days) (i.+ ..millis_per_day millis)])) + (i./% ..millis_per_day offset))] + [(date.from_days days) + (duration.from_millis day_time)])) (template [<value> <definition>] [(def: <definition> Text <value>)] - ["T" date-suffix] - ["Z" time-suffix] + ["T" date_suffix] + ["Z" time_suffix] ) -(def: (clock-time duration) +(def: (clock_time duration) (-> Duration Time) (let [time (if (\ duration.order < duration.empty duration) (duration.merge duration.day duration) duration)] - (|> time duration.to-millis .nat //.from-millis try.assume))) + (|> time duration.to_millis .nat //.from_millis try.assume))) (def: (encode instant) (-> Instant Text) - (let [[date time] (..split-date-time instant) - time (..clock-time time)] + (let [[date time] (..split_date_time instant) + time (..clock_time time)] ($_ text\compose - (\ date.codec encode date) ..date-suffix - (\ //.codec encode time) ..time-suffix))) + (\ date.codec encode date) ..date_suffix + (\ //.codec encode time) ..time_suffix))) (def: parser (Parser Instant) (do {! <>.monad} [days (\ ! map date.days date.parser) - _ (<t>.this ..date-suffix) - time (\ ! map //.to-millis //.parser) - _ (<t>.this ..time-suffix)] + _ (<t>.this ..date_suffix) + time (\ ! map //.to_millis //.parser) + _ (<t>.this ..time_suffix)] (wrap (|> (if (i.< +0 days) (|> duration.day - (duration.scale-up (.nat (i.* -1 days))) + (duration.scale_up (.nat (i.* -1 days))) duration.inverse) - (duration.scale-up (.nat days) duration.day)) - (duration.merge (duration.scale-up time duration.milli-second)) + (duration.scale_up (.nat days) duration.day)) + (duration.merge (duration.scale_up time duration.milli_second)) ..absolute)))) (structure: #export codec @@ -150,25 +150,25 @@ (def: #export now (IO Instant) - (io (..from-millis ("lux io current-time")))) + (io (..from_millis ("lux io current-time")))) -(template [<field> <type> <post-processing>] +(template [<field> <type> <post_processing>] [(def: #export (<field> instant) (-> Instant <type>) - (let [[date time] (..split-date-time instant)] - (|> <field> <post-processing>)))] + (let [[date time] (..split_date_time instant)] + (|> <field> <post_processing>)))] [date Date (|>)] - [time Time ..clock-time] + [time Time ..clock_time] ) -(def: #export (day-of-week instant) +(def: #export (day_of_week instant) (-> Instant Day) (let [offset (..relative instant) days (duration.query duration.day offset) - day-time (duration.frame duration.day offset) + day_time (duration.frame duration.day offset) days (if (and (duration.negative? offset) - (not (duration.neutral? day-time))) + (not (duration.neutral? day_time))) (dec days) days) ## 1970/01/01 was a Thursday @@ -186,8 +186,8 @@ +6 #day.Saturday _ (undefined)))) -(def: #export (from-date-time date time) +(def: #export (from_date_time date time) (-> Date Time Instant) - (..from-millis - (i.+ (i.* (date.days date) (duration.to-millis duration.day)) - (.int (//.to-millis time))))) + (..from_millis + (i.+ (i.* (date.days date) (duration.to_millis duration.day)) + (.int (//.to_millis time))))) diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux index f33a4e11c..dcfd3d1a2 100644 --- a/stdlib/source/lux/time/month.lux +++ b/stdlib/source/lux/time/month.lux @@ -49,7 +49,7 @@ _ false))) -(with-expansions [<pairs> (as-is [01 #January] +(with_expansions [<pairs> (as_is [01 #January] [02 #February] [03 #March] [04 #April] @@ -68,17 +68,17 @@ [<month> <number>]) (<pairs>))) - (exception: #export (invalid-month {number Nat}) + (exception: #export (invalid_month {number Nat}) (exception.report ["Number" (\ n.decimal encode number)])) - (def: #export (by-number number) + (def: #export (by_number number) (-> Nat (Try Month)) (case number (^template [<number> <month>] [<number> (#try.Success <month>)]) (<pairs>) - _ (exception.throw ..invalid-month [number]))) + _ (exception.throw ..invalid_month [number]))) ) (structure: #export order @@ -145,7 +145,7 @@ [30 #November] [31 #December]))) -(def: #export (leap-year-days month) +(def: #export (leap_year_days month) (-> Month Nat) (case month #February (inc (..days month)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux index e6fea4ef1..619f3c1d5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux @@ -105,7 +105,7 @@ (type: #export Match (Match' Analysis)) -(structure: primitive-equivalence +(structure: primitive_equivalence (Equivalence Primitive) (def: (= reference sample) @@ -126,16 +126,16 @@ _ false))) -(structure: #export (composite-equivalence (^open "/\.")) +(structure: #export (composite_equivalence (^open "/\.")) (All [a] (-> (Equivalence a) (Equivalence (Composite a)))) (def: (= reference sample) (case [reference sample] - [(#Variant [reference-lefts reference-right? reference-value]) - (#Variant [sample-lefts sample-right? sample-value])] - (and (n.= reference-lefts sample-lefts) - (bit\= reference-right? sample-right?) - (/\= reference-value sample-value)) + [(#Variant [reference_lefts reference_right? reference_value]) + (#Variant [sample_lefts sample_right? sample_value])] + (and (n.= reference_lefts sample_lefts) + (bit\= reference_right? sample_right?) + (/\= reference_value sample_value)) [(#Tuple reference) (#Tuple sample)] (\ (list.equivalence /\=) = reference sample) @@ -143,11 +143,11 @@ _ false))) -(structure: #export (composite-hash super) +(structure: #export (composite_hash super) (All [a] (-> (Hash a) (Hash (Composite a)))) (def: &equivalence - (..composite-equivalence (\ super &equivalence))) + (..composite_equivalence (\ super &equivalence))) (def: (hash value) (case value @@ -162,16 +162,16 @@ (\ (list.hash super) hash members)) ))) -(structure: pattern-equivalence +(structure: pattern_equivalence (Equivalence Pattern) (def: (= reference sample) (case [reference sample] [(#Simple reference) (#Simple sample)] - (\ primitive-equivalence = reference sample) + (\ primitive_equivalence = reference sample) [(#Complex reference) (#Complex sample)] - (\ (composite-equivalence =) = reference sample) + (\ (composite_equivalence =) = reference sample) [(#Bind reference) (#Bind sample)] (n.= reference sample) @@ -179,12 +179,12 @@ _ false))) -(structure: (branch-equivalence equivalence) +(structure: (branch_equivalence equivalence) (-> (Equivalence Analysis) (Equivalence Branch)) - (def: (= [reference-pattern reference-body] [sample-pattern sample-body]) - (and (\ pattern-equivalence = reference-pattern sample-pattern) - (\ equivalence = reference-body sample-body)))) + (def: (= [reference_pattern reference_body] [sample_pattern sample_body]) + (and (\ pattern_equivalence = reference_pattern sample_pattern) + (\ equivalence = reference_body sample_body)))) (structure: #export equivalence (Equivalence Analysis) @@ -192,28 +192,28 @@ (def: (= reference sample) (case [reference sample] [(#Primitive reference) (#Primitive sample)] - (\ primitive-equivalence = reference sample) + (\ primitive_equivalence = reference sample) [(#Structure reference) (#Structure sample)] - (\ (composite-equivalence =) = reference sample) + (\ (composite_equivalence =) = reference sample) [(#Reference reference) (#Reference sample)] (\ reference.equivalence = reference sample) - [(#Case [reference-analysis reference-match]) - (#Case [sample-analysis sample-match])] - (and (= reference-analysis sample-analysis) - (\ (list.equivalence (branch-equivalence =)) = (#.Cons reference-match) (#.Cons sample-match))) + [(#Case [reference_analysis reference_match]) + (#Case [sample_analysis sample_match])] + (and (= reference_analysis sample_analysis) + (\ (list.equivalence (branch_equivalence =)) = (#.Cons reference_match) (#.Cons sample_match))) - [(#Function [reference-environment reference-analysis]) - (#Function [sample-environment sample-analysis])] - (and (= reference-analysis sample-analysis) - (\ (list.equivalence =) = reference-environment sample-environment)) + [(#Function [reference_environment reference_analysis]) + (#Function [sample_environment sample_analysis])] + (and (= reference_analysis sample_analysis) + (\ (list.equivalence =) = reference_environment sample_environment)) - [(#Apply [reference-input reference-abstraction]) - (#Apply [sample-input sample-abstraction])] - (and (= reference-input sample-input) - (= reference-abstraction sample-abstraction)) + [(#Apply [reference_input reference_abstraction]) + (#Apply [sample_input sample_abstraction])] + (and (= reference_input sample_input) + (= reference_abstraction sample_abstraction)) [(#Extension reference) (#Extension sample)] (\ (extension.equivalence =) = reference sample) @@ -253,7 +253,7 @@ (-> Nat Tag Bit) (n.= (dec size) tag)) -(template: #export (no-op value) +(template: #export (no_op value) (|> 1 #variable.Local #reference.Variable #..Reference (#..Function (list)) (#..Apply value))) @@ -353,7 +353,7 @@ (#Tuple members) (|> members (list\map %analysis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))) (#Reference reference) @@ -367,7 +367,7 @@ (format " ") (format (|> environment (list\map %analysis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))) (text.enclose ["(" ")"])) @@ -376,13 +376,13 @@ ..application #.Cons (list\map %analysis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["(" ")"])) (#Extension name parameters) (|> parameters (list\map %analysis) - (text.join-with " ") + (text.join_with " ") (format (%.text name) " ") (text.enclose ["(" ")"])))) @@ -397,34 +397,34 @@ [Bundle extension.Bundle] ) -(def: #export (with-source-code source action) +(def: #export (with_source_code source action) (All [a] (-> Source (Operation a) (Operation a))) (function (_ [bundle state]) - (let [old-source (get@ #.source state)] + (let [old_source (get@ #.source state)] (case (action [bundle (set@ #.source source state)]) (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ #.source old-source state')] + (#try.Success [[bundle' (set@ #.source old_source state')] output]) (#try.Failure error) (#try.Failure error))))) -(def: fresh-bindings +(def: fresh_bindings (All [k v] (Bindings k v)) {#.counter 0 #.mappings (list)}) -(def: fresh-scope +(def: fresh_scope Scope {#.name (list) #.inner 0 - #.locals fresh-bindings - #.captured fresh-bindings}) + #.locals fresh_bindings + #.captured fresh_bindings}) -(def: #export (with-scope action) +(def: #export (with_scope action) (All [a] (-> (Operation a) (Operation [Scope a]))) (function (_ [bundle state]) - (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)]) + (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh_scope)) state)]) (#try.Success [[bundle' state'] output]) (case (get@ #.scopes state') (#.Cons head tail) @@ -437,35 +437,35 @@ (#try.Failure error) (#try.Failure error)))) -(def: #export (with-current-module name) +(def: #export (with_current_module name) (All [a] (-> Text (Operation a) (Operation a))) - (extension.localized (get@ #.current-module) - (set@ #.current-module) + (extension.localized (get@ #.current_module) + (set@ #.current_module) (function.constant (#.Some name)))) -(def: #export (with-location location action) +(def: #export (with_location location action) (All [a] (-> Location (Operation a) (Operation a))) (if (text\= "" (product.left location)) action (function (_ [bundle state]) - (let [old-location (get@ #.location state)] + (let [old_location (get@ #.location state)] (case (action [bundle (set@ #.location location state)]) (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ #.location old-location state')] + (#try.Success [[bundle' (set@ #.location old_location state')] output]) (#try.Failure error) (#try.Failure error)))))) -(def: (locate-error location error) +(def: (locate_error location error) (-> Location Text Text) - (format "@ " (%.location location) text.new-line + (format "@ " (%.location location) text.new_line error)) (def: #export (fail error) (-> Text Operation) (function (_ [bundle state]) - (#try.Failure (locate-error (get@ #.location state) error)))) + (#try.Failure (locate_error (get@ #.location state) error)))) (def: #export (throw exception parameters) (All [e] (-> (Exception e) e Operation)) @@ -480,13 +480,13 @@ (def: #export (fail' error) (-> Text (phase.Operation Lux)) (function (_ state) - (#try.Failure (locate-error (get@ #.location state) error)))) + (#try.Failure (locate_error (get@ #.location state) error)))) (def: #export (throw' exception parameters) (All [e] (-> (Exception e) e (phase.Operation Lux))) (..fail' (exception.construct exception parameters))) -(def: #export (with-stack exception message action) +(def: #export (with_stack exception message action) (All [e o] (-> (Exception e) e (Operation o) (Operation o))) (function (_ bundle,state) (case (exception.with exception message @@ -496,7 +496,7 @@ (#try.Failure error) (let [[bundle state] bundle,state] - (#try.Failure (locate-error (get@ #.location state) error)))))) + (#try.Failure (locate_error (get@ #.location state) error)))))) (def: #export (install state) (-> .Lux (Operation Any)) @@ -509,9 +509,9 @@ (-> <type> (Operation Any)) (extension.update (set@ <field> <value>)))] - [set-source-code Source #.source value] - [set-current-module Text #.current-module (#.Some value)] - [set-location Location #.location value] + [set_source_code Source #.source value] + [set_current_module Text #.current_module (#.Some value)] + [set_location Location #.location value] ) (def: #export (location file) @@ -522,15 +522,15 @@ (-> Text Text Source) [(location file) 0 code]) -(def: dummy-source +(def: dummy_source Source [location.dummy 0 ""]) -(def: type-context - Type-Context - {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)}) +(def: type_context + Type_Context + {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)}) (def: #export (info version host) (-> Version Text Info) @@ -541,14 +541,14 @@ (def: #export (state info) (-> Info Lux) {#.info info - #.source ..dummy-source + #.source ..dummy_source #.location location.dummy - #.current-module #.None + #.current_module #.None #.modules (list) #.scopes (list) - #.type-context ..type-context + #.type_context ..type_context #.expected #.None #.seed 0 - #.scope-type-vars (list) + #.scope_type_vars (list) #.extensions [] #.host []}) diff --git a/stdlib/source/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/directive.lux index 788b8fc4a..896a9a1cb 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/directive.lux @@ -37,12 +37,12 @@ {#imports (List Import) #referrals (List Code)}) -(def: #export no-requirements +(def: #export no_requirements Requirements {#imports (list) #referrals (list)}) -(def: #export (merge-requirements left right) +(def: #export (merge_requirements left right) (-> Requirements Requirements Requirements) {#imports (list\compose (get@ #imports left) (get@ #imports right)) #referrals (list\compose (get@ #referrals left) (get@ #referrals right))}) @@ -67,16 +67,16 @@ (set@ [<component> #..state])]) extension.lift))] - [lift-analysis #..analysis analysis.Operation] - [lift-synthesis #..synthesis synthesis.Operation] - [lift-generation #..generation (generation.Operation anchor expression directive)] + [lift_analysis #..analysis analysis.Operation] + [lift_synthesis #..synthesis synthesis.Operation] + [lift_generation #..generation (generation.Operation anchor expression directive)] ) -(def: #export (set-current-module module) +(def: #export (set_current_module module) (All [anchor expression directive] (-> Module (Operation anchor expression directive Any))) (do phase.monad - [_ (..lift-analysis - (analysis.set-current-module module))] - (..lift-generation - (generation.enter-module module)))) + [_ (..lift_analysis + (analysis.set_current_module module))] + (..lift_generation + (generation.enter_module module)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index da24f66f3..85a9ded21 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -31,7 +31,7 @@ (type: #export Context [archive.ID artifact.ID]) (type: #export (Buffer directive) (Row [Text directive])) -(exception: #export (cannot-interpret {error Text}) +(exception: #export (cannot_interpret {error Text}) (exception.report ["Error" error])) @@ -40,8 +40,8 @@ (exception.report ["Output" (%.text name)]))] - [cannot-overwrite-output] - [no-buffer-for-saving-code] + [cannot_overwrite_output] + [no_buffer_for_saving_code] ) (signature: #export (Host expression directive) @@ -55,9 +55,9 @@ (: (-> Context Binary directive) ingest) (: (-> Context directive (Try Any)) - re-learn) + re_learn) (: (-> Context directive (Try Any)) - re-load)) + re_load)) (type: #export (State anchor expression directive) {#module Module @@ -95,18 +95,18 @@ #context #.None #log row.empty}) -(def: #export empty-buffer Buffer row.empty) +(def: #export empty_buffer Buffer row.empty) (template [<tag> - <with-declaration> <with-type> <with-value> - <set> <get> <get-type> <exception>] + <with_declaration> <with_type> <with_value> + <set> <get> <get_type> <exception>] [(exception: #export <exception>) - (def: #export <with-declaration> - (All [anchor expression directive output] <with-type>) + (def: #export <with_declaration> + (All [anchor expression directive output] <with_type>) (function (_ body) (function (_ [bundle state]) - (case (body [bundle (set@ <tag> (#.Some <with-value>) state)]) + (case (body [bundle (set@ <tag> (#.Some <with_value>) state)]) (#try.Success [[bundle' state'] output]) (#try.Success [[bundle' (set@ <tag> (get@ <tag> state) state')] output]) @@ -116,7 +116,7 @@ (def: #export <get> (All [anchor expression directive] - (Operation anchor expression directive <get-type>)) + (Operation anchor expression directive <get_type>)) (function (_ (^@ stateE [bundle state])) (case (get@ <tag> state) (#.Some output) @@ -127,33 +127,33 @@ (def: #export (<set> value) (All [anchor expression directive] - (-> <get-type> (Operation anchor expression directive Any))) + (-> <get_type> (Operation anchor expression directive Any))) (function (_ [bundle state]) (#try.Success [[bundle (set@ <tag> (#.Some value) state)] []])))] [#anchor - (with-anchor anchor) + (with_anchor anchor) (-> anchor (Operation anchor expression directive output) (Operation anchor expression directive output)) anchor - set-anchor anchor anchor no-anchor] + set_anchor anchor anchor no_anchor] [#buffer - with-buffer + with_buffer (-> (Operation anchor expression directive output) (Operation anchor expression directive output)) - ..empty-buffer - set-buffer buffer (Buffer directive) no-active-buffer] + ..empty_buffer + set_buffer buffer (Buffer directive) no_active_buffer] ) -(def: #export get-registry +(def: #export get_registry (All [anchor expression directive] (Operation anchor expression directive artifact.Registry)) (function (_ (^@ stateE [bundle state])) (#try.Success [stateE (get@ #registry state)]))) -(def: #export (set-registry value) +(def: #export (set_registry value) (All [anchor expression directive] (-> artifact.Registry (Operation anchor expression directive Any))) (function (_ [bundle state]) @@ -173,7 +173,7 @@ (-> Text (Operation anchor expression directive Text))) (\ phase.monad map (|>> %.nat (format prefix)) ..next)) -(def: #export (enter-module module) +(def: #export (enter_module module) (All [anchor expression directive] (-> Module (Operation anchor expression directive Any))) (extension.update (set@ #module module))) @@ -192,7 +192,7 @@ (#try.Success [state+ output]) (#try.Failure error) - (exception.throw ..cannot-interpret error)))) + (exception.throw ..cannot_interpret error)))) (def: #export (execute! code) (All [anchor expression directive] @@ -203,7 +203,7 @@ (#try.Success [state+ output]) (#try.Failure error) - (exception.throw ..cannot-interpret error)))) + (exception.throw ..cannot_interpret error)))) (def: #export (define! context code) (All [anchor expression directive] @@ -214,7 +214,7 @@ (#try.Success [stateE output]) (#try.Failure error) - (exception.throw ..cannot-interpret error)))) + (exception.throw ..cannot_interpret error)))) (def: #export (save! name code) (All [anchor expression directive] @@ -224,11 +224,11 @@ (case ?buffer (#.Some buffer) (if (row.any? (|>> product.left (text\= name)) buffer) - (phase.throw ..cannot-overwrite-output [name]) + (phase.throw ..cannot_overwrite_output [name]) (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) #.None - (phase.throw ..no-buffer-for-saving-code [name])))) + (phase.throw ..no_buffer_for_saving_code [name])))) (template [<name> <artifact>] [(def: #export (<name> name) @@ -240,18 +240,18 @@ id]))))] [learn artifact.definition] - [learn-analyser artifact.analyser] - [learn-synthesizer artifact.synthesizer] - [learn-generator artifact.generator] - [learn-directive artifact.directive] + [learn_analyser artifact.analyser] + [learn_synthesizer artifact.synthesizer] + [learn_generator artifact.generator] + [learn_directive artifact.directive] ) -(exception: #export (unknown-definition {name Name} - {known-definitions (List Text)}) +(exception: #export (unknown_definition {name Name} + {known_definitions (List Text)}) (exception.report ["Definition" (name.short name)] ["Module" (name.module name)] - ["Known Definitions" (exception.enumerate function.identity known-definitions)])) + ["Known Definitions" (exception.enumerate function.identity known_definitions)])) (def: #export (remember archive name) (All [anchor expression directive] @@ -259,7 +259,7 @@ (function (_ (^@ stateE [bundle state])) (let [[_module _name] name] (do try.monad - [module-id (archive.id _module archive) + [module_id (archive.id _module archive) registry (if (text\= (get@ #module state) _module) (#try.Success (get@ #registry state)) (do try.monad @@ -267,20 +267,20 @@ (#try.Success (get@ #descriptor.registry descriptor))))] (case (artifact.remember _name registry) #.None - (exception.throw ..unknown-definition [name (artifact.definitions registry)]) + (exception.throw ..unknown_definition [name (artifact.definitions registry)]) (#.Some id) - (#try.Success [stateE [module-id id]])))))) + (#try.Success [stateE [module_id id]])))))) -(exception: #export no-context) +(exception: #export no_context) -(def: #export (module-id module archive) +(def: #export (module_id module archive) (All [anchor expression directive] (-> Module Archive (Operation anchor expression directive archive.ID))) (function (_ (^@ stateE [bundle state])) (do try.monad - [module-id (archive.id module archive)] - (wrap [stateE module-id])))) + [module_id (archive.id module archive)] + (wrap [stateE module_id])))) (def: #export (context archive) (All [anchor expression directive] @@ -288,14 +288,14 @@ (function (_ (^@ stateE [bundle state])) (case (get@ #context state) #.None - (exception.throw ..no-context []) + (exception.throw ..no_context []) (#.Some id) (do try.monad - [module-id (archive.id (get@ #module state) archive)] - (wrap [stateE [module-id id]]))))) + [module_id (archive.id (get@ #module state) archive)] + (wrap [stateE [module_id id]]))))) -(def: #export (with-context id body) +(def: #export (with_context id body) (All [anchor expression directive a] (-> artifact.ID (Operation anchor expression directive a) @@ -306,7 +306,7 @@ (wrap [[bundle' (set@ #context (get@ #context state) state')] output])))) -(def: #export (with-new-context archive body) +(def: #export (with_new_context archive body) (All [anchor expression directive a] (-> Archive (Operation anchor expression directive a) (Operation anchor expression directive [Context a]))) @@ -316,9 +316,9 @@ [[[bundle' state'] output] (body [bundle (|> state (set@ #registry registry') (set@ #context (#.Some id)))]) - module-id (archive.id (get@ #module state) archive)] + module_id (archive.id (get@ #module state) archive)] (wrap [[bundle' (set@ #context (get@ #context state) state')] - [[module-id id] + [[module_id id] output]]))))) (def: #export (log! message) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux index 5d5aa835d..f72ec593b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux @@ -15,41 +15,41 @@ [/// ["#" phase]]]]) -(def: #export (with-type expected) +(def: #export (with_type expected) (All [a] (-> Type (Operation a) (Operation a))) (///extension.localized (get@ #.expected) (set@ #.expected) (function.constant (#.Some expected)))) -(def: #export (with-env action) +(def: #export (with_env action) (All [a] (-> (Check a) (Operation a))) (function (_ (^@ stateE [bundle state])) - (case (action (get@ #.type-context state)) + (case (action (get@ #.type_context state)) (#try.Success [context' output]) - (#try.Success [[bundle (set@ #.type-context context' state)] + (#try.Success [[bundle (set@ #.type_context context' state)] output]) (#try.Failure error) ((/.fail error) stateE)))) -(def: #export with-fresh-env +(def: #export with_fresh_env (All [a] (-> (Operation a) (Operation a))) - (///extension.localized (get@ #.type-context) (set@ #.type-context) - (function.constant check.fresh-context))) + (///extension.localized (get@ #.type_context) (set@ #.type_context) + (function.constant check.fresh_context))) (def: #export (infer actualT) (-> Type (Operation Any)) (do ///.monad - [expectedT (///extension.lift meta.expected-type)] - (with-env + [expectedT (///extension.lift meta.expected_type)] + (with_env (check.check expectedT actualT)))) -(def: #export (with-inference action) +(def: #export (with_inference action) (All [a] (-> (Operation a) (Operation [Type a]))) (do ///.monad - [[_ varT] (..with-env + [[_ varT] (..with_env check.var) - output (with-type varT + output (with_type varT action) - knownT (..with-env + knownT (..with_env (check.clean varT))] (wrap [knownT output]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux index f121b78ca..9803de0e4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux @@ -36,7 +36,7 @@ (|>> list.hash (product.hash text.hash))) -(with-expansions [<Bundle> (as-is (Dictionary Name (Handler s i o)))] +(with_expansions [<Bundle> (as_is (Dictionary Name (Handler s i o)))] (type: #export (Handler s i o) (-> Name (//.Phase [<Bundle> s] i o) @@ -55,17 +55,17 @@ (type: #export (Phase s i o) (//.Phase (State s i o) i o)) -(exception: #export (cannot-overwrite {name Name}) +(exception: #export (cannot_overwrite {name Name}) (exception.report ["Extension" (%.text name)])) -(exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat}) +(exception: #export (incorrect_arity {name Name} {arity Nat} {args Nat}) (exception.report ["Extension" (%.text name)] ["Expected" (%.nat arity)] ["Actual" (%.nat args)])) -(exception: #export [a] (invalid-syntax {name Name} {%format (Format a)} {inputs (List a)}) +(exception: #export [a] (invalid_syntax {name Name} {%format (Format a)} {inputs (List a)}) (exception.report ["Extension" (%.text name)] ["Inputs" (exception.enumerate %format inputs)])) @@ -91,7 +91,7 @@ []]) _ - (exception.throw ..cannot-overwrite name)))) + (exception.throw ..cannot_overwrite name)))) (def: #export (with extender extensions) (All [s i o] @@ -142,7 +142,7 @@ (#try.Failure error) (#try.Failure error))))) -(def: #export (with-state state) +(def: #export (with_state state) (All [s i o v] (-> s (-> (Operation s i o v) (Operation s i o v)))) (..temporary (function.constant state))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux index 1916cfe15..bdbba5134 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/syntax.lux @@ -93,37 +93,37 @@ (type: #export Aliases (Dictionary Text Text)) -(def: #export no-aliases +(def: #export no_aliases Aliases (dictionary.new text.hash)) (def: #export prelude "lux") -(def: #export text-delimiter text.double-quote) +(def: #export text_delimiter text.double_quote) (template [<char> <definition>] [(def: #export <definition> <char>)] ## Form delimiters - ["(" open-form] - [")" close-form] + ["(" open_form] + [")" close_form] ## Tuple delimiters - ["[" open-tuple] - ["]" close-tuple] + ["[" open_tuple] + ["]" close_tuple] ## Record delimiters - ["{" open-record] - ["}" close-record] + ["{" open_record] + ["}" close_record] ["#" sigil] - ["," digit-separator] + ["," digit_separator] - ["+" positive-sign] - ["-" negative-sign] + ["+" positive_sign] + ["-" negative_sign] - ["." frac-separator] + ["." frac_separator] ## The parts of a name are separated by a single mark. ## E.g. module.short. @@ -132,52 +132,52 @@ ## mark], and the short [after the mark]). ## There are also some extra rules regarding name syntax, ## encoded in the parser. - ["." name-separator] + ["." name_separator] ) -(exception: #export (end-of-file {module Text}) +(exception: #export (end_of_file {module Text}) (exception.report ["Module" (%.text module)])) -(def: amount-of-input-shown 64) +(def: amount_of_input_shown 64) -(template: (input-at start input) +(template: (input_at start input) ## (-> Offset Text Text) - (let [end (|> start (!n/+ amount-of-input-shown) (n.min ("lux text size" input)))] + (let [end (|> start (!n/+ amount_of_input_shown) (n.min ("lux text size" input)))] (!clip start end input))) -(exception: #export (unrecognized-input {[file line column] Location} {context Text} {input Text} {offset Offset}) +(exception: #export (unrecognized_input {[file line column] Location} {context Text} {input Text} {offset Offset}) (exception.report ["File" file] ["Line" (%.nat line)] ["Column" (%.nat column)] ["Context" (%.text context)] - ["Input" (input-at offset input)])) + ["Input" (input_at offset input)])) -(exception: #export (text-cannot-contain-new-lines {text Text}) +(exception: #export (text_cannot_contain_new_lines {text Text}) (exception.report ["Text" (%.text text)])) -(template: (!failure parser where offset source-code) - (#.Left [[where offset source-code] - (exception.construct ..unrecognized-input [where (%.name (name-of parser)) source-code offset])])) +(template: (!failure parser where offset source_code) + (#.Left [[where offset source_code] + (exception.construct ..unrecognized_input [where (%.name (name_of parser)) source_code offset])])) -(template: (!end-of-file where offset source-code current-module) - (#.Left [[where offset source-code] - (exception.construct ..end-of-file current-module)])) +(template: (!end_of_file where offset source_code current_module) + (#.Left [[where offset source_code] + (exception.construct ..end_of_file current_module)])) (type: (Parser a) (-> Source (Either [Source Text] [Source a]))) -(template: (!with-char+ @source-code-size @source-code @offset @char @else @body) - (if (!i/< (:coerce Int @source-code-size) +(template: (!with_char+ @source_code_size @source_code @offset @char @else @body) + (if (!i/< (:coerce Int @source_code_size) (:coerce Int @offset)) - (let [@char ("lux text char" @offset @source-code)] + (let [@char ("lux text char" @offset @source_code)] @body) @else)) -(template: (!with-char @source-code @offset @char @else @body) - (!with-char+ ("lux text size" @source-code) @source-code @offset @char @else @body)) +(template: (!with_char @source_code @offset @char @else @body) + (!with_char+ ("lux text size" @source_code) @source_code @offset @char @else @body)) (template: (!letE <binding> <computation> <body>) (case <computation> @@ -188,12 +188,12 @@ <<otherwise>> (:assume <<otherwise>>))) -(template: (!horizontal where offset source-code) +(template: (!horizontal where offset source_code) [(update@ #.column inc where) (!inc offset) - source-code]) + source_code]) -(template: (!new-line where) +(template: (!new_line where) ## (-> Location Location) (let [[where::file where::line where::column] where] [where::file (!inc where::line) 0])) @@ -203,15 +203,15 @@ (let [[where::file where::line where::column] where] [where::file where::line (!n/+ length where::column)])) -(template: (!vertical where offset source-code) - [(!new-line where) +(template: (!vertical where offset source_code) + [(!new_line where) (!inc offset) - source-code]) + source_code]) (template [<name> <close> <tag>] - [(template: (<name> parse where offset source-code) + [(template: (<name> parse where offset source_code) ## (-> (Parser Code) (Parser Code)) - (loop [source (: Source [(!forward 1 where) offset source-code]) + (loop [source (: Source [(!forward 1 where) offset source_code]) stack (: (List Code) #.Nil)] (case (parse source) (#.Right [source' top]) @@ -226,13 +226,13 @@ ## Form and tuple syntax is mostly the same, differing only in the ## delimiters involved. ## They may have an arbitrary number of arbitrary Code nodes as elements. - [parse-form ..close-form #.Form] - [parse-tuple ..close-tuple #.Tuple] + [parse_form ..close_form #.Form] + [parse_tuple ..close_tuple #.Tuple] ) -(template: (parse-record parse where offset source-code) +(template: (parse_record parse where offset source_code) ## (-> (Parser Code) (Parser Code)) - (loop [source (: Source [(!forward 1 where) offset source-code]) + (loop [source (: Source [(!forward 1 where) offset source_code]) stack (: (List [Code Code]) #.Nil)] (case (parse source) (#.Right [sourceF field]) @@ -240,50 +240,50 @@ (recur sourceFV (#.Cons [field value] stack))) (#.Left [source' error]) - (if (is? ..close-record error) + (if (is? ..close_record error) (#.Right [source' [where (#.Record (list.reverse stack))]]) (#.Left [source' error]))))) -(template: (!guarantee-no-new-lines where offset source-code content body) - (case ("lux text index" 0 (static text.new-line) content) +(template: (!guarantee_no_new_lines where offset source_code content body) + (case ("lux text index" 0 (static text.new_line) content) #.None body g!_ - (#.Left [[where offset source-code] - (exception.construct ..text-cannot-contain-new-lines content)]))) + (#.Left [[where offset source_code] + (exception.construct ..text_cannot_contain_new_lines content)]))) -(def: (parse-text where offset source-code) +(def: (parse_text where offset source_code) (-> Location Nat Text (Either [Source Text] [Source Code])) - (case ("lux text index" offset (static ..text-delimiter) source-code) + (case ("lux text index" offset (static ..text_delimiter) source_code) (#.Some g!end) - (<| (let [g!content (!clip offset g!end source-code)]) - (!guarantee-no-new-lines where offset source-code g!content) + (<| (let [g!content (!clip offset g!end source_code)]) + (!guarantee_no_new_lines where offset source_code g!content) (#.Right [[(let [size (!n/- offset g!end)] (update@ #.column (|>> (!n/+ size) (!n/+ 2)) where)) (!inc g!end) - source-code] + source_code] [where (#.Text g!content)]])) _ - (!failure ..parse-text where offset source-code))) + (!failure ..parse_text where offset source_code))) -(with-expansions [<digits> (as-is "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") - <non-name-chars> (template [<char>] +(with_expansions [<digits> (as_is "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") + <non_name_chars> (template [<char>] [(~~ (static <char>))] [text.space] - [text.new-line] [text.carriage-return] - [..name-separator] - [..open-form] [..close-form] - [..open-tuple] [..close-tuple] - [..open-record] [..close-record] - [..text-delimiter] + [text.new_line] [text.carriage_return] + [..name_separator] + [..open_form] [..close_form] + [..open_tuple] [..close_tuple] + [..open_record] [..close_record] + [..text_delimiter] [..sigil]) - <digit-separator> (static ..digit-separator)] - (template: (!if-digit? @char @then @else) + <digit_separator> (static ..digit_separator)] + (template: (!if_digit? @char @then @else) ("lux syntax char case!" @char [[<digits>] @then] @@ -291,279 +291,279 @@ ## else @else)) - (template: (!if-digit?+ @char @then @else-options @else) + (template: (!if_digit?+ @char @then @else_options @else) (`` ("lux syntax char case!" @char - [[<digits> <digit-separator>] + [[<digits> <digit_separator>] @then - (~~ (template.splice @else-options))] + (~~ (template.splice @else_options))] ## else @else))) - (`` (template: (!if-name-char?|tail @char @then @else) + (`` (template: (!if_name_char?|tail @char @then @else) ("lux syntax char case!" @char - [[<non-name-chars>] + [[<non_name_chars>] @else] ## else @then))) - (`` (template: (!if-name-char?|head @char @then @else) + (`` (template: (!if_name_char?|head @char @then @else) ("lux syntax char case!" @char - [[<non-name-chars> <digits>] + [[<non_name_chars> <digits>] @else] ## else @then))) ) -(template: (!number-output <source-code> <start> <end> <codec> <tag>) - (case (|> <source-code> +(template: (!number_output <source_code> <start> <end> <codec> <tag>) + (case (|> <source_code> (!clip <start> <end>) - (text.replace-all ..digit-separator "") + (text.replace_all ..digit_separator "") (\ <codec> decode)) (#.Right output) (#.Right [[(let [[where::file where::line where::column] where] [where::file where::line (!n/+ (!n/- <start> <end>) where::column)]) <end> - <source-code>] + <source_code>] [where (<tag> output)]]) (#.Left error) - (#.Left [[where <start> <source-code>] + (#.Left [[where <start> <source_code>] error]))) -(def: no-exponent Offset 0) +(def: no_exponent Offset 0) -(with-expansions [<int-output> (as-is (!number-output source-code start end int.decimal #.Int)) - <frac-output> (as-is (!number-output source-code start end frac.decimal #.Frac)) - <failure> (!failure ..parse-frac where offset source-code) - <frac-separator> (static ..frac-separator) +(with_expansions [<int_output> (as_is (!number_output source_code start end int.decimal #.Int)) + <frac_output> (as_is (!number_output source_code start end frac.decimal #.Frac)) + <failure> (!failure ..parse_frac where offset source_code) + <frac_separator> (static ..frac_separator) <signs> (template [<sign>] [(~~ (static <sign>))] - [..positive-sign] - [..negative-sign])] - (template: (parse-frac source-code//size start where offset source-code) + [..positive_sign] + [..negative_sign])] + (template: (parse_frac source_code//size start where offset source_code) ## (-> Nat Offset (Parser Code)) (loop [end offset - exponent (static ..no-exponent)] - (<| (!with-char+ source-code//size source-code end char/0 <frac-output>) - (!if-digit?+ char/0 + exponent (static ..no_exponent)] + (<| (!with_char+ source_code//size source_code end char/0 <frac_output>) + (!if_digit?+ char/0 (recur (!inc end) exponent) [["e" "E"] - (if (is? (static ..no-exponent) exponent) - (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>) + (if (is? (static ..no_exponent) exponent) + (<| (!with_char+ source_code//size source_code (!inc end) char/1 <failure>) (`` ("lux syntax char case!" char/1 [[<signs>] - (<| (!with-char+ source-code//size source-code (!n/+ 2 end) char/2 <failure>) - (!if-digit?+ char/2 + (<| (!with_char+ source_code//size source_code (!n/+ 2 end) char/2 <failure>) + (!if_digit?+ char/2 (recur (!n/+ 3 end) char/0) [] <failure>))] ## else <failure>))) - <frac-output>)] + <frac_output>)] - <frac-output>)))) + <frac_output>)))) - (template: (parse-signed source-code//size start where offset source-code) + (template: (parse_signed source_code//size start where offset source_code) ## (-> Nat Offset (Parser Code)) (loop [end offset] - (<| (!with-char+ source-code//size source-code end char <int-output>) - (!if-digit?+ char + (<| (!with_char+ source_code//size source_code end char <int_output>) + (!if_digit?+ char (recur (!inc end)) - [[<frac-separator>] - (parse-frac source-code//size start where (!inc end) source-code)] + [[<frac_separator>] + (parse_frac source_code//size start where (!inc end) source_code)] - <int-output>)))) + <int_output>)))) ) (template [<parser> <codec> <tag>] - [(template: (<parser> source-code//size start where offset source-code) + [(template: (<parser> source_code//size start where offset source_code) ## (-> Nat Nat Location Nat Text (Either [Source Text] [Source Code])) (loop [g!end offset] - (<| (!with-char+ source-code//size source-code g!end g!char (!number-output source-code start g!end <codec> <tag>)) - (!if-digit?+ g!char + (<| (!with_char+ source_code//size source_code g!end g!char (!number_output source_code start g!end <codec> <tag>)) + (!if_digit?+ g!char (recur (!inc g!end)) [] - (!number-output source-code start g!end <codec> <tag>)))))] + (!number_output source_code start g!end <codec> <tag>)))))] - [parse-nat n.decimal #.Nat] - [parse-rev rev.decimal #.Rev] + [parse_nat n.decimal #.Nat] + [parse_rev rev.decimal #.Rev] ) -(template: (!parse-signed source-code//size offset where source-code @aliases @end) +(template: (!parse_signed source_code//size offset where source_code @aliases @end) (<| (let [g!offset/1 (!inc offset)]) - (!with-char+ source-code//size source-code g!offset/1 g!char/1 @end) - (!if-digit? g!char/1 - (parse-signed source-code//size offset where (!inc/2 offset) source-code) - (!parse-full-name offset [where (!inc offset) source-code] where @aliases #.Identifier)))) + (!with_char+ source_code//size source_code g!offset/1 g!char/1 @end) + (!if_digit? g!char/1 + (parse_signed source_code//size offset where (!inc/2 offset) source_code) + (!parse_full_name offset [where (!inc offset) source_code] where @aliases #.Identifier)))) -(with-expansions [<output> (#.Right [[(update@ #.column (|>> (!n/+ (!n/- start end))) where) +(with_expansions [<output> (#.Right [[(update@ #.column (|>> (!n/+ (!n/- start end))) where) end - source-code] - (!clip start end source-code)])] - (template: (parse-name-part start where offset source-code) + source_code] + (!clip start end source_code)])] + (template: (parse_name_part start where offset source_code) ## (-> Offset (Parser Text)) - (let [source-code//size ("lux text size" source-code)] + (let [source_code//size ("lux text size" source_code)] (loop [end offset] - (<| (!with-char+ source-code//size source-code end char <output>) - (!if-name-char?|tail char + (<| (!with_char+ source_code//size source_code end char <output>) + (!if_name_char?|tail char (recur (!inc end)) <output>)))))) -(template: (!parse-half-name @offset @char @module) - (!if-name-char?|head @char - (!letE [source' name] (..parse-name-part @offset where (!inc @offset) source-code) +(template: (!parse_half_name @offset @char @module) + (!if_name_char?|head @char + (!letE [source' name] (..parse_name_part @offset where (!inc @offset) source_code) (#.Right [source' [@module name]])) - (!failure ..!parse-half-name where @offset source-code))) + (!failure ..!parse_half_name where @offset source_code))) -(`` (def: (parse-short-name source-code//size current-module [where offset/0 source-code]) +(`` (def: (parse_short_name source_code//size current_module [where offset/0 source_code]) (-> Nat Text (Parser Name)) - (<| (!with-char+ source-code//size source-code offset/0 char/0 - (!end-of-file where offset/0 source-code current-module)) - (if (!n/= (char (~~ (static ..name-separator))) char/0) + (<| (!with_char+ source_code//size source_code offset/0 char/0 + (!end_of_file where offset/0 source_code current_module)) + (if (!n/= (char (~~ (static ..name_separator))) char/0) (<| (let [offset/1 (!inc offset/0)]) - (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) - (!parse-half-name offset/1 char/1 current-module)) - (!parse-half-name offset/0 char/0 (static ..prelude)))))) + (!with_char+ source_code//size source_code offset/1 char/1 + (!end_of_file where offset/1 source_code current_module)) + (!parse_half_name offset/1 char/1 current_module)) + (!parse_half_name offset/0 char/0 (static ..prelude)))))) -(template: (!parse-short-name source-code//size @current-module @source @where @tag) - (!letE [source' name] (..parse-short-name source-code//size @current-module @source) +(template: (!parse_short_name source_code//size @current_module @source @where @tag) + (!letE [source' name] (..parse_short_name source_code//size @current_module @source) (#.Right [source' [@where (@tag name)]]))) -(with-expansions [<simple> (as-is (#.Right [source' ["" simple]]))] - (`` (def: (parse-full-name aliases start source) +(with_expansions [<simple> (as_is (#.Right [source' ["" simple]]))] + (`` (def: (parse_full_name aliases start source) (-> Aliases Offset (Parser Name)) - (<| (!letE [source' simple] (let [[where offset source-code] source] - (..parse-name-part start where offset source-code))) - (let [[where' offset' source-code'] source']) - (!with-char source-code' offset' char/separator <simple>) - (if (!n/= (char (~~ (static ..name-separator))) char/separator) + (<| (!letE [source' simple] (let [[where offset source_code] source] + (..parse_name_part start where offset source_code))) + (let [[where' offset' source_code'] source']) + (!with_char source_code' offset' char/separator <simple>) + (if (!n/= (char (~~ (static ..name_separator))) char/separator) (<| (let [offset'' (!inc offset')]) - (!letE [source'' complex] (..parse-name-part offset'' (!forward 1 where') offset'' source-code')) + (!letE [source'' complex] (..parse_name_part offset'' (!forward 1 where') offset'' source_code')) (if ("lux text =" "" complex) - (let [[where offset source-code] source] - (!failure ..parse-full-name where offset source-code)) + (let [[where offset source_code] source] + (!failure ..parse_full_name where offset source_code)) (#.Right [source'' [(|> aliases (dictionary.get simple) (maybe.default simple)) complex]]))) <simple>))))) -(template: (!parse-full-name @offset @source @where @aliases @tag) - (!letE [source' full-name] (..parse-full-name @aliases @offset @source) - (#.Right [source' [@where (@tag full-name)]]))) +(template: (!parse_full_name @offset @source @where @aliases @tag) + (!letE [source' full_name] (..parse_full_name @aliases @offset @source) + (#.Right [source' [@where (@tag full_name)]]))) ## TODO: Grammar macro for specifying syntax. -## (grammar: lux-grammar +## (grammar: lux_grammar ## [expression ...] ## [form "(" [#* expression] ")"]) -(with-expansions [<consume-1> (as-is where (!inc offset/0) source-code) - <move-1> (as-is [(!forward 1 where) (!inc offset/0) source-code]) - <move-2> (as-is [(!forward 1 where) (!inc/2 offset/0) source-code]) - <recur> (as-is (parse current-module aliases source-code//size)) - <horizontal-move> (as-is (recur (!horizontal where offset/0 source-code)))] +(with_expansions [<consume_1> (as_is where (!inc offset/0) source_code) + <move_1> (as_is [(!forward 1 where) (!inc offset/0) source_code]) + <move_2> (as_is [(!forward 1 where) (!inc/2 offset/0) source_code]) + <recur> (as_is (parse current_module aliases source_code//size)) + <horizontal_move> (as_is (recur (!horizontal where offset/0 source_code)))] (template: (!close closer) - (#.Left [<move-1> closer])) + (#.Left [<move_1> closer])) - (def: #export (parse current-module aliases source-code//size) + (def: #export (parse current_module aliases source_code//size) (-> Text Aliases Nat (Parser Code)) ## The "exec []" is only there to avoid function fusion. ## This is to preserve the loop as much as possible and keep it tight. (exec [] - (function (recur [where offset/0 source-code]) - (<| (!with-char+ source-code//size source-code offset/0 char/0 - (!end-of-file where offset/0 source-code current-module)) - (with-expansions [<composites> (template [<open> <close> <parser>] + (function (recur [where offset/0 source_code]) + (<| (!with_char+ source_code//size source_code offset/0 char/0 + (!end_of_file where offset/0 source_code current_module)) + (with_expansions [<composites> (template [<open> <close> <parser>] [[(~~ (static <open>))] - (<parser> <recur> <consume-1>) + (<parser> <recur> <consume_1>) [(~~ (static <close>))] (!close <close>)] - [..open-form ..close-form parse-form] - [..open-tuple ..close-tuple parse-tuple] - [..open-record ..close-record parse-record] + [..open_form ..close_form parse_form] + [..open_tuple ..close_tuple parse_tuple] + [..open_record ..close_record parse_record] )] (`` ("lux syntax char case!" char/0 [[(~~ (static text.space)) - (~~ (static text.carriage-return))] - <horizontal-move> + (~~ (static text.carriage_return))] + <horizontal_move> ## New line - [(~~ (static text.new-line))] - (recur (!vertical where offset/0 source-code)) + [(~~ (static text.new_line))] + (recur (!vertical where offset/0 source_code)) <composites> ## Text - [(~~ (static ..text-delimiter))] - (parse-text where (!inc offset/0) source-code) + [(~~ (static ..text_delimiter))] + (parse_text where (!inc offset/0) source_code) ## Special code [(~~ (static ..sigil))] (<| (let [offset/1 (!inc offset/0)]) - (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) + (!with_char+ source_code//size source_code offset/1 char/1 + (!end_of_file where offset/1 source_code current_module)) ("lux syntax char case!" char/1 - [[(~~ (static ..name-separator))] - (!parse-short-name source-code//size current-module <move-2> where #.Tag) + [[(~~ (static ..name_separator))] + (!parse_short_name source_code//size current_module <move_2> where #.Tag) - ## Single-line comment + ## Single_line comment [(~~ (static ..sigil))] - (case ("lux text index" (!inc offset/1) (static text.new-line) source-code) + (case ("lux text index" (!inc offset/1) (static text.new_line) source_code) (#.Some end) - (recur (!vertical where end source-code)) + (recur (!vertical where end source_code)) _ - (!end-of-file where offset/1 source-code current-module)) + (!end_of_file where offset/1 source_code current_module)) (~~ (template [<char> <bit>] [[<char>] (#.Right [[(update@ #.column (|>> !inc/2) where) (!inc offset/1) - source-code] + source_code] [where (#.Bit <bit>)]])] ["0" #0] ["1" #1]))] ## else - (!if-name-char?|head char/1 + (!if_name_char?|head char/1 ## Tag - (!parse-full-name offset/1 <move-2> where aliases #.Tag) - (!failure ..parse where offset/0 source-code)))) + (!parse_full_name offset/1 <move_2> where aliases #.Tag) + (!failure ..parse where offset/0 source_code)))) - ## Coincidentally (= ..name-separator ..frac-separator) - [(~~ (static ..name-separator)) - ## (~~ (static ..frac-separator)) + ## Coincidentally (= ..name_separator ..frac_separator) + [(~~ (static ..name_separator)) + ## (~~ (static ..frac_separator)) ] (<| (let [offset/1 (!inc offset/0)]) - (!with-char+ source-code//size source-code offset/1 char/1 - (!end-of-file where offset/1 source-code current-module)) - (!if-digit? char/1 - (parse-rev source-code//size offset/0 where (!inc offset/1) source-code) - (!parse-short-name source-code//size current-module [where offset/1 source-code] where #.Identifier))) + (!with_char+ source_code//size source_code offset/1 char/1 + (!end_of_file where offset/1 source_code current_module)) + (!if_digit? char/1 + (parse_rev source_code//size offset/0 where (!inc offset/1) source_code) + (!parse_short_name source_code//size current_module [where offset/1 source_code] where #.Identifier))) - [(~~ (static ..positive-sign)) - (~~ (static ..negative-sign))] - (!parse-signed source-code//size offset/0 where source-code aliases - (!end-of-file where offset/0 source-code current-module))] + [(~~ (static ..positive_sign)) + (~~ (static ..negative_sign))] + (!parse_signed source_code//size offset/0 where source_code aliases + (!end_of_file where offset/0 source_code current_module))] ## else - (!if-digit? char/0 + (!if_digit? char/0 ## Natural number - (parse-nat source-code//size offset/0 where (!inc offset/0) source-code) + (parse_nat source_code//size offset/0 where (!inc offset/0) source_code) ## Identifier - (!parse-full-name offset/0 [<consume-1>] where aliases #.Identifier)) + (!parse_full_name offset/0 [<consume_1>] where aliases #.Identifier)) ))) ))) )) diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux index 36dd33b23..a421d1ba9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux @@ -40,7 +40,7 @@ ## https://en.wikipedia.org/wiki/Currying #currying? Bit}) -(def: #export fresh-resolver +(def: #export fresh_resolver Resolver (dictionary.new variable.hash)) @@ -72,10 +72,10 @@ #Pop (#Access Access) (#Bind Register) - (#Bit-Fork Bit (Path' s) (Maybe (Path' s))) - (#I64-Fork (Fork (I64 Any) (Path' s))) - (#F64-Fork (Fork Frac (Path' s))) - (#Text-Fork (Fork Text (Path' s))) + (#Bit_Fork Bit (Path' s) (Maybe (Path' s))) + (#I64_Fork (Fork (I64 Any) (Path' s))) + (#F64_Fork (Fork Frac (Path' s))) + (#Text_Fork (Fork Text (Path' s))) (#Alt (Path' s) (Path' s)) (#Seq (Path' s) (Path' s)) (#Then s)) @@ -194,15 +194,15 @@ (Operation <type>) (extension.read (get@ <tag>)))] - [with-locals locals #locals Nat] - [with-currying? currying? #currying? Bit] + [with_locals locals #locals Nat] + [with_currying? currying? #currying? Bit] ) -(def: #export with-new-local +(def: #export with_new_local (All [a] (-> (Operation a) (Operation a))) (<<| (do phase.monad [locals ..locals]) - (..with-locals (inc locals)))) + (..with_locals (inc locals)))) (template [<name> <tag>] [(template: #export (<name> content) @@ -261,7 +261,7 @@ #Pop "_" - (#Bit-Fork when then else) + (#Bit_Fork when then else) (format "(?" " " (%.bit when) " " (%path' %then then) (case else @@ -277,11 +277,11 @@ (|> (#.Cons cons) (list\map (function (_ [test then]) (format (<format> test) " " (%path' %then then)))) - (text.join-with " ") + (text.join_with " ") (text.enclose ["(? " ")"]))]) - ([#I64-Fork (|>> .int %.int)] - [#F64-Fork %.frac] - [#Text-Fork %.text]) + ([#I64_Fork (|>> .int %.int)] + [#F64_Fork %.frac] + [#Text_Fork %.text]) (#Access access) (case access @@ -339,7 +339,7 @@ (#analysis.Tuple members) (|> members (list\map %synthesis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))) (#Reference reference) @@ -352,7 +352,7 @@ (#Abstraction [environment arity body]) (let [environment' (|> environment (list\map %synthesis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"]))] (|> (format environment' " " (%.nat arity) " " (%synthesis body)) (text.enclose ["(#function " ")"]))) @@ -360,7 +360,7 @@ (#Apply func args) (|> args (list\map %synthesis) - (text.join-with " ") + (text.join_with " ") (format (%synthesis func) " ") (text.enclose ["(" ")"]))) @@ -390,7 +390,7 @@ (|> (format (%.nat (get@ #start scope)) " " (|> (get@ #inits scope) (list\map %synthesis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["[" "]"])) " " (%synthesis (get@ #iteration scope))) (text.enclose ["(#loop " ")"])) @@ -398,12 +398,12 @@ (#Recur args) (|> args (list\map %synthesis) - (text.join-with " ") + (text.join_with " ") (text.enclose ["(#recur " ")"])))) (#Extension [name args]) (|> (list\map %synthesis args) - (text.join-with " ") + (text.join_with " ") (format (%.text name) " ") (text.enclose ["(" ")"])))) @@ -411,7 +411,7 @@ (Format Path) (%path' %synthesis)) -(structure: #export primitive-equivalence +(structure: #export primitive_equivalence (Equivalence Primitive) (def: (= reference sample) @@ -429,10 +429,10 @@ _ false))) -(structure: primitive-hash +(structure: primitive_hash (Hash Primitive) - (def: &equivalence ..primitive-equivalence) + (def: &equivalence ..primitive_equivalence) (def: hash (|>> (case> (^template [<tag> <hash>] @@ -443,19 +443,19 @@ [#Text text.hash] [#I64 i64.hash]))))) -(def: side-equivalence +(def: side_equivalence (Equivalence Side) (sum.equivalence n.equivalence n.equivalence)) -(def: member-equivalence +(def: member_equivalence (Equivalence Member) (sum.equivalence n.equivalence n.equivalence)) -(def: member-hash +(def: member_hash (Hash Member) (sum.hash n.hash n.hash)) -(structure: #export access-equivalence +(structure: #export access_equivalence (Equivalence Access) (def: (= reference sample) @@ -463,27 +463,27 @@ (^template [<tag> <equivalence>] [[(<tag> reference) (<tag> sample)] (\ <equivalence> = reference sample)]) - ([#Side ..side-equivalence] - [#Member ..member-equivalence]) + ([#Side ..side_equivalence] + [#Member ..member_equivalence]) _ false))) -(structure: access-hash +(structure: access_hash (Hash Access) - (def: &equivalence ..access-equivalence) + (def: &equivalence ..access_equivalence) (def: (hash value) - (let [sub-hash (sum.hash n.hash n.hash)] + (let [sub_hash (sum.hash n.hash n.hash)] (case value (^template [<tag>] [(<tag> value) - (\ sub-hash hash value)]) + (\ sub_hash hash value)]) ([#Side] [#Member]))))) -(structure: #export (path'-equivalence equivalence) +(structure: #export (path'_equivalence equivalence) (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) (def: (= reference sample) @@ -491,26 +491,26 @@ [#Pop #Pop] true - [(#Bit-Fork reference-when reference-then reference-else) - (#Bit-Fork sample-when sample-then sample-else)] - (and (bit\= reference-when sample-when) - (= reference-then sample-then) - (\ (maybe.equivalence =) = reference-else sample-else)) + [(#Bit_Fork reference_when reference_then reference_else) + (#Bit_Fork sample_when sample_then sample_else)] + (and (bit\= reference_when sample_when) + (= reference_then sample_then) + (\ (maybe.equivalence =) = reference_else sample_else)) (^template [<tag> <equivalence>] - [[(<tag> reference-cons) - (<tag> sample-cons)] + [[(<tag> reference_cons) + (<tag> sample_cons)] (\ (list.equivalence (product.equivalence <equivalence> =)) = - (#.Cons reference-cons) - (#.Cons sample-cons))]) - ([#I64-Fork i64.equivalence] - [#F64-Fork f.equivalence] - [#Text-Fork text.equivalence]) + (#.Cons reference_cons) + (#.Cons sample_cons))]) + ([#I64_Fork i64.equivalence] + [#F64_Fork f.equivalence] + [#Text_Fork text.equivalence]) (^template [<tag> <equivalence>] [[(<tag> reference') (<tag> sample')] (\ <equivalence> = reference' sample')]) - ([#Access ..access-equivalence] + ([#Access ..access_equivalence] [#Then equivalence]) [(#Bind reference') (#Bind sample')] @@ -526,11 +526,11 @@ _ false))) -(structure: (path'-hash super) +(structure: (path'_hash super) (All [a] (-> (Hash a) (Hash (Path' a)))) (def: &equivalence - (..path'-equivalence (\ super &equivalence))) + (..path'_equivalence (\ super &equivalence))) (def: (hash value) (case value @@ -538,32 +538,32 @@ 2 (#Access access) - (n.* 3 (\ ..access-hash hash access)) + (n.* 3 (\ ..access_hash hash access)) (#Bind register) (n.* 5 (\ n.hash hash register)) - (#Bit-Fork when then else) + (#Bit_Fork when then else) ($_ n.* 7 (\ bit.hash hash when) (hash then) - (\ (maybe.hash (path'-hash super)) hash else)) + (\ (maybe.hash (path'_hash super)) hash else)) (^template [<factor> <tag> <hash>] [(<tag> cons) - (let [case-hash (product.hash <hash> - (path'-hash super)) - cons-hash (product.hash case-hash (list.hash case-hash))] - (n.* <factor> (\ cons-hash hash cons)))]) - ([11 #I64-Fork i64.hash] - [13 #F64-Fork f.hash] - [17 #Text-Fork text.hash]) + (let [case_hash (product.hash <hash> + (path'_hash super)) + cons_hash (product.hash case_hash (list.hash case_hash))] + (n.* <factor> (\ cons_hash hash cons)))]) + ([11 #I64_Fork i64.hash] + [13 #F64_Fork f.hash] + [17 #Text_Fork text.hash]) (^template [<factor> <tag>] [(<tag> fork) - (let [recur-hash (path'-hash super) - fork-hash (product.hash recur-hash recur-hash)] - (n.* <factor> (\ fork-hash hash fork)))]) + (let [recur_hash (path'_hash super) + fork_hash (product.hash recur_hash recur_hash)] + (n.* <factor> (\ fork_hash hash fork)))]) ([19 #Alt] [23 #Seq]) @@ -571,41 +571,41 @@ (n.* 29 (\ super hash body)) ))) -(structure: (branch-equivalence (^open "\.")) +(structure: (branch_equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Branch a)))) (def: (= reference sample) (case [reference sample] - [(#Let [reference-input reference-register reference-body]) - (#Let [sample-input sample-register sample-body])] - (and (\= reference-input sample-input) - (n.= reference-register sample-register) - (\= reference-body sample-body)) - - [(#If [reference-test reference-then reference-else]) - (#If [sample-test sample-then sample-else])] - (and (\= reference-test sample-test) - (\= reference-then sample-then) - (\= reference-else sample-else)) + [(#Let [reference_input reference_register reference_body]) + (#Let [sample_input sample_register sample_body])] + (and (\= reference_input sample_input) + (n.= reference_register sample_register) + (\= reference_body sample_body)) + + [(#If [reference_test reference_then reference_else]) + (#If [sample_test sample_then sample_else])] + (and (\= reference_test sample_test) + (\= reference_then sample_then) + (\= reference_else sample_else)) - [(#Get [reference-path reference-record]) - (#Get [sample-path sample-record])] - (and (\ (list.equivalence ..member-equivalence) = reference-path sample-path) - (\= reference-record sample-record)) + [(#Get [reference_path reference_record]) + (#Get [sample_path sample_record])] + (and (\ (list.equivalence ..member_equivalence) = reference_path sample_path) + (\= reference_record sample_record)) - [(#Case [reference-input reference-path]) - (#Case [sample-input sample-path])] - (and (\= reference-input sample-input) - (\ (path'-equivalence \=) = reference-path sample-path)) + [(#Case [reference_input reference_path]) + (#Case [sample_input sample_path])] + (and (\= reference_input sample_input) + (\ (path'_equivalence \=) = reference_path sample_path)) _ false))) -(structure: (branch-hash super) +(structure: (branch_hash super) (All [a] (-> (Hash a) (Hash (Branch a)))) (def: &equivalence - (..branch-equivalence (\ super &equivalence))) + (..branch_equivalence (\ super &equivalence))) (def: (hash value) (case value @@ -623,25 +623,25 @@ (#Get [path record]) ($_ n.* 5 - (\ (list.hash ..member-hash) hash path) + (\ (list.hash ..member_hash) hash path) (\ super hash record)) (#Case [input path]) ($_ n.* 7 (\ super hash input) - (\ (..path'-hash super) hash path)) + (\ (..path'_hash super) hash path)) ))) -(structure: (loop-equivalence (^open "\.")) +(structure: (loop_equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Loop a)))) (def: (= reference sample) (case [reference sample] - [(#Scope [reference-start reference-inits reference-iteration]) - (#Scope [sample-start sample-inits sample-iteration])] - (and (n.= reference-start sample-start) - (\ (list.equivalence \=) = reference-inits sample-inits) - (\= reference-iteration sample-iteration)) + [(#Scope [reference_start reference_inits reference_iteration]) + (#Scope [sample_start sample_inits sample_iteration])] + (and (n.= reference_start sample_start) + (\ (list.equivalence \=) = reference_inits sample_inits) + (\= reference_iteration sample_iteration)) [(#Recur reference) (#Recur sample)] (\ (list.equivalence \=) = reference sample) @@ -649,11 +649,11 @@ _ false))) -(structure: (loop-hash super) +(structure: (loop_hash super) (All [a] (-> (Hash a) (Hash (Loop a)))) (def: &equivalence - (..loop-equivalence (\ super &equivalence))) + (..loop_equivalence (\ super &equivalence))) (def: (hash value) (case value @@ -668,30 +668,30 @@ (\ (list.hash super) hash resets)) ))) -(structure: (function-equivalence (^open "\.")) +(structure: (function_equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Function a)))) (def: (= reference sample) (case [reference sample] - [(#Abstraction [reference-environment reference-arity reference-body]) - (#Abstraction [sample-environment sample-arity sample-body])] - (and (\ (list.equivalence \=) = reference-environment sample-environment) - (n.= reference-arity sample-arity) - (\= reference-body sample-body)) + [(#Abstraction [reference_environment reference_arity reference_body]) + (#Abstraction [sample_environment sample_arity sample_body])] + (and (\ (list.equivalence \=) = reference_environment sample_environment) + (n.= reference_arity sample_arity) + (\= reference_body sample_body)) - [(#Apply [reference-abstraction reference-arguments]) - (#Apply [sample-abstraction sample-arguments])] - (and (\= reference-abstraction sample-abstraction) - (\ (list.equivalence \=) = reference-arguments sample-arguments)) + [(#Apply [reference_abstraction reference_arguments]) + (#Apply [sample_abstraction sample_arguments])] + (and (\= reference_abstraction sample_abstraction) + (\ (list.equivalence \=) = reference_arguments sample_arguments)) _ false))) -(structure: (function-hash super) +(structure: (function_hash super) (All [a] (-> (Hash a) (Hash (Function a)))) (def: &equivalence - (..function-equivalence (\ super &equivalence))) + (..function_equivalence (\ super &equivalence))) (def: (hash value) (case value @@ -707,7 +707,7 @@ (\ (list.hash super) hash arguments)) ))) -(structure: (control-equivalence (^open "\.")) +(structure: (control_equivalence (^open "\.")) (All [a] (-> (Equivalence a) (Equivalence (Control a)))) (def: (= reference sample) @@ -715,27 +715,27 @@ (^template [<tag> <equivalence>] [[(<tag> reference) (<tag> sample)] (\ (<equivalence> \=) = reference sample)]) - ([#Branch ..branch-equivalence] - [#Loop ..loop-equivalence] - [#Function ..function-equivalence]) + ([#Branch ..branch_equivalence] + [#Loop ..loop_equivalence] + [#Function ..function_equivalence]) _ false))) -(structure: (control-hash super) +(structure: (control_hash super) (All [a] (-> (Hash a) (Hash (Control a)))) (def: &equivalence - (..control-equivalence (\ super &equivalence))) + (..control_equivalence (\ super &equivalence))) (def: (hash value) (case value (^template [<factor> <tag> <hash>] [(<tag> value) (n.* <factor> (\ (<hash> super) hash value))]) - ([2 #Branch ..branch-hash] - [3 #Loop ..loop-hash] - [5 #Function ..function-hash]) + ([2 #Branch ..branch_hash] + [3 #Loop ..loop_hash] + [5 #Function ..function_hash]) ))) (structure: #export equivalence @@ -746,18 +746,18 @@ (^template [<tag> <equivalence>] [[(<tag> reference') (<tag> sample')] (\ <equivalence> = reference' sample')]) - ([#Primitive ..primitive-equivalence] - [#Structure (analysis.composite-equivalence =)] + ([#Primitive ..primitive_equivalence] + [#Structure (analysis.composite_equivalence =)] [#Reference reference.equivalence] - [#Control (control-equivalence =)] + [#Control (control_equivalence =)] [#Extension (extension.equivalence =)]) _ false))) -(def: #export path-equivalence +(def: #export path_equivalence (Equivalence Path) - (path'-equivalence equivalence)) + (path'_equivalence equivalence)) (structure: #export hash (Hash Synthesis) @@ -765,24 +765,24 @@ (def: &equivalence ..equivalence) (def: (hash value) - (let [recur-hash [..equivalence hash]] + (let [recur_hash [..equivalence hash]] (case value (^template [<tag> <hash>] [(<tag> value) (\ <hash> hash value)]) - ([#Primitive ..primitive-hash] - [#Structure (analysis.composite-hash recur-hash)] + ([#Primitive ..primitive_hash] + [#Structure (analysis.composite_hash recur_hash)] [#Reference reference.hash] - [#Control (..control-hash recur-hash)] - [#Extension (extension.hash recur-hash)]))))) + [#Control (..control_hash recur_hash)] + [#Extension (extension.hash recur_hash)]))))) -(template: #export (!bind-top register thenP) +(template: #export (!bind_top register thenP) ($_ ..path/seq (#..Bind register) #..Pop thenP)) -(template: #export (!multi-pop nextP) +(template: #export (!multi_pop nextP) ($_ ..path/seq #..Pop #..Pop @@ -802,6 +802,6 @@ #..Pop nextP))] - [simple-left-side ..side/left] - [simple-right-side ..side/right] + [simple_left_side ..side/left] + [simple_right_side ..side/right] ) diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux index eaabf6aee..7abacd4fc 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive.lux @@ -33,13 +33,13 @@ [/// [version (#+ Version)]]]) -(exception: #export (unknown-document {module Module} - {known-modules (List Module)}) +(exception: #export (unknown_document {module Module} + {known_modules (List Module)}) (exception.report ["Module" (%.text module)] - ["Known Modules" (exception.enumerate %.text known-modules)])) + ["Known Modules" (exception.enumerate %.text known_modules)])) -(exception: #export (cannot-replace-document {module Module} +(exception: #export (cannot_replace_document {module Module} {old (Document Any)} {new (Document Any)}) (exception.report @@ -47,22 +47,22 @@ ["Old key" (signature.description (document.signature old))] ["New key" (signature.description (document.signature new))])) -(exception: #export (module-has-already-been-reserved {module Module}) +(exception: #export (module_has_already_been_reserved {module Module}) (exception.report ["Module" (%.text module)])) -(exception: #export (module-must-be-reserved-before-it-can-be-added {module Module}) +(exception: #export (module_must_be_reserved_before_it_can_be_added {module Module}) (exception.report ["Module" (%.text module)])) -(exception: #export (module-is-only-reserved {module Module}) +(exception: #export (module_is_only_reserved {module Module}) (exception.report ["Module" (%.text module)])) (type: #export ID Nat) -(def: #export runtime-module +(def: #export runtime_module Module "") @@ -87,7 +87,7 @@ (#try.Success id) #.None - (exception.throw ..unknown-document [module + (exception.throw ..unknown_document [module (dictionary.keys resolver)])))) (def: #export (reserve module archive) @@ -95,7 +95,7 @@ (let [(^slots [#..next #..resolver]) (:representation archive)] (case (dictionary.get module resolver) (#.Some _) - (exception.throw ..module-has-already-been-reserved [module]) + (exception.throw ..module_has_already_been_reserved [module]) #.None (#try.Success [next @@ -115,14 +115,14 @@ (update@ #..resolver (dictionary.put module [id (#.Some [descriptor document])])) :abstraction)) - (#.Some [id (#.Some [existing-descriptor existing-document])]) - (if (is? document existing-document) + (#.Some [id (#.Some [existing_descriptor existing_document])]) + (if (is? document existing_document) ## TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... (#try.Success archive) - (exception.throw ..cannot-replace-document [module existing-document document])) + (exception.throw ..cannot_replace_document [module existing_document document])) #.None - (exception.throw ..module-must-be-reserved-before-it-can-be-added [module])))) + (exception.throw ..module_must_be_reserved_before_it_can_be_added [module])))) (def: #export (find module archive) (-> Module Archive (Try [Descriptor (Document Any)])) @@ -132,10 +132,10 @@ (#try.Success document) (#.Some [id #.None]) - (exception.throw ..module-is-only-reserved [module]) + (exception.throw ..module_is_only_reserved [module]) #.None - (exception.throw ..unknown-document [module + (exception.throw ..unknown_document [module (dictionary.keys resolver)])))) (def: #export (archived? archive module) @@ -228,42 +228,42 @@ [version next] (binary.run ..writer)))) - (exception: #export (version-mismatch {expected Version} {actual Version}) + (exception: #export (version_mismatch {expected Version} {actual Version}) (exception.report ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) - (exception: #export corrupt-data) + (exception: #export corrupt_data) - (def: (correct-modules? reservations) + (def: (correct_modules? reservations) (-> (List Reservation) Bit) (n.= (list.size reservations) (|> reservations (list\map product.left) - (set.from-list text.hash) + (set.from_list text.hash) set.size))) - (def: (correct-ids? reservations) + (def: (correct_ids? reservations) (-> (List Reservation) Bit) (n.= (list.size reservations) (|> reservations (list\map product.right) - (set.from-list n.hash) + (set.from_list n.hash) set.size))) - (def: (correct-reservations? reservations) + (def: (correct_reservations? reservations) (-> (List Reservation) Bit) - (and (correct-modules? reservations) - (correct-ids? reservations))) + (and (correct_modules? reservations) + (correct_ids? reservations))) (def: #export (import expected binary) (-> Version Binary (Try Archive)) (do try.monad [[actual next reservations] (<b>.run ..reader binary) - _ (exception.assert ..version-mismatch [expected actual] + _ (exception.assert ..version_mismatch [expected actual] (n\= expected actual)) - _ (exception.assert ..corrupt-data [] - (correct-reservations? reservations))] + _ (exception.assert ..corrupt_data [] + (correct_reservations? reservations))] (wrap (:abstraction {#next next #resolver (list\fold (function (_ [module id] archive) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 319b23169..5592df470 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -79,7 +79,7 @@ (|> registry :representation (get@ #artifacts) - row.to-list + row.to_list (list.all (|>> (get@ #category) (case> (<tag> name) (#.Some name) _ #.None)))))] @@ -117,7 +117,7 @@ (row\map (get@ #category)) artifacts))) - (exception: #export (invalid-category {tag Nat}) + (exception: #export (invalid_category {tag Nat}) (exception.report ["Tag" (%.nat tag)])) @@ -133,7 +133,7 @@ 3 (\ ! map (|>> #Synthesizer) <b>.text) 4 (\ ! map (|>> #Generator) <b>.text) 5 (\ ! map (|>> #Directive) <b>.text) - _ (<>.fail (exception.construct ..invalid-category [tag])))))] + _ (<>.fail (exception.construct ..invalid_category [tag])))))] (|> (<b>.row/64 category) (\ <>.monad map (row\fold (function (_ artifact registry) (product.right diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux index 2ae89cf4e..a31f6e793 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux @@ -21,7 +21,7 @@ {#name Module #file Path #hash Nat - #state Module-State + #state Module_State #references (Set Module) #registry Registry}) diff --git a/stdlib/source/lux/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux index 0a7927aa0..6bafa0a79 100644 --- a/stdlib/source/lux/tool/compiler/meta/io.lux +++ b/stdlib/source/lux/tool/compiler/meta/io.lux @@ -13,7 +13,7 @@ (def: #export (sanitize system) (All [m] (-> (System m) Text Text)) - (text.replace-all "/" (\ system separator))) + (text.replace_all "/" (\ system separator))) -(def: #export lux-context +(def: #export lux_context "lux") diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index f8b31df58..6c44c026a 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -34,14 +34,14 @@ (exception.report ["Module" (%.text module)]))] - [cannot-find-module] - [cannot-read-module] + [cannot_find_module] + [cannot_read_module] ) (type: #export Extension Text) -(def: lux-extension +(def: lux_extension Extension ".lux") @@ -51,12 +51,12 @@ (//.sanitize system) (format context (\ system separator)))) -(def: (find-source-file system contexts module extension) +(def: (find_source_file system contexts module extension) (-> (file.System Promise) (List Context) Module Extension (Promise (Try [Path (File Promise)]))) (case contexts #.Nil - (promise\wrap (exception.throw ..cannot-find-module [module])) + (promise\wrap (exception.throw ..cannot_find_module [module])) (#.Cons context contexts') (do promise.monad @@ -67,19 +67,19 @@ (wrap (#try.Success [path file])) (#try.Failure _) - (find-source-file system contexts' module extension))))) + (find_source_file system contexts' module extension))))) -(def: (full-host-extension partial-host-extension) +(def: (full_host_extension partial_host_extension) (-> Extension Extension) - (format partial-host-extension ..lux-extension)) + (format partial_host_extension ..lux_extension)) -(def: (find-local-source-file system import contexts partial-host-extension module) +(def: (find_local_source_file system import contexts partial_host_extension module) (-> (file.System Promise) Import (List Context) Extension Module (Promise (Try [Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do {! promise.monad} - [outcome (..find-source-file system contexts module (..full-host-extension partial-host-extension))] + [outcome (..find_source_file system contexts module (..full_host_extension partial_host_extension))] (case outcome (#try.Success [path file]) (do (try.with !) @@ -88,45 +88,45 @@ (#try.Failure _) (do (try.with !) - [[path file] (..find-source-file system contexts module ..lux-extension) + [[path file] (..find_source_file system contexts module ..lux_extension) data (!.use (\ file content) [])] (wrap [path data]))))) -(def: (find-library-source-file import partial-host-extension module) +(def: (find_library_source_file import partial_host_extension module) (-> Import Extension Module (Try [Path Binary])) - (let [path (format module (..full-host-extension partial-host-extension))] + (let [path (format module (..full_host_extension partial_host_extension))] (case (dictionary.get path import) (#.Some data) (#try.Success [path data]) #.None - (let [path (format module ..lux-extension)] + (let [path (format module ..lux_extension)] (case (dictionary.get path import) (#.Some data) (#try.Success [path data]) #.None - (exception.throw ..cannot-find-module [module])))))) + (exception.throw ..cannot_find_module [module])))))) -(def: (find-any-source-file system import contexts partial-host-extension module) +(def: (find_any_source_file system import contexts partial_host_extension module) (-> (file.System Promise) Import (List Context) Extension Module (Promise (Try [Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. (do {! promise.monad} - [outcome (find-local-source-file system import contexts partial-host-extension module)] + [outcome (find_local_source_file system import contexts partial_host_extension module)] (case outcome (#try.Success [path data]) (wrap outcome) (#try.Failure _) - (wrap (..find-library-source-file import partial-host-extension module))))) + (wrap (..find_library_source_file import partial_host_extension module))))) -(def: #export (read system import contexts partial-host-extension module) +(def: #export (read system import contexts partial_host_extension module) (-> (file.System Promise) Import (List Context) Extension Module (Promise (Try Input))) (do (try.with promise.monad) - [[path binary] (..find-any-source-file system import contexts partial-host-extension module)] + [[path binary] (..find_any_source_file system import contexts partial_host_extension module)] (case (\ encoding.utf8 decode binary) (#try.Success code) (wrap {#////.module module @@ -135,27 +135,27 @@ #////.code code}) (#try.Failure _) - (promise\wrap (exception.throw ..cannot-read-module [module]))))) + (promise\wrap (exception.throw ..cannot_read_module [module]))))) (type: #export Enumeration (Dictionary Path Binary)) -(exception: #export (cannot-clean-path {prefix Path} {path Path}) +(exception: #export (cannot_clean_path {prefix Path} {path Path}) (exception.report ["Prefix" (%.text prefix)] ["Path" (%.text path)])) -(def: (clean-path system context path) +(def: (clean_path system context path) (All [!] (-> (file.System !) Context Path (Try Path))) (let [prefix (format context (\ system separator))] - (case (text.split-with prefix path) + (case (text.split_with prefix path) #.None - (exception.throw ..cannot-clean-path [prefix path]) + (exception.throw ..cannot_clean_path [prefix path]) (#.Some [_ path]) (#try.Success path)))) -(def: (enumerate-context system context enumeration) +(def: (enumerate_context system context enumeration) (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) (do {! (try.with promise.monad)} [directory (!.use (\ system directory) [context])] @@ -165,12 +165,12 @@ [files (!.use (\ directory files) []) enumeration (monad.fold ! (function (_ file enumeration) (let [path (!.use (\ file path) [])] - (if (text.ends-with? ..lux-extension path) + (if (text.ends_with? ..lux_extension path) (do ! - [path (promise\wrap (..clean-path system context path)) - source-code (!.use (\ file content) [])] + [path (promise\wrap (..clean_path system context path)) + source_code (!.use (\ file content) [])] (promise\wrap - (dictionary.try-put path source-code enumeration))) + (dictionary.try_put path source_code enumeration))) (wrap enumeration)))) enumeration files) @@ -184,7 +184,7 @@ (-> (file.System Promise) (List Context) (Action Enumeration)) (monad.fold (: (Monad Action) (try.with promise.monad)) - (enumerate-context system) + (enumerate_context system) (: Enumeration (dictionary.new text.hash)) contexts)) diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux index 847faaefa..20cba5fc1 100644 --- a/stdlib/source/lux/tool/compiler/phase.lux +++ b/stdlib/source/lux/tool/compiler/phase.lux @@ -44,13 +44,13 @@ operation (\ try.monad map product.right))) -(def: #export get-state +(def: #export get_state (All [s o] (Operation s s)) (function (_ state) (#try.Success [state state]))) -(def: #export (set-state state) +(def: #export (set_state state) (All [s o] (-> s (Operation s Any))) (function (_ _) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 1d390b8b6..bfdfd94f9 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -26,34 +26,34 @@ (template [<name> <tag>] [(def: #export (<name> type) (-> Type [Nat Type]) - (loop [num-args 0 + (loop [num_args 0 type type] (case type - (<tag> env sub-type) - (recur (inc num-args) sub-type) + (<tag> env sub_type) + (recur (inc num_args) sub_type) _ - [num-args type])))] + [num_args type])))] - [flatten-univ-q #.UnivQ] - [flatten-ex-q #.ExQ] + [flatten_univ_q #.UnivQ] + [flatten_ex_q #.ExQ] ) -(def: #export (flatten-function type) +(def: #export (flatten_function type) (-> Type [(List Type) Type]) (case type (#.Function in out') - (let [[ins out] (flatten-function out')] + (let [[ins out] (flatten_function out')] [(list& in ins) out]) _ [(list) type])) -(def: #export (flatten-application type) +(def: #export (flatten_application type) (-> Type [Type (List Type)]) (case type (#.Apply arg func') - (let [[func args] (flatten-application func')] + (let [[func args] (flatten_application func')] [func (list\compose args (list arg))]) _ @@ -69,8 +69,8 @@ _ (list type)))] - [flatten-variant #.Sum] - [flatten-tuple #.Product] + [flatten_variant #.Sum] + [flatten_tuple #.Product] ) (def: #export (format type) @@ -79,7 +79,7 @@ (#.Primitive name params) ($_ text\compose "(primitive " - (text.enclose' text.double-quote name) + (text.enclose' text.double_quote name) (|> params (list\map (|>> format (text\compose " "))) (list\fold (function.flip text\compose) "")) @@ -94,11 +94,11 @@ (list.interpose " ") (list\fold text\compose "")) <close>)]) - ([#.Sum "(| " ")" flatten-variant] - [#.Product "[" "]" flatten-tuple]) + ([#.Sum "(| " ")" flatten_variant] + [#.Product "[" "]" flatten_tuple]) (#.Function input output) - (let [[ins out] (flatten-function type)] + (let [[ins out] (flatten_function type)] ($_ text\compose "(-> " (|> ins (list\map format) @@ -117,12 +117,12 @@ ($_ text\compose "⟨e:" (n\encode id) "⟩") (#.Apply param fun) - (let [[type-func type-args] (flatten-application type)] - ($_ text\compose "(" (format type-func) " " (|> type-args (list\map format) list.reverse (list.interpose " ") (list\fold text\compose "")) ")")) + (let [[type_func type_args] (flatten_application type)] + ($_ text\compose "(" (format type_func) " " (|> type_args (list\map format) list.reverse (list.interpose " ") (list\fold text\compose "")) ")")) (^template [<tag> <desc>] [(<tag> env body) - ($_ text\compose "(" <desc> " {" (|> env (list\map format) (text.join-with " ")) "} " (format body) ")")]) + ($_ text\compose "(" <desc> " {" (|> env (list\map format) (text.join_with " ")) "} " (format body) ")")]) ([#.UnivQ "All"] [#.ExQ "Ex"]) @@ -130,40 +130,40 @@ ($_ text\compose module "." name) )) -(def: (beta-reduce env type) +(def: (beta_reduce env type) (-> (List Type) Type Type) (case type (#.Primitive name params) - (#.Primitive name (list\map (beta-reduce env) params)) + (#.Primitive name (list\map (beta_reduce env) params)) (^template [<tag>] [(<tag> left right) - (<tag> (beta-reduce env left) (beta-reduce env right))]) + (<tag> (beta_reduce env left) (beta_reduce env right))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) (^template [<tag>] - [(<tag> old-env def) - (case old-env + [(<tag> old_env def) + (case old_env #.Nil (<tag> env def) _ - (<tag> (list\map (beta-reduce env) old-env) def))]) + (<tag> (list\map (beta_reduce env) old_env) def))]) ([#.UnivQ] [#.ExQ]) (#.Parameter idx) (maybe.default (error! ($_ text\compose - "Unknown type parameter" text.new-line - " Index: " (n\encode idx) text.new-line + "Unknown type parameter" text.new_line + " Index: " (n\encode idx) text.new_line "Environment: " (|> env list.enumeration (list\map (.function (_ [index type]) ($_ text\compose (n\encode index) " " (..format type)))) - (text.join-with (text\compose text.new-line " "))))) + (text.join_with (text\compose text.new_line " "))))) (list.nth idx env)) _ @@ -225,7 +225,7 @@ (^template [<tag>] [(<tag> env body) (|> body - (beta-reduce (list& func param env)) + (beta_reduce (list& func param env)) (apply params'))]) ([#.UnivQ] [#.ExQ]) @@ -238,12 +238,12 @@ _ #.None))) -(def: #export (to-code type) +(def: #export (to_code type) (-> Type Code) (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (.list (~+ (list\map to-code params))))) + (.list (~+ (list\map to_code params))))) (^template [<tag>] [(<tag> idx) @@ -252,34 +252,34 @@ (^template [<tag>] [(<tag> left right) - (` (<tag> (~ (to-code left)) - (~ (to-code right))))]) + (` (<tag> (~ (to_code left)) + (~ (to_code right))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) - (#.Named name sub-type) + (#.Named name sub_type) (code.identifier name) (^template [<tag>] [(<tag> env body) - (` (<tag> (.list (~+ (list\map to-code env))) - (~ (to-code body))))]) + (` (<tag> (.list (~+ (list\map to_code env))) + (~ (to_code body))))]) ([#.UnivQ] [#.ExQ]) )) -(def: #export (un-alias type) +(def: #export (un_alias type) (-> Type Type) (case type (#.Named _ (#.Named name type')) - (un-alias (#.Named name type')) + (un_alias (#.Named name type')) _ type)) -(def: #export (un-name type) +(def: #export (un_name type) (-> Type Type) (case type (#.Named name type') - (un-name type') + (un_name type') _ type)) @@ -326,8 +326,8 @@ 0 body _ (|> body (<name> (dec size)) (<tag> (list)))))] - [univ-q #.UnivQ] - [ex-q #.ExQ] + [univ_q #.UnivQ] + [ex_q #.ExQ] ) (def: #export (quantified? type) @@ -348,53 +348,53 @@ _ #0)) -(def: #export (array depth elem-type) +(def: #export (array depth elem_type) (-> Nat Type Type) (case depth - 0 elem-type - _ (|> elem-type (array (dec depth)) (list) (#.Primitive array.type-name)))) + 0 elem_type + _ (|> elem_type (array (dec depth)) (list) (#.Primitive array.type_name)))) -(syntax: (new-secret-marker) - (meta.with-gensyms [g!_secret-marker_] - (wrap (list g!_secret-marker_)))) +(syntax: (new_secret_marker) + (meta.with_gensyms [g!_secret_marker_] + (wrap (list g!_secret_marker_)))) -(def: secret-marker - (`` (name-of (~~ (new-secret-marker))))) +(def: secret_marker + (`` (name_of (~~ (new_secret_marker))))) (syntax: #export (:log! {input (<>.or (<>.and <c>.identifier - (<>.maybe (<>.after (<c>.identifier! ..secret-marker) <c>.any))) + (<>.maybe (<>.after (<c>.identifier! ..secret_marker) <c>.any))) <c>.any)}) (case input (#.Left [valueN valueC]) (do meta.monad [location meta.location - valueT (meta.find-type valueN) + valueT (meta.find_type valueN) #let [_ (log! ($_ text\compose - (name\encode (name-of ..:log!)) " " (location.format location) text.new-line + (name\encode (name_of ..:log!)) " " (location.format location) text.new_line "Expression: " (case valueC (#.Some valueC) (code.format valueC) #.None (name\encode valueN)) - text.new-line + text.new_line " Type: " (..format valueT)))]] (wrap (list (code.identifier valueN)))) (#.Right valueC) - (meta.with-gensyms [g!value] + (meta.with_gensyms [g!value] (wrap (list (` (.let [(~ g!value) (~ valueC)] - (..:log! (~ valueC) (~ (code.identifier ..secret-marker)) (~ g!value))))))))) + (..:log! (~ valueC) (~ (code.identifier ..secret_marker)) (~ g!value))))))))) -(def: type-parameters +(def: type_parameters (Parser (List Text)) - (<c>.tuple (<>.some <c>.local-identifier))) + (<c>.tuple (<>.some <c>.local_identifier))) -(syntax: #export (:cast {type-vars type-parameters} +(syntax: #export (:cast {type_vars type_parameters} input output {value (<>.maybe <c>.any)}) - (let [casterC (` (: (All [(~+ (list\map code.local-identifier type-vars))] + (let [casterC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ input) (~ output))) (|>> :assume)))] (case value @@ -413,28 +413,28 @@ (<c>.record (<>.and <c>.any <c>.any))) ## TODO: Make sure the generated code always gets optimized away. -(syntax: #export (:share {type-vars type-parameters} +(syntax: #export (:share {type_vars type_parameters} {exemplar typed} {computation typed}) - (meta.with-gensyms [g!_] - (let [shareC (` (: (All [(~+ (list\map code.local-identifier type-vars))] + (meta.with_gensyms [g!_] + (let [shareC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ (get@ #type exemplar)) (~ (get@ #type computation)))) (.function ((~ g!_) (~ g!_)) (~ (get@ #expression computation)))))] (wrap (list (` ((~ shareC) (~ (get@ #expression exemplar))))))))) -(syntax: #export (:by-example {type-vars type-parameters} +(syntax: #export (:by_example {type_vars type_parameters} {exemplar typed} {extraction <c>.any}) (wrap (list (` (:of ((~! :share) - [(~+ (list\map code.local-identifier type-vars))] + [(~+ (list\map code.local_identifier type_vars))] {(~ (get@ #type exemplar)) (~ (get@ #expression exemplar))} {(~ extraction) (:assume [])})))))) -(exception: #export (hole-type {location Location} {type Type}) +(exception: #export (hole_type {location Location} {type Type}) (exception.report ["Location" (location.format location)] ["Type" (..format type)])) @@ -442,5 +442,5 @@ (syntax: #export (:hole) (do meta.monad [location meta.location - expectedT meta.expected-type] - (meta.fail (exception.construct ..hole-type [location expectedT])))) + expectedT meta.expected_type] + (meta.fail (exception.construct ..hole_type [location expectedT])))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 604984c10..1aa673f41 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -37,7 +37,7 @@ (type: #export Frame {#name Text - #type-vars (List Code) + #type_vars (List Code) #abstraction Code #representation Code}) @@ -48,49 +48,49 @@ (template: (!peek <source> <reference> <then>) (loop [entries <source>] (case entries - (#.Cons [head-name head] tail) - (if (text\= <reference> head-name) + (#.Cons [head_name head] tail) + (if (text\= <reference> head_name) <then> (recur tail)) #.Nil (undefined)))) -(def: (peek-frames-definition reference source) +(def: (peek_frames_definition reference source) (-> Text (List [Text Global]) (Stack Frame)) (!peek source reference (case head (#.Left _) (undefined) - (#.Right [exported? frame-type frame-anns frame-value]) - (:coerce (Stack Frame) frame-value)))) + (#.Right [exported? frame_type frame_anns frame_value]) + (:coerce (Stack Frame) frame_value)))) -(def: (peek-frames reference definition-reference source) +(def: (peek_frames reference definition_reference source) (-> Text Text (List [Text Module]) (Stack Frame)) (!peek source reference - (peek-frames-definition definition-reference (get@ #.definitions head)))) + (peek_frames_definition definition_reference (get@ #.definitions head)))) -(exception: #export no-active-frames) +(exception: #export no_active_frames) (def: (peek! frame) (-> (Maybe Text) (Meta Frame)) (function (_ compiler) - (let [[reference definition-reference] (name-of ..frames) - current-frames (peek-frames reference definition-reference (get@ #.modules compiler))] + (let [[reference definition_reference] (name_of ..frames) + current_frames (peek_frames reference definition_reference (get@ #.modules compiler))] (case (case frame (#.Some frame) (list.find (function (_ [actual _]) (text\= frame actual)) - current-frames) + current_frames) #.None - (..peek current-frames)) + (..peek current_frames)) (#.Some frame) (#.Right [compiler frame]) #.None - (exception.throw ..no-active-frames []))))) + (exception.throw ..no_active_frames []))))) (def: #export current (Meta Frame) @@ -103,131 +103,131 @@ (template: (!push <source> <reference> <then>) (loop [entries <source>] (case entries - (#.Cons [head-name head] tail) - (if (text\= <reference> head-name) - (#.Cons [head-name <then>] + (#.Cons [head_name head] tail) + (if (text\= <reference> head_name) + (#.Cons [head_name <then>] tail) - (#.Cons [head-name head] + (#.Cons [head_name head] (recur tail))) #.Nil (undefined)))) -(def: (push-frame-definition reference frame source) +(def: (push_frame_definition reference frame source) (-> Text Frame (List [Text Global]) (List [Text Global])) (!push source reference (case head (#.Left _) (undefined) - (#.Right [exported? frames-type frames-anns frames-value]) + (#.Right [exported? frames_type frames_anns frames_value]) (#.Right [exported? - frames-type - frames-anns - (..push frame (:coerce (Stack Frame) frames-value))])))) + frames_type + frames_anns + (..push frame (:coerce (Stack Frame) frames_value))])))) -(def: (push-frame [module-reference definition-reference] frame source) +(def: (push_frame [module_reference definition_reference] frame source) (-> Name Frame (List [Text Module]) (List [Text Module])) - (!push source module-reference - (update@ #.definitions (push-frame-definition definition-reference frame) head))) + (!push source module_reference + (update@ #.definitions (push_frame_definition definition_reference frame) head))) (def: (push! frame) (-> Frame (Meta Any)) (function (_ compiler) (#.Right [(update@ #.modules - (..push-frame (name-of ..frames) frame) + (..push_frame (name_of ..frames) frame) compiler) []]))) -(def: (pop-frame-definition reference source) +(def: (pop_frame_definition reference source) (-> Text (List [Text Global]) (List [Text Global])) (!push source reference (case head (#.Left _) (undefined) - (#.Right [exported? frames-type frames-anns frames-value]) + (#.Right [exported? frames_type frames_anns frames_value]) (#.Right [exported? - frames-type - frames-anns - (let [current-frames (:coerce (Stack Frame) frames-value)] - (case (..pop current-frames) - (#.Some current-frames') - current-frames' + frames_type + frames_anns + (let [current_frames (:coerce (Stack Frame) frames_value)] + (case (..pop current_frames) + (#.Some current_frames') + current_frames' #.None - current-frames))])))) + current_frames))])))) -(def: (pop-frame [module-reference definition-reference] source) +(def: (pop_frame [module_reference definition_reference] source) (-> Name (List [Text Module]) (List [Text Module])) - (!push source module-reference - (|> head (update@ #.definitions (pop-frame-definition definition-reference))))) + (!push source module_reference + (|> head (update@ #.definitions (pop_frame_definition definition_reference))))) (syntax: (pop!) (function (_ compiler) (#.Right [(update@ #.modules - (..pop-frame (name-of ..frames)) + (..pop_frame (name_of ..frames)) compiler) (list)]))) (def: cast (Parser [(Maybe Text) Code]) - (<>.either (<>.and (<>.maybe <c>.local-identifier) <c>.any) + (<>.either (<>.and (<>.maybe <c>.local_identifier) <c>.any) (<>.and (<>\wrap #.None) <c>.any))) (template [<name> <from> <to>] [(syntax: #export (<name> {[frame value] ..cast}) (do meta.monad - [[name type-vars abstraction representation] (peek! frame)] - (wrap (list (` ((~! :cast) [(~+ type-vars)] (~ <from>) (~ <to>) + [[name type_vars abstraction representation] (peek! frame)] + (wrap (list (` ((~! :cast) [(~+ type_vars)] (~ <from>) (~ <to>) (~ value)))))))] [:abstraction representation abstraction] [:representation abstraction representation] ) -(def: abstraction-type-name +(def: abstraction_type_name (-> Name Text) (|>> name\encode ($_ text\compose - (name\encode (name-of #..Abstraction)) + (name\encode (name_of #..Abstraction)) " "))) -(def: representation-definition-name +(def: representation_definition_name (-> Text Text) (|>> ($_ text\compose - (name\encode (name-of #Representation)) + (name\encode (name_of #Representation)) " "))) (def: declaration (Parser [Text (List Text)]) - (<>.either (<c>.form (<>.and <c>.local-identifier (<>.some <c>.local-identifier))) - (<>.and <c>.local-identifier (\ <>.monad wrap (list))))) + (<>.either (<c>.form (<>.and <c>.local_identifier (<>.some <c>.local_identifier))) + (<>.and <c>.local_identifier (\ <>.monad wrap (list))))) ## TODO: Make sure the generated code always gets optimized away. ## (This applies to uses of ":abstraction" and ":representation") (syntax: #export (abstract: {export |export|.parser} - {[name type-vars] declaration} - representation-type - {annotations (<>.default cs.empty-annotations csr.annotations)} + {[name type_vars] declaration} + representation_type + {annotations (<>.default cs.empty_annotations csr.annotations)} {primitives (<>.some <c>.any)}) (do meta.monad - [current-module meta.current-module-name - #let [type-varsC (list\map code.local-identifier type-vars) - abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) - representation-declaration (` ((~ (code.local-identifier (representation-definition-name name))) - (~+ type-varsC)))] + [current_module meta.current_module_name + #let [type_varsC (list\map code.local_identifier type_vars) + abstraction_declaration (` ((~ (code.local_identifier name)) (~+ type_varsC))) + representation_declaration (` ((~ (code.local_identifier (representation_definition_name name))) + (~+ type_varsC)))] _ (..push! [name - type-varsC - abstraction-declaration - representation-declaration])] - (wrap (list& (` (type: (~+ (|export|.write export)) (~ abstraction-declaration) + type_varsC + abstraction_declaration + representation_declaration])] + (wrap (list& (` (type: (~+ (|export|.write export)) (~ abstraction_declaration) (~ (csw.annotations annotations)) - (primitive (~ (code.text (abstraction-type-name [current-module name]))) - [(~+ type-varsC)]))) - (` (type: (~ representation-declaration) - (~ representation-type))) + (primitive (~ (code.text (abstraction_type_name [current_module name]))) + [(~+ type_varsC)]))) + (` (type: (~ representation_declaration) + (~ representation_type))) ($_ list\compose primitives (list (` ((~! ..pop!))))))))) @@ -235,10 +235,10 @@ (syntax: #export (:transmutation value) (wrap (list (` (..:abstraction (..:representation (~ value))))))) -(syntax: #export (^:representation {name (<c>.form <c>.local-identifier)} +(syntax: #export (^:representation {name (<c>.form <c>.local_identifier)} body {branches (<>.some <c>.any)}) - (let [g!var (code.local-identifier name)] + (let [g!var (code.local_identifier name)] (wrap (list& g!var (` (.let [(~ g!var) (..:representation (~ g!var))] (~ body))) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 13a1e1381..d8d358010 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -24,26 +24,26 @@ (template: (!text\= reference subject) ("lux text =" reference subject)) -(exception: #export (unknown-type-var {id Nat}) +(exception: #export (unknown_type_var {id Nat}) (exception.report ["ID" (n\encode id)])) -(exception: #export (unbound-type-var {id Nat}) +(exception: #export (unbound_type_var {id Nat}) (exception.report ["ID" (n\encode id)])) -(exception: #export (invalid-type-application {funcT Type} {argT Type}) +(exception: #export (invalid_type_application {funcT Type} {argT Type}) (exception.report ["Type function" (//.format funcT)] ["Type argument" (//.format argT)])) -(exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type}) +(exception: #export (cannot_rebind_var {id Nat} {type Type} {bound Type}) (exception.report ["Var" (n\encode id)] ["Wanted Type" (//.format type)] ["Current Type" (//.format bound)])) -(exception: #export (type-check-failed {expected Type} {actual Type}) +(exception: #export (type_check_failed {expected Type} {actual Type}) (exception.report ["Expected" (//.format expected)] ["Actual" (//.format actual)])) @@ -53,12 +53,12 @@ (type: #export Assumption [Type Type]) (type: #export (Check a) - (-> Type-Context (Try [Type-Context a]))) + (-> Type_Context (Try [Type_Context a]))) (type: #export (Checker a) (-> (List Assumption) a a (Check (List Assumption)))) -(type: #export Type-Vars +(type: #export Type_Vars (List [Var (Maybe Type)])) (structure: #export functor @@ -122,37 +122,37 @@ (open: "check\." ..monad) (def: (var::new id plist) - (-> Var Type-Vars Type-Vars) + (-> Var Type_Vars Type_Vars) (#.Cons [id #.None] plist)) (def: (var::get id plist) - (-> Var Type-Vars (Maybe (Maybe Type))) + (-> Var Type_Vars (Maybe (Maybe Type))) (case plist - (#.Cons [var-id var-type] + (#.Cons [var_id var_type] plist') - (if (!n/= id var-id) - (#.Some var-type) + (if (!n/= id var_id) + (#.Some var_type) (var::get id plist')) #.Nil #.None)) (def: (var::put id value plist) - (-> Var (Maybe Type) Type-Vars Type-Vars) + (-> Var (Maybe Type) Type_Vars Type_Vars) (case plist #.Nil (list [id value]) - (#.Cons [var-id var-type] + (#.Cons [var_id var_type] plist') - (if (!n/= id var-id) - (#.Cons [var-id value] + (if (!n/= id var_id) + (#.Cons [var_id value] plist') - (#.Cons [var-id var-type] + (#.Cons [var_id var_type] (var::put id value plist'))))) (def: #export (run context proc) - (All [a] (-> Type-Context (Check a) (Try a))) + (All [a] (-> Type_Context (Check a) (Try a))) (case (proc context) (#try.Success [context' output]) (#try.Success output) @@ -180,15 +180,15 @@ {#.doc "A producer of existential types."} (Check [Nat Type]) (function (_ context) - (let [id (get@ #.ex-counter context)] - (#try.Success [(update@ #.ex-counter inc context) + (let [id (get@ #.ex_counter context)] + (#try.Success [(update@ #.ex_counter inc context) [id (#.Ex id)]])))) (template [<name> <outputT> <fail> <succeed>] [(def: #export (<name> id) (-> Var (Check <outputT>)) (function (_ context) - (case (|> context (get@ #.var-bindings) (var::get id)) + (case (|> context (get@ #.var_bindings) (var::get id)) (^or (#.Some (#.Some (#.Var _))) (#.Some #.None)) (#try.Success [context <fail>]) @@ -197,7 +197,7 @@ (#try.Success [context <succeed>]) #.None - (exception.throw unknown-type-var id))))] + (exception.throw ..unknown_type_var id))))] [bound? Bit false true] [read (Maybe Type) #.None (#.Some bound)] @@ -212,72 +212,72 @@ (wrap type) #.None - (..throw unbound-type-var id)))) + (..throw ..unbound_type_var id)))) (def: (peek id) (-> Var (Check Type)) (function (_ context) - (case (|> context (get@ #.var-bindings) (var::get id)) + (case (|> context (get@ #.var_bindings) (var::get id)) (#.Some (#.Some bound)) (#try.Success [context bound]) (#.Some _) - (exception.throw unbound-type-var id) + (exception.throw ..unbound_type_var id) _ - (exception.throw unknown-type-var id)))) + (exception.throw ..unknown_type_var id)))) (def: #export (bind type id) (-> Type Var (Check Any)) (function (_ context) - (case (|> context (get@ #.var-bindings) (var::get id)) + (case (|> context (get@ #.var_bindings) (var::get id)) (#.Some #.None) - (#try.Success [(update@ #.var-bindings (var::put id (#.Some type)) context) + (#try.Success [(update@ #.var_bindings (var::put id (#.Some type)) context) []]) (#.Some (#.Some bound)) - (exception.throw cannot-rebind-var [id type bound]) + (exception.throw ..cannot_rebind_var [id type bound]) _ - (exception.throw unknown-type-var id)))) + (exception.throw ..unknown_type_var id)))) (def: (update type id) (-> Type Var (Check Any)) (function (_ context) - (case (|> context (get@ #.var-bindings) (var::get id)) + (case (|> context (get@ #.var_bindings) (var::get id)) (#.Some _) - (#try.Success [(update@ #.var-bindings (var::put id (#.Some type)) context) + (#try.Success [(update@ #.var_bindings (var::put id (#.Some type)) context) []]) _ - (exception.throw unknown-type-var id)))) + (exception.throw ..unknown_type_var id)))) (def: #export var (Check [Var Type]) (function (_ context) - (let [id (get@ #.var-counter context)] + (let [id (get@ #.var_counter context)] (#try.Success [(|> context - (update@ #.var-counter inc) - (update@ #.var-bindings (var::new id))) + (update@ #.var_counter inc) + (update@ #.var_bindings (var::new id))) [id (#.Var id)]])))) -(def: (apply-type! funcT argT) +(def: (apply_type! funcT argT) (-> Type Type (Check Type)) (case funcT - (#.Var func-id) + (#.Var func_id) (do ..monad - [?funcT' (read func-id)] + [?funcT' (read func_id)] (case ?funcT' (#.Some funcT') - (apply-type! funcT' argT) + (apply_type! funcT' argT) _ - (throw ..invalid-type-application [funcT argT]))) + (throw ..invalid_type_application [funcT argT]))) (#.Apply argT' funcT') (do ..monad - [funcT'' (apply-type! funcT' argT')] - (apply-type! funcT'' argT)) + [funcT'' (apply_type! funcT' argT')] + (apply_type! funcT'' argT)) _ (case (//.apply (list argT) funcT) @@ -285,19 +285,19 @@ (check\wrap output) _ - (throw ..invalid-type-application [funcT argT])))) + (throw ..invalid_type_application [funcT argT])))) (type: #export Ring (Set Var)) -(def: empty-ring Ring (set.new n.hash)) +(def: empty_ring Ring (set.new n.hash)) ## TODO: Optimize this by not using sets anymore. (def: #export (ring start) (-> Var (Check Ring)) (function (_ context) (loop [current start - output (set.add start empty-ring)] - (case (|> context (get@ #.var-bindings) (var::get current)) + output (set.add start empty_ring)] + (case (|> context (get@ #.var_bindings) (var::get current)) (#.Some (#.Some type)) (case type (#.Var post) @@ -306,19 +306,19 @@ (recur post (set.add post output))) _ - (#try.Success [context empty-ring])) + (#try.Success [context empty_ring])) (#.Some #.None) (#try.Success [context output]) #.None - (exception.throw unknown-type-var current))))) + (exception.throw ..unknown_type_var current))))) -(def: #export fresh-context - Type-Context - {#.var-counter 0 - #.ex-counter 0 - #.var-bindings (list)}) +(def: #export fresh_context + Type_Context + {#.var_counter 0 + #.ex_counter 0 + #.var_bindings (list)}) (def: (attempt op) (All [a] (-> (Check a) (Check (Maybe a)))) @@ -351,8 +351,8 @@ (-> Assumption (List Assumption) (List Assumption)) (#.Cons assumption assumptions)) -## TODO: "if-bind" can be optimized... -(def: (if-bind id type then else) +## TODO: "if_bind" can be optimized... +(def: (if_bind id type then else) (All [a] (-> Var Type (Check a) (-> Type (Check a)) (Check a))) @@ -363,28 +363,28 @@ (do {! ..monad} [ring (..ring id) _ (assert "" (n.> 1 (set.size ring))) - _ (monad.map ! (update type) (set.to-list ring))] + _ (monad.map ! (update type) (set.to_list ring))] then) (do ..monad [?bound (read id)] (else (maybe.default (#.Var id) ?bound))))) -## TODO: "link-2" can be optimized... -(def: (link-2 left right) +## TODO: "link_2" can be optimized... +(def: (link_2 left right) (-> Var Var (Check Any)) (do ..monad [_ (..bind (#.Var right) left)] (..bind (#.Var left) right))) -## TODO: "link-3" can be optimized... -(def: (link-3 interpose to from) +## TODO: "link_3" can be optimized... +(def: (link_3 interpose to from) (-> Var Var Var (Check Any)) (do ..monad [_ (update (#.Var interpose) from)] (update (#.Var to) interpose))) -## TODO: "check-vars" can be optimized... -(def: (check-vars check' assumptions idE idA) +## TODO: "check_vars" can be optimized... +(def: (check_vars check' assumptions idE idA) (-> (Checker Type) (Checker Var)) (if (!n/= idE idA) (check\wrap assumptions) @@ -395,7 +395,7 @@ ## Link the 2 variables circularly [#.None #.None] (do ! - [_ (link-2 idE idA)] + [_ (link_2 idE idA)] (wrap assumptions)) ## Interpose new variable between 2 existing links @@ -403,7 +403,7 @@ (case etype (#.Var targetE) (do ! - [_ (link-3 idA targetE idE)] + [_ (link_3 idA targetE idE)] (wrap assumptions)) _ @@ -414,7 +414,7 @@ (case atype (#.Var targetA) (do ! - [_ (link-3 idE targetA idA)] + [_ (link_3 idE targetA idA)] (wrap assumptions)) _ @@ -432,17 +432,17 @@ (do ! [_ (monad.fold ! (function (_ interpose to) (do ! - [_ (link-3 interpose to idE)] + [_ (link_3 interpose to idE)] (wrap interpose))) targetE - (set.to-list ringA))] + (set.to_list ringA))] (wrap assumptions)))) (^template [<pattern> <id> <type>] [<pattern> (do ! [ring (..ring <id>) - _ (monad.map ! (update <type>) (set.to-list ring))] + _ (monad.map ! (update <type>) (set.to_list ring))] (wrap assumptions))]) ([[(#.Var _) _] idE atype] [[_ (#.Var _)] idA etype]) @@ -450,87 +450,87 @@ _ (check' assumptions etype atype)))))) -## TODO: "check-apply" can be optimized... -(def: (check-apply check' assumptions expected actual) +## TODO: "check_apply" can be optimized... +(def: (check_apply check' assumptions expected actual) (-> (Checker Type) (Checker [Type Type])) - (let [[expected-input expected-function] expected - [actual-input actual-function] actual] - (case [expected-function actual-function] + (let [[expected_input expected_function] expected + [actual_input actual_function] actual] + (case [expected_function actual_function] [(#.Ex exE) (#.Ex exA)] (if (!n/= exE exA) - (check' assumptions expected-input actual-input) + (check' assumptions expected_input actual_input) (fail "")) [(#.UnivQ _ _) (#.Ex _)] (do ..monad - [expected' (apply-type! expected-function expected-input)] + [expected' (apply_type! expected_function expected_input)] (check' assumptions expected' (#.Apply actual))) [(#.Ex _) (#.UnivQ _ _)] (do ..monad - [actual' (apply-type! actual-function actual-input)] + [actual' (apply_type! actual_function actual_input)] (check' assumptions (#.Apply expected) actual')) - [(#.Apply [expected-input' expected-function']) (#.Ex _)] + [(#.Apply [expected_input' expected_function']) (#.Ex _)] (do ..monad - [expected-function'' (apply-type! expected-function' expected-input')] - (check' assumptions (#.Apply [expected-input expected-function'']) (#.Apply actual))) + [expected_function'' (apply_type! expected_function' expected_input')] + (check' assumptions (#.Apply [expected_input expected_function'']) (#.Apply actual))) - [(#.Ex _) (#.Apply [actual-input' actual-function'])] + [(#.Ex _) (#.Apply [actual_input' actual_function'])] (do ..monad - [actual-function'' (apply-type! actual-function' actual-input')] - (check' assumptions (#.Apply expected) (#.Apply [actual-input actual-function'']))) + [actual_function'' (apply_type! actual_function' actual_input')] + (check' assumptions (#.Apply expected) (#.Apply [actual_input actual_function'']))) (^or [(#.Ex _) _] [_ (#.Ex _)]) (do ..monad - [assumptions (check' assumptions expected-function actual-function)] - (check' assumptions expected-input actual-input)) + [assumptions (check' assumptions expected_function actual_function)] + (check' assumptions expected_input actual_input)) [(#.Var id) _] (function (_ context) (case ((do ..monad - [expected-function' (read! id)] - (check' assumptions (#.Apply expected-input expected-function') (#.Apply actual))) + [expected_function' (read! id)] + (check' assumptions (#.Apply expected_input expected_function') (#.Apply actual))) context) (#try.Success output) (#try.Success output) (#try.Failure _) - (case actual-function + (case actual_function (#.UnivQ _ _) ((do ..monad - [actual' (apply-type! actual-function actual-input)] + [actual' (apply_type! actual_function actual_input)] (check' assumptions (#.Apply expected) actual')) context) (#.Ex exA) ((do ..monad - [assumptions (check' assumptions expected-function actual-function)] - (check' assumptions expected-input actual-input)) + [assumptions (check' assumptions expected_function actual_function)] + (check' assumptions expected_input actual_input)) context) _ ((do ..monad - [assumptions (check' assumptions expected-function actual-function) - expected' (apply-type! actual-function expected-input) - actual' (apply-type! actual-function actual-input)] + [assumptions (check' assumptions expected_function actual_function) + expected' (apply_type! actual_function expected_input) + actual' (apply_type! actual_function actual_input)] (check' assumptions expected' actual')) context)))) [_ (#.Var id)] (function (_ context) (case ((do ..monad - [actual-function' (read! id)] - (check' assumptions (#.Apply expected) (#.Apply actual-input actual-function'))) + [actual_function' (read! id)] + (check' assumptions (#.Apply expected) (#.Apply actual_input actual_function'))) context) (#try.Success output) (#try.Success output) _ ((do ..monad - [assumptions (check' assumptions expected-function actual-function) - expected' (apply-type! expected-function expected-input) - actual' (apply-type! expected-function actual-input)] + [assumptions (check' assumptions expected_function actual_function) + expected' (apply_type! expected_function expected_input) + actual' (apply_type! expected_function actual_input)] (check' assumptions expected' actual')) context))) @@ -547,42 +547,42 @@ (Checker Type) (if (is? expected actual) (check\wrap assumptions) - (with type-check-failed [expected actual] + (with type_check_failed [expected actual] (case [expected actual] [(#.Var idE) (#.Var idA)] - (check-vars check' assumptions idE idA) + (check_vars check' assumptions idE idA) [(#.Var id) _] - (if-bind id actual + (if_bind id actual (check\wrap assumptions) (function (_ bound) (check' assumptions bound actual))) [_ (#.Var id)] - (if-bind id expected + (if_bind id expected (check\wrap assumptions) (function (_ bound) (check' assumptions expected bound))) (^template [<fE> <fA>] [[(#.Apply aE <fE>) (#.Apply aA <fA>)] - (check-apply check' assumptions [aE <fE>] [aA <fA>])]) + (check_apply check' assumptions [aE <fE>] [aA <fA>])]) ([F1 (#.Ex ex)] [(#.Ex exE) fA] [fE (#.Var idA)] [(#.Var idE) fA]) [(#.Apply A F) _] - (let [new-assumption [expected actual]] - (if (assumed? new-assumption assumptions) + (let [new_assumption [expected actual]] + (if (assumed? new_assumption assumptions) (check\wrap assumptions) (do ..monad - [expected' (apply-type! F A)] - (check' (assume! new-assumption assumptions) expected' actual)))) + [expected' (apply_type! F A)] + (check' (assume! new_assumption assumptions) expected' actual)))) [_ (#.Apply A F)] (do ..monad - [actual' (apply-type! F A)] + [actual' (apply_type! F A)] (check' assumptions expected actual')) ## TODO: Refactor-away as cold-code @@ -590,7 +590,7 @@ [[(<tag> _) _] (do ..monad [[_ paramT] <instancer> - expected' (apply-type! expected paramT)] + expected' (apply_type! expected paramT)] (check' assumptions expected' actual))]) ([#.UnivQ ..existential] [#.ExQ ..var]) @@ -600,24 +600,24 @@ [[_ (<tag> _)] (do ..monad [[_ paramT] <instancer> - actual' (apply-type! actual paramT)] + actual' (apply_type! actual paramT)] (check' assumptions expected actual'))]) ([#.UnivQ ..var] [#.ExQ ..existential]) - [(#.Primitive e-name e-params) (#.Primitive a-name a-params)] - (if (!text\= e-name a-name) + [(#.Primitive e_name e_params) (#.Primitive a_name a_params)] + (if (!text\= e_name a_name) (loop [assumptions assumptions - e-params e-params - a-params a-params] - (case [e-params a-params] + e_params e_params + a_params a_params] + (case [e_params a_params] [#.Nil #.Nil] (check\wrap assumptions) - [(#.Cons e-head e-tail) (#.Cons a-head a-tail)] + [(#.Cons e_head e_tail) (#.Cons a_head a_tail)] (do ..monad - [assumptions' (check' assumptions e-head a-head)] - (recur assumptions' e-tail a-tail)) + [assumptions' (check' assumptions e_head a_head)] + (recur assumptions' e_tail a_tail)) _ (fail ""))) @@ -658,7 +658,7 @@ (def: #export (checks? expected actual) {#.doc "A simple type-checking function that just returns a yes/no answer."} (-> Type Type Bit) - (case (run fresh-context (check' (list) expected actual)) + (case (run fresh_context (check' (list) expected actual)) (#try.Failure _) false @@ -666,7 +666,7 @@ true)) (def: #export context - (Check Type-Context) + (Check Type_Context) (function (_ context) (#try.Success [context context]))) diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux index 9d9027e72..21a0d6cf3 100644 --- a/stdlib/source/lux/type/dynamic.lux +++ b/stdlib/source/lux/type/dynamic.lux @@ -7,13 +7,13 @@ [data [text ["%" format (#+ format)]]] - [meta (#+ with-gensyms)] + [meta (#+ with_gensyms)] [macro ["." syntax (#+ syntax:)]] ["." type abstract]]) -(exception: #export (wrong-type {expected Type} {actual Type}) +(exception: #export (wrong_type {expected Type} {actual Type}) (exception.report ["Expected" (%.type expected)] ["Actual" (%.type actual)])) @@ -29,20 +29,20 @@ (syntax: #export (:dynamic value) {#.doc (doc (: Dynamic (:dynamic 123)))} - (with-gensyms [g!value] + (with_gensyms [g!value] (wrap (list (` (let [(~ g!value) (~ value)] ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)]))))))) (syntax: #export (:check type value) {#.doc (doc (: (try.Try Nat) (:check Nat (:dynamic 123))))} - (with-gensyms [g!type g!value] + (with_gensyms [g!type g!value] (wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] (: ((~! try.Try) (~ type)) (if (\ (~! type.equivalence) (~' =) (.type (~ type)) (~ g!type)) (#try.Success (:coerce (~ type) (~ g!value))) - ((~! exception.throw) ..wrong-type [(.type (~ type)) (~ g!type)]))))))))) + ((~! exception.throw) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) (def: #export (print value) (-> Dynamic (Try Text)) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 69890cd3e..f24a80599 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -26,14 +26,14 @@ ["." type ["." check (#+ Check)]]]) -(def: (find-type-var id env) - (-> Nat Type-Context (Meta Type)) +(def: (find_type_var id env) + (-> Nat Type_Context (Meta Type)) (case (list.find (|>> product.left (n.= id)) - (get@ #.var-bindings env)) + (get@ #.var_bindings env)) (#.Some [_ (#.Some type)]) (case type (#.Var id') - (find-type-var id' env) + (find_type_var id' env) _ (\ meta.monad wrap type)) @@ -45,57 +45,57 @@ (meta.fail (format "Unknown type-var " (%.nat id))) )) -(def: (resolve-type var-name) +(def: (resolve_type var_name) (-> Name (Meta Type)) (do meta.monad - [raw-type (meta.find-type var-name) - compiler meta.get-compiler] - (case raw-type + [raw_type (meta.find_type var_name) + compiler meta.get_compiler] + (case raw_type (#.Var id) - (find-type-var id (get@ #.type-context compiler)) + (find_type_var id (get@ #.type_context compiler)) _ - (wrap raw-type)))) + (wrap raw_type)))) -(def: (find-member-type idx sig-type) +(def: (find_member_type idx sig_type) (-> Nat Type (Check Type)) - (case sig-type - (#.Named _ sig-type') - (find-member-type idx sig-type') + (case sig_type + (#.Named _ sig_type') + (find_member_type idx sig_type') (#.Apply arg func) (case (type.apply (list arg) func) #.None (check.fail (format "Cannot apply type " (%.type func) " to type " (%.type arg))) - (#.Some sig-type') - (find-member-type idx sig-type')) + (#.Some sig_type') + (find_member_type idx sig_type')) (#.Product left right) (if (n.= 0 idx) (\ check.monad wrap left) - (find-member-type (dec idx) right)) + (find_member_type (dec idx) right)) _ (if (n.= 0 idx) - (\ check.monad wrap sig-type) - (check.fail (format "Cannot find member type " (%.nat idx) " for " (%.type sig-type)))))) + (\ check.monad wrap sig_type) + (check.fail (format "Cannot find member type " (%.nat idx) " for " (%.type sig_type)))))) -(def: (find-member-name member) +(def: (find_member_name member) (-> Name (Meta Name)) (case member - ["" simple-name] + ["" simple_name] (meta.either (do meta.monad [member (meta.normalize member) - _ (meta.resolve-tag member)] + _ (meta.resolve_tag member)] (wrap member)) (do {! meta.monad} - [this-module-name meta.current-module-name - imp-mods (meta.imported-modules this-module-name) - tag-lists (monad.map ! meta.tag-lists imp-mods) - #let [tag-lists (|> tag-lists list\join (list\map product.left) list\join) - candidates (list.filter (|>> product.right (text\= simple-name)) - tag-lists)]] + [this_module_name meta.current_module_name + imp_mods (meta.imported_modules this_module_name) + tag_lists (monad.map ! meta.tag_lists imp_mods) + #let [tag_lists (|> tag_lists list\join (list\map product.left) list\join) + candidates (list.filter (|>> product.right (text\= simple_name)) + tag_lists)]] (case candidates #.Nil (meta.fail (format "Unknown tag: " (%.name member))) @@ -109,64 +109,64 @@ _ (\ meta.monad wrap member))) -(def: (resolve-member member) +(def: (resolve_member member) (-> Name (Meta [Nat Type])) (do meta.monad - [member (find-member-name member) - [idx tag-list sig-type] (meta.resolve-tag member)] - (wrap [idx sig-type]))) + [member (find_member_name member) + [idx tag_list sig_type] (meta.resolve_tag member)] + (wrap [idx sig_type]))) -(def: (prepare-definitions source-module target-module constants) +(def: (prepare_definitions source_module target_module constants) (-> Text Text (List [Text Definition]) (List [Name Type])) (do list.monad - [[name [exported? def-type def-anns def-value]] constants] - (if (and (annotation.structure? def-anns) - (or (text\= target-module source-module) + [[name [exported? def_type def_anns def_value]] constants] + (if (and (annotation.structure? def_anns) + (or (text\= target_module source_module) exported?)) - (list [[source-module name] def-type]) + (list [[source_module name] def_type]) (list)))) -(def: local-env +(def: local_env (Meta (List [Name Type])) (do meta.monad - [local-batches meta.locals - #let [total-locals (list\fold (function (_ [name type] table) - (try.default table (dict.try-put name type table))) + [local_batches meta.locals + #let [total_locals (list\fold (function (_ [name type] table) + (try.default table (dict.try_put name type table))) (: (Dictionary Text Type) (dict.new text.hash)) - (list\join local-batches))]] - (wrap (|> total-locals + (list\join local_batches))]] + (wrap (|> total_locals dict.entries (list\map (function (_ [name type]) [["" name] type])))))) -(def: local-structs +(def: local_structs (Meta (List [Name Type])) (do {! meta.monad} - [this-module-name meta.current-module-name] - (\ ! map (prepare-definitions this-module-name this-module-name) - (meta.definitions this-module-name)))) + [this_module_name meta.current_module_name] + (\ ! map (prepare_definitions this_module_name this_module_name) + (meta.definitions this_module_name)))) -(def: import-structs +(def: import_structs (Meta (List [Name Type])) (do {! meta.monad} - [this-module-name meta.current-module-name - imp-mods (meta.imported-modules this-module-name) - export-batches (monad.map ! (function (_ imp-mod) - (\ ! map (prepare-definitions imp-mod this-module-name) - (meta.definitions imp-mod))) - imp-mods)] - (wrap (list\join export-batches)))) - -(def: (apply-function-type func arg) + [this_module_name meta.current_module_name + imp_mods (meta.imported_modules this_module_name) + export_batches (monad.map ! (function (_ imp_mod) + (\ ! map (prepare_definitions imp_mod this_module_name) + (meta.definitions imp_mod))) + imp_mods)] + (wrap (list\join export_batches)))) + +(def: (apply_function_type func arg) (-> Type Type (Check Type)) (case func (#.Named _ func') - (apply-function-type func' arg) + (apply_function_type func' arg) (#.UnivQ _) (do check.monad [[id var] check.var] - (apply-function-type (maybe.assume (type.apply (list var) func)) + (apply_function_type (maybe.assume (type.apply (list var) func)) arg)) (#.Function input output) @@ -177,46 +177,46 @@ _ (check.fail (format "Invalid function type: " (%.type func))))) -(def: (concrete-type type) +(def: (concrete_type type) (-> Type (Check [(List Nat) Type])) (case type (#.UnivQ _) (do check.monad [[id var] check.var - [ids final-output] (concrete-type (maybe.assume (type.apply (list var) type)))] + [ids final_output] (concrete_type (maybe.assume (type.apply (list var) type)))] (wrap [(#.Cons id ids) - final-output])) + final_output])) _ (\ check.monad wrap [(list) type]))) -(def: (check-apply member-type input-types output-type) +(def: (check_apply member_type input_types output_type) (-> Type (List Type) Type (Check [])) (do check.monad - [member-type' (monad.fold check.monad + [member_type' (monad.fold check.monad (function (_ input member) - (apply-function-type member input)) - member-type - input-types)] - (check.check output-type member-type'))) + (apply_function_type member input)) + member_type + input_types)] + (check.check output_type member_type'))) (type: #rec Instance {#constructor Name #dependencies (List Instance)}) -(def: (test-provision provision context dep alts) - (-> (-> Lux Type-Context Type (Check Instance)) - Type-Context Type (List [Name Type]) +(def: (test_provision provision context dep alts) + (-> (-> Lux Type_Context Type (Check Instance)) + Type_Context Type (List [Name Type]) (Meta (List Instance))) (do meta.monad - [compiler meta.get-compiler] + [compiler meta.get_compiler] (case (|> alts - (list\map (function (_ [alt-name alt-type]) + (list\map (function (_ [alt_name alt_type]) (case (check.run context (do {! check.monad} - [[tvars alt-type] (concrete-type alt-type) - #let [[deps alt-type] (type.flatten-function alt-type)] - _ (check.check dep alt-type) + [[tvars alt_type] (concrete_type alt_type) + #let [[deps alt_type] (type.flatten_function alt_type)] + _ (check.check dep alt_type) context' check.context =deps (monad.map ! (provision compiler context') deps)] (wrap =deps))) @@ -224,7 +224,7 @@ (list) (#.Right =deps) - (list [alt-name =deps])))) + (list [alt_name =deps])))) list\join) #.Nil (meta.fail (format "No candidates for provisioning: " (%.type dep))) @@ -233,12 +233,12 @@ (wrap found)))) (def: (provision compiler context dep) - (-> Lux Type-Context Type (Check Instance)) + (-> Lux Type_Context Type (Check Instance)) (case (meta.run compiler ($_ meta.either - (do meta.monad [alts ..local-env] (..test-provision provision context dep alts)) - (do meta.monad [alts ..local-structs] (..test-provision provision context dep alts)) - (do meta.monad [alts ..import-structs] (..test-provision provision context dep alts)))) + (do meta.monad [alts ..local_env] (..test_provision provision context dep alts)) + (do meta.monad [alts ..local_structs] (..test_provision provision context dep alts)) + (do meta.monad [alts ..import_structs] (..test_provision provision context dep alts)))) (#.Left error) (check.fail error) @@ -254,20 +254,20 @@ (check.fail (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) )) -(def: (test-alternatives sig-type member-idx input-types output-type alts) +(def: (test_alternatives sig_type member_idx input_types output_type alts) (-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance))) (do meta.monad - [compiler meta.get-compiler - context meta.type-context] + [compiler meta.get_compiler + context meta.type_context] (case (|> alts - (list\map (function (_ [alt-name alt-type]) + (list\map (function (_ [alt_name alt_type]) (case (check.run context (do {! check.monad} - [[tvars alt-type] (concrete-type alt-type) - #let [[deps alt-type] (type.flatten-function alt-type)] - _ (check.check alt-type sig-type) - member-type (find-member-type member-idx alt-type) - _ (check-apply member-type input-types output-type) + [[tvars alt_type] (concrete_type alt_type) + #let [[deps alt_type] (type.flatten_function alt_type)] + _ (check.check alt_type sig_type) + member_type (find_member_type member_idx alt_type) + _ (check_apply member_type input_types output_type) context' check.context =deps (monad.map ! (provision compiler context') deps)] (wrap =deps))) @@ -275,21 +275,21 @@ (list) (#.Right =deps) - (list [alt-name =deps])))) + (list [alt_name =deps])))) list\join) #.Nil - (meta.fail (format "No alternatives for " (%.type (type.function input-types output-type)))) + (meta.fail (format "No alternatives for " (%.type (type.function input_types output_type)))) found (wrap found)))) -(def: (find-alternatives sig-type member-idx input-types output-type) +(def: (find_alternatives sig_type member_idx input_types output_type) (-> Type Nat (List Type) Type (Meta (List Instance))) - (let [test (test-alternatives sig-type member-idx input-types output-type)] + (let [test (test_alternatives sig_type member_idx input_types output_type)] ($_ meta.either - (do meta.monad [alts local-env] (test alts)) - (do meta.monad [alts local-structs] (test alts)) - (do meta.monad [alts import-structs] (test alts))))) + (do meta.monad [alts local_env] (test alts)) + (do meta.monad [alts local_structs] (test alts)) + (do meta.monad [alts import_structs] (test alts))))) (def: (var? input) (-> Code Bit) @@ -300,7 +300,7 @@ _ #0)) -(def: (join-pair [l r]) +(def: (join_pair [l r]) (All [a] (-> [a a] (List a))) (list l r)) @@ -343,34 +343,34 @@ (case args (#.Left [args _]) (do {! meta.monad} - [[member-idx sig-type] (resolve-member member) - input-types (monad.map ! resolve-type args) - output-type meta.expected-type - chosen-ones (find-alternatives sig-type member-idx input-types output-type)] - (case chosen-ones + [[member_idx sig_type] (resolve_member member) + input_types (monad.map ! resolve_type args) + output_type meta.expected_type + chosen_ones (find_alternatives sig_type member_idx input_types output_type)] + (case chosen_ones #.Nil (meta.fail (format "No structure option could be found for member: " (%.name member))) (#.Cons chosen #.Nil) (wrap (list (` (\ (~ (instance$ chosen)) - (~ (code.local-identifier (product.right member))) + (~ (code.local_identifier (product.right member))) (~+ (list\map code.identifier args)))))) _ (meta.fail (format "Too many options available: " - (|> chosen-ones + (|> chosen_ones (list\map (|>> product.left %.name)) - (text.join-with ", ")) - " --- for type: " (%.type sig-type))))) + (text.join_with ", ")) + " --- for type: " (%.type sig_type))))) (#.Right [args _]) (do {! meta.monad} [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq !))] - (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list\map join-pair) list\join))] + (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list\map join_pair) list\join))] (..\\ (~ (code.identifier member)) (~+ labels))))))) )) -(def: (implicit-bindings amount) +(def: (implicit_bindings amount) (-> Nat (Meta (List Code))) (|> (meta.gensym "g!implicit") (list.repeat amount) @@ -382,7 +382,7 @@ (syntax: #export (implicit {structures ..implicits} body) (do meta.monad - [g!implicit+ (implicit-bindings (list.size structures))] + [g!implicit+ (implicit_bindings (list.size structures))] (wrap (list (` (let [(~+ (|> (list.zip/2 g!implicit+ structures) (list\map (function (_ [g!implicit structure]) (list g!implicit structure))) @@ -391,7 +391,7 @@ (syntax: #export (implicit: {structures ..implicits}) (do meta.monad - [g!implicit+ (implicit-bindings (list.size structures))] + [g!implicit+ (implicit_bindings (list.size structures))] (wrap (|> (list.zip/2 g!implicit+ structures) (list\map (function (_ [g!implicit structure]) (` (def: (~ g!implicit) (~ structure))))))))) diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux index 1daa8ff1b..3429d28af 100644 --- a/stdlib/source/lux/type/refinement.lux +++ b/stdlib/source/lux/type/refinement.lux @@ -5,7 +5,7 @@ ["." meta] [macro [syntax (#+ syntax:)]] - [type (#+ :by-example) + [type (#+ :by_example) abstract]]) (abstract: #export (Refined t r) @@ -21,9 +21,9 @@ (All [t] (Ex [r] (-> (Predicate t) (Refiner t r)))) - (function (_ un-refined) - (if (predicate un-refined) - (#.Some (:abstraction {#value un-refined + (function (_ un_refined) + (if (predicate un_refined) + (#.Some (:abstraction {#value un_refined #predicate predicate})) #.None))) @@ -32,7 +32,7 @@ (All [t r] (-> (Refined t r) <output>)) (|> refined :representation (get@ <slot>)))] - [un-refine t #value] + [un_refine t #value] [predicate (Predicate t) #predicate] ) @@ -81,8 +81,8 @@ (#.Cons head no)])))) (syntax: #export (type refiner) - (meta.with-gensyms [g!t g!r] - (wrap (list (` ((~! :by-example) [(~ g!t) (~ g!r)] + (meta.with_gensyms [g!t g!r] + (wrap (list (` ((~! :by_example) [(~ g!t) (~ g!r)] {(..Refiner (~ g!t) (~ g!r)) (~ refiner)} (..Refined (~ g!t) (~ g!r)))))))) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index b91f9d990..26407ba39 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -74,9 +74,9 @@ [output procedure] (wrap [keys output]))))] - [pure Identity identity.monad run-pure lift-pure] - [sync IO io.monad run-sync lift-sync] - [async Promise promise.monad run-async lift-async] + [pure Identity identity.monad run_pure lift_pure] + [sync IO io.monad run_sync lift_sync] + [async Promise promise.monad run_async lift_async] ) (abstract: #export Ordered []) @@ -91,8 +91,8 @@ (Ex [k] (-> [] (Key <mode> k))) (|>> :abstraction))] - [ordered-key Ordered] - [commutative-key Commutative] + [ordered_key Ordered] + [commutative_key Commutative] )) (type: #export OK (Key Ordered)) @@ -109,12 +109,12 @@ (function (_ keys) (\ <monad> wrap [[(<key> []) keys] (:abstraction value)])))] - [ordered-pure Identity identity.monad Ordered ordered-key] - [ordered-sync IO io.monad Ordered ordered-key] - [ordered-async Promise promise.monad Ordered ordered-key] - [commutative-sync IO io.monad Commutative commutative-key] - [commutative-pure Identity identity.monad Commutative commutative-key] - [commutative-async Promise promise.monad Commutative commutative-key] + [ordered_pure Identity identity.monad Ordered ordered_key] + [ordered_sync IO io.monad Ordered ordered_key] + [ordered_async Promise promise.monad Ordered ordered_key] + [commutative_sync IO io.monad Commutative commutative_key] + [commutative_pure Identity identity.monad Commutative commutative_key] + [commutative_async Promise promise.monad Commutative commutative_key] ) (template [<name> <m> <monad>] @@ -124,16 +124,16 @@ (function (_ [key keys]) (\ <monad> wrap [keys (:representation resource)])))] - [read-pure Identity identity.monad] - [read-sync IO io.monad] - [read-async Promise promise.monad] + [read_pure Identity identity.monad] + [read_sync IO io.monad] + [read_async Promise promise.monad] )) -(exception: #export (index-cannot-be-repeated {index Nat}) +(exception: #export (index_cannot_be_repeated {index Nat}) (exception.report ["Index" (%.nat index)])) -(exception: #export amount-cannot-be-zero) +(exception: #export amount_cannot_be_zero) (def: indices (Parser (List Nat)) @@ -144,26 +144,26 @@ (wrap (list)) (do ! [head s.nat - _ (p.assert (exception.construct index-cannot-be-repeated head) + _ (p.assert (exception.construct index_cannot_be_repeated head) (not (set.member? seen head))) tail (recur (set.add head seen))] (wrap (list& head tail)))))))) -(def: (no-op Monad<m>) +(def: (no_op Monad<m>) (All [m] (-> (Monad m) (Linear m Any))) (function (_ context) (\ Monad<m> wrap [context []]))) (template [<name> <m> <monad>] [(syntax: #export (<name> {swaps ..indices}) - (meta.with-gensyms [g!_ g!context] + (meta.with_gensyms [g!_ g!context] (case swaps #.Nil - (wrap (list (` ((~! no-op) <monad>)))) + (wrap (list (` ((~! no_op) <monad>)))) (#.Cons head tail) (do {! meta.monad} - [#let [max-idx (list\fold n.max head tail)] - g!inputs (<| (monad.seq !) (list.repeat (inc max-idx)) (meta.gensym "input")) + [#let [max_idx (list\fold n.max head tail)] + g!inputs (<| (monad.seq !) (list.repeat (inc max_idx)) (meta.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) (do maybe.monad @@ -172,7 +172,7 @@ (: (Row Code) row.empty) swaps) maybe.assume - row.to-list) + row.to_list) g!inputsT+ (list\map (|>> (~) ..CK (`)) g!inputs) g!outputsT+ (list\map (|>> (~) ..CK (`)) g!outputs)]] (wrap (list (` (: (All [(~+ g!inputs) (~ g!context)] @@ -183,22 +183,22 @@ (function ((~ g!_) [(~+ g!inputs) (~ g!context)]) (\ (~! <monad>) (~' wrap) [[(~+ g!outputs) (~ g!context)] []]))))))))))] - [exchange-pure Identity identity.monad] - [exchange-sync IO io.monad] - [exchange-async Promise promise.monad] + [exchange_pure Identity identity.monad] + [exchange_sync IO io.monad] + [exchange_async Promise promise.monad] ) (def: amount (Parser Nat) (do p.monad [raw s.nat - _ (p.assert (exception.construct amount-cannot-be-zero []) + _ (p.assert (exception.construct ..amount_cannot_be_zero []) (n.> 0 raw))] (wrap raw))) (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) - (meta.with-gensyms [g!_ g!context] + (meta.with_gensyms [g!_ g!context] (do {! meta.monad} [g!keys (<| (monad.seq !) (list.repeat amount) (meta.gensym "keys"))] (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] @@ -209,10 +209,10 @@ (function ((~ g!_) [<from> (~ g!context)]) (\ (~! <monad>) (~' wrap) [[<to> (~ g!context)] []])))))))))] - [group-pure Identity identity.monad (~+ g!keys) [(~+ g!keys)]] - [group-sync IO io.monad (~+ g!keys) [(~+ g!keys)]] - [group-async Promise promise.monad (~+ g!keys) [(~+ g!keys)]] - [un-group-pure Identity identity.monad [(~+ g!keys)] (~+ g!keys)] - [un-group-sync IO io.monad [(~+ g!keys)] (~+ g!keys)] - [un-group-async Promise promise.monad [(~+ g!keys)] (~+ g!keys)] + [group_pure Identity identity.monad (~+ g!keys) [(~+ g!keys)]] + [group_sync IO io.monad (~+ g!keys) [(~+ g!keys)]] + [group_async Promise promise.monad (~+ g!keys) [(~+ g!keys)]] + [un_group_pure Identity identity.monad [(~+ g!keys)] (~+ g!keys)] + [un_group_sync IO io.monad [(~+ g!keys)] (~+ g!keys)] + [un_group_async Promise promise.monad [(~+ g!keys)] (~+ g!keys)] ) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 9f5fdba78..c00b0eae4 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -40,7 +40,7 @@ (: (All [u] (-> (Qty u) (Qty (s u)))) scale) (: (All [u] (-> (Qty (s u)) (Qty u))) - de-scale) + de_scale) (: Ratio ratio)) @@ -64,21 +64,21 @@ [(def: <name> (-> Text Text) (|>> (format "{" kind "@" module "}") - (let [[module kind] (name-of <tag>)])))] + (let [[module kind] (name_of <tag>)])))] - [unit-name #..Unit] - [scale-name #..Scale] + [unit_name #..Unit] + [scale_name #..Scale] ) (syntax: #export (unit: {export |export|.parser} - {name s.local-identifier} - {annotations (p.default cs.empty-annotations csr.annotations)}) - (wrap (list (` (type: (~+ (|export|.write export)) (~ (code.local-identifier name)) + {name s.local_identifier} + {annotations (p.default cs.empty_annotations csr.annotations)}) + (wrap (list (` (type: (~+ (|export|.write export)) (~ (code.local_identifier name)) (~ (csw.annotations annotations)) - (primitive (~ (code.text (unit-name name)))))) - (` (def: (~+ (|export|.write export)) (~ (code.local-identifier (format "@" name))) - (~ (code.local-identifier name)) + (primitive (~ (code.text (unit_name name)))))) + (` (def: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) + (~ (code.local_identifier name)) (:assume []))) ))) @@ -95,21 +95,21 @@ (syntax: #export (scale: {export |export|.parser} - {name s.local-identifier} + {name s.local_identifier} {(^slots [#ratio.numerator #ratio.denominator]) ratio^} - {annotations (p.default cs.empty-annotations csr.annotations)}) - (let [g!scale (code.local-identifier name)] + {annotations (p.default cs.empty_annotations csr.annotations)}) + (let [g!scale (code.local_identifier name)] (wrap (list (` (type: (~+ (|export|.write export)) ((~ g!scale) (~' u)) (~ (csw.annotations annotations)) - (primitive (~ (code.text (scale-name name))) [(~' u)]))) - (` (structure: (~+ (|export|.write export)) (~ (code.local-identifier (format "@" name))) + (primitive (~ (code.text (scale_name name))) [(~' u)]))) + (` (structure: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) (..Scale (~ g!scale)) (def: (~' scale) (|>> ..out (i.* (~ (code.int (.int numerator)))) (i./ (~ (code.int (.int denominator)))) ..in)) - (def: (~' de-scale) + (def: (~' de_scale) (|>> ..out (i.* (~ (code.int (.int denominator)))) (i./ (~ (code.int (.int numerator)))) @@ -143,7 +143,7 @@ (i.* (out (input param))) in))) -(def: #export (re-scale from to quantity) +(def: #export (re_scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) (let [[numerator denominator] (ratio./ (\ from ratio) (\ to ratio))] diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 8c074c4d8..68e1d056f 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -21,27 +21,27 @@ [(exception: #export (<name>) "")] - [cannot-open] - [cannot-close] + [cannot_open] + [cannot_close] ) -(capability: #export (Can-Read ! o) - (can-read [] (! (Try o)))) +(capability: #export (Can_Read ! o) + (can_read [] (! (Try o)))) -(capability: #export (Can-Write ! i) - (can-write i (! (Try Any)))) +(capability: #export (Can_Write ! i) + (can_write i (! (Try Any)))) -(capability: #export (Can-Close !) - (can-close [] (! (Try Any)))) +(capability: #export (Can_Close !) + (can_close [] (! (Try Any)))) (signature: #export (Console !) - (: (Can-Read ! Char) + (: (Can_Read ! Char) read) - (: (Can-Read ! Text) - read-line) - (: (Can-Write ! Text) + (: (Can_Read ! Text) + read_line) + (: (Can_Write ! Text) write) - (: (Can-Close !) + (: (Can_Close !) close)) (def: #export (async console) @@ -51,12 +51,12 @@ (<forge> (|>> (!.use (\ console <capability>)) promise.future)))] - [read ..can-read] - [read-line ..can-read] - [write ..can-write] - [close ..can-close]))))) + [read ..can_read] + [read_line ..can_read] + [write ..can_write] + [close ..can_close]))))) -(with-expansions [<jvm> (as-is (import: java/lang/String) +(with_expansions [<jvm> (as_is (import: java/lang/String) (import: java/io/Console ["#::." @@ -79,54 +79,54 @@ (def: #export default (IO (Try (Console IO))) (do io.monad - [?jvm-console (java/lang/System::console)] - (case ?jvm-console + [?jvm_console (java/lang/System::console)] + (case ?jvm_console #.None - (wrap (exception.throw ..cannot-open [])) + (wrap (exception.throw ..cannot_open [])) - (#.Some jvm-console) - (let [jvm-input (java/lang/System::in) - jvm-output (java/lang/System::out)] + (#.Some jvm_console) + (let [jvm_input (java/lang/System::in) + jvm_output (java/lang/System::out)] (<| wrap exception.return (: (Console IO)) ## TODO: Remove ASAP (structure (def: read - (..can-read + (..can_read (function (_ _) - (|> jvm-input + (|> jvm_input java/io/InputStream::read (\ (try.with io.monad) map .nat))))) - (def: read-line - (..can-read + (def: read_line + (..can_read (function (_ _) - (java/io/Console::readLine jvm-console)))) + (java/io/Console::readLine jvm_console)))) (def: write - (..can-write + (..can_write (function (_ message) - (java/io/PrintStream::print message jvm-output)))) + (java/io/PrintStream::print message jvm_output)))) (def: close - (..can-close - (|>> (exception.throw ..cannot-close) wrap))))))))))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (..can_close + (|>> (exception.throw ..cannot_close) wrap))))))))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) -(def: #export (write-line message console) +(def: #export (write_line message console) (All [!] (-> Text (Console !) (! (Try Any)))) - (!.use (\ console write) [(format message text.new-line)])) + (!.use (\ console write) [(format message text.new_line)])) (signature: #export (Simulation s) (: (-> s (Try [s Char])) - on-read) + on_read) (: (-> s (Try [s Text])) - on-read-line) + on_read_line) (: (-> Text s (Try s)) - on-write) + on_write) (: (-> s (Try s)) - on-close)) + on_close)) (def: #export (mock simulation init) (All [s] (-> (Simulation s) s (Console Promise))) @@ -134,7 +134,7 @@ (`` (structure (~~ (template [<method> <simulation>] [(def: <method> - (..can-read + (..can_read (function (_ _) (stm.commit (do {! stm.monad} @@ -148,17 +148,17 @@ (#try.Failure error) (wrap (#try.Failure error))))))))] - [read on-read] - [read-line on-read-line] + [read on_read] + [read_line on_read_line] )) (def: write - (..can-write + (..can_write (function (_ input) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-write input |state|) + (case (\ simulation on_write input |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -168,12 +168,12 @@ (wrap (#try.Failure error)))))))) (def: close - (..can-close + (..can_close (function (_ _) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-close |state|) + (case (\ simulation on_close |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 3a4359f6f..db973ece4 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -36,24 +36,24 @@ (type: #export Path Text) -(capability: #export (Can-Open ! capability) - (can-open Path (! (Try (capability !))))) +(capability: #export (Can_Open ! capability) + (can_open Path (! (Try (capability !))))) -(capability: #export (Can-See o) - (can-see [] o)) +(capability: #export (Can_See o) + (can_see [] o)) -(capability: #export (Can-Query ! o) - (can-query [] (! (Try o)))) +(capability: #export (Can_Query ! o) + (can_query [] (! (Try o)))) -(capability: #export (Can-Modify ! i) - (can-modify [i] (! (Try Any)))) +(capability: #export (Can_Modify ! i) + (can_modify [i] (! (Try Any)))) -(capability: #export (Can-Delete !) - (can-delete [] (! (Try Any)))) +(capability: #export (Can_Delete !) + (can_delete [] (! (Try Any)))) (`` (signature: #export (File !) (~~ (template [<name> <output>] - [(: (Can-See <output>) + [(: (Can_See <output>) <name>)] [name Text] @@ -61,135 +61,135 @@ )) (~~ (template [<name> <output>] - [(: (Can-Query ! <output>) + [(: (Can_Query ! <output>) <name>)] [size Nat] - [last-modified Instant] - [can-execute? Bit] + [last_modified Instant] + [can_execute? Bit] [content Binary] )) - (: (Can-Open ! File) + (: (Can_Open ! File) move) (~~ (template [<name> <input>] - [(: (Can-Modify ! <input>) + [(: (Can_Modify ! <input>) <name>)] [modify Instant] - [over-write Binary] + [over_write Binary] [append Binary] )) - (: (Can-Delete !) + (: (Can_Delete !) delete) )) (signature: #export (Directory !) - (: (Can-See Path) + (: (Can_See Path) scope) - (: (Can-Query ! (List (File !))) + (: (Can_Query ! (List (File !))) files) - (: (Can-Query ! (List (Directory !))) + (: (Can_Query ! (List (Directory !))) directories) - (: (Can-Delete !) + (: (Can_Delete !) discard)) (`` (signature: #export (System !) (~~ (template [<name> <capability>] - [(: (Can-Open ! <capability>) + [(: (Can_Open ! <capability>) <name>)] [file File] - [create-file File] + [create_file File] [directory Directory] - [create-directory Directory] + [create_directory Directory] )) (: Text separator) )) -(def: (async-file file) +(def: (async_file file) (-> (File IO) (File Promise)) (`` (structure (~~ (template [<forge> <name>+] - [(with-expansions [<rows> (template.splice <name>+)] + [(with_expansions [<rows> (template.splice <name>+)] (template [<name>] [(def: <name> (<forge> (|>> (!.use (\ file <name>)))))] <rows>))] - [..can-see + [..can_see [[name] [path]]] )) (~~ (template [<forge> <name>+] - [(with-expansions [<rows> (template.splice <name>+)] + [(with_expansions [<rows> (template.splice <name>+)] (template [<name>] [(def: <name> (<forge> (|>> (!.use (\ file <name>)) promise.future)))] <rows>))] - [..can-query - [[size] [last-modified] [can-execute?] [content]]] + [..can_query + [[size] [last_modified] [can_execute?] [content]]] - [..can-modify - [[modify] [over-write] [append]]] + [..can_modify + [[modify] [over_write] [append]]] - [..can-delete + [..can_delete [[delete]]])) (def: move - (..can-open - (|>> (!.use (\ file move)) (io\map (try\map async-file)) promise.future)))))) + (..can_open + (|>> (!.use (\ file move)) (io\map (try\map async_file)) promise.future)))))) -(def: (async-directory directory) +(def: (async_directory directory) (-> (Directory IO) (Directory Promise)) (`` (structure (def: scope (\ directory scope)) (~~ (template [<name> <async>] [(def: <name> - (..can-query + (..can_query (|>> (!.use (\ directory <name>)) (io\map (try\map (list\map <async>))) promise.future)))] - [files ..async-file] - [directories async-directory])) + [files ..async_file] + [directories async_directory])) (def: discard - (..can-delete + (..can_delete (|>> (!.use (\ directory discard)) promise.future)))))) (def: #export (async system) (-> (System IO) (System Promise)) (`` (structure (~~ (template [<name> <async>] - [(def: <name> (..can-open + [(def: <name> (..can_open (|>> (!.use (\ system <name>)) (io\map (try\map <async>)) promise.future)))] - [file ..async-file] - [create-file ..async-file] - [directory ..async-directory] - [create-directory ..async-directory])) + [file ..async_file] + [create_file ..async_file] + [directory ..async_directory] + [create_directory ..async_directory])) (def: separator (\ system separator))))) -(def: #export (un-nest system file) +(def: #export (un_nest system file) (All [!] (-> (System !) Path (Maybe [Path Text]))) - (case (text.last-index-of (\ system separator) file) + (case (text.last_index_of (\ system separator) file) #.None #.None - (#.Some last-separator) - (let [[parent temp] (maybe.assume (text.split last-separator file)) + (#.Some last_separator) + (let [[parent temp] (maybe.assume (text.split last_separator file)) [_ child] (maybe.assume (text.split (text.size (\ system separator)) temp))] (#.Some [parent child])))) @@ -202,25 +202,25 @@ (exception.report ["Path" file]))] - [cannot-create-file] - [cannot-find-file] - [cannot-delete-file] - [not-a-file] + [cannot_create_file] + [cannot_find_file] + [cannot_delete_file] + [not_a_file] - [cannot-create-directory] - [cannot-find-directory] - [cannot-discard-directory] + [cannot_create_directory] + [cannot_find_directory] + [cannot_discard_directory] - [cannot-read-all-data] - [not-a-directory] + [cannot_read_all_data] + [not_a_directory] ) -(with-expansions [<for-jvm> (as-is (exception: #export (cannot-move {target Path} {source Path}) +(with_expansions [<for_jvm> (as_is (exception: #export (cannot_move {target Path} {source Path}) (exception.report ["Source" source] ["Target" target])) - (exception: #export (cannot-modify {instant Instant} {file Path}) + (exception: #export (cannot_modify {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] ["Path" file])) @@ -283,7 +283,7 @@ (~~ (template [<name> <flag>] [(def: <name> - (..can-modify + (..can_modify (function (<name> data) (do (try.with io.monad) [stream (java/io/FileOutputStream::new (java/io/File::new path) <flag>) @@ -291,61 +291,61 @@ _ (java/io/OutputStream::flush stream)] (java/lang/AutoCloseable::close stream)))))] - [over-write #0] + [over_write #0] [append #1] )) (def: content - (..can-query + (..can_query (function (content _) (do (try.with io.monad) [#let [file (java/io/File::new path)] size (java/io/File::length file) #let [data (binary.create (.nat size))] stream (java/io/FileInputStream::new file) - bytes-read (java/io/InputStream::read data stream) + bytes_read (java/io/InputStream::read data stream) _ (java/lang/AutoCloseable::close stream)] - (if (i.= size bytes-read) + (if (i.= size bytes_read) (wrap data) - (\ io.monad wrap (exception.throw ..cannot-read-all-data path))))))) + (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))))) (def: name - (..can-see + (..can_see (function (name _) (|> path java/io/File::new java/io/File::getName)))) (def: path - (..can-see + (..can_see (function (_ _) path))) (def: size - (..can-query + (..can_query (function (size _) (|> path java/io/File::new java/io/File::length (\ (try.with io.monad) map .nat))))) - (def: last-modified - (..can-query - (function (last-modified _) + (def: last_modified + (..can_query + (function (last_modified _) (|> path java/io/File::new (java/io/File::lastModified) - (\ (try.with io.monad) map (|>> duration.from-millis instant.absolute)))))) + (\ (try.with io.monad) map (|>> duration.from_millis instant.absolute)))))) - (def: can-execute? - (..can-query - (function (can-execute? _) + (def: can_execute? + (..can_query + (function (can_execute? _) (|> path java/io/File::new java/io/File::canExecute)))) (def: move - (..can-open + (..can_open (function (move destination) (do io.monad [outcome (java/io/File::renameTo (java/io/File::new destination) @@ -355,66 +355,66 @@ (wrap (#try.Success (file destination))) _ - (wrap (exception.throw ..cannot-move [destination path]))))))) + (wrap (exception.throw ..cannot_move [destination path]))))))) (def: modify - (..can-modify - (function (modify time-stamp) + (..can_modify + (function (modify time_stamp) (do io.monad - [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis) + [outcome (java/io/File::setLastModified (|> time_stamp instant.relative duration.to_millis) (java/io/File::new path))] (case outcome (#try.Success #1) (wrap (#try.Success [])) _ - (wrap (exception.throw ..cannot-modify [time-stamp path]))))))) + (wrap (exception.throw ..cannot_modify [time_stamp path]))))))) (def: delete - (..can-delete + (..can_delete (function (delete _) - (!delete path cannot-delete-file)))))) + (!delete path cannot_delete_file)))))) (`` (structure: (directory path) (-> Path (Directory IO)) (def: scope - (..can-see + (..can_see (function (_ _) path))) (~~ (template [<name> <method> <capability>] [(def: <name> - (..can-query + (..can_query (function (<name> _) (do {! (try.with io.monad)} [?children (java/io/File::listFiles (java/io/File::new path))] (case ?children (#.Some children) (|> children - array.to-list + array.to_list (monad.filter ! (|>> <method>)) (\ ! map (monad.map ! (|>> java/io/File::getAbsolutePath (\ ! map <capability>)))) (\ ! join)) #.None - (\ io.monad wrap (exception.throw ..not-a-directory [path])))))))] + (\ io.monad wrap (exception.throw ..not_a_directory [path])))))))] [files java/io/File::isFile file] [directories java/io/File::isDirectory directory] )) (def: discard - (..can-delete + (..can_delete (function (discard _) - (!delete path cannot-discard-directory)))))) + (!delete path cannot_discard_directory)))))) (`` (structure: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] [(def: <name> - (..can-open + (..can_open (function (<name> path) (do io.monad [#let [file (java/io/File::new path)] @@ -426,22 +426,22 @@ _ (wrap (exception.throw <exception> [path])))))))] - [file java/io/File::isFile ..file cannot-find-file] - [create-file java/io/File::createNewFile ..file cannot-create-file] - [directory java/io/File::isDirectory ..directory cannot-find-directory] - [create-directory java/io/File::mkdir ..directory cannot-create-directory] + [file java/io/File::isFile ..file cannot_find_file] + [create_file java/io/File::createNewFile ..file cannot_create_file] + [directory java/io/File::isDirectory ..directory cannot_find_directory] + [create_directory java/io/File::mkdir ..directory cannot_create_directory] )) (def: separator (java/io/File::separator)) )))] (for {@.old - (as-is <for-jvm>) + (as_is <for_jvm>) @.jvm - (as-is <for-jvm>) + (as_is <for_jvm>) @.js - (as-is (import: Buffer + (as_is (import: Buffer (#static from [Binary] ..Buffer)) (import: FileDescriptor) @@ -481,14 +481,14 @@ (-> [] (Maybe (-> host.String Any))) (host.constant (-> host.String Any) <path>))] - [normal-require [require]] - [global-require [global require]] - [process-load [global process mainModule constructor _load]] + [normal_require [require]] + [global_require [global require]] + [process_load [global process mainModule constructor _load]] ) (def: (require _) (-> [] (-> host.String Any)) - (case [(normal-require []) (global-require []) (process-load [])] + (case [(normal_require []) (global_require []) (process_load [])] (^or [(#.Some require) _ _] [_ (#.Some require) _] [_ _ (#.Some require)]) @@ -502,8 +502,8 @@ (-> [] <type>) (:coerce <type> (..require [] <module>)))] - [node-fs "fs" ..Fs] - [node-path "path" ..JsPath] + [node_fs "fs" ..Fs] + [node_path "path" ..JsPath] ) (`` (structure: (file path) @@ -511,57 +511,57 @@ (~~ (template [<name> <method>] [(def: <name> - (..can-modify + (..can_modify (function (<name> data) - (<method> [path (Buffer::from data)] (..node-fs [])))))] + (<method> [path (Buffer::from data)] (..node_fs [])))))] - [over-write Fs::writeFileSync] + [over_write Fs::writeFileSync] [append Fs::appendFileSync] )) (def: content - (..can-query + (..can_query (function (_ _) - (Fs::readFileSync [path] (..node-fs []))))) + (Fs::readFileSync [path] (..node_fs []))))) (def: name - (..can-see + (..can_see (function (_ _) - (JsPath::basename path (..node-path []))))) + (JsPath::basename path (..node_path []))))) (def: path - (..can-see + (..can_see (function (_ _) path))) (def: size - (..can-query + (..can_query (function (_ _) (do (try.with io.monad) - [stat (Fs::statSync [path] (..node-fs []))] + [stat (Fs::statSync [path] (..node_fs []))] (wrap (|> stat Stats::size f.nat)))))) - (def: last-modified - (..can-query + (def: last_modified + (..can_query (function (_ _) (do (try.with io.monad) - [stat (Fs::statSync [path] (..node-fs []))] + [stat (Fs::statSync [path] (..node_fs []))] (wrap (|> stat Stats::mtimeMs f.int - duration.from-millis + duration.from_millis instant.absolute)))))) - (def: can-execute? - (..can-query - (function (can-execute? _) + (def: can_execute? + (..can_query + (function (can_execute? _) (do (try.with io.monad) - [#let [node-fs (..node-fs [])] - _ (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] + [#let [node_fs (..node_fs [])] + _ (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] (do io.monad - [outcome (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::X_OK)] node-fs)] + [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::X_OK)] node_fs)] (wrap (#try.Success (case outcome (#try.Success _) true @@ -570,44 +570,44 @@ false)))))))) (def: move - (..can-open + (..can_open (function (move destination) (do (try.with io.monad) - [_ (Fs::renameSync [path destination] (..node-fs []))] + [_ (Fs::renameSync [path destination] (..node_fs []))] (wrap (file destination)))))) (def: modify - (..can-modify - (function (modify time-stamp) - (let [when (|> time-stamp instant.relative duration.to-millis i.frac)] - (Fs::utimesSync [path when when] (..node-fs [])))))) + (..can_modify + (function (modify time_stamp) + (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] + (Fs::utimesSync [path when when] (..node_fs [])))))) (def: delete - (..can-delete + (..can_delete (function (delete _) - (Fs::unlink [path] (..node-fs []))))))) + (Fs::unlink [path] (..node_fs []))))))) (`` (structure: (directory path) (-> Path (Directory IO)) (def: scope - (..can-see + (..can_see (function (_ _) path))) (~~ (template [<name> <method> <capability>] [(def: <name> - (..can-query + (..can_query (function (<name> _) (do {! (try.with io.monad)} - [#let [node-fs (..node-fs [])] - subs (Fs::readdirSync [path] node-fs) + [#let [node_fs (..node_fs [])] + subs (Fs::readdirSync [path] node_fs) subs (monad.map ! (function (_ sub) (do ! - [stats (Fs::statSync [sub] node-fs) + [stats (Fs::statSync [sub] node_fs) verdict (<method> [] stats)] (wrap [verdict sub]))) - (array.to-list subs))] + (array.to_list subs))] (wrap (|> subs (list.filter product.left) (list\map (|>> product.right <capability>))))))))] @@ -617,51 +617,51 @@ )) (def: discard - (..can-delete + (..can_delete (function (discard _) - (Fs::rmdirSync [path] (..node-fs []))))))) + (Fs::rmdirSync [path] (..node_fs []))))))) (`` (structure: #export default (System IO) (~~ (template [<name> <method> <capability> <exception>] [(def: <name> - (..can-open + (..can_open (function (<name> path) (do (try.with io.monad) - [stats (Fs::statSync [path] (..node-fs [])) + [stats (Fs::statSync [path] (..node_fs [])) verdict (<method> [] stats)] (if verdict (wrap (<capability> path)) (\ io.monad wrap (exception.throw <exception> [path])))))))] - [file Stats::isFile ..file ..cannot-find-file] - [directory Stats::isDirectory ..directory ..cannot-find-directory] + [file Stats::isFile ..file ..cannot_find_file] + [directory Stats::isDirectory ..directory ..cannot_find_directory] )) (~~ (template [<name> <capability> <exception> <prep>] [(def: <name> - (..can-open + (..can_open (function (<name> path) - (let [node-fs (..node-fs [])] + (let [node_fs (..node_fs [])] (do io.monad - [outcome (Fs::accessSync [path (|> node-fs Fs::constants FsConstants::F_OK)] node-fs)] + [outcome (Fs::accessSync [path (|> node_fs Fs::constants FsConstants::F_OK)] node_fs)] (case outcome (#try.Success _) (wrap (exception.throw <exception> [path])) (#try.Failure _) (do (try.with io.monad) - [_ (|> node-fs <prep>)] + [_ (|> node_fs <prep>)] (wrap (<capability> path)))))))))] - [create-file ..file ..cannot-create-file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])] - [create-directory ..directory ..cannot-create-directory (Fs::mkdirSync [path])] + [create_file ..file ..cannot_create_file (Fs::appendFileSync [path (Buffer::from (binary.create 0))])] + [create_directory ..directory ..cannot_create_directory (Fs::mkdirSync [path])] )) (def: separator - (if host.on-node-js? - (JsPath::sep (..node-path [])) + (if host.on_node_js? + (JsPath::sep (..node_path [])) "/")) )) ) @@ -681,8 +681,8 @@ (!.use (\ system <create>) path) (wrap (#try.Failure error))))))] - [get-file File create-file file ..cannot-find-file] - [get-directory Directory create-directory directory ..cannot-find-directory] + [get_file File create_file file ..cannot_find_file] + [get_directory Directory create_directory directory ..cannot_find_directory] ) (template [<predicate> <capability>] @@ -697,34 +697,34 @@ (#try.Failure _) (wrap false))))] - [file-exists? file] - [directory-exists? directory] + [file_exists? file] + [directory_exists? directory] ) (def: #export (exists? monad system path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [verdict (..file-exists? monad system path)] + [verdict (..file_exists? monad system path)] (if verdict (wrap verdict) - (..directory-exists? monad system path)))) + (..directory_exists? monad system path)))) -(type: Mock-File - {#mock-last-modified Instant - #mock-can-execute Bit - #mock-content Binary}) +(type: Mock_File + {#mock_last_modified Instant + #mock_can_execute Bit + #mock_content Binary}) (type: #rec Mock - (Dictionary Text (Either Mock-File Mock))) + (Dictionary Text (Either Mock_File Mock))) -(def: empty-mock +(def: empty_mock Mock (dictionary.new text.hash)) -(def: (create-mock-file! separator path now mock) +(def: (create_mock_file! separator path now mock) (-> Text Path Instant Mock (Try [Text Mock])) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) @@ -732,108 +732,108 @@ (case tail #.Nil (#try.Success [head (dictionary.put head - (#.Left {#mock-last-modified now - #mock-can-execute false - #mock-content (binary.create 0)}) + (#.Left {#mock_last_modified now + #mock_can_execute false + #mock_content (binary.create 0)}) directory)]) (#.Cons _) - (exception.throw ..cannot-create-file [path])) + (exception.throw ..cannot_create_file [path])) (#.Some node) (case [node tail] - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [[file-name sub-directory] (recur sub-directory tail)] - (wrap [file-name (dictionary.put head (#.Right sub-directory) directory)])) + [[file_name sub_directory] (recur sub_directory tail)] + (wrap [file_name (dictionary.put head (#.Right sub_directory) directory)])) _ - (exception.throw ..cannot-create-file [path]))) + (exception.throw ..cannot_create_file [path]))) #.Nil - (exception.throw ..cannot-create-file [path])))) + (exception.throw ..cannot_create_file [path])))) -(def: (retrieve-mock-file! separator path mock) - (-> Text Path Mock (Try [Text Mock-File])) +(def: (retrieve_mock_file! separator path mock) + (-> Text Path Mock (Try [Text Mock_File])) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-file [path]) + (exception.throw ..cannot_find_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success [head file]) - [(#.Right sub-directory) (#.Cons _)] - (recur sub-directory tail) + [(#.Right sub_directory) (#.Cons _)] + (recur sub_directory tail) _ - (exception.throw ..cannot-find-file [path]))) + (exception.throw ..cannot_find_file [path]))) #.Nil - (exception.throw ..not-a-file [path])))) + (exception.throw ..not_a_file [path])))) -(def: (update-mock-file! separator path now content mock) +(def: (update_mock_file! separator path now content mock) (-> Text Path Instant Binary Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-file [path]) + (exception.throw ..cannot_find_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success (dictionary.put head (#.Left (|> file - (set@ #mock-last-modified now) - (set@ #mock-content content))) + (set@ #mock_last_modified now) + (set@ #mock_content content))) directory)) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-find-file [path]))) + (exception.throw ..cannot_find_file [path]))) #.Nil - (exception.throw ..cannot-find-file [path])))) + (exception.throw ..cannot_find_file [path])))) -(def: (delete-mock-file! separator path mock) +(def: (delete_mock_file! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-delete-file [path]) + (exception.throw ..cannot_delete_file [path]) (#.Some node) (case [node tail] [(#.Left file) #.Nil] (#try.Success (dictionary.remove head directory)) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-delete-file [path]))) + (exception.throw ..cannot_delete_file [path]))) #.Nil - (exception.throw ..cannot-delete-file [path])))) + (exception.throw ..cannot_delete_file [path])))) -(def: (try-update! transform var) +(def: (try_update! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) (do {! stm.monad} [|var| (stm.read var)] @@ -846,109 +846,109 @@ (#try.Failure error) (wrap (#try.Failure error))))) -(def: (mock-file separator name path store) +(def: (mock_file separator name path store) (-> Text Text Path (Var Mock) (File Promise)) (structure (def: name - (..can-see + (..can_see (function.constant name))) (def: path - (..can-see + (..can_see (function.constant path))) (def: size - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (wrap (binary.size (get@ #mock-content file)))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (binary.size (get@ #mock_content file)))))))))) (def: content - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (wrap (get@ #mock-content file))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_content file))))))))) - (def: last-modified - (..can-query + (def: last_modified + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (wrap (get@ #mock-last-modified file))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_last_modified file))))))))) - (def: can-execute? - (..can-query + (def: can_execute? + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (wrap (get@ #mock-can-execute file))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (get@ #mock_can_execute file))))))))) - (def: over-write - (..can-modify + (def: over_write + (..can_modify (function (_ content) (do promise.monad [now (promise.future instant.now)] (stm.commit - (..try-update! (..update-mock-file! separator path now content) store)))))) + (..try_update! (..update_mock_file! separator path now content) store)))))) (def: append - (..can-modify + (..can_modify (function (_ content) (do promise.monad [now (promise.future instant.now)] (stm.commit - (..try-update! (function (_ |store|) + (..try_update! (function (_ |store|) (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (..update-mock-file! separator path now + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (\ binary.monoid compose - (get@ #mock-content file) + (get@ #mock_content file) content) |store|))) store)))))) (def: modify - (..can-modify + (..can_modify (function (_ now) (stm.commit - (..try-update! (function (_ |store|) + (..try_update! (function (_ |store|) (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (..update-mock-file! separator path now (get@ #mock-content file) |store|))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (..update_mock_file! separator path now (get@ #mock_content file) |store|))) store))))) (def: delete - (..can-delete + (..can_delete (function (_ _) (stm.commit - (..try-update! (..delete-mock-file! separator path) store))))) + (..try_update! (..delete_mock_file! separator path) store))))) (def: move - (..can-open + (..can_open (function (_ path) (stm.commit (do {! stm.monad} [|store| (stm.read store)] (case (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|) - |store| (..delete-mock-file! separator path |store|) - [name |store|] (..create-mock-file! separator path (get@ #mock-last-modified file) |store|) - |store| (..update-mock-file! separator path (get@ #mock-last-modified file) (get@ #mock-content file) |store|)] - (wrap [|store| (mock-file separator name path store)])) + [[name file] (..retrieve_mock_file! separator path |store|) + |store| (..delete_mock_file! separator path |store|) + [name |store|] (..create_mock_file! separator path (get@ #mock_last_modified file) |store|) + |store| (..update_mock_file! separator path (get@ #mock_last_modified file) (get@ #mock_content file) |store|)] + (wrap [|store| (mock_file separator name path store)])) (#try.Success [|store| moved]) (do ! [_ (stm.write |store| store)] @@ -958,142 +958,142 @@ (wrap (#try.Failure error)))))))) )) -(def: (create-mock-directory! separator path mock) +(def: (create_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None (case tail #.Nil - (#try.Success (dictionary.put head (#.Right ..empty-mock) directory)) + (#try.Success (dictionary.put head (#.Right ..empty_mock) directory)) (#.Cons _) - (exception.throw ..cannot-create-directory [path])) + (exception.throw ..cannot_create_directory [path])) (#.Some node) (case [node tail] - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-create-directory [path]))) + (exception.throw ..cannot_create_directory [path]))) #.Nil - (exception.throw ..cannot-create-directory [path])))) + (exception.throw ..cannot_create_directory [path])))) -(def: (retrieve-mock-directory! separator path mock) +(def: (retrieve_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-find-directory [path]) + (exception.throw ..cannot_find_directory [path]) (#.Some node) (case [node tail] - [(#.Right sub-directory) #.Nil] - (#try.Success sub-directory) + [(#.Right sub_directory) #.Nil] + (#try.Success sub_directory) - [(#.Right sub-directory) (#.Cons _)] - (recur sub-directory tail) + [(#.Right sub_directory) (#.Cons _)] + (recur sub_directory tail) _ - (exception.throw ..cannot-find-directory [path]))) + (exception.throw ..cannot_find_directory [path]))) #.Nil (#try.Success directory)))) -(def: (delete-mock-directory! separator path mock) +(def: (delete_mock_directory! separator path mock) (-> Text Path Mock (Try Mock)) (loop [directory mock - trail (text.split-all-with separator path)] + trail (text.split_all_with separator path)] (case trail (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot-discard-directory [path]) + (exception.throw ..cannot_discard_directory [path]) (#.Some node) (case [node tail] [(#.Right directory) #.Nil] (if (dictionary.empty? directory) (#try.Success (dictionary.remove head directory)) - (exception.throw ..cannot-discard-directory [path])) + (exception.throw ..cannot_discard_directory [path])) - [(#.Right sub-directory) (#.Cons _)] + [(#.Right sub_directory) (#.Cons _)] (do try.monad - [sub-directory (recur sub-directory tail)] - (wrap (dictionary.put head (#.Right sub-directory) directory))) + [sub_directory (recur sub_directory tail)] + (wrap (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot-discard-directory [path]))) + (exception.throw ..cannot_discard_directory [path]))) #.Nil - (exception.throw ..cannot-discard-directory [path])))) + (exception.throw ..cannot_discard_directory [path])))) -(def: (mock-directory separator path store) +(def: (mock_directory separator path store) (-> Text Path (Var Mock) (Directory Promise)) (structure (def: scope - (..can-see + (..can_see (function (_ _) path))) (def: files - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [directory (..retrieve-mock-directory! separator path |store|)] + [directory (..retrieve_mock_directory! separator path |store|)] (wrap (|> directory dictionary.entries - (list.all (function (_ [node-name node]) + (list.all (function (_ [node_name node]) (case node (#.Left file) - (#.Some (..mock-file separator - node-name - (format path separator node-name) + (#.Some (..mock_file separator + node_name + (format path separator node_name) store)) (#.Right directory) #.None)))))))))))) (def: directories - (..can-query + (..can_query (function (_ _) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [directory (..retrieve-mock-directory! separator path |store|)] + [directory (..retrieve_mock_directory! separator path |store|)] (wrap (|> directory dictionary.entries - (list.all (function (_ [node-name node]) + (list.all (function (_ [node_name node]) (case node (#.Left file) #.None (#.Right directory) - (#.Some (mock-directory separator - (format path separator node-name) + (#.Some (mock_directory separator + (format path separator node_name) store)))))))))))))) (def: discard - (..can-delete + (..can_delete (function (_ _) (stm.commit (do {! stm.monad} [|store| (stm.read store)] - (case (..delete-mock-directory! separator path |store|) + (case (..delete_mock_directory! separator path |store|) (#try.Success |store|) (do ! [_ (stm.write |store| store)] @@ -1105,72 +1105,72 @@ (def: #export (mock separator) (-> Text (System Promise)) - (let [store (stm.var ..empty-mock)] + (let [store (stm.var ..empty_mock)] (structure (def: separator separator) (def: file - (..can-open + (..can_open (function (_ path) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [[name file] (..retrieve-mock-file! separator path |store|)] - (wrap (..mock-file separator name path store))))))))) + [[name file] (..retrieve_mock_file! separator path |store|)] + (wrap (..mock_file separator name path store))))))))) - (def: create-file - (..can-open + (def: create_file + (..can_open (function (_ path) (do promise.monad [now (promise.future instant.now)] (stm.commit (do {! stm.monad} [|store| (stm.read store)] - (case (..create-mock-file! separator path now |store|) + (case (..create_mock_file! separator path now |store|) (#try.Success [name |store|]) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success (..mock-file separator name path store)))) + (wrap (#try.Success (..mock_file separator name path store)))) (#try.Failure error) (wrap (#try.Failure error))))))))) (def: directory - (..can-open + (..can_open (function (_ path) (stm.commit (do stm.monad [|store| (stm.read store)] (wrap (do try.monad - [directory (..retrieve-mock-directory! separator path |store|)] - (wrap (..mock-directory separator path store))))))))) + [directory (..retrieve_mock_directory! separator path |store|)] + (wrap (..mock_directory separator path store))))))))) - (def: create-directory - (..can-open + (def: create_directory + (..can_open (function (_ path) (stm.commit (do {! stm.monad} [|store| (stm.read store)] - (case (..create-mock-directory! separator path |store|) + (case (..create_mock_directory! separator path |store|) (#try.Success |store|) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success (..mock-directory separator path store)))) + (wrap (#try.Success (..mock_directory separator path store)))) (#try.Failure error) (wrap (#try.Failure error)))))))) ))) -(def: #export (make-directories monad system path) +(def: #export (make_directories monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try Path)))) - (let [rooted? (text.starts-with? (\ system separator) path) - segments (text.split-all-with (\ system separator) path)] + (let [rooted? (text.starts_with? (\ system separator) path) + segments (text.split_all_with (\ system separator) path)] (case (if rooted? (list.drop 1 segments) segments) #.Nil - (\ monad wrap (exception.throw ..cannot-create-directory [path])) + (\ monad wrap (exception.throw ..cannot_create_directory [path])) (#.Cons head tail) (loop [current (if rooted? @@ -1178,7 +1178,7 @@ head) next tail] (do (try.with monad) - [_ (..get-directory monad system current)] + [_ (..get_directory monad system current)] (case next #.Nil (wrap current) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 5d995bbd4..1a59721d4 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -90,164 +90,164 @@ (: (-> [] (! (Try (List [//.Path Concern])))) poll)) -(exception: #export (not-being-watched {path //.Path}) +(exception: #export (not_being_watched {path //.Path}) (exception.report ["Path" (%.text path)])) -(type: File-Tracker +(type: File_Tracker (Dictionary //.Path [(//.File Promise) Instant])) -(type: Directory-Tracker - (Dictionary //.Path [Concern (//.Directory Promise) File-Tracker])) +(type: Directory_Tracker + (Dictionary //.Path [Concern (//.Directory Promise) File_Tracker])) -(def: (update-watch! new-concern path tracker) - (-> Concern //.Path (Var Directory-Tracker) (STM Bit)) +(def: (update_watch! new_concern path tracker) + (-> Concern //.Path (Var Directory_Tracker) (STM Bit)) (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.get path @tracker) - (#.Some [old-concern file last-modified]) + (#.Some [old_concern file last_modified]) (do ! - [_ (stm.update (dictionary.put path [new-concern file last-modified]) tracker)] + [_ (stm.update (dictionary.put path [new_concern file last_modified]) tracker)] (wrap true)) #.None (wrap false)))) -(def: (file-tracker fs directory) - (-> (//.System Promise) (//.Directory Promise) (Promise (Try File-Tracker))) +(def: (file_tracker fs directory) + (-> (//.System Promise) (//.Directory Promise) (Promise (Try File_Tracker))) (do {! (try.with promise.monad)} [files (!.use (\ directory files) [])] (monad.fold ! (function (_ file tracker) (do ! - [last-modified (!.use (\ file last-modified) [])] + [last_modified (!.use (\ file last_modified) [])] (wrap (dictionary.put (!.use (\ file path) []) - [file last-modified] + [file last_modified] tracker)))) - (: File-Tracker + (: File_Tracker (dictionary.new text.hash)) files))) -(def: (poll-files directory file-tracker) - (-> (//.Directory Promise) File-Tracker (Promise (Try (List [//.Path (//.File Promise) Instant])))) +(def: (poll_files directory file_tracker) + (-> (//.Directory Promise) File_Tracker (Promise (Try (List [//.Path (//.File Promise) Instant])))) (do {! (try.with promise.monad)} [files (!.use (\ directory files) [])] (monad.map ! (function (_ file) (do ! - [last-modified (!.use (\ file last-modified) [])] - (wrap [(!.use (\ file path) []) file last-modified]))) + [last_modified (!.use (\ file last_modified) [])] + (wrap [(!.use (\ file path) []) file last_modified]))) files))) -(def: (poll-directory-changes [path [concern directory file-tracker]]) - (-> [//.Path [Concern (//.Directory Promise) File-Tracker]] - (Promise (Try [[//.Path [Concern (//.Directory Promise) File-Tracker]] +(def: (poll_directory_changes [path [concern directory file_tracker]]) + (-> [//.Path [Concern (//.Directory Promise) File_Tracker]] + (Promise (Try [[//.Path [Concern (//.Directory Promise) File_Tracker]] [(List [//.Path (//.File Promise) Instant]) (List [//.Path Instant Instant]) (List [//.Path])]]))) (do {! (try.with promise.monad)} - [current-files (..poll-files directory file-tracker) + [current_files (..poll_files directory file_tracker) #let [creations (if (..creation? concern) - (list.filter (|>> product.left (dictionary.key? file-tracker) not) - current-files) + (list.filter (|>> product.left (dictionary.key? file_tracker) not) + current_files) (list)) - available (|> current-files + available (|> current_files (list\map product.left) - (set.from-list text.hash)) + (set.from_list text.hash)) deletions (if (..deletion? concern) - (|> (dictionary.entries file-tracker) + (|> (dictionary.entries file_tracker) (list\map product.left) (list.filter (|>> (set.member? available) not))) (list)) - modifications (list.all (function (_ [path file current-modification]) + modifications (list.all (function (_ [path file current_modification]) (do maybe.monad - [[_ previous-modification] (dictionary.get path file-tracker)] - (wrap [path previous-modification current-modification]))) - current-files)]] + [[_ previous_modification] (dictionary.get path file_tracker)] + (wrap [path previous_modification current_modification]))) + current_files)]] (wrap [[path [concern directory - (let [with-deletions (list\fold dictionary.remove file-tracker deletions) - with-creations (list\fold (function (_ [path file last-modified] tracker) - (dictionary.put path [file last-modified] tracker)) - with-deletions + (let [with_deletions (list\fold dictionary.remove file_tracker deletions) + with_creations (list\fold (function (_ [path file last_modified] tracker) + (dictionary.put path [file last_modified] tracker)) + with_deletions creations) - with-modifications (list\fold (function (_ [path previous-modification current-modification] tracker) + with_modifications (list\fold (function (_ [path previous_modification current_modification] tracker) (dictionary.update path (function (_ [file _]) - [file current-modification]) + [file current_modification]) tracker)) - with-creations + with_creations modifications)] - with-modifications)]] + with_modifications)]] [creations modifications deletions]]))) (def: #export (polling fs) (-> (//.System Promise) (Watcher Promise)) - (let [tracker (: (Var Directory-Tracker) + (let [tracker (: (Var Directory_Tracker) (stm.var (dictionary.new text.hash)))] (structure - (def: (start new-concern path) + (def: (start new_concern path) (do {! promise.monad} - [updated? (stm.commit (..update-watch! new-concern path tracker))] + [updated? (stm.commit (..update_watch! new_concern path tracker))] (if updated? (wrap (#try.Success [])) (do (try.with !) [directory (!.use (\ fs directory) path) - file-tracker (..file-tracker fs directory)] + file_tracker (..file_tracker fs directory)] (do ! - [_ (stm.commit (stm.update (dictionary.put path [new-concern directory file-tracker]) tracker))] + [_ (stm.commit (stm.update (dictionary.put path [new_concern directory file_tracker]) tracker))] (wrap (#try.Success []))))))) (def: (concern path) (stm.commit (do stm.monad [@tracker (stm.read tracker)] (wrap (case (dictionary.get path @tracker) - (#.Some [concern directory file-tracker]) + (#.Some [concern directory file_tracker]) (#try.Success concern) #.None - (exception.throw ..not-being-watched [path])))))) + (exception.throw ..not_being_watched [path])))))) (def: (stop path) (stm.commit (do {! stm.monad} [@tracker (stm.read tracker)] (case (dictionary.get path @tracker) - (#.Some [concern directory file-tracker]) + (#.Some [concern directory file_tracker]) (do ! [_ (stm.update (dictionary.remove path) tracker)] (wrap (#try.Success concern))) #.None - (wrap (exception.throw ..not-being-watched [path])))))) + (wrap (exception.throw ..not_being_watched [path])))))) (def: (poll _) (do promise.monad [@tracker (stm.commit (stm.read tracker))] (do {! (try.with promise.monad)} [changes (|> @tracker dictionary.entries - (monad.map ! ..poll-directory-changes)) + (monad.map ! ..poll_directory_changes)) _ (do promise.monad [_ (stm.commit (stm.write (|> changes (list\map product.left) - (dictionary.from-list text.hash)) + (dictionary.from_list text.hash)) tracker))] (wrap (#try.Success []))) #let [[creations modifications deletions] (list\fold (function (_ [_ [creations modifications deletions]] - [all-creations all-modifications all-deletions]) - [(list\compose creations all-creations) - (list\compose modifications all-modifications) - (list\compose deletions all-deletions)]) + [all_creations all_modifications all_deletions]) + [(list\compose creations all_creations) + (list\compose modifications all_modifications) + (list\compose deletions all_deletions)]) [(list) (list) (list)] changes)]] (wrap ($_ list\compose - (list\map (function (_ [path file last-modification]) [path ..creation]) creations) + (list\map (function (_ [path file last_modification]) [path ..creation]) creations) (|> modifications - (list.filter (function (_ [path previous-modification current-modification]) - (not (instant\= previous-modification current-modification)))) - (list\map (function (_ [path previous-modification current-modification]) + (list.filter (function (_ [path previous_modification current_modification]) + (not (instant\= previous_modification current_modification)))) + (list\map (function (_ [path previous_modification current_modification]) [path ..modification]))) (list\map (function (_ path) [path ..deletion]) deletions) ))))) @@ -259,7 +259,7 @@ [fs (..polling fs)])) -(with-expansions [<jvm> (as-is (import: java/lang/Object) +(with_expansions [<jvm> (as_is (import: java/lang/Object) (import: java/lang/String) @@ -298,7 +298,7 @@ (#static ENTRY_MODIFY (java/nio/file/WatchEvent$Kind java/nio/file/Path)) (#static ENTRY_DELETE (java/nio/file/WatchEvent$Kind java/nio/file/Path))]) - (def: (default\\event-concern event) + (def: (default\\event_concern event) (All [a] (-> (java/nio/file/WatchEvent a) Concern)) (let [kind (:coerce (java/nio/file/WatchEvent$Kind java/nio/file/Path) @@ -326,11 +326,11 @@ (watchable [] java/nio/file/Watchable) (pollEvents [] #io (java/util/List (java/nio/file/WatchEvent ?)))]) - (def: default\\key-concern + (def: default\\key_concern (-> java/nio/file/WatchKey (IO Concern)) (|>> java/nio/file/WatchKey::pollEvents (\ io.monad map (|>> ..default\\list - (list\map default\\event-concern) + (list\map default\\event_concern) (list\fold ..also ..none))))) (import: java/nio/file/WatchService @@ -350,14 +350,14 @@ (new [java/lang/String]) (toPath [] java/nio/file/Path)]) - (type: Watch-Event + (type: Watch_Event (java/nio/file/WatchEvent$Kind java/lang/Object)) - (def: (default\\start watch-events watcher path) - (-> (List Watch-Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) + (def: (default\\start watch_events watcher path) + (-> (List Watch_Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) (promise.future (java/nio/file/Path::register watcher - (array.from-list watch-events) + (array.from_list watch_events) (|> path java/io/File::new java/io/File::toPath)))) (def: (default\\poll watcher) @@ -377,7 +377,7 @@ (:coerce java/nio/file/Path) java/nio/file/Path::toString (:coerce //.Path))] - concern (..default\\key-concern key)] + concern (..default\\key_concern key)] (recur (#.Cons [path concern] output))) (recur output))) @@ -385,17 +385,17 @@ #.None (wrap output))))) - (def: (watch-events concern) - (-> Concern (List Watch-Event)) + (def: (watch_events concern) + (-> Concern (List Watch_Event)) ($_ list\compose (if (..creation? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) (list)) (if (..modification? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) (list)) (if (..deletion? concern) - (list (:coerce Watch-Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) + (list (:coerce Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) (list)) )) @@ -420,14 +420,14 @@ (wrap (#try.Success concern))) #.None - (wrap (exception.throw ..not-being-watched [path]))))))]] + (wrap (exception.throw ..not_being_watched [path]))))))]] (wrap (: (Watcher Promise) (structure (def: (start concern path) (do promise.monad [?concern (stop path)] (do (try.with promise.monad) - [key (..default\\start (..watch-events (..also (try.default ..none ?concern) + [key (..default\\start (..watch_events (..also (try.default ..none ?concern) concern)) watcher path)] @@ -442,11 +442,11 @@ (wrap (#try.Success concern)) #.None - (wrap (exception.throw ..not-being-watched [path]))))) + (wrap (exception.throw ..not_being_watched [path]))))) (def: stop stop) (def: (poll _) (promise.future (..default\\poll watcher))) ))))) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index eb8a05f9c..049a80dea 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -60,7 +60,7 @@ ## Do not trust the values of environment variables ## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables -(with-expansions [<jvm> (as-is (import: java/lang/String) +(with_expansions [<jvm> (as_is (import: java/lang/String) (import: (java/util/Map$Entry k v) ["#::." @@ -93,44 +93,44 @@ (jvm\\consume f iterator)) #.Nil)) - (def: (jvm\\to-kv entry) + (def: (jvm\\to_kv entry) (All [k v] (-> (java/util/Map$Entry k v) [k v])) [(java/util/Map$Entry::getKey entry) (java/util/Map$Entry::getValue entry)]) (def: jvm\\environment (IO Environment) - (with-expansions [<jvm> (as-is (io.io (|> (java/lang/System::getenv) + (with_expansions [<jvm> (as_is (io.io (|> (java/lang/System::getenv) java/util/Map::entrySet java/util/Set::iterator - (..jvm\\consume ..jvm\\to-kv) - (dictionary.from-list text.hash))))] + (..jvm\\consume ..jvm\\to_kv) + (dictionary.from_list text.hash))))] (for {@.old <jvm> @.jvm <jvm>}))) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) (structure: #export default (Program IO) (def: (environment _) - (with-expansions [<jvm> ..jvm\\environment] + (with_expansions [<jvm> ..jvm\\environment] (for {@.old <jvm> @.jvm <jvm>}))) (def: (home _) - (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] + (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.home")))] (for {@.old <jvm> @.jvm <jvm>}))) (def: (directory _) - (with-expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] + (with_expansions [<jvm> (io.io (maybe.default "" (java/lang/System::getProperty "user.dir")))] (for {@.old <jvm> @.jvm <jvm>}))) (def: (exit code) - (with-expansions [<jvm> (do io.monad + (with_expansions [<jvm> (do io.monad [_ (java/lang/System::exit code)] (wrap (undefined)))] (for {@.old <jvm> diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index aaa686061..273d64039 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -30,14 +30,14 @@ [// [file (#+ Path)]]) -(capability: #export (Can-Read !) - (can-read [] (! (Try Text)))) +(capability: #export (Can_Read !) + (can_read [] (! (Try Text)))) -(capability: #export (Can-Write !) - (can-write Text (! (Try Any)))) +(capability: #export (Can_Write !) + (can_write Text (! (Try Any)))) -(capability: #export (Can-Destroy !) - (can-destroy [] (! (Try Any)))) +(capability: #export (Can_Destroy !) + (can_destroy [] (! (Try Any)))) (type: #export Exit Int) @@ -51,22 +51,22 @@ [+1 error] ) -(capability: #export (Can-Wait !) - (can-wait [] (! (Try Exit)))) +(capability: #export (Can_Wait !) + (can_wait [] (! (Try Exit)))) (signature: #export (Process !) - (: (Can-Read !) + (: (Can_Read !) read) - (: (Can-Read !) + (: (Can_Read !) error) - (: (Can-Write !) + (: (Can_Write !) write) - (: (Can-Destroy !) + (: (Can_Destroy !) destroy) - (: (Can-Wait !) + (: (Can_Wait !) await)) -(def: (async-process process) +(def: (async_process process) (-> (Process IO) (Process Promise)) (`` (structure (~~ (template [<method> <capability>] @@ -75,11 +75,11 @@ (|>> (!.use (\ process <method>)) promise.future)))] - [read ..can-read] - [error ..can-read] - [write ..can-write] - [destroy ..can-destroy] - [await ..can-wait] + [read ..can_read] + [error ..can_read] + [write ..can_write] + [destroy ..can_destroy] + [await ..can_wait] ))))) (type: #export Command @@ -88,23 +88,23 @@ (type: #export Argument Text) -(capability: #export (Can-Execute !) - (can-execute [Environment Path Command (List Argument)] (! (Try (Process !))))) +(capability: #export (Can_Execute !) + (can_execute [Environment Path Command (List Argument)] (! (Try (Process !))))) (signature: #export (Shell !) - (: (Can-Execute !) + (: (Can_Execute !) execute)) (def: #export (async shell) (-> (Shell IO) (Shell Promise)) (structure (def: execute - (..can-execute + (..can_execute (function (_ input) (promise.future (do (try.with io.monad) [process (!.use (\ shell execute) input)] - (wrap (..async-process process))))))))) + (wrap (..async_process process))))))))) (signature: (Policy ?) (: (-> Command (Safe Command ?)) @@ -122,12 +122,12 @@ (def: (replace bad replacer) (-> Text Replacer (-> Text Text)) - (text.replace-all bad (replacer bad))) + (text.replace_all bad (replacer bad))) -(def: sanitize-common-command +(def: sanitize_common_command (-> Replacer (Sanitizer Command)) - (let [x0A (text.from-code (hex "0A")) - xFF (text.from-code (hex "FF"))] + (let [x0A (text.from_code (hex "0A")) + xFF (text.from_code (hex "FF"))] (function (_ replacer) (|>> (..replace x0A replacer) (..replace xFF replacer) @@ -147,49 +147,49 @@ (..replace "[" replacer) (..replace "]" replacer) (..replace "{" replacer) (..replace "}" replacer))))) -(def: (policy sanitize-command sanitize-argument) +(def: (policy sanitize_command sanitize_argument) (Ex [?] (-> (Sanitizer Command) (Sanitizer Argument) (Policy ?))) - (?.with-policy + (?.with_policy (: (Context Safety Policy) (function (_ (^open "?\.")) (structure - (def: command (|>> sanitize-command (!.use ?\can-upgrade))) - (def: argument (|>> sanitize-argument (!.use ?\can-upgrade))) - (def: value (!.use ?\can-downgrade))))))) + (def: command (|>> sanitize_command (!.use ?\can_upgrade))) + (def: argument (|>> sanitize_argument (!.use ?\can_upgrade))) + (def: value (!.use ?\can_downgrade))))))) -(def: unix-policy +(def: unix_policy (let [replacer (: Replacer (|>> (format "\"))) - sanitize-command (: (Sanitizer Command) - (..sanitize-common-command replacer)) - sanitize-argument (: (Sanitizer Argument) + sanitize_command (: (Sanitizer Command) + (..sanitize_common_command replacer)) + sanitize_argument (: (Sanitizer Argument) (|>> (..replace "'" replacer) (text.enclose' "'")))] - (..policy sanitize-command sanitize-argument))) + (..policy sanitize_command sanitize_argument))) -(def: windows-policy +(def: windows_policy (let [replacer (: Replacer (function.constant " ")) - sanitize-command (: (Sanitizer Command) - (|>> (..sanitize-common-command replacer) + sanitize_command (: (Sanitizer Command) + (|>> (..sanitize_common_command replacer) (..replace "%" replacer) (..replace "!" replacer))) - sanitize-argument (: (Sanitizer Argument) + sanitize_argument (: (Sanitizer Argument) (|>> (..replace "%" replacer) (..replace "!" replacer) - (..replace text.double-quote replacer) - (text.enclose' text.double-quote)))] - (..policy sanitize-command sanitize-argument))) + (..replace text.double_quote replacer) + (text.enclose' text.double_quote)))] + (..policy sanitize_command sanitize_argument))) -(with-expansions [<jvm> (as-is (import: java/lang/String +(with_expansions [<jvm> (as_is (import: java/lang/String ["#::." (toLowerCase [] java/lang/String)]) - (def: (jvm::arguments-array arguments) + (def: (jvm::arguments_array arguments) (-> (List Argument) (Array java/lang/String)) (product.right (list\fold (function (_ argument [idx output]) - [(inc idx) (jvm.array-write idx argument output)]) + [(inc idx) (jvm.array_write idx argument output)]) [0 (jvm.array java/lang/String (list.size arguments))] arguments))) @@ -197,7 +197,7 @@ ["#::." (put [k v] v)]) - (def: (jvm::load-environment input target) + (def: (jvm::load_environment input target) (-> Environment (java/util/Map java/lang/String java/lang/String) (java/util/Map java/lang/String java/lang/String)) @@ -234,33 +234,33 @@ (destroy [] #io #try void) (waitFor [] #io #try int)]) - (def: (default-process process) + (def: (default_process process) (-> java/lang/Process (IO (Try (Process IO)))) (do (try.with io.monad) - [jvm-input (java/lang/Process::getInputStream process) - jvm-error (java/lang/Process::getErrorStream process) - jvm-output (java/lang/Process::getOutputStream process) - #let [jvm-input (|> jvm-input + [jvm_input (java/lang/Process::getInputStream process) + jvm_error (java/lang/Process::getErrorStream process) + jvm_output (java/lang/Process::getOutputStream process) + #let [jvm_input (|> jvm_input java/io/InputStreamReader::new java/io/BufferedReader::new) - jvm-error (|> jvm-error + jvm_error (|> jvm_error java/io/InputStreamReader::new java/io/BufferedReader::new)]] (wrap (: (Process IO) (`` (structure (~~ (template [<name> <stream>] [(def: <name> - (..can-read + (..can_read (function (_ _) (java/io/BufferedReader::readLine <stream>))))] - [read jvm-input] - [error jvm-error] + [read jvm_input] + [error jvm_error] )) (def: write - (..can-write + (..can_write (function (_ message) - (|> jvm-output + (|> jvm_output (java/io/OutputStream::write (\ encoding.utf8 encode message)))))) (~~ (template [<name> <capability> <method>] [(def: <name> @@ -268,8 +268,8 @@ (function (_ _) (<method> process))))] - [destroy ..can-destroy java/lang/Process::destroy] - [await ..can-wait java/lang/Process::waitFor] + [destroy ..can_destroy java/lang/Process::destroy] + [await ..can_wait java/lang/Process::waitFor] )))))))) (import: java/io/File @@ -287,63 +287,63 @@ ["#::." (#static getProperty [java/lang/String] #io #try java/lang/String)]) )] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) ## https://en.wikipedia.org/wiki/Code_injection#Shell_injection (def: windows? (IO (Try Bit)) (\ (try.with io.monad) map - (|>> java/lang/String::toLowerCase (text.starts-with? "windows")) + (|>> java/lang/String::toLowerCase (text.starts_with? "windows")) (java/lang/System::getProperty "os.name"))) -(def: (jvm::process-builder policy command arguments) +(def: (jvm::process_builder policy command arguments) (All [?] (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) java/lang/ProcessBuilder)) (|> (list\map (\ policy value) arguments) (list& (\ policy value command)) - ..jvm::arguments-array + ..jvm::arguments_array java/lang/ProcessBuilder::new)) (structure: #export default (Shell IO) (def: execute - (..can-execute - (function (_ [environment working-directory command arguments]) - (with-expansions [<jvm> (as-is (do {! (try.with io.monad)} + (..can_execute + (function (_ [environment working_directory command arguments]) + (with_expansions [<jvm> (as_is (do {! (try.with io.monad)} [windows? ..windows? #let [builder (if windows? - (..jvm::process-builder ..windows-policy - (\ ..windows-policy command command) - (list\map (\ ..windows-policy argument) arguments)) - (..jvm::process-builder ..unix-policy - (\ ..unix-policy command command) - (list\map (\ ..unix-policy argument) arguments)))] + (..jvm::process_builder ..windows_policy + (\ ..windows_policy command command) + (list\map (\ ..windows_policy argument) arguments)) + (..jvm::process_builder ..unix_policy + (\ ..unix_policy command command) + (list\map (\ ..unix_policy argument) arguments)))] _ (|> builder - (java/lang/ProcessBuilder::directory (java/io/File::new working-directory)) + (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)) java/lang/ProcessBuilder::environment - (\ try.functor map (..jvm::load-environment environment)) + (\ try.functor map (..jvm::load_environment environment)) (\ io.monad wrap)) process (java/lang/ProcessBuilder::start builder)] - (..default-process process)))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})))))) + (..default_process process)))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})))))) (signature: #export (Simulation s) (: (-> s (Try [s Text])) - on-read) + on_read) (: (-> s (Try [s Text])) - on-error) + on_error) (: (-> Text s (Try s)) - on-write) + on_write) (: (-> s (Try s)) - on-destroy) + on_destroy) (: (-> s (Try [s Exit])) - on-await)) + on_await)) -(`` (structure: (mock-process simulation state) +(`` (structure: (mock_process simulation state) (All [s] (-> (Simulation s) (Var s) (Process Promise))) (~~ (template [<name> <capability> <simulation>] @@ -362,17 +362,17 @@ (#try.Failure error) (wrap (#try.Failure error))))))))] - [read ..can-read on-read] - [error ..can-read on-error] - [await ..can-wait on-await] + [read ..can_read on_read] + [error ..can_read on_error] + [await ..can_wait on_await] )) (def: write - (..can-write + (..can_write (function (_ message) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-write message |state|) + (case (\ simulation on_write message |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -381,12 +381,12 @@ (#try.Failure error) (wrap (#try.Failure error)))))))) (def: destroy - (..can-destroy + (..can_destroy (function (_ _) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-destroy |state|) + (case (\ simulation on_destroy |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -403,9 +403,9 @@ (Shell Promise))) (def: execute - (..can-execute + (..can_execute (function (_ input) (promise\wrap (do try.monad [simulation (simulation input)] - (wrap (..mock-process simulation (stm.var init))))))))) + (wrap (..mock_process simulation (stm.var init))))))))) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index f8d8d1fa8..b6cfa2c2c 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -43,12 +43,12 @@ (poly: #export equivalence (`` (do {! p.monad} - [#let [g!_ (code.local-identifier "_____________")] + [#let [g!_ (code.local_identifier "_____________")] *env* <type>.env inputT <type>.peek #let [@Equivalence (: (-> Type Code) (function (_ type) - (` ((~! /.Equivalence) (~ (poly.to-code *env* type))))))]] + (` ((~! /.Equivalence) (~ (poly.to_code *env* type))))))]] ($_ p.either ## Basic types (~~ (template [<matcher> <eq>] @@ -109,9 +109,9 @@ (do ! [members (<type>.variant (p.many equivalence)) #let [last (dec (list.size members)) - g!_ (code.local-identifier "_____________") - g!left (code.local-identifier "_____________left") - g!right (code.local-identifier "_____________right")]] + g!_ (code.local_identifier "_____________") + g!left (code.local_identifier "_____________left") + g!right (code.local_identifier "_____________right")]] (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) (~ g!left) (~ g!right)) (case [(~ g!left) (~ g!right)] @@ -129,10 +129,10 @@ ## Tuples (do ! [g!eqs (<type>.tuple (p.many equivalence)) - #let [g!_ (code.local-identifier "_____________") + #let [g!_ (code.local_identifier "_____________") indices (list.indices (list.size g!eqs)) - g!lefts (list\map (|>> nat\encode (text\compose "left") code.local-identifier) indices) - g!rights (list\map (|>> nat\encode (text\compose "right") code.local-identifier) indices)]] + g!lefts (list\map (|>> nat\encode (text\compose "left") code.local_identifier) indices) + g!rights (list\map (|>> nat\encode (text\compose "right") code.local_identifier) indices)]] (wrap (` (: (~ (@Equivalence inputT)) (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) (and (~+ (|> (list.zip/3 g!eqs g!lefts g!rights) @@ -141,11 +141,11 @@ ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) - #let [g!_ (code.local-identifier "_____________")]] + #let [g!_ (code.local_identifier "_____________")]] (wrap (` (: (~ (@Equivalence inputT)) ((~! /.rec) (.function ((~ g!_) (~ g!self)) (~ bodyC))))))) - <type>.recursive-self + <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.apply (p.and equivalence (p.many equivalence)))] @@ -157,10 +157,10 @@ [[funcC varsC bodyC] (<type>.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) - <type>.recursive-call + <type>.recursive_call ## If all else fails... (|> <type>.any (\ ! map (|>> %.type (format "Cannot create Equivalence for: ") p.fail)) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index d640d4205..70f4f9b64 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -25,27 +25,27 @@ (poly: #export functor (do {! p.monad} - [#let [type-funcC (code.local-identifier "____________type-funcC") - funcC (code.local-identifier "____________funcC") - inputC (code.local-identifier "____________inputC")] + [#let [type_funcC (code.local_identifier "____________type_funcC") + funcC (code.local_identifier "____________funcC") + inputC (code.local_identifier "____________inputC")] *env* <type>.env inputT <type>.peek - [polyC varsC non-functorT] (<type>.local (list inputT) + [polyC varsC non_functorT] (<type>.local (list inputT) (<type>.polymorphic <type>.any)) - #let [num-vars (list.size varsC)] + #let [num_vars (list.size varsC)] #let [@Functor (: (-> Type Code) (function (_ unwrappedT) - (if (n.= 1 num-vars) - (` ((~! /.Functor) (~ (poly.to-code *env* unwrappedT)))) - (let [paramsC (|> num-vars dec list.indices (list\map (|>> %.nat code.local-identifier)))] + (if (n.= 1 num_vars) + (` ((~! /.Functor) (~ (poly.to_code *env* unwrappedT)))) + (let [paramsC (|> num_vars dec list.indices (list\map (|>> %.nat code.local_identifier)))] (` (All [(~+ paramsC)] - ((~! /.Functor) ((~ (poly.to-code *env* unwrappedT)) (~+ paramsC))))))))) + ((~! /.Functor) ((~ (poly.to_code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (: (-> Code (<type>.Parser Code)) (function (Arg<?> valueC) ($_ p.either ## Type-var (do p.monad - [#let [varI (|> num-vars (n.* 2) dec)] + [#let [varI (|> num_vars (n.* 2) dec)] _ (<type>.parameter! varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants @@ -67,7 +67,7 @@ (<type>.tuple (loop [idx 0 pairsCC (: (List [Code Code]) (list))] - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local-identifier)] + (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_identifier)] (do ! [_ (wrap []) memberC (Arg<?> slotC)] @@ -80,19 +80,19 @@ ## Functions (do ! [_ (wrap []) - #let [g! (code.local-identifier "____________") - outL (code.local-identifier "____________outL")] + #let [g! (code.local_identifier "____________") + outL (code.local_identifier "____________outL")] [inT+ outC] (<type>.function (p.many <type>.any) (Arg<?> outL)) #let [inC+ (|> (list.size inT+) list.indices - (list\map (|>> %.nat (format "____________inC") code.local-identifier)))]] + (list\map (|>> %.nat (format "____________inC") code.local_identifier)))]] (wrap (` (function ((~ g!) (~+ inC+)) (let [(~ outL) ((~ valueC) (~+ inC+))] (~ outC)))))) ## Recursion (do p.monad - [_ <type>.recursive-call] + [_ <type>.recursive_call] (wrap (` ((~' map) (~ funcC) (~ valueC))))) ## Parameters (do p.monad diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 3cba2eb3b..58784dccd 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -44,22 +44,22 @@ (-> Nat Frac) (|>> .int int.frac)) -(def: (rec-encode non-rec) +(def: (rec_encode non_rec) (All [a] (-> (-> (-> a JSON) (-> a JSON)) (-> a JSON))) (function (_ input) - (non-rec (rec-encode non-rec) input))) + (non_rec (rec_encode non_rec) input))) -(def: low-mask Nat (|> 1 (i64.left-shift 32) dec)) -(def: high-mask Nat (|> low-mask (i64.left-shift 32))) +(def: low_mask Nat (|> 1 (i64.left_shift 32) dec)) +(def: high_mask Nat (|> low_mask (i64.left_shift 32))) -(structure: nat-codec +(structure: nat_codec (codec.Codec JSON Nat) (def: (encode input) - (let [high (|> input (i64.and high-mask) (i64.logic-right-shift 32)) - low (i64.and low-mask input)] + (let [high (|> input (i64.and high_mask) (i64.logic_right_shift 32)) + low (i64.and low_mask input)] (#/.Array (row (|> high .int int.frac #/.Number) (|> low .int int.frac #/.Number))))) (def: decode @@ -67,15 +67,15 @@ (do <>.monad [high </>.number low </>.number] - (wrap (n.+ (|> high frac.int .nat (i64.left-shift 32)) + (wrap (n.+ (|> high frac.int .nat (i64.left_shift 32)) (|> low frac.int .nat)))))))) -(structure: int-codec +(structure: int_codec (codec.Codec JSON Int) - (def: encode (|>> .nat (\ nat-codec encode))) + (def: encode (|>> .nat (\ nat_codec encode))) (def: decode - (|>> (\ nat-codec decode) (\ try.functor map .int)))) + (|>> (\ nat_codec decode) (\ try.functor map .int)))) (def: (nullable writer) {#.doc "Builds a JSON generator for potentially inexistent values."} @@ -85,28 +85,28 @@ #.None #/.Null (#.Some value) (writer value)))) -(structure: qty-codec +(structure: qty_codec (All [unit] (codec.Codec JSON (unit.Qty unit))) (def: encode - (|>> unit.out (\ ..int-codec encode))) + (|>> unit.out (\ ..int_codec encode))) (def: decode - (|>> (\ ..int-codec decode) (\ try.functor map unit.in)))) + (|>> (\ ..int_codec decode) (\ try.functor map unit.in)))) (poly: encode - (with-expansions + (with_expansions [<basic> (template [<matcher> <encoder>] [(do ! - [#let [g!_ (code.local-identifier "_______")] + [#let [g!_ (code.local_identifier "_______")] _ <matcher>] (wrap (` (: (~ (@JSON\encode inputT)) <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] [(<type>.sub Bit) (|>> #/.Boolean)] - [(<type>.sub Nat) (\ (~! ..nat-codec) (~' encode))] - [(<type>.sub Int) (\ (~! ..int-codec) (~' encode))] + [(<type>.sub Nat) (\ (~! ..nat_codec) (~' encode))] + [(<type>.sub Int) (\ (~! ..int_codec) (~' encode))] [(<type>.sub Frac) (|>> #/.Number)] [(<type>.sub Text) (|>> #/.String)]) <time> (template [<type> <codec>] @@ -124,7 +124,7 @@ [*env* <type>.env #let [@JSON\encode (: (-> Type Code) (function (_ type) - (` (-> (~ (poly.to-code *env* type)) /.JSON))))] + (` (-> (~ (poly.to_code *env* type)) /.JSON))))] inputT <type>.peek] ($_ <>.either <basic> @@ -133,11 +133,11 @@ [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON\encode inputT)) - (\ (~! qty-codec) (~' encode)))))) + (\ (~! qty_codec) (~' encode)))))) (do ! - [#let [g!_ (code.local-identifier "_______") - g!key (code.local-identifier "_______key") - g!val (code.local-identifier "_______val")] + [#let [g!_ (code.local_identifier "_______") + g!key (code.local_identifier "_______key") + g!val (code.local_identifier "_______val")] [_ _ =val=] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) @@ -146,7 +146,7 @@ (|>> ((~! d.entries)) ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! d.from-list) (~! text.hash)) + ((~! d.from_list) (~! text.hash)) #/.Object))))) (do ! [[_ =sub=] (<type>.apply ($_ <>.and @@ -159,10 +159,10 @@ (<type>.exactly .List) encode))] (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! list\map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) + (|>> ((~! list\map) (~ =sub=)) ((~! row.from_list)) #/.Array))))) (do ! - [#let [g!_ (code.local-identifier "_______") - g!input (code.local-identifier "_______input")] + [#let [g!_ (code.local_identifier "_______") + g!input (code.local_identifier "_______input")] members (<type>.variant (<>.many encode)) #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON\encode inputT)) @@ -181,10 +181,10 @@ (list.enumeration members)))))))))) (do ! [g!encoders (<type>.tuple (<>.many encode)) - #let [g!_ (code.local-identifier "_______") + #let [g!_ (code.local_identifier "_______") g!members (|> (list.size g!encoders) list.indices - (list\map (|>> n\encode code.local-identifier)))]] + (list\map (|>> n\encode code.local_identifier)))]] (wrap (` (: (~ (@JSON\encode inputT)) (function ((~ g!_) [(~+ g!members)]) ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) @@ -192,12 +192,12 @@ (list.zip/2 g!members g!encoders)))])))))) ## Type recursion (do ! - [[selfC non-recC] (<type>.recursive encode) - #let [g! (code.local-identifier "____________")]] + [[selfC non_recC] (<type>.recursive encode) + #let [g! (code.local_identifier "____________")]] (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..rec-encode) (.function ((~ g!) (~ selfC)) - (~ non-recC))))))) - <type>.recursive-self + ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) + <type>.recursive_self ## Type applications (do ! [partsC (<type>.apply (<>.many encode))] @@ -208,18 +208,18 @@ (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) varsC)) - (-> ((~ (poly.to-code *env* inputT)) (~+ varsC)) + (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) /.JSON))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) <type>.parameter - <type>.recursive-call + <type>.recursive_call ## If all else fails... (<>.fail (format "Cannot create JSON encoder for: " (type.format inputT))) )))) (poly: decode - (with-expansions + (with_expansions [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] @@ -228,8 +228,8 @@ [(<type>.exactly Any) </>.null] [(<type>.sub Bit) </>.boolean] - [(<type>.sub Nat) (<>.codec ..nat-codec </>.any)] - [(<type>.sub Int) (<>.codec ..int-codec </>.any)] + [(<type>.sub Nat) (<>.codec ..nat_codec </>.any)] + [(<type>.sub Int) (<>.codec ..int_codec </>.any)] [(<type>.sub Frac) </>.number] [(<type>.sub Text) </>.string]) <time> (template [<type> <codec>] @@ -247,7 +247,7 @@ [*env* <type>.env #let [@JSON\decode (: (-> Type Code) (function (_ type) - (` (</>.Parser (~ (poly.to-code *env* type))))))] + (` (</>.Parser (~ (poly.to_code *env* type))))))] inputT <type>.peek] ($_ <>.either <basic> @@ -256,7 +256,7 @@ [unitT (<type>.apply (<>.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! qty-codec) (~! </>.any)))))) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.apply ($_ <>.and (<type>.exactly d.Dictionary) @@ -297,11 +297,11 @@ ## Type recursion (do ! [[selfC bodyC] (<type>.recursive decode) - #let [g! (code.local-identifier "____________")]] + #let [g! (code.local_identifier "____________")]] (wrap (` (: (~ (@JSON\decode inputT)) ((~! <>.rec) (.function ((~ g!) (~ selfC)) (~ bodyC))))))) - <type>.recursive-self + <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.apply (<>.and decode (<>.many decode)))] @@ -311,11 +311,11 @@ [[funcC varsC bodyC] (<type>.polymorphic decode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) <type>.parameter - <type>.recursive-call + <type>.recursive_call ## If all else fails... (<>.fail (format "Cannot create JSON decoder for: " (type.format inputT))) )))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 4e78183f1..67c4e89f3 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -62,10 +62,10 @@ (def: repositories (-> /.Profile (List (Repository Promise))) (|>> (get@ #/.repositories) - set.to-list + set.to_list (list\map (|>> (/repository.remote #.None) /repository.async)))) -(def: (with-dependencies program console command profile) +(def: (with_dependencies program console command profile) (All [a] (-> (Program Promise) (Console Promise) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command a)) @@ -74,7 +74,7 @@ [resolution (/command/deps.do! program console (file.async file.default) (..repositories profile) profile)] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile))) -(exception: (cannot-find-repository {repository Text} +(exception: (cannot_find_repository {repository Text} {options (Dictionary Text Address)}) (exception.report ["Repository" (%.text repository)] @@ -146,7 +146,7 @@ (#/cli.Deploy repository identity) (..command (case [(get@ #/.identity profile) - (dictionary.get repository (get@ #/.deploy-repositories profile))] + (dictionary.get repository (get@ #/.deploy_repositories profile))] [(#.Some artifact) (#.Some repository)] (/command/deploy.do! console (/repository.async (/repository.remote (#.Some identity) repository)) @@ -155,10 +155,10 @@ profile) [#.None _] - (promise\wrap (exception.throw /.no-identity [])) + (promise\wrap (exception.throw /.no_identity [])) [_ #.None] - (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))) + (promise\wrap (exception.throw ..cannot_find_repository [repository (get@ #/.deploy_repositories profile)])))) #/cli.Dependencies (..command @@ -167,9 +167,9 @@ (#/cli.Compilation compilation) (case compilation #/cli.Build (..command - (..with-dependencies program console /command/build.do! profile)) + (..with_dependencies program console /command/build.do! profile)) #/cli.Test (..command - (..with-dependencies program console /command/test.do! profile))) + (..with_dependencies program console /command/test.do! profile))) (#/cli.Auto auto) (do ! @@ -181,6 +181,6 @@ (#try.Success watcher) (..command (case auto - #/cli.Build (..with-dependencies program console (/command/auto.do! watcher /command/build.do!) profile) - #/cli.Test (..with-dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))))) + #/cli.Build (..with_dependencies program console (/command/auto.do! watcher /command/build.do!) profile) + #/cli.Test (..with_dependencies program console (/command/auto.do! watcher /command/test.do!) profile))))))) )))))) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index e4fe812f1..6ba0a1e48 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -45,28 +45,28 @@ Text <separator>)] - ["." group-separator] - ["-" version-separator] - [":" identity-separator] + ["." group_separator] + ["-" version_separator] + [":" identity_separator] ) (def: #export (identity artifact) (-> Artifact Text) (%.format (get@ #name artifact) - ..version-separator + ..version_separator (get@ #version artifact))) (def: #export (format value) (Format Artifact) (%.format (get@ #group value) - ..identity-separator + ..identity_separator (..identity value))) (def: #export (directory separator group) (-> Text Group Text) (|> group - (text.split-all-with ..group-separator) - (text.join-with separator))) + (text.split_all_with ..group_separator) + (text.join_with separator))) (def: (address separator artifact) (-> Text Artifact Text) @@ -91,6 +91,6 @@ (-> Artifact (List Text)) (list\compose (|> artifact (get@ #group) - (text.split-all-with ..group-separator)) + (text.split_all_with ..group_separator)) (list (get@ #name artifact) (get@ #version artifact)))) diff --git a/stdlib/source/program/aedifex/artifact/extension.lux b/stdlib/source/program/aedifex/artifact/extension.lux index e108a3727..ad0122512 100644 --- a/stdlib/source/program/aedifex/artifact/extension.lux +++ b/stdlib/source/program/aedifex/artifact/extension.lux @@ -20,15 +20,15 @@ (def: #export type (-> Extension //.Type) - (text.replace-all ..separator "")) + (text.replace_all ..separator "")) (template [<name>] [(def: #export <name> Extension (..extension (template.identifier [//._] [<name>])))] - [lux-library] - [jvm-library] + [lux_library] + [jvm_library] [pom] [sha-1] [md5] diff --git a/stdlib/source/program/aedifex/artifact/type.lux b/stdlib/source/program/aedifex/artifact/type.lux index 5e5772ea2..5c9ba8bb2 100644 --- a/stdlib/source/program/aedifex/artifact/type.lux +++ b/stdlib/source/program/aedifex/artifact/type.lux @@ -10,8 +10,8 @@ Type <type>)] - ["tar" lux-library] - ["jar" jvm-library] + ["tar" lux_library] + ["jar" jvm_library] ["pom" pom] ["sha1" sha-1] ["md5" md5] diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index ce95f65b7..d36bb8dff 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -39,10 +39,10 @@ (-> (file.System Promise) Binary Path (Promise (Try Any))) (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad system file))] - (!.use (\ file over-write) [content]))) + (file.get_file promise.monad system file))] + (!.use (\ file over_write) [content]))) -(def: (write-hashed system directory [artifact type] [data status]) +(def: (write_hashed system directory [artifact type] [data status]) (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any))) (let [prefix (format directory (\ system separator) @@ -50,7 +50,7 @@ (//artifact/extension.extension type))] (do {! (try.with promise.monad)} [_ (..write! system data prefix) - #let [write-hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) + #let [write_hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any)))) (function (_ codec extension hash) (..write! system (|> hash (\ codec encode) (\ encoding.utf8 encode)) @@ -62,40 +62,40 @@ (#//dependency/status.Partial partial) (case partial (#.Left sha-1) - (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1) + (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1) (#.Right md5) - (write-hash //hash.md5-codec //artifact/extension.md5 md5)) + (write_hash //hash.md5_codec //artifact/extension.md5 md5)) (#//dependency/status.Verified sha-1 md5) (do ! - [_ (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)] - (write-hash //hash.md5-codec //artifact/extension.md5 md5)))))) + [_ (write_hash //hash.sha-1_codec //artifact/extension.sha-1 sha-1)] + (write_hash //hash.md5_codec //artifact/extension.md5 md5)))))) -(def: #export (write-one program system [artifact type] package) +(def: #export (write_one program system [artifact type] package) (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact))) (do promise.monad [home (\ program home [])] (do (try.with promise.monad) [directory (: (Promise (Try Path)) - (file.make-directories promise.monad system (//.path system home artifact))) - _ (write-hashed system directory [artifact type] (get@ #//package.library package)) + (file.make_directories promise.monad system (//.path system home artifact))) + _ (write_hashed system directory [artifact type] (get@ #//package.library package)) _ (let [[pom status] (get@ #//package.pom package)] - (write-hashed system directory + (write_hashed system directory [artifact //artifact/type.pom] [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) status]))] (wrap artifact)))) -(def: #export (write-all program system resolution) +(def: #export (write_all program system resolution) (-> (Program Promise) (file.System Promise) Resolution (Promise (Try (Set Artifact)))) (do {! (try.with promise.monad)} [] (|> (dictionary.entries resolution) (list.filter (|>> product.right //package.local? not)) (monad.map ! (function (_ [dependency package]) - (..write-one program system dependency package))) - (\ ! map (set.from-list //artifact.hash))))) + (..write_one program system dependency package))) + (\ ! map (set.from_list //artifact.hash))))) (def: (read! system path) (-> (file.System Promise) Path (Promise (Try Binary))) @@ -112,7 +112,7 @@ (_\map (\ codec decode)) _\join))) -(def: #export (read-one program system [artifact type]) +(def: #export (read_one program system [artifact type]) (-> (Program Promise) (file.System Promise) Dependency (Promise (Try Package))) (do promise.monad [home (\ program home []) @@ -123,18 +123,18 @@ [pom (..read! system (format prefix //artifact/extension.pom)) #let [extension (//artifact/extension.extension type)] library (..read! system (format prefix extension)) - library-sha-1 (..read! system (format prefix extension //artifact/extension.sha-1)) - library-md5 (..read! system (format prefix extension //artifact/extension.md5))] + library_sha-1 (..read! system (format prefix extension //artifact/extension.sha-1)) + library_md5 (..read! system (format prefix extension //artifact/extension.md5))] (\ promise.monad wrap (do try.monad [pom (..decode xml.codec pom) - library-sha-1 (..decode //hash.sha-1-codec library-sha-1) - library-md5 (..decode //hash.md5-codec library-md5)] + library_sha-1 (..decode //hash.sha-1_codec library_sha-1) + library_md5 (..decode //hash.md5_codec library_md5)] (wrap {#//package.origin #//package.Local - #//package.library [library (#//dependency/status.Verified library-sha-1 library-md5)] + #//package.library [library (#//dependency/status.Verified library_sha-1 library_md5)] #//package.pom [pom #//dependency/status.Unverified]})))))) -(def: #export (read-all program system dependencies resolution) +(def: #export (read_all program system dependencies resolution) (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) (case dependencies #.Nil @@ -147,17 +147,17 @@ (wrap (#try.Success package)) #.None - (..read-one program system head))] - (with-expansions [<next> (as-is (read-all program system tail resolution))] + (..read_one program system head))] + (with_expansions [<next> (as_is (read_all program system tail resolution))] (case package (#try.Success package) (do (try.with promise.monad) - [sub-dependencies (|> package + [sub_dependencies (|> package //package.dependencies (\ promise.monad wrap)) resolution (|> resolution (dictionary.put head package) - (read-all program system (set.to-list sub-dependencies)))] + (read_all program system (set.to_list sub_dependencies)))] <next>) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 4625136a3..f2f502bac 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -18,16 +18,16 @@ #Build #Test) -(structure: any-equivalence +(structure: any_equivalence (Equivalence Any) (def: (= reference subject) true)) -(def: compilation-equivalence +(def: compilation_equivalence (Equivalence Compilation) - (sum.equivalence ..any-equivalence - ..any-equivalence)) + (sum.equivalence ..any_equivalence + ..any_equivalence)) (def: compilation (Parser Compilation) @@ -48,24 +48,24 @@ (Equivalence Command) ($_ sum.equivalence ## #Version - ..any-equivalence + ..any_equivalence ## #Clean - ..any-equivalence + ..any_equivalence ## #POM - ..any-equivalence + ..any_equivalence ## #Dependencies - ..any-equivalence + ..any_equivalence ## #Install - ..any-equivalence + ..any_equivalence ## #Deploy ($_ product.equivalence text.equivalence text.equivalence text.equivalence) ## #Compilation - ..compilation-equivalence + ..compilation_equivalence ## #Auto - ..compilation-equivalence)) + ..compilation_equivalence)) (def: command' (Parser Command) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 4b151861b..afce4d6ff 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -53,11 +53,11 @@ (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any)))) (function (_ console program fs shell resolution) (function (_ profile) - (with-expansions [<call> ((command console program fs shell resolution) profile)] + (with_expansions [<call> ((command console program fs shell resolution) profile)] (do {! promise.monad} [targets (|> profile (get@ #///.sources) - set.to-list + set.to_list (monad.map ! (..targets fs)) (\ ! map list.concat))] (do {! ///action.monad} diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index de8ceb991..cb4465edd 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -42,7 +42,7 @@ (type: Finder (-> Resolution (Maybe Dependency))) -(def: (dependency-finder group name) +(def: (dependency_finder group name) (-> Group Name Finder) (|>> dictionary.entries (list.one (function (_ [dependency package]) @@ -51,60 +51,60 @@ (#.Some dependency) #.None))))) -(def: #export lux-group +(def: #export lux_group Group "com.github.luxlang") -(def: #export jvm-compiler-name +(def: #export jvm_compiler_name Name "lux-jvm") -(def: #export js-compiler-name +(def: #export js_compiler_name Name "lux-js") (template [<finder> <name>] [(def: <finder> Finder - (..dependency-finder ..lux-group <name>))] + (..dependency_finder ..lux_group <name>))] - [jvm-compiler ..jvm-compiler-name] - [js-compiler ..js-compiler-name] + [jvm_compiler ..jvm_compiler_name] + [js_compiler ..js_compiler_name] ) -(exception: #export no-available-compiler) -(exception: #export no-specified-program) -(exception: #export no-specified-target) +(exception: #export no_available_compiler) +(exception: #export no_specified_program) +(exception: #export no_specified_target) (type: #export Compiler (#JVM Artifact) (#JS Artifact)) -(def: (remove-dependency dependency) +(def: (remove_dependency dependency) (-> Dependency (-> Resolution Resolution)) (|>> dictionary.entries (list.filter (|>> product.left (is? dependency) not)) - (dictionary.from-list ///dependency.hash))) + (dictionary.from_list ///dependency.hash))) (def: (compiler resolution) (-> Resolution (Try [Resolution Compiler])) - (case [(..jvm-compiler resolution) - (..js-compiler resolution)] + (case [(..jvm_compiler resolution) + (..js_compiler resolution)] [(#.Some dependency) _] - (#try.Success [(..remove-dependency dependency resolution) + (#try.Success [(..remove_dependency dependency resolution) (#JVM (get@ #///dependency.artifact dependency))]) [_ (#.Some dependency)] - (#try.Success [(..remove-dependency dependency resolution) + (#try.Success [(..remove_dependency dependency resolution) (#JS (get@ #///dependency.artifact dependency))]) _ - (exception.throw ..no-available-compiler []))) + (exception.throw ..no_available_compiler []))) (def: (libraries fs home) (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library))) + (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library))) (list\map (|>> (get@ #///dependency.artifact) (///local.path fs home))))) (def: (singular name) @@ -124,16 +124,16 @@ (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] - (promise\wrap (exception.throw ..no-specified-program [])) + (promise\wrap (exception.throw ..no_specified_program [])) [_ #.None] - (promise\wrap (exception.throw ..no-specified-target [])) + (promise\wrap (exception.throw ..no_specified_target [])) - [(#.Some program-module) (#.Some target)] + [(#.Some program_module) (#.Some target)] (do promise.monad [environment (\ program environment []) home (\ program home []) - working-directory (\ program directory [])] + working_directory (\ program directory [])] (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) #let [[command output] (let [[compiler output] (case compiler @@ -143,20 +143,20 @@ "program.js"])] [(format compiler " build") output]) / (\ fs separator) - cache-directory (format working-directory / target)] - _ (console.write-line ..start console) + cache_directory (format working_directory / target)] + _ (console.write_line ..start console) process (!.use (\ shell execute) [environment - working-directory + working_directory command (list.concat (list (..plural "--library" (..libraries fs home resolution)) - (..plural "--source" (set.to-list (get@ #///.sources profile))) - (..singular "--target" cache-directory) - (..singular "--module" program-module)))]) + (..plural "--source" (set.to_list (get@ #///.sources profile))) + (..singular "--target" cache_directory) + (..singular "--module" program_module)))]) exit (!.use (\ process await) []) - _ (console.write-line (if (i.= shell.normal exit) + _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) console)] (wrap [compiler - (format cache-directory / output)]))))) + (format cache_directory / output)]))))) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index 7f942fc00..900de2cc4 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -16,7 +16,7 @@ ["#" profile] ["#." action (#+ Action)]]) -(def: (clean-files! root) +(def: (clean_files! root) (-> (Directory Promise) (Promise (Try Any))) (do {! ///action.monad} [nodes (: (Promise (Try (List (File Promise)))) @@ -41,12 +41,12 @@ (!.use (\ fs directory) target)) _ (loop [root target] (do ! - [_ (..clean-files! root) + [_ (..clean_files! root) subs (: (Promise (Try (List (Directory Promise)))) (!.use (\ root directories) [])) _ (monad.map ! recur subs)] (!.use (\ root discard) [])))] - (console.write-line ..success console)) + (console.write_line ..success console)) #.None - (console.write-line ..failure console))) + (console.write_line ..failure console))) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 5763c1ff5..1f84567f0 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -47,7 +47,7 @@ (def: epoch Instant - (instant.from-millis +0)) + (instant.from_millis +0)) (template [<name> <type> <uri> <parser> <default>] [(def: (<name> repository artifact) @@ -65,37 +65,37 @@ (#try.Failure error) (wrap (#try.Success <default>)))))] - [read-project-metadata ///metadata/artifact.Metadata ///metadata.project ///metadata/artifact.parser + [read_project_metadata ///metadata/artifact.Metadata ///metadata.project ///metadata/artifact.parser (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact] {#///metadata/artifact.group group #///metadata/artifact.name name #///metadata/artifact.versions (list) - #///metadata/artifact.last-updated ..epoch})] - [read-version-metadata ///metadata/snapshot.Metadata ///metadata.version ///metadata/snapshot.parser + #///metadata/artifact.last_updated ..epoch})] + [read_version_metadata ///metadata/snapshot.Metadata ///metadata.version ///metadata/snapshot.parser (let [(^slots [#///artifact.group #///artifact.name #///artifact.version]) artifact] {#///metadata/snapshot.group group #///metadata/snapshot.name name #///metadata/snapshot.version version - #///metadata/snapshot.versioning {#///metadata/snapshot.time-stamp ..epoch + #///metadata/snapshot.versioning {#///metadata/snapshot.time_stamp ..epoch #///metadata/snapshot.build 0 #///metadata/snapshot.snapshot (list)}})] ) -(def: snapshot-artifacts +(def: snapshot_artifacts (List ///artifact/type.Type) (list ///artifact/type.pom (format ///artifact/type.pom ///artifact/extension.sha-1) (format ///artifact/type.pom ///artifact/extension.md5) - ///artifact/type.lux-library - (format ///artifact/type.lux-library ///artifact/extension.sha-1) - (format ///artifact/type.lux-library ///artifact/extension.md5))) + ///artifact/type.lux_library + (format ///artifact/type.lux_library ///artifact/extension.sha-1) + (format ///artifact/type.lux_library ///artifact/extension.md5))) (def: #export (do! console repository fs artifact profile) (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any)) (let [deploy! (: (-> Extension Binary (Action Any)) (|>> (///repository.uri artifact) (\ repository upload))) - fully-deploy! (: (-> Extension Binary (Action Any)) + fully_deploy! (: (-> Extension Binary (Action Any)) (function (_ extension payload) (do ///action.monad [_ (deploy! extension payload) @@ -108,31 +108,31 @@ (do promise.monad [now (promise.future instant.now)] (do {! ///action.monad} - [project (..read-project-metadata repository artifact) - snapshot (..read-version-metadata repository artifact) + [project (..read_project_metadata repository artifact) + snapshot (..read_version_metadata repository artifact) pom (\ ! map (|>> (\ xml.codec encode) (\ encoding.utf8 encode)) (promise\wrap (///pom.write profile))) library (|> profile (get@ #/.sources) - set.to-list + set.to_list (export.library fs) (\ ! map (binary.run tar.writer))) - _ (fully-deploy! ///artifact/extension.pom pom) - _ (fully-deploy! ///artifact/extension.lux-library library) + _ (fully_deploy! ///artifact/extension.pom pom) + _ (fully_deploy! ///artifact/extension.lux_library library) _ (|> snapshot - (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.time-stamp] now) + (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.time_stamp] now) (update@ [#///metadata/snapshot.versioning #///metadata/snapshot.build] inc) - (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.snapshot] ..snapshot-artifacts) + (set@ [#///metadata/snapshot.versioning #///metadata/snapshot.snapshot] ..snapshot_artifacts) ///metadata/snapshot.write (\ xml.codec encode) (\ encoding.utf8 encode) (\ repository upload (///metadata.version artifact))) _ (|> project (set@ #///metadata/artifact.versions (list version)) - (set@ #///metadata/artifact.last-updated now) + (set@ #///metadata/artifact.last_updated now) ///metadata/artifact.write (\ xml.codec encode) (\ encoding.utf8 encode) (\ repository upload (///metadata.project artifact)))] - (console.write-line //clean.success console))))) + (console.write_line //clean.success console))))) diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index dbb277948..315c6375c 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -27,9 +27,9 @@ (def: #export (do! program console fs repositories profile) (-> (Program Promise) (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution)) (do ///action.monad - [#let [dependencies (set.to-list (get@ #///.dependencies profile))] - cache (///cache.read-all program fs dependencies ///dependency/resolution.empty) + [#let [dependencies (set.to_list (get@ #///.dependencies profile))] + cache (///cache.read_all program fs dependencies ///dependency/resolution.empty) resolution (///dependency/resolution.all repositories dependencies cache) - cached (///cache.write-all program fs resolution) - _ (console.write-line //clean.success console)] + cached (///cache.write_all program fs resolution) + _ (console.write_line //clean.success console)] (wrap resolution))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 67dc242ac..033b41b40 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -42,8 +42,8 @@ (-> (file.System Promise) Binary Path (Promise (Try Any))) (do (try.with promise.monad) [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad system file))] - (!.use (\ file over-write) [content]))) + (file.get_file promise.monad system file))] + (!.use (\ file over_write) [content]))) (def: #export failure "Failure: No 'identity' defined for the project.") @@ -55,16 +55,16 @@ (do promise.monad [home (\ program home [])] (do ///action.monad - [package (export.library system (set.to-list (get@ #/.sources profile))) + [package (export.library system (set.to_list (get@ #/.sources profile))) repository (: (Promise (Try Path)) - (file.make-directories promise.monad system (///local.path system home identity))) - #let [artifact-name (format repository (\ system separator) (///artifact.identity identity))] + (file.make_directories promise.monad system (///local.path system home identity))) + #let [artifact_name (format repository (\ system separator) (///artifact.identity identity))] _ (..save! system (binary.run tar.writer package) - (format artifact-name ///artifact/extension.lux-library)) + (format artifact_name ///artifact/extension.lux_library)) pom (\ promise.monad wrap (///pom.write profile)) _ (..save! system (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) - (format artifact-name ///artifact/extension.pom))] - (console.write-line //clean.success console))) + (format artifact_name ///artifact/extension.pom))] + (console.write_line //clean.success console))) _ - (console.write-line ..failure console))) + (console.write_line ..failure console))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 618c6b4b9..390d7d7d2 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -29,10 +29,10 @@ (do ///action.monad [pom (promise\wrap (///pom.write profile)) file (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs ///pom.file)) + (file.get_file promise.monad fs ///pom.file)) outcome (|> pom (\ xml.codec encode) (\ encoding.utf8 encode) - (!.use (\ file over-write))) - _ (console.write-line //clean.success console)] + (!.use (\ file over_write))) + _ (console.write_line //clean.success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 089417b94..2727fc461 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -34,19 +34,19 @@ (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any)) (do promise.monad [environment (\ program environment []) - working-directory (\ program directory [])] + working_directory (\ program directory [])] (do ///action.monad [[compiler program] (//build.do! console program fs shell resolution profile) - _ (console.write-line ..start console) + _ (console.write_line ..start console) process (!.use (\ shell execute) [environment - working-directory + working_directory (case compiler (#//build.JVM artifact) (///runtime.java program) (#//build.JS artifact) (///runtime.node program)) (list)]) exit (!.use (\ process await) []) - _ (console.write-line (if (i.= shell.normal exit) + _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) console)] diff --git a/stdlib/source/program/aedifex/command/version.lux b/stdlib/source/program/aedifex/command/version.lux index 076d2a71d..be40d54eb 100644 --- a/stdlib/source/program/aedifex/command/version.lux +++ b/stdlib/source/program/aedifex/command/version.lux @@ -16,5 +16,5 @@ (def: #export (do! console profile) (-> (Console Promise) (Command Any)) - (console.write-line (version.format language/lux.version) + (console.write_line (version.format language/lux.version) console)) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index f49d1da56..11c3cd057 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -48,11 +48,11 @@ ["Extension" (%.text extension)] ["Hash" (%.text hash)]))] - [sha-1-does-not-match] - [md5-does-not-match] + [sha-1_does_not_match] + [md5_does_not_match] ) -(def: (verified-hash library repository artifact extension hash codec exception) +(def: (verified_hash library repository artifact extension hash codec exception) (All [h] (-> Binary (Repository Promise) Artifact Extension (-> Binary (Hash h)) (Codec Text (Hash h)) @@ -72,12 +72,12 @@ (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status]))) (do (try.with promise.monad) [data (\ repository download (///repository.uri artifact extension)) - sha-1 (..verified-hash data + sha-1 (..verified_hash data repository artifact (format extension ///artifact/extension.sha-1) - ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match) - md5 (..verified-hash data + ///hash.sha-1 ///hash.sha-1_codec ..sha-1_does_not_match) + md5 (..verified_hash data repository artifact (format extension ///artifact/extension.md5) - ///hash.md5 ///hash.md5-codec ..md5-does-not-match)] + ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] (wrap [data (#//status.Verified sha-1 md5)]))) (def: #export (one repository dependency) @@ -85,16 +85,16 @@ (let [[artifact type] dependency extension (///artifact/extension.extension type)] (do (try.with promise.monad) - [[pom pom-status] (..hashed repository artifact ///artifact/extension.pom) - library-&-status (..hashed repository artifact extension)] + [[pom pom_status] (..hashed repository artifact ///artifact/extension.pom) + library_&_status (..hashed repository artifact extension)] (\ promise.monad wrap (do try.monad [pom (\ encoding.utf8 decode pom) pom (\ xml.codec decode pom) profile (<xml>.run ///pom.parser pom)] (wrap {#///package.origin #///package.Remote - #///package.library library-&-status - #///package.pom [pom pom-status]})))))) + #///package.library library_&_status + #///package.pom [pom pom_status]})))))) (type: #export Resolution (Dictionary Dependency Package)) @@ -107,7 +107,7 @@ (Equivalence Resolution) (dictionary.equivalence ///package.equivalence)) -(exception: #export (cannot-resolve {dependency Dependency}) +(exception: #export (cannot_resolve {dependency Dependency}) (exception.report ["Artifact" (%.text (///artifact.format (get@ #//.artifact dependency)))] ["Type" (%.text (get@ #//.type dependency))])) @@ -117,7 +117,7 @@ (case repositories #.Nil (|> dependency - (exception.throw ..cannot-resolve) + (exception.throw ..cannot_resolve) (\ promise.monad wrap)) (#.Cons repository alternatives) @@ -144,8 +144,8 @@ #.None (..any repositories head)) - sub-dependencies (\ promise.monad wrap (///package.dependencies package)) + sub_dependencies (\ promise.monad wrap (///package.dependencies package)) resolution (|> resolution (dictionary.put head package) - (all repositories (set.to-list sub-dependencies)))] + (all repositories (set.to_list sub_dependencies)))] (all repositories tail resolution)))) diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index fa62f643e..bedaffdb8 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -14,7 +14,7 @@ (Hash MD5))) (#Verified (Hash SHA-1) (Hash MD5))) -(structure: any-equivalence +(structure: any_equivalence (Equivalence Any) (def: (= _ _) @@ -23,7 +23,7 @@ (def: #export equivalence (Equivalence Status) ($_ sum.equivalence - ..any-equivalence + ..any_equivalence ($_ sum.equivalence ///hash.equivalence ///hash.equivalence diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index b5d6571be..d42333fd9 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -57,14 +57,14 @@ (Format Aggregate) (|>> dictionary.entries (list\map (function (_ [key value]) - [(code.local-tag key) value])) + [(code.local_tag key) value])) code.record)) (def: empty Aggregate (dictionary.new text.hash)) -(def: (on-maybe field value format aggregate) +(def: (on_maybe field value format aggregate) (All [a] (-> Text (Maybe a) (Format a) Aggregate Aggregate)) (case value @@ -74,7 +74,7 @@ (#.Some value) (dictionary.put field (format value) aggregate))) -(def: (on-list field value format aggregate) +(def: (on_list field value format aggregate) (All [a] (-> Text (List a) (Format a) Aggregate Aggregate)) (case value @@ -84,12 +84,12 @@ value (dictionary.put field (` [(~+ (list\map format value))]) aggregate))) -(def: (on-set field value format aggregate) +(def: (on_set field value format aggregate) (All [a] (-> Text (Set a) (Format a) Aggregate Aggregate)) - (..on-list field (set.to-list value) format aggregate)) + (..on_list field (set.to_list value) format aggregate)) -(def: (on-dictionary field value key-format value-format aggregate) +(def: (on_dictionary field value key_format value_format aggregate) (All [k v] (-> Text (Dictionary k v) (Format k) (Format v) Aggregate Aggregate)) (if (dictionary.empty? value) @@ -98,20 +98,20 @@ (|> value dictionary.entries (list\map (function (_ [key value]) - [(key-format key) (value-format value)])) + [(key_format key) (value_format value)])) code.record) aggregate))) (def: (info value) (Format /.Info) (|> ..empty - (..on-maybe "url" (get@ #/.url value) code.text) - (..on-maybe "scm" (get@ #/.scm value) code.text) - (..on-maybe "description" (get@ #/.description value) code.text) - (..on-list "licenses" (get@ #/.licenses value) ..license) - (..on-maybe "organization" (get@ #/.organization value) ..organization) - (..on-list "developers" (get@ #/.developers value) ..developer) - (..on-list "contributors" (get@ #/.contributors value) ..contributor) + (..on_maybe "url" (get@ #/.url value) code.text) + (..on_maybe "scm" (get@ #/.scm value) code.text) + (..on_maybe "description" (get@ #/.description value) code.text) + (..on_list "licenses" (get@ #/.licenses value) ..license) + (..on_maybe "organization" (get@ #/.organization value) ..organization) + (..on_list "developers" (get@ #/.developers value) ..developer) + (..on_list "contributors" (get@ #/.contributors value) ..contributor) ..aggregate)) (def: (artifact' [group name version]) @@ -126,7 +126,7 @@ (def: (dependency [artifact type]) (Format Dependency) - (if (text\= //artifact/type.lux-library type) + (if (text\= //artifact/type.lux_library type) (` [(~+ (..artifact' artifact))]) (` [(~+ (..artifact' artifact)) (~ (code.text type))]))) @@ -134,16 +134,16 @@ (def: #export (profile value) (Format /.Profile) (|> ..empty - (..on-list "parents" (get@ #/.parents value) code.text) - (..on-maybe "identity" (get@ #/.identity value) ..artifact) - (..on-maybe "info" (get@ #/.info value) ..info) - (..on-set "repositories" (get@ #/.repositories value) code.text) - (..on-set "dependencies" (get@ #/.dependencies value) ..dependency) - (..on-set "sources" (get@ #/.sources value) code.text) - (..on-maybe "target" (get@ #/.target value) code.text) - (..on-maybe "program" (get@ #/.program value) code.text) - (..on-maybe "test" (get@ #/.test value) code.text) - (..on-dictionary "deploy-repositories" (get@ #/.deploy-repositories value) code.text code.text) + (..on_list "parents" (get@ #/.parents value) code.text) + (..on_maybe "identity" (get@ #/.identity value) ..artifact) + (..on_maybe "info" (get@ #/.info value) ..info) + (..on_set "repositories" (get@ #/.repositories value) code.text) + (..on_set "dependencies" (get@ #/.dependencies value) ..dependency) + (..on_set "sources" (get@ #/.sources value) code.text) + (..on_maybe "target" (get@ #/.target value) code.text) + (..on_maybe "program" (get@ #/.program value) code.text) + (..on_maybe "test" (get@ #/.test value) code.text) + (..on_dictionary "deploy-repositories" (get@ #/.deploy_repositories value) code.text code.text) ..aggregate)) (def: #export project diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index 74d965f8c..2c0c6df25 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -69,13 +69,13 @@ [16 md5::size] ) - (def: hex-per-byte + (def: hex_per_byte 2) - (def: hex-per-chunk - (n.* hex-per-byte i64.bytes-per-i64)) + (def: hex_per_chunk + (n.* hex_per_byte i64.bytes_per_i64)) - (exception: #export (not-a-hash {size Nat} {value Text}) + (exception: #export (not_a_hash {size Nat} {value Text}) (exception.report ["Pseudo hash" (%.text value)] ["Expected size" (%.nat size)] @@ -88,8 +88,8 @@ ["Expected size" (%.nat <size>)] ["Actual size" (%.nat (binary.size data))]))] - [not-a-sha-1 ..sha-1::size] - [not-a-md5 ..md5::size] + [not_a_sha-1 ..sha-1::size] + [not_a_md5 ..md5::size] ) (template [<name> <kind> <size> <exception>] @@ -99,29 +99,29 @@ (#try.Success (:abstraction data)) (exception.throw <exception> [data])))] - [as-sha-1 SHA-1 ..sha-1::size ..not-a-sha-1] - [as-md5 MD5 ..md5::size ..not-a-md5] + [as_sha-1 SHA-1 ..sha-1::size ..not_a_sha-1] + [as_md5 MD5 ..md5::size ..not_a_md5] ) - (def: hash-size + (def: hash_size (-> Text Nat) - (|>> text.size (n./ ..hex-per-byte))) + (|>> text.size (n./ ..hex_per_byte))) - (def: encoding-size + (def: encoding_size (-> Nat Nat) - (n.* ..hex-per-byte)) + (n.* ..hex_per_byte)) (def: (decode size constructor encoded) (All [h] (-> Nat (-> Binary (Try (Hash h))) (-> Text (Try (Hash h))))) - (let [hash-size (..hash-size encoded)] - (if (n.= size hash-size) + (let [hash_size (..hash_size encoded)] + (if (n.= size hash_size) (loop [input encoded chunk 0 - output (binary.create hash-size)] - (let [index (n.* chunk i64.bytes-per-i64)] - (case (text.split ..hex-per-chunk input) + output (binary.create hash_size)] + (let [index (n.* chunk i64.bytes_per_i64)] + (case (text.split ..hex_per_chunk input) (#.Some [head tail]) (do try.monad [head (\ n.hex decode head) @@ -129,7 +129,7 @@ (recur tail (inc chunk) output)) #.None - (case (..hash-size input) + (case (..hash_size input) 0 (constructor output) (^template [<size> <write>] [<size> @@ -140,8 +140,8 @@ ([1 binary.write/8] [2 binary.write/16] [4 binary.write/32]) - _ (exception.throw ..not-a-hash [(..encoding-size size) encoded]))))) - (exception.throw ..not-a-hash [(..encoding-size size) encoded])))) + _ (exception.throw ..not_a_hash [(..encoding_size size) encoded]))))) + (exception.throw ..not_a_hash [(..encoding_size size) encoded])))) (template [<codec> <hash> <nat> <constructor>] [(structure: #export <codec> @@ -150,8 +150,8 @@ (def: encode (|>> :representation ..encode)) (def: decode (..decode <nat> <constructor>)))] - [sha-1-codec SHA-1 ..sha-1::size ..as-sha-1] - [md5-codec MD5 ..md5::size ..as-md5] + [sha-1_codec SHA-1 ..sha-1::size ..as_sha-1] + [md5_codec MD5 ..md5::size ..as_md5] ) (structure: #export equivalence diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index 623346237..11e648697 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -28,32 +28,32 @@ ["#." project (#+ Project)] ["#." parser]]) -(def: (parse-lux source-code) +(def: (parse_lux source_code) (-> Text (Try Code)) (let [parse (syntax.parse "" - syntax.no-aliases - (text.size source-code))] - (case (parse [location.dummy 0 source-code]) + syntax.no_aliases + (text.size source_code))] + (case (parse [location.dummy 0 source_code]) (#.Left [_ error]) (#try.Failure error) - (#.Right [_ lux-code]) - (#try.Success lux-code)))) + (#.Right [_ lux_code]) + (#try.Success lux_code)))) -(def: parse-project +(def: parse_project (-> Binary (Try Project)) (|>> (do> try.monad [(\ encoding.utf8 decode)] - [..parse-lux] + [..parse_lux] [(list) (<c>.run //parser.project)]))) (def: #export (read monad fs profile) (All [!] (-> (Monad !) (file.System !) Text (! (Try Profile)))) (do (try.with monad) - [project-file (!.use (\ fs file) //project.file) - project-file (!.use (\ project-file content) [])] + [project_file (!.use (\ fs file) //project.file) + project_file (!.use (\ project_file content) [])] (\ monad wrap - (|> project-file + (|> project_file (do> try.monad - [..parse-project] + [..parse_project] [(//project.profile profile)]))))) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index aa7b9abce..cf9a34b58 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -29,7 +29,7 @@ {#group Group #name Name #versions (List Version) - #last-updated Instant}) + #last_updated Instant}) (def: (pad value) (-> Nat Text) @@ -37,23 +37,23 @@ (format "0" (%.nat value)) (%.nat value))) -(def: (date-format value) +(def: (date_format value) (%.Format Date) (format (|> value date.year year.value .nat %.nat) (|> value date.month month.number ..pad) - (|> value date.day-of-month ..pad))) + (|> value date.day_of_month ..pad))) -(def: (time-format value) +(def: (time_format value) (%.Format Time) (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] (format (..pad hour) (..pad minute) (..pad second)))) -(def: (instant-format value) +(def: (instant_format value) (%.Format Instant) - (format (..date-format (instant.date value)) - (..time-format (instant.time value)))) + (format (..date_format (instant.date value)) + (..time_format (instant.time value)))) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -63,7 +63,7 @@ [<version> "version"] [<versioning> "versioning"] [<versions> "versions"] - [<last-updated> "lastUpdated"] + [<last_updated> "lastUpdated"] [<metadata> "metadata"] ) @@ -72,26 +72,26 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write-group Group ..<group> (|>)] - [write-name Name ..<name> (|>)] - [write-version Version ..<version> (|>)] - [write-last-updated Instant ..<last-updated> ..instant-format] + [write_group Group ..<group> (|>)] + [write_name Name ..<name> (|>)] + [write_version Version ..<version> (|>)] + [write_last_updated Instant ..<last_updated> ..instant_format] ) -(def: write-versions +(def: write_versions (-> (List Version) XML) - (|>> (list\map ..write-version) (#xml.Node ..<versions> xml.attributes))) + (|>> (list\map ..write_version) (#xml.Node ..<versions> xml.attributes))) (def: #export (write value) (-> Metadata XML) (#xml.Node ..<metadata> xml.attributes - (list (..write-group (get@ #group value)) - (..write-name (get@ #name value)) + (list (..write_group (get@ #group value)) + (..write_name (get@ #name value)) (#xml.Node ..<versioning> xml.attributes - (list (..write-versions (get@ #versions value)) - (..write-last-updated (get@ #last-updated value))))))) + (list (..write_versions (get@ #versions value)) + (..write_last_updated (get@ #last_updated value))))))) (def: (sub tag parser) (All [a] (-> xml.Tag (Parser a) (Parser a))) @@ -103,17 +103,17 @@ (-> xml.Tag (Parser Text)) (..sub tag <xml>.text)) -(def: date-parser +(def: date_parser (<text>.Parser Date) (do <>.monad [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) year (<>.lift (year.year (.int year))) month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) - month (<>.lift (month.by-number month)) - day-of-month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] - (<>.lift (date.date year month day-of-month)))) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] + (<>.lift (date.date year month day_of_month)))) -(def: time-parser +(def: time_parser (<text>.Parser Time) (do <>.monad [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) @@ -123,15 +123,15 @@ {#time.hour hour #time.minute minute #time.second second - #time.milli-second 0})))) + #time.milli_second 0})))) -(def: last-updated-parser +(def: last_updated_parser (Parser Instant) (<text>.embed (do <>.monad - [date ..date-parser - time ..time-parser] - (wrap (instant.from-date-time date time))) - (..text ..<last-updated>))) + [date ..date_parser + time ..time_parser] + (wrap (instant.from_date_time date time))) + (..text ..<last_updated>))) (def: #export parser (Parser Metadata) @@ -144,7 +144,7 @@ (<| <xml>.somewhere (..sub ..<versions>) (<>.many (..text ..<version>))) - (<xml>.somewhere ..last-updated-parser) + (<xml>.somewhere ..last_updated_parser) )) ))) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index 1919d06ca..ea6ce4719 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -30,19 +30,19 @@ (def: snapshot "SNAPSHOT") -(type: #export Time-Stamp +(type: #export Time_Stamp Instant) (type: #export Build Nat) (type: #export Versioning - {#time-stamp Time-Stamp + {#time_stamp Time_Stamp #build Build #snapshot (List Type)}) (type: #export Value - [Version Time-Stamp Build]) + [Version Time_Stamp Build]) (type: #export Metadata {#group Group @@ -56,44 +56,44 @@ (format "0" (%.nat value)) (%.nat value))) -(def: (date-format value) +(def: (date_format value) (%.Format Date) (format (|> value date.year year.value .nat %.nat) (|> value date.month month.number ..pad) - (|> value date.day-of-month ..pad))) + (|> value date.day_of_month ..pad))) -(def: (time-format value) +(def: (time_format value) (%.Format Time) (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] (format (..pad hour) (..pad minute) (..pad second)))) -(def: (instant-format value) +(def: (instant_format value) (%.Format Instant) - (format (..date-format (instant.date value)) - (..time-format (instant.time value)))) + (format (..date_format (instant.date value)) + (..time_format (instant.time value)))) (template [<separator> <name>] [(def: <name> <separator>)] - ["." time-stamp-separator] - ["-" value-separator] + ["." time_stamp_separator] + ["-" value_separator] ) -(def: (time-stamp-format value) - (%.Format Time-Stamp) - (format (..date-format (instant.date value)) - ..time-stamp-separator - (..time-format (instant.time value)))) +(def: (time_stamp_format value) + (%.Format Time_Stamp) + (format (..date_format (instant.date value)) + ..time_stamp_separator + (..time_format (instant.time value)))) -(def: (value-format [version time-stamp build]) +(def: (value_format [version time_stamp build]) (%.Format Value) - (format (text.replace-all ..snapshot - (..time-stamp-format time-stamp) + (format (text.replace_all ..snapshot + (..time_stamp_format time_stamp) version) - ..value-separator + ..value_separator (%.nat build))) (template [<definition> <tag>] @@ -102,14 +102,14 @@ [<group> "groupId"] [<name> "artifactId"] [<version> "version"] - [<last-updated> "lastUpdated"] + [<last_updated> "lastUpdated"] [<metadata> "metadata"] [<versioning> "versioning"] [<snapshot> "snapshot"] [<timestamp> "timestamp"] - [<build-number> "buildNumber"] - [<snapshot-versions> "snapshotVersions"] - [<snapshot-version> "snapshotVersion"] + [<build_number> "buildNumber"] + [<snapshot_versions> "snapshotVersions"] + [<snapshot_version> "snapshotVersion"] [<extension> "extension"] [<value> "value"] [<updated> "updated"] @@ -120,44 +120,44 @@ (-> <type> XML) (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] - [write-group Group ..<group> (|>)] - [write-name Name ..<name> (|>)] - [write-version Version ..<version> (|>)] - [write-last-updated Instant ..<last-updated> ..instant-format] - [write-time-stamp Instant ..<timestamp> ..time-stamp-format] - [write-build-number Nat ..<build-number> %.nat] - [write-extension Type ..<extension> (|>)] - [write-value Value ..<value> ..value-format] - [write-updated Instant ..<updated> ..instant-format] + [write_group Group ..<group> (|>)] + [write_name Name ..<name> (|>)] + [write_version Version ..<version> (|>)] + [write_last_updated Instant ..<last_updated> ..instant_format] + [write_time_stamp Instant ..<timestamp> ..time_stamp_format] + [write_build_number Nat ..<build_number> %.nat] + [write_extension Type ..<extension> (|>)] + [write_value Value ..<value> ..value_format] + [write_updated Instant ..<updated> ..instant_format] ) -(def: (write-snapshot value type) +(def: (write_snapshot value type) (-> Value Type XML) - (<| (#xml.Node ..<snapshot-version> xml.attributes) - (list (..write-extension type) - (..write-value value) - (let [[version time-stamp build] value] - (..write-updated time-stamp))))) + (<| (#xml.Node ..<snapshot_version> xml.attributes) + (list (..write_extension type) + (..write_value value) + (let [[version time_stamp build] value] + (..write_updated time_stamp))))) -(def: (write-versioning version (^slots [#time-stamp #build #snapshot])) +(def: (write_versioning version (^slots [#time_stamp #build #snapshot])) (-> Version Versioning XML) (<| (#xml.Node ..<versioning> xml.attributes) (list (<| (#xml.Node ..<snapshot> xml.attributes) - (list (..write-time-stamp time-stamp) - (..write-build-number build))) - (..write-last-updated time-stamp) - (<| (#xml.Node ..<snapshot-versions> xml.attributes) - (list\map (..write-snapshot [version time-stamp build]) + (list (..write_time_stamp time_stamp) + (..write_build_number build))) + (..write_last_updated time_stamp) + (<| (#xml.Node ..<snapshot_versions> xml.attributes) + (list\map (..write_snapshot [version time_stamp build]) snapshot))))) (def: #export (write (^slots [#group #name #version #versioning])) (-> Metadata XML) (#xml.Node ..<metadata> xml.attributes - (list (..write-group group) - (..write-name name) - (..write-version version) - (..write-versioning version versioning)))) + (list (..write_group group) + (..write_name name) + (..write_version version) + (..write_versioning version versioning)))) (def: (sub tag parser) (All [a] (-> xml.Tag (Parser a) (Parser a))) @@ -169,17 +169,17 @@ (-> xml.Tag (Parser Text)) (..sub tag <xml>.text)) -(def: date-parser +(def: date_parser (<text>.Parser Date) (do <>.monad [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) year (<>.lift (year.year (.int year))) month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) - month (<>.lift (month.by-number month)) - day-of-month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] - (<>.lift (date.date year month day-of-month)))) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] + (<>.lift (date.date year month day_of_month)))) -(def: time-parser +(def: time_parser (<text>.Parser Time) (do <>.monad [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) @@ -189,69 +189,69 @@ {#time.hour hour #time.minute minute #time.second second - #time.milli-second 0})))) + #time.milli_second 0})))) -(def: last-updated-parser +(def: last_updated_parser (Parser Instant) (<text>.embed (do <>.monad - [date ..date-parser - time ..time-parser] - (wrap (instant.from-date-time date time))) - (..text ..<last-updated>))) + [date ..date_parser + time ..time_parser] + (wrap (instant.from_date_time date time))) + (..text ..<last_updated>))) -(def: time-stamp-parser - (Parser Time-Stamp) +(def: time_stamp_parser + (Parser Time_Stamp) (<text>.embed (do <>.monad - [date ..date-parser - _ (<text>.this ..time-stamp-separator) - time ..time-parser] - (wrap (instant.from-date-time date time))) + [date ..date_parser + _ (<text>.this ..time_stamp_separator) + time ..time_parser] + (wrap (instant.from_date_time date time))) (..text ..<timestamp>))) -(def: build-parser +(def: build_parser (Parser Build) (<text>.embed (<>.codec n.decimal (<text>.many <text>.decimal)) - (..text ..<build-number>))) + (..text ..<build_number>))) -(exception: #export (time-stamp-mismatch {expected Time-Stamp} {actual Text}) +(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text}) (exception.report - ["Expected time-stamp" (instant-format expected)] + ["Expected time-stamp" (instant_format expected)] ["Actual time-stamp" actual])) -(exception: #export (value-mismatch {expected Value} {actual Text}) +(exception: #export (value_mismatch {expected Value} {actual Text}) (exception.report - ["Expected" (..value-format expected)] + ["Expected" (..value_format expected)] ["Actual" actual])) -(def: (snapshot-parser expected) +(def: (snapshot_parser expected) (-> Value (Parser Type)) - (<| (..sub ..<snapshot-version>) + (<| (..sub ..<snapshot_version>) (do <>.monad - [#let [[version time-stamp build] expected] + [#let [[version time_stamp build] expected] updated (<xml>.somewhere (..text ..<updated>)) - _ (<>.assert (exception.construct ..time-stamp-mismatch [time-stamp updated]) - (\ text.equivalence = (instant-format time-stamp) updated)) + _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated]) + (\ text.equivalence = (instant_format time_stamp) updated)) actual (<xml>.somewhere (..text ..<value>)) - _ (<>.assert (exception.construct ..value-mismatch [expected actual]) - (\ text.equivalence = (..value-format expected) actual))] + _ (<>.assert (exception.construct ..value_mismatch [expected actual]) + (\ text.equivalence = (..value_format expected) actual))] (<xml>.somewhere (..text ..<extension>))))) -(def: (versioning-parser version) +(def: (versioning_parser version) (-> Version (Parser Versioning)) (<| (..sub ..<versioning>) (do <>.monad - [[time-stamp build] (<| <xml>.somewhere + [[time_stamp build] (<| <xml>.somewhere (..sub ..<snapshot>) - (<>.and (<xml>.somewhere ..time-stamp-parser) - (<xml>.somewhere ..build-parser))) - last-updated (<xml>.somewhere ..last-updated-parser) - _ (<>.assert (exception.construct ..time-stamp-mismatch [time-stamp (instant-format last-updated)]) - (\ instant.equivalence = time-stamp last-updated)) + (<>.and (<xml>.somewhere ..time_stamp_parser) + (<xml>.somewhere ..build_parser))) + last_updated (<xml>.somewhere ..last_updated_parser) + _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)]) + (\ instant.equivalence = time_stamp last_updated)) snapshot (<| <xml>.somewhere - (..sub ..<snapshot-versions>) - (<>.some (..snapshot-parser [version time-stamp build])))] - (wrap {#time-stamp time-stamp + (..sub ..<snapshot_versions>) + (<>.some (..snapshot_parser [version time_stamp build])))] + (wrap {#time_stamp time_stamp #build build #snapshot snapshot})))) @@ -262,13 +262,13 @@ [group (<xml>.somewhere (..text ..<group>)) name (<xml>.somewhere (..text ..<name>)) version (<xml>.somewhere (..text ..<version>)) - versioning (<xml>.somewhere (..versioning-parser version))] + versioning (<xml>.somewhere (..versioning_parser version))] (wrap {#group group #name name #version version #versioning versioning})))) -(def: versioning-equivalence +(def: versioning_equivalence (Equivalence Versioning) ($_ product.equivalence instant.equivalence @@ -282,5 +282,5 @@ text.equivalence text.equivalence text.equivalence - ..versioning-equivalence + ..versioning_equivalence )) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 03f2c3994..b3118a7e0 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -25,17 +25,17 @@ #Local #Remote) -(structure: any-equivalence +(structure: any_equivalence (Equivalence Any) (def: (= _ _) true)) -(def: origin-equivalence +(def: origin_equivalence (Equivalence Origin) ($_ sum.equivalence - ..any-equivalence - ..any-equivalence + ..any_equivalence + ..any_equivalence )) (type: #export Package @@ -46,7 +46,7 @@ (template [<name> <tag>] [(def: #export <name> (-> Package Bit) - (|>> (get@ #origin) (\ ..origin-equivalence = <tag>)))] + (|>> (get@ #origin) (\ ..origin_equivalence = <tag>)))] [local? #Local] [remote? #Remote] @@ -68,7 +68,7 @@ (def: #export equivalence (Equivalence Package) ($_ product.equivalence - ..origin-equivalence + ..origin_equivalence (product.equivalence binary.equivalence //status.equivalence) (product.equivalence xml.equivalence //status.equivalence) )) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 9fdc00f3b..8f95cc6a4 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -25,7 +25,7 @@ ["#." artifact (#+ Artifact) ["#/." type]]]) -(def: (as-input input) +(def: (as_input input) (-> (Maybe Code) (List Code)) (case input (#.Some input) @@ -36,12 +36,12 @@ (def: (singular input tag parser) (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser a))) - (<c>.local (..as-input (dictionary.get tag input)) + (<c>.local (..as_input (dictionary.get tag input)) parser)) (def: (plural input tag parser) (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser (List a)))) - (<c>.local (..as-input (dictionary.get tag input)) + (<c>.local (..as_input (dictionary.get tag input)) (<c>.tuple (<>.some parser)))) (def: group @@ -80,8 +80,8 @@ (Parser /.License) (do {! <>.monad} [input (\ ! map - (dictionary.from-list text.hash) - (<c>.record (<>.some (<>.and <c>.local-tag + (dictionary.from_list text.hash) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any))))] ($_ <>.and (..singular input "name" ..name) @@ -95,8 +95,8 @@ (Parser /.Organization) (do {! <>.monad} [input (\ ! map - (dictionary.from-list text.hash) - (<c>.record (<>.some (<>.and <c>.local-tag + (dictionary.from_list text.hash) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any))))] ($_ <>.and (..singular input "name" ..name) @@ -106,8 +106,8 @@ (Parser /.Developer) (do {! <>.monad} [input (\ ! map - (dictionary.from-list text.hash) - (<c>.record (<>.some (<>.and <c>.local-tag + (dictionary.from_list text.hash) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any))))] ($_ <>.and (..singular input "name" ..name) @@ -123,8 +123,8 @@ (Parser /.Info) (do {! <>.monad} [input (\ ! map - (dictionary.from-list text.hash) - (<c>.record (<>.some (<>.and <c>.local-tag + (dictionary.from_list text.hash) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any))))] ($_ <>.and (<>.maybe (..singular input "url" ..url)) @@ -149,7 +149,7 @@ (<c>.tuple ($_ <>.and ..artifact' - (<>.default //artifact/type.lux-library ..type) + (<>.default //artifact/type.lux_library ..type) ))) (def: source @@ -164,7 +164,7 @@ (Parser Module) <c>.text) -(def: deploy-repository +(def: deploy_repository (Parser (List [Text //repository.Address])) (<c>.record (<>.some (<>.and <c>.text @@ -174,8 +174,8 @@ (Parser /.Profile) (do {! <>.monad} [input (\ ! map - (dictionary.from-list text.hash) - (<c>.record (<>.some (<>.and <c>.local-tag + (dictionary.from_list text.hash) + (<c>.record (<>.some (<>.and <c>.local_tag <c>.any)))) #let [^parents (: (Parser (List /.Name)) (<>.default (list) @@ -188,16 +188,16 @@ (..singular input "info" ..info))) ^repositories (: (Parser (Set //repository.Address)) (|> (..plural input "repositories" ..repository) - (\ ! map (set.from-list text.hash)) + (\ ! map (set.from_list text.hash)) (<>.default (set.new text.hash)))) ^dependencies (: (Parser (Set //dependency.Dependency)) (|> (..plural input "dependencies" ..dependency) - (\ ! map (set.from-list //dependency.hash)) + (\ ! map (set.from_list //dependency.hash)) (<>.default (set.new //dependency.hash)))) ^sources (: (Parser (Set /.Source)) (|> (..plural input "sources" ..source) - (\ ! map (set.from-list text.hash)) - (<>.default (set.from-list text.hash (list /.default-source))))) + (\ ! map (set.from_list text.hash)) + (<>.default (set.from_list text.hash (list /.default_source))))) ^target (: (Parser (Maybe /.Target)) (<>.maybe (..singular input "target" ..target))) @@ -207,10 +207,10 @@ ^test (: (Parser (Maybe Module)) (<>.maybe (..singular input "test" ..module))) - ^deploy-repositories (: (Parser (Dictionary Text //repository.Address)) - (<| (\ ! map (dictionary.from-list text.hash)) + ^deploy_repositories (: (Parser (Dictionary Text //repository.Address)) + (<| (\ ! map (dictionary.from_list text.hash)) (<>.default (list)) - (..singular input "deploy-repositories" ..deploy-repository)))]] + (..singular input "deploy-repositories" ..deploy_repository)))]] ($_ <>.and ^parents ^identity @@ -221,19 +221,19 @@ ^target ^program ^test - ^deploy-repositories + ^deploy_repositories ))) (def: #export project (Parser Project) - (let [default-profile (: (Parser Project) + (let [default_profile (: (Parser Project) (\ <>.monad map - (|>> [/.default] (list) (dictionary.from-list text.hash)) + (|>> [/.default] (list) (dictionary.from_list text.hash)) ..profile)) - multi-profile (: (Parser Project) + multi_profile (: (Parser Project) (\ <>.monad map - (dictionary.from-list text.hash) + (dictionary.from_list text.hash) (<c>.record (<>.many (<>.and <c>.text ..profile)))))] - (<>.either multi-profile - default-profile))) + (<>.either multi_profile + default_profile))) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index c7d950092..d1787d07c 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -26,11 +26,11 @@ ## https://maven.apache.org/pom.html -(def: project-tag "project") -(def: dependencies-tag "dependencies") -(def: group-tag "groupId") -(def: artifact-tag "artifactId") -(def: version-tag "version") +(def: project_tag "project") +(def: dependencies_tag "dependencies") +(def: group_tag "groupId") +(def: artifact_tag "artifactId") +(def: version_tag "version") (def: #export file "pom.xml") @@ -48,9 +48,9 @@ (def: (artifact value) (-> Artifact (List XML)) - (list (..property ..group-tag (get@ #//artifact.group value)) - (..property ..artifact-tag (get@ #//artifact.name value)) - (..property ..version-tag (get@ #//artifact.version value)))) + (list (..property ..group_tag (get@ #//artifact.group value)) + (..property ..artifact_tag (get@ #//artifact.name value)) + (..property ..version_tag (get@ #//artifact.version value)))) (def: distribution (-> /.Distribution XML) @@ -95,7 +95,7 @@ (..property "url" url)) (#_.Node ["" "organization"] _.attributes))) - (def: (developer-organization [name url]) + (def: (developer_organization [name url]) (-> /.Organization (List XML)) (list (..property "organization" name) (..property "organizationUrl" url))) @@ -104,7 +104,7 @@ (-> /.Developer (List XML)) (list& (..property "name" name) (..property "email" email) - (|> organization (maybe\map ..developer-organization) (maybe.default (list))))) + (|> organization (maybe\map ..developer_organization) (maybe.default (list))))) (template [<name> <type> <tag>] [(def: <name> @@ -118,11 +118,11 @@ (def: (info value) (-> /.Info (List XML)) ($_ list\compose - (|> value (get@ #/.url) (maybe\map (..property "url")) maybe.to-list) - (|> value (get@ #/.description) (maybe\map (..property "description")) maybe.to-list) + (|> value (get@ #/.url) (maybe\map (..property "url")) maybe.to_list) + (|> value (get@ #/.description) (maybe\map (..property "description")) maybe.to_list) (|> value (get@ #/.licenses) (list\map ..license) (..group "licenses") list) - (|> value (get@ #/.scm) (maybe\map ..scm) maybe.to-list) - (|> value (get@ #/.organization) (maybe\map ..organization) maybe.to-list) + (|> value (get@ #/.scm) (maybe\map ..scm) maybe.to_list) + (|> value (get@ #/.organization) (maybe\map ..organization) maybe.to_list) (|> value (get@ #/.developers) (list\map ..developer) (..group "developers") list) (|> value (get@ #/.contributors) (list\map ..contributor) (..group "contributors") list) )) @@ -133,53 +133,53 @@ (case (get@ #/.identity value) (#.Some identity) (#try.Success - (#_.Node ["" ..project-tag] _.attributes + (#_.Node ["" ..project_tag] _.attributes ($_ list\compose (list ..version) (..artifact identity) - (|> value (get@ #/.repositories) set.to-list (list\map ..repository) (..group "repositories") list) - (|> value (get@ #/.dependencies) set.to-list (list\map ..dependency) (..group ..dependencies-tag) list) + (|> value (get@ #/.repositories) set.to_list (list\map ..repository) (..group "repositories") list) + (|> value (get@ #/.dependencies) set.to_list (list\map ..dependency) (..group ..dependencies_tag) list) ))) _ - (exception.throw /.no-identity []))) + (exception.throw /.no_identity []))) -(def: parse-property +(def: parse_property (Parser [Tag Text]) (<>.and <xml>.tag (<xml>.children <xml>.text))) -(def: parse-dependency +(def: parse_dependency (Parser Dependency) (do {! <>.monad} - [properties (\ ! map (dictionary.from-list name.hash) - (<xml>.children (<>.some ..parse-property)))] + [properties (\ ! map (dictionary.from_list name.hash) + (<xml>.children (<>.some ..parse_property)))] (<| <>.lift - try.from-maybe + try.from_maybe (do maybe.monad - [group (dictionary.get ["" ..group-tag] properties) - artifact (dictionary.get ["" ..artifact-tag] properties) - version (dictionary.get ["" ..version-tag] properties)] + [group (dictionary.get ["" ..group_tag] properties) + artifact (dictionary.get ["" ..artifact_tag] properties) + version (dictionary.get ["" ..version_tag] properties)] (wrap {#//dependency.artifact {#//artifact.group group #//artifact.name artifact #//artifact.version version} #//dependency.type (|> properties (dictionary.get ["" "type"]) - (maybe.default //artifact/type.lux-library))}))))) + (maybe.default //artifact/type.lux_library))}))))) -(def: parse-dependencies +(def: parse_dependencies (Parser (List Dependency)) (do {! <>.monad} - [_ (<xml>.node ["" ..dependencies-tag])] - (<xml>.children (<>.some ..parse-dependency)))) + [_ (<xml>.node ["" ..dependencies_tag])] + (<xml>.children (<>.some ..parse_dependency)))) (def: #export parser (Parser /.Profile) (do {! <>.monad} - [_ (<xml>.node ["" ..project-tag])] + [_ (<xml>.node ["" ..project_tag])] (<xml>.children (do ! - [dependencies (<xml>.somewhere ..parse-dependencies) + [dependencies (<xml>.somewhere ..parse_dependencies) _ (<>.some <xml>.ignore)] (wrap (|> (\ /.monoid identity) (update@ #/.dependencies (function (_ empty) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 9729514f2..adf1b049e 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -30,7 +30,7 @@ #Repo #Manual) -(structure: distribution-equivalence +(structure: distribution_equivalence (Equivalence Distribution) (def: (= reference subject) @@ -49,12 +49,12 @@ URL Distribution]) -(def: license-equivalence +(def: license_equivalence (Equivalence License) ($_ product.equivalence text.equivalence text.equivalence - ..distribution-equivalence)) + ..distribution_equivalence)) (type: #export SCM URL) @@ -63,7 +63,7 @@ [Text URL]) -(def: organization-equivalence +(def: organization_equivalence (Equivalence Organization) ($_ product.equivalence text.equivalence @@ -77,12 +77,12 @@ Email (Maybe Organization)]) -(def: developer-equivalence +(def: developer_equivalence (Equivalence Developer) ($_ product.equivalence text.equivalence text.equivalence - (maybe.equivalence ..organization-equivalence))) + (maybe.equivalence ..organization_equivalence))) (type: #export Contributor Developer) @@ -96,18 +96,18 @@ #developers (List Developer) #contributors (List Contributor)}) -(def: info-equivalence +(def: info_equivalence (Equivalence Info) ($_ product.equivalence (maybe.equivalence text.equivalence) (maybe.equivalence text.equivalence) (maybe.equivalence text.equivalence) - (list.equivalence ..license-equivalence) - (maybe.equivalence ..organization-equivalence) - (list.equivalence ..developer-equivalence) - (list.equivalence ..developer-equivalence))) + (list.equivalence ..license_equivalence) + (maybe.equivalence ..organization_equivalence) + (list.equivalence ..developer_equivalence) + (list.equivalence ..developer_equivalence))) -(def: #export default-info +(def: #export default_info Info {#url #.None #scm #.None @@ -120,14 +120,14 @@ (type: #export Source Path) -(def: #export default-source +(def: #export default_source Source "source") (type: #export Target Path) -(def: #export default-target +(def: #export default_target Target "target") @@ -148,7 +148,7 @@ #target (Maybe Target) #program (Maybe Module) #test (Maybe Module) - #deploy-repositories (Dictionary Text repository.Address)}) + #deploy_repositories (Dictionary Text repository.Address)}) (def: #export equivalence (Equivalence Profile) @@ -158,7 +158,7 @@ ## #identity (maybe.equivalence artifact.equivalence) ## #info - (maybe.equivalence ..info-equivalence) + (maybe.equivalence ..info_equivalence) ## #repositories set.equivalence ## #dependencies @@ -171,7 +171,7 @@ (maybe.equivalence text.equivalence) ## #test (maybe.equivalence text.equivalence) - ## #deploy-repositories + ## #deploy_repositories (dictionary.equivalence text.equivalence))) (structure: #export monoid @@ -187,7 +187,7 @@ #target #.None #program #.None #test #.None - #deploy-repositories (dictionary.new text.hash)}) + #deploy_repositories (dictionary.new text.hash)}) (def: (compose override baseline) {#parents (list\compose (get@ #parents baseline) (get@ #parents override)) @@ -199,6 +199,6 @@ #target (maybe\compose (get@ #target override) (get@ #target baseline)) #program (maybe\compose (get@ #program override) (get@ #program baseline)) #test (maybe\compose (get@ #test override) (get@ #test baseline)) - #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))})) + #deploy_repositories (dictionary.merge (get@ #deploy_repositories override) (get@ #deploy_repositories baseline))})) -(exception: #export no-identity) +(exception: #export no_identity) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index bd191fffb..5dce87e0a 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -25,7 +25,7 @@ (def: #export (project name profile) (-> Name Profile Project) - (dictionary.from-list text.hash (list [name profile]))) + (dictionary.from_list text.hash (list [name profile]))) (def: #export equivalence (Equivalence Project) @@ -38,13 +38,13 @@ (dictionary.new text.hash)) (def: compose - (dictionary.merge-with (\ //.monoid compose)))) + (dictionary.merge_with (\ //.monoid compose)))) -(exception: #export (unknown-profile {name Name}) +(exception: #export (unknown_profile {name Name}) (exception.report ["Name" (%.text name)])) -(exception: #export (circular-dependency {dependee Name} {dependent Name}) +(exception: #export (circular_dependency {dependee Name} {dependent Name}) (exception.report ["Dependent" (%.text dependent)] ["Dependee" (%.text dependee)])) @@ -56,7 +56,7 @@ (case (list.find (set.member? lineage) (get@ #//.parents profile)) (#.Some ouroboros) - (exception.throw ..circular-dependency [ouroboros name]) + (exception.throw ..circular_dependency [ouroboros name]) #.None (do {! try.monad} @@ -68,7 +68,7 @@ parents)))) #.None - (exception.throw ..unknown-profile [name]))) + (exception.throw ..unknown_profile [name]))) (def: #export (profile name project) (-> Name Project (Try Profile)) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index 351d1c066..582144ad4 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -52,9 +52,9 @@ (signature: #export (Simulation s) (: (-> URI s (Try [s Binary])) - on-download) + on_download) (: (-> URI Binary s (Try s)) - on-upload)) + on_upload)) (def: #export (mock simulation init) (All [s] (-> (Simulation s) s (Repository Promise))) @@ -64,7 +64,7 @@ (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-download uri |state|) + (case (\ simulation on_download uri |state|) (#try.Success [|state| output]) (do ! [_ (stm.write |state| state)] @@ -77,7 +77,7 @@ (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on-upload uri content |state|) + (case (\ simulation on_upload uri content |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] @@ -122,11 +122,11 @@ (new [java/io/InputStream]) (read [[byte] int int] #io #try int)]) -(exception: #export (no-credentials {address Address}) +(exception: #export (no_credentials {address Address}) (exception.report ["Address" (%.text address)])) -(exception: #export (deployment-failure {code Int}) +(exception: #export (deployment_failure {code Int}) (exception.report ["Code" (%.int code)])) @@ -134,10 +134,10 @@ (-> Artifact Extension URI) (format (//artifact.uri artifact) extension)) -(def: buffer-size +(def: buffer_size (n.* 512 1,024)) -(def: user-agent +(def: user_agent (format "LuxAedifex/" (version.format language/lux.version))) (structure: #export (remote identity address) @@ -150,28 +150,28 @@ java/net/URL::openConnection) #let [connection (:coerce java/net/HttpURLConnection connection)] _ (java/net/HttpURLConnection::setRequestMethod "GET" connection) - _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user-agent connection) + _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection) input (|> connection java/net/URLConnection::getInputStream (\ ! map (|>> java/io/BufferedInputStream::new))) - #let [buffer (binary.create ..buffer-size)]] + #let [buffer (binary.create ..buffer_size)]] (loop [output (\ binary.monoid identity)] (do ! - [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)] - (case bytes-read + [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)] + (case bytes_read -1 (do ! [_ (java/lang/AutoCloseable::close input)] (wrap output)) - _ (if (n.= ..buffer-size bytes-read) + _ (if (n.= ..buffer_size bytes_read) (recur (\ binary.monoid compose output buffer)) (do ! - [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))] + [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))] (recur (\ binary.monoid compose output chunk))))))))) (def: (upload uri content) (case identity #.None - (\ io.monad wrap (exception.throw ..no-credentials [address])) + (\ io.monad wrap (exception.throw ..no_credentials [address])) (#.Some [user password]) (do (try.with io.monad) @@ -181,7 +181,7 @@ #let [connection (:coerce java/net/HttpURLConnection connection)] _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) _ (java/net/URLConnection::setDoOutput true connection) - _ (java/net/URLConnection::setRequestProperty "Authorization" (/identity.basic-auth user password) connection) + _ (java/net/URLConnection::setRequestProperty "Authorization" (/identity.basic_auth user password) connection) stream (java/net/URLConnection::getOutputStream connection) _ (java/io/OutputStream::write content stream) _ (java/io/OutputStream::flush stream) @@ -189,5 +189,5 @@ code (java/net/HttpURLConnection::getResponseCode connection)] (case code +201 (wrap []) - _ (\ io.monad wrap (exception.throw ..deployment-failure [code])))))) + _ (\ io.monad wrap (exception.throw ..deployment_failure [code])))))) ) diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux index fbc93f367..2de3c6751 100644 --- a/stdlib/source/program/aedifex/repository/identity.lux +++ b/stdlib/source/program/aedifex/repository/identity.lux @@ -34,7 +34,7 @@ ["#::." (#static getEncoder [] java/util/Base64$Encoder)]) -(def: #export (basic-auth user password) +(def: #export (basic_auth user password) (-> User Password Text) (let [credentials (\ encoding.utf8 encode (format user ":" password))] (|> (java/util/Base64::getEncoder) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index b649f333b..2c764aff9 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -32,11 +32,11 @@ (def: file "library.tar") -(def: no-ownership +(def: no_ownership tar.Ownership (let [commons (: tar.Owner {#tar.name tar.anonymous - #tar.id tar.no-id})] + #tar.id tar.no_id})] {#tar.user commons #tar.group commons})) @@ -46,21 +46,21 @@ [files (io.enumerate system sources)] (|> (dictionary.entries files) (monad.map try.monad - (function (_ [path source-code]) + (function (_ [path source_code]) (do try.monad [path (|> path - (text.replace-all (\ system separator) .module-separator) + (text.replace_all (\ system separator) .module_separator) tar.path) - source-code (tar.content source-code)] + source_code (tar.content source_code)] (wrap (#tar.Normal [path - (instant.from-millis +0) + (instant.from_millis +0) ($_ tar.and - tar.read-by-owner tar.write-by-owner - tar.read-by-group tar.write-by-group - tar.read-by-other) - ..no-ownership - source-code]))))) - (\ try.monad map row.from-list) + tar.read_by_owner tar.write_by_owner + tar.read_by_group tar.write_by_group + tar.read_by_other) + ..no_ownership + source_code]))))) + (\ try.monad map row.from_list) (\ promise.monad wrap)))) (def: #export (export system [sources target]) @@ -68,8 +68,8 @@ (do (try.with promise.monad) [tar (..library system sources) package (: (Promise (Try (file.File Promise))) - (file.get-file promise.monad system + (file.get_file promise.monad system (format target (\ system separator) ..file)))] (|> tar (binary.run tar.writer) - (!.use (\ package over-write))))) + (!.use (\ package over_write))))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 54227c7f3..7b4a9262e 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -33,7 +33,7 @@ (def: Action (type (All [a] (Promise (Try a))))) -(exception: #export useless-tar-entry) +(exception: #export useless_tar_entry) (exception: #export (duplicate {library Library} {module Module}) (exception.report @@ -43,7 +43,7 @@ (type: #export Import (Dictionary Path Binary)) -(def: (import-library system library import) +(def: (import_library system library import) (-> (file.System Promise) Library Import (Action Import)) (do (try.with promise.monad) [file (: (Action (File Promise)) @@ -55,8 +55,8 @@ (monad.fold ! (function (_ entry import) (case entry (#tar.Normal [path instant mode ownership content]) - (let [path (tar.from-path path)] - (case (dictionary.try-put path (tar.data content) import) + (let [path (tar.from_path path)] + (case (dictionary.try_put path (tar.data content) import) (#try.Success import) (wrap import) @@ -64,14 +64,14 @@ (exception.throw ..duplicate [library path]))) _ - (exception.throw ..useless-tar-entry []))) + (exception.throw ..useless_tar_entry []))) import - (row.to-list tar)))))) + (row.to_list tar)))))) (def: #export (import system libraries) (-> (file.System Promise) (List Library) (Action Import)) (monad.fold (: (Monad Action) (try.with promise.monad)) - (..import-library system) + (..import_library system) (dictionary.new text.hash) libraries)) diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux index 0c492ea08..35f26eabc 100644 --- a/stdlib/source/spec/aedifex/repository.lux +++ b/stdlib/source/spec/aedifex/repository.lux @@ -22,17 +22,17 @@ ["_." // #_ ["#." artifact]]}) -(def: #export (spec valid-artifact invalid-artifact subject) +(def: #export (spec valid_artifact invalid_artifact subject) (-> Artifact Artifact (/.Repository Promise) Test) (do random.monad [expected (_binary.random 100)] (wrap ($_ _.and' (do promise.monad - [#let [uri/good (/.uri valid-artifact //artifact/extension.lux-library)] + [#let [uri/good (/.uri valid_artifact //artifact/extension.lux_library)] upload!/good (\ subject upload uri/good expected) download!/good (\ subject download uri/good) - #let [uri/bad (/.uri invalid-artifact //artifact/extension.lux-library)] + #let [uri/bad (/.uri invalid_artifact //artifact/extension.lux_library)] upload!/bad (\ subject upload uri/bad expected) download!/bad (\ subject download uri/bad)] (_.cover' [/.Repository] diff --git a/stdlib/source/spec/lux/world/console.lux b/stdlib/source/spec/lux/world/console.lux index 1da631a98..f875cd07e 100644 --- a/stdlib/source/spec/lux/world/console.lux +++ b/stdlib/source/spec/lux/world/console.lux @@ -23,26 +23,26 @@ (wrap (do promise.monad [console (promise.future console) ?read (!.use (\ console read) []) - ?read-line (!.use (\ console read-line) []) + ?read_line (!.use (\ console read_line) []) ?write (!.use (\ console write) [message]) ?close/good (!.use (\ console close) []) ?close/bad (!.use (\ console close) [])] ($_ _.and' - (_.cover' [/.Can-Read] - (case [?read ?read-line] + (_.cover' [/.Can_Read] + (case [?read ?read_line] [(#try.Success _) (#try.Success _)] true _ false)) - (_.cover' [/.Can-Write] + (_.cover' [/.Can_Write] (case ?write (#try.Success _) true _ false)) - (_.cover' [/.Can-Close] + (_.cover' [/.Can_Close] (case [?close/good ?close/bad] [(#try.Success _) (#try.Failure _)] true diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 935bd3ab3..1a9d649b8 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -34,20 +34,20 @@ [sleep! "sleep" Nat %.nat] ) -(def: (read-test expected process) +(def: (read_test expected process) (-> Text (/.Process Promise) _.Assertion) (do promise.monad [?read (!.use (\ process read) []) ?await (!.use (\ process await) [])] ($_ _.and' - (_.cover' [/.Can-Read] + (_.cover' [/.Can_Read] (case ?read (#try.Success actual) (text\= expected actual) (#try.Failure error) false)) - (_.cover' [/.Can-Wait /.Exit /.normal] + (_.cover' [/.Can_Wait /.Exit /.normal] (case ?await (#try.Success exit) (i.= /.normal exit) @@ -56,12 +56,12 @@ false)) ))) -(def: (destroy-test process) +(def: (destroy_test process) (-> (/.Process Promise) _.Assertion) (do promise.monad [?destroy (!.use (\ process destroy) []) ?await (!.use (\ process await) [])] - (_.cover' [/.Can-Destroy] + (_.cover' [/.Can_Destroy] (and (case ?destroy (#try.Success _) true @@ -75,7 +75,7 @@ (#try.Failure error) true))))) -(with-expansions [<shell-coverage> (as-is [/.Can-Execute /.Command /.Argument])] +(with_expansions [<shell_coverage> (as_is [/.Can_Execute /.Command /.Argument])] (def: #export (spec shell) (-> (/.Shell Promise) Test) (<| (_.for [/.Shell /.Process]) @@ -88,11 +88,11 @@ (case [?echo ?sleep] [(#try.Success echo) (#try.Success sleep)] ($_ _.and' - (_.cover' <shell-coverage> + (_.cover' <shell_coverage> true) - (..read-test message echo) - (..destroy-test sleep)) + (..read_test message echo) + (..destroy_test sleep)) _ - (_.cover' <shell-coverage> + (_.cover' <shell_coverage> false)))))))) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index a718d51f6..fc8bb2dae 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -46,7 +46,7 @@ (file.mock (\ file.default separator)))]] (_.cover [/.uri /.path] (|> (/.path fs sample) - (text.replace-all uri.separator (\ fs separator)) + (text.replace_all uri.separator (\ fs separator)) (text\= (/.uri sample))))) /type.test diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index cd695ae93..2a3f3f564 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -22,10 +22,10 @@ (<| (_.covering /._) (_.for [/.Extension] ($_ _.and - (_.cover [/.lux-library /.jvm-library /.pom + (_.cover [/.lux_library /.jvm_library /.pom /.sha-1 /.md5] - (let [options (list /.lux-library /.jvm-library /.pom /.sha-1 /.md5) - uniques (set.from-list text.hash options)] + (let [options (list /.lux_library /.jvm_library /.pom /.sha-1 /.md5) + uniques (set.from_list text.hash options)] (n.= (list.size options) (set.size uniques)))) (_.cover [/.extension] @@ -33,8 +33,8 @@ [(text\= <extension> (/.extension <type>))] - [//.lux-library /.lux-library] - [//.jvm-library /.jvm-library] + [//.lux_library /.lux_library] + [//.jvm_library /.jvm_library] [//.pom /.pom] ))))) )))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 5dc1b9caa..7f153b2a9 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -19,8 +19,8 @@ (Random /.Type) ($_ random.either ($_ random.either - (random\wrap /.lux-library) - (random\wrap /.jvm-library)) + (random\wrap /.lux_library) + (random\wrap /.jvm_library)) ($_ random.either (random\wrap /.pom) (random\wrap /.md5) @@ -32,11 +32,11 @@ (<| (_.covering /._) (_.for [/.Type] ($_ _.and - (_.cover [/.lux-library /.jvm-library + (_.cover [/.lux_library /.jvm_library /.pom /.md5 /.sha-1] - (let [options (list /.lux-library /.jvm-library + (let [options (list /.lux_library /.jvm_library /.pom /.md5 /.sha-1) - uniques (set.from-list text.hash options)] + uniques (set.from_list text.hash options)] (n.= (list.size options) (set.size uniques)))) )))) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 0bb0aea68..c4c2d044f 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -45,24 +45,24 @@ (def: type (Random Type) ($_ random.either - (random\wrap //artifact/type.lux-library) - (random\wrap //artifact/type.jvm-library))) + (random\wrap //artifact/type.lux_library) + (random\wrap //artifact/type.jvm_library))) (def: profile (Random [Artifact Profile XML]) (random.one (function (_ profile) - (try.to-maybe + (try.to_maybe (do try.monad [pom (//pom.write profile) - identity (try.from-maybe (get@ #//.identity profile))] + identity (try.from_maybe (get@ #//.identity profile))] (wrap [identity profile pom])))) @profile.random)) (def: content (Random Binary) (do {! random.monad} - [content-size (\ ! map (n.% 100) random.nat)] - (_binary.random content-size))) + [content_size (\ ! map (n.% 100) random.nat)] + (_binary.random content_size))) (def: package (Random [Dependency Package]) @@ -77,9 +77,9 @@ (def: resolution (Random Resolution) (do {! random.monad} - [[main-dependency main-package] ..package - dependencies (|> (//package.dependencies main-package) - (\ try.monad map set.to-list) + [[main_dependency main_package] ..package + dependencies (|> (//package.dependencies main_package) + (\ try.monad map set.to_list) (try.default (list)) (monad.map ! (function (_ dependency) (do ! @@ -88,47 +88,47 @@ (set@ #//.dependencies (set.new //dependency.hash)) (set@ #//.identity (#.Some (get@ #//dependency.artifact dependency))) //pom.write - try.to-maybe)) + try.to_maybe)) ..profile) content ..content] (wrap [dependency (set@ #//package.origin #//package.Remote (//package.local pom content))])))))] - (wrap (dictionary.from-list //dependency.hash (list& [main-dependency main-package] dependencies))))) + (wrap (dictionary.from_list //dependency.hash (list& [main_dependency main_package] dependencies))))) (def: singular Test (do {! random.monad} - [[dependency expected-package] ..package + [[dependency expected_package] ..package home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) + working_directory (random.ascii/alpha 5) #let [fs (: (file.System Promise) (file.mock (\ file.default separator))) - program (program.async (program.mock environment.empty home working-directory))]] + program (program.async (program.mock environment.empty home working_directory))]] (wrap (do promise.monad - [wrote! (/.write-one program fs dependency expected-package) - read! (/.read-one program fs dependency)] - (_.cover' [/.write-one /.read-one] + [wrote! (/.write_one program fs dependency expected_package) + read! (/.read_one program fs dependency)] + (_.cover' [/.write_one /.read_one] (<| (try.default false) (do try.monad [_ wrote! - actual-package read!] + actual_package read!] (wrap (\ //package.equivalence = - (set@ #//package.origin #//package.Local expected-package) - actual-package))))))))) + (set@ #//package.origin #//package.Local expected_package) + actual_package))))))))) (def: plural Test (do {! random.monad} [expected ..resolution home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) + working_directory (random.ascii/alpha 5) #let [fs (: (file.System Promise) (file.mock (\ file.default separator))) - program (program.async (program.mock environment.empty home working-directory))]] + program (program.async (program.mock environment.empty home working_directory))]] (wrap (do promise.monad - [wrote! (/.write-all program fs expected) - read! (/.read-all program fs (dictionary.keys expected) //dependency/resolution.empty)] - (_.cover' [/.write-all /.read-all] + [wrote! (/.write_all program fs expected) + read! (/.read_all program fs (dictionary.keys expected) //dependency/resolution.empty)] + (_.cover' [/.write_all /.read_all] (<| (try.default false) (do try.monad [_ wrote! diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index c43d8642f..817b4db5f 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -47,26 +47,26 @@ ["#." dependency ["#/." resolution (#+ Resolution)]]]]]}) -(def: (command end-signal dummy-files) +(def: (command end_signal dummy_files) (-> Text (List Path) [(Atom [Nat (List Path)]) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom [Nat (List Path)]) - (atom.atom [0 dummy-files]))] + (atom.atom [0 dummy_files]))] [@runs (function (_ console program fs shell resolution profile) (do {! promise.monad} - [[runs remaining-files] (promise.future - (atom.update (function (_ [runs remaining-files]) - [(inc runs) remaining-files]) + [[runs remaining_files] (promise.future + (atom.update (function (_ [runs remaining_files]) + [(inc runs) remaining_files]) @runs))] - (case remaining-files + (case remaining_files #.Nil - (wrap (#try.Failure end-signal)) + (wrap (#try.Failure end_signal)) (#.Cons head tail) (do (try.with !) - [_ (!.use (\ fs create-file) [head])] + [_ (!.use (\ fs create_file) [head])] (do ! [_ (promise.future (atom.write [runs tail] @runs))] (wrap (#try.Success [])))))))])) @@ -77,47 +77,47 @@ (do {! random.monad} [#let [/ (\ file.default separator) [fs watcher] (watch.mock /)] - end-signal (random.ascii/alpha 5) + end_signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) - expected-runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) + working_directory (random.ascii/alpha 5) + expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) source (random.ascii/alpha 5) - dummy-files (|> (random.ascii/alpha 5) - (random.set text.hash (dec expected-runs)) - (\ ! map (|>> set.to-list (list\map (|>> (format source /)))))) - #let [empty-profile (: Profile + dummy_files (|> (random.ascii/alpha 5) + (random.set text.hash (dec expected_runs)) + (\ ! map (|>> set.to_list (list\map (|>> (format source /)))))) + #let [empty_profile (: Profile (\ ///.monoid identity)) - with-target (: (-> Profile Profile) + with_target (: (-> Profile Profile) (set@ #///.target (#.Some target))) - with-program (: (-> Profile Profile) + with_program (: (-> Profile Profile) (set@ #///.program (#.Some program))) - profile (|> empty-profile - with-program - with-target - (set@ #///.sources (set.from-list text.hash (list source))))] + profile (|> empty_profile + with_program + with_target + (set@ #///.sources (set.from_list text.hash (list source))))] resolution @build.resolution] ($_ _.and (wrap (do promise.monad [verdict (do ///action.monad - [#let [[@runs command] (..command end-signal dummy-files)] - _ (!.use (\ fs create-directory) [source]) + [#let [[@runs command] (..command end_signal dummy_files)] + _ (!.use (\ fs create_directory) [source]) _ (\ watcher poll [])] (do promise.monad [outcome ((/.do! watcher command) (@version.echo "") - (program.async (program.mock environment.empty home working-directory)) + (program.async (program.mock environment.empty home working_directory)) fs - (@build.good-shell []) + (@build.good_shell []) resolution profile) - [actual-runs _] (promise.future (atom.read @runs))] - (wrap (#try.Success (and (n.= expected-runs actual-runs) + [actual_runs _] (promise.future (atom.read @runs))] + (wrap (#try.Success (and (n.= expected_runs actual_runs) (case outcome (#try.Failure error) - (is? end-signal error) + (is? end_signal error) (#try.Success _) false))))))] diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 025d01c0b..8a4df9a7e 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -36,55 +36,55 @@ ["#." dependency ["#/." resolution]]]]}) -(def: #export good-shell +(def: #export good_shell (-> Any (Shell Promise)) (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success (: (shell.Simulation []) (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) + (def: (on_read state) + (#try.Failure "on_read")) + (def: (on_error state) + (#try.Failure "on_error")) + (def: (on_write input state) + (#try.Failure "on_write")) + (def: (on_destroy state) + (#try.Failure "on_destroy")) + (def: (on_await state) (#try.Success [state shell.normal])))))))) -(def: #export bad-shell +(def: #export bad_shell (-> Any (Shell Promise)) (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success (: (shell.Simulation []) (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) + (def: (on_read state) + (#try.Failure "on_read")) + (def: (on_error state) + (#try.Failure "on_error")) + (def: (on_write input state) + (#try.Failure "on_write")) + (def: (on_destroy state) + (#try.Failure "on_destroy")) + (def: (on_await state) (#try.Success [state shell.error])))))))) (def: compiler (do random.monad - [lux-version (random.ascii/alpha 5) - #let [jvm-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.jvm-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library} - js-compiler {#///dependency.artifact {#///artifact.group /.lux-group - #///artifact.name /.js-compiler-name - #///artifact.version lux-version} - #///dependency.type ///artifact/type.lux-library}]] - (random.either (wrap jvm-compiler) - (wrap js-compiler)))) + [lux_version (random.ascii/alpha 5) + #let [jvm_compiler {#///dependency.artifact {#///artifact.group /.lux_group + #///artifact.name /.jvm_compiler_name + #///artifact.version lux_version} + #///dependency.type ///artifact/type.lux_library} + js_compiler {#///dependency.artifact {#///artifact.group /.lux_group + #///artifact.name /.js_compiler_name + #///artifact.version lux_version} + #///dependency.type ///artifact/type.lux_library}]] + (random.either (wrap jvm_compiler) + (wrap js_compiler)))) (def: #export resolution (do random.monad @@ -98,63 +98,63 @@ (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - shell (..good-shell [])] + shell (..good_shell [])] program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) - #let [empty-profile (: Profile + working_directory (random.ascii/alpha 5) + #let [empty_profile (: Profile (\ ///.monoid identity)) - with-target (: (-> Profile Profile) + with_target (: (-> Profile Profile) (set@ #///.target (#.Some target))) - with-program (: (-> Profile Profile) + with_program (: (-> Profile Profile) (set@ #///.program (#.Some program))) - profile (|> empty-profile - with-program - with-target)]] + profile (|> empty_profile + with_program + with_target)]] ($_ _.and (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty - (with-target empty-profile))] - (_.cover' [/.no-specified-program] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty + (with_target empty_profile))] + (_.cover' [/.no_specified_program] (case outcome (#try.Success _) false (#try.Failure error) - (exception.match? /.no-specified-program error))))) + (exception.match? /.no_specified_program error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty - (with-program empty-profile))] - (_.cover' [/.no-specified-target] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty + (with_program empty_profile))] + (_.cover' [/.no_specified_target] (case outcome (#try.Success _) false (#try.Failure error) - (exception.match? /.no-specified-target error))))) + (exception.match? /.no_specified_target error))))) (wrap (do promise.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working-directory)) fs shell ///dependency/resolution.empty profile)] - (_.cover' [/.Compiler /.no-available-compiler] + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty profile)] + (_.cover' [/.Compiler /.no_available_compiler] (case outcome (#try.Success _) false (#try.Failure error) - (exception.match? /.no-available-compiler error))))) + (exception.match? /.no_available_compiler error))))) (do ! [#let [console (@version.echo "")] resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs shell resolution profile) - start (!.use (\ console read-line) []) - end (!.use (\ console read-line) [])] + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution profile) + start (!.use (\ console read_line) []) + end (!.use (\ console read_line) [])] (wrap (and (text\= /.start start) (text\= /.success end))))] (_.cover' [/.do! - /.lux-group /.jvm-compiler-name /.js-compiler-name + /.lux_group /.jvm_compiler_name /.js_compiler_name /.start /.success] (try.default false verdict))))) (do ! @@ -162,9 +162,9 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs (..bad-shell []) resolution profile) - start (!.use (\ console read-line) []) - end (!.use (\ console read-line) [])] + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (..bad_shell []) resolution profile) + start (!.use (\ console read_line) []) + end (!.use (\ console read_line) [])] (wrap (and (text\= /.start start) (text\= /.failure end))))] (_.cover' [/.failure] diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 739bd1a34..c429f34fb 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -37,7 +37,7 @@ ["#" profile] ["#." action (#+ Action)]]]}) -(def: node-name +(def: node_name (Random Text) (random.ascii/alpha 10)) @@ -45,58 +45,58 @@ (-> Path (Random (List [Path Binary]))) (do {! random.monad} [count (\ ! map (n.% 10) random.nat) - names (random.set text.hash count ..node-name) + names (random.set text.hash count ..node_name) contents (random.list count (_binary.random 100))] - (wrap (list.zip/2 (list\map (|>> (format prefix)) (set.to-list names)) + (wrap (list.zip/2 (list\map (|>> (format prefix)) (set.to_list names)) contents)))) -(def: (create-file! fs [path content]) +(def: (create_file! fs [path content]) (-> (file.System Promise) [Path Binary] (Promise (Try Any))) (do {! (try.with promise.monad)} [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs path))] - (!.use (\ file over-write) content))) + (file.get_file promise.monad fs path))] + (!.use (\ file over_write) content))) -(def: (create-directory! fs path files) +(def: (create_directory! fs path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any))) (do {! (try.with promise.monad)} [_ (: (Promise (Try Path)) - (file.make-directories promise.monad fs path)) - _ (monad.map ! (..create-file! fs) files)] + (file.make_directories promise.monad fs path)) + _ (monad.map ! (..create_file! fs) files)] (wrap []))) -(def: (directory-exists? fs) +(def: (directory_exists? fs) (-> (file.System Promise) Path (Promise (Try Bit))) - (|>> (file.directory-exists? promise.monad fs) (try.lift promise.monad))) + (|>> (file.directory_exists? promise.monad fs) (try.lift promise.monad))) -(def: (file-exists? fs) +(def: (file_exists? fs) (-> (file.System Promise) Path (Promise (Try Bit))) - (|>> (file.file-exists? promise.monad fs) (try.lift promise.monad))) + (|>> (file.file_exists? promise.monad fs) (try.lift promise.monad))) -(def: (assets-exist? fs directory-path files) +(def: (assets_exist? fs directory_path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit))) (do {! (try.with promise.monad)} - [directory-exists? (..directory-exists? fs directory-path) - files-exist? (: (Action (List Bit)) + [directory_exists? (..directory_exists? fs directory_path) + files_exist? (: (Action (List Bit)) (|> files (list\map product.left) - (monad.map ///action.monad (..file-exists? fs))))] - (wrap (and directory-exists? - (list.every? (|>>) files-exist?))))) + (monad.map ///action.monad (..file_exists? fs))))] + (wrap (and directory_exists? + (list.every? (|>>) files_exist?))))) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [context ..node-name - target ..node-name - sub ..node-name + [context ..node_name + target ..node_name + sub ..node_name #let [fs (file.mock (\ file.default separator)) / (\ fs separator) - target-path (format context / target) - sub-path (format target-path / sub)] - direct-files (..files (format target-path /)) - sub-files (..files (format sub-path /)) + target_path (format context / target) + sub_path (format target_path / sub)] + direct_files (..files (format target_path /)) + sub_files (..files (format sub_path /)) dummy @profile.random] ($_ _.and @@ -105,28 +105,28 @@ verdict (do {! (try.with promise.monad)} [_ (/.do! console fs (set@ #///.target #.None dummy))] (\ ! map (text\= /.failure) - (!.use (\ console read-line) [])))] + (!.use (\ console read_line) [])))] (_.cover' [/.failure] (try.default false verdict)))) (wrap (do promise.monad [#let [console (@version.echo "")] verdict (do {! (try.with promise.monad)} - [_ (..create-directory! fs target-path direct-files) - _ (..create-directory! fs sub-path sub-files) - context-exists!/pre (..directory-exists? fs context) - target-exists!/pre (..assets-exist? fs target-path direct-files) - sub-exists!/pre (..assets-exist? fs sub-path sub-files) - _ (/.do! console fs (set@ #///.target (#.Some target-path) dummy)) - context-exists!/post (..directory-exists? fs context) - target-exists!/post (..assets-exist? fs target-path direct-files) - sub-exists!/post (..assets-exist? fs sub-path sub-files) - logging (!.use (\ console read-line) [])] - (wrap (and (and context-exists!/pre - context-exists!/post) - (and target-exists!/pre - (not target-exists!/post)) - (and sub-exists!/pre - (not sub-exists!/post)) + [_ (..create_directory! fs target_path direct_files) + _ (..create_directory! fs sub_path sub_files) + context_exists!/pre (..directory_exists? fs context) + target_exists!/pre (..assets_exist? fs target_path direct_files) + sub_exists!/pre (..assets_exist? fs sub_path sub_files) + _ (/.do! console fs (set@ #///.target (#.Some target_path) dummy)) + context_exists!/post (..directory_exists? fs context) + target_exists!/post (..assets_exist? fs target_path direct_files) + sub_exists!/post (..assets_exist? fs sub_path sub_files) + logging (!.use (\ console read_line) [])] + (wrap (and (and context_exists!/pre + context_exists!/post) + (and target_exists!/pre + (not target_exists!/post)) + (and sub_exists!/pre + (not sub_exists!/post)) (text\= /.success logging))))] (_.cover' [/.do! /.success] (try.default false verdict)))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 86f3e0dbb..b6cd89469 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -53,9 +53,9 @@ ["#." artifact (#+ Artifact) ["#/." extension]]]]]}) -(def: (make-sources! fs sources) +(def: (make_sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) - (loop [sources (set.to-list sources)] + (loop [sources (set.to_list sources)] (case sources #.Nil (|> [] @@ -65,9 +65,9 @@ (#.Cons head tail) (do (try.with promise.monad) [_ (: (Promise (Try Path)) - (file.make-directories promise.monad fs head)) + (file.make_directories promise.monad fs head)) _ (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs (format head (\ fs separator) head ".lux")))] + (file.get_file promise.monad fs (format head (\ fs separator) head ".lux")))] (recur tail))))) (def: (execute! program repository fs artifact profile) @@ -78,67 +78,67 @@ [home (\ program home [])] (do ///action.monad [#let [console (@version.echo "")] - _ (..make-sources! fs (get@ #///.sources profile)) + _ (..make_sources! fs (get@ #///.sources profile)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs home))) + (file.make_directories promise.monad fs (///local.repository fs home))) _ (/.do! console repository fs artifact profile)] - (!.use (\ console read-line) [])))) + (!.use (\ console read_line) [])))) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [[artifact expected-pom profile] + [[artifact expected_pom profile] (random.one (function (_ profile) (do maybe.monad [artifact (get@ #///.identity profile) - expected-pom (try.to-maybe (///pom.write profile))] - (wrap [artifact expected-pom profile]))) + expected_pom (try.to_maybe (///pom.write profile))] + (wrap [artifact expected_pom profile]))) @profile.random) home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) + working_directory (random.ascii/alpha 5) #let [repository (///repository.mock @repository.simulation @repository.empty) fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working-directory))]] + program (program.async (program.mock environment.empty home working_directory))]] (wrap (do {! promise.monad} [verdict (do {! ///action.monad} [logging (..execute! program repository fs artifact profile) - expected-library (|> profile + expected_library (|> profile (get@ #///.sources) - set.to-list + set.to_list (export.library fs) (\ ! map (format.run tar.writer))) - actual-pom (\ repository download (///repository.uri artifact ///artifact/extension.pom)) - actual-library (\ repository download (///repository.uri artifact ///artifact/extension.lux-library)) - actual-sha-1 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux-library ///artifact/extension.sha-1))) - actual-md5 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux-library ///artifact/extension.md5))) + actual_pom (\ repository download (///repository.uri artifact ///artifact/extension.pom)) + actual_library (\ repository download (///repository.uri artifact ///artifact/extension.lux_library)) + actual_sha-1 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_md5 (\ repository download (///repository.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) - #let [deployed-library! + #let [deployed_library! (\ binary.equivalence = - expected-library - actual-library) + expected_library + actual_library) - deployed-pom! + deployed_pom! (\ binary.equivalence = - (|> expected-pom (\ xml.codec encode) (\ encoding.utf8 encode)) - actual-pom) + (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode)) + actual_pom) - deployed-sha-1! + deployed_sha-1! (\ binary.equivalence = - (///hash.data (///hash.sha-1 expected-library)) - actual-sha-1) + (///hash.data (///hash.sha-1 expected_library)) + actual_sha-1) - deployed-md5! + deployed_md5! (\ binary.equivalence = - (///hash.data (///hash.md5 expected-library)) - actual-md5)]] + (///hash.data (///hash.md5 expected_library)) + actual_md5)]] (wrap (and (text\= //clean.success logging) - deployed-library! - deployed-pom! - deployed-sha-1! - deployed-md5!)))] + deployed_library! + deployed_pom! + deployed_sha-1! + deployed_md5!)))] (_.cover' [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 84c51dc93..7002238e7 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -52,55 +52,55 @@ (<| (_.covering /._) (do random.monad [home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) + working_directory (random.ascii/alpha 5) - dependee-artifact $///artifact.random - depender-artifact (random.filter (predicate.complement - (\ ///artifact.equivalence = dependee-artifact)) + dependee_artifact $///artifact.random + depender_artifact (random.filter (predicate.complement + (\ ///artifact.equivalence = dependee_artifact)) $///artifact.random) - [_ dependee-package] $///package.random - [_ depender-package] $///package.random + [_ dependee_package] $///package.random + [_ depender_package] $///package.random - #let [dependee {#///dependency.artifact dependee-artifact - #///dependency.type ///artifact/type.lux-library} - depender {#///dependency.artifact depender-artifact - #///dependency.type ///artifact/type.lux-library} + #let [dependee {#///dependency.artifact dependee_artifact + #///dependency.type ///artifact/type.lux_library} + depender {#///dependency.artifact depender_artifact + #///dependency.type ///artifact/type.lux_library} - dependee-pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some dependee-artifact)) + dependee_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some dependee_artifact)) ///pom.write try.assume) - depender-pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some depender-artifact)) - (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee))) + depender_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some depender_artifact)) + (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) ///pom.write try.assume) - dependee-package (|> dependee-package + dependee_package (|> dependee_package (set@ #///package.origin #///package.Remote) - (set@ #///package.pom [dependee-pom #///dependency/status.Unverified])) - depender-package (|> depender-package + (set@ #///package.pom [dependee_pom #///dependency/status.Unverified])) + depender_package (|> depender_package (set@ #///package.origin #///package.Remote) - (set@ #///package.pom [depender-pom #///dependency/status.Unverified])) + (set@ #///package.pom [depender_pom #///dependency/status.Unverified])) fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working-directory))]] + program (program.async (program.mock environment.empty home working_directory))]] (wrap (do promise.monad [verdict (do ///action.monad [#let [console (@version.echo "")] pre (|> ///dependency/resolution.empty - (dictionary.put dependee dependee-package) - (///cache.write-all program fs)) + (dictionary.put dependee dependee_package) + (///cache.write_all program fs)) post (|> (\ ///.monoid identity) - (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee depender))) - (/.do! program console fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) [])))) + (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) + (/.do! program console fs (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) logging! (\ ///action.monad map (text\= //clean.success) - (!.use (\ console read-line) []))] + (!.use (\ console read_line) []))] (wrap (and logging! - (and (set.member? pre dependee-artifact) - (not (set.member? pre depender-artifact))) + (and (set.member? pre dependee_artifact) + (not (set.member? pre depender_artifact))) (and (dictionary.key? post dependee) (dictionary.key? post depender)))))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 9ffa65bab..9df49efa4 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -44,9 +44,9 @@ ["#." artifact ["#/." extension]]]]]}) -(def: (make-sources! fs sources) +(def: (make_sources! fs sources) (-> (file.System Promise) (Set Path) (Promise (Try Any))) - (loop [sources (set.to-list sources)] + (loop [sources (set.to_list sources)] (case sources #.Nil (|> [] @@ -56,9 +56,9 @@ (#.Cons head tail) (do (try.with promise.monad) [_ (: (Promise (Try Path)) - (file.make-directories promise.monad fs head)) + (file.make_directories promise.monad fs head)) _ (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs (format head (\ fs separator) head ".lux")))] + (file.get_file promise.monad fs (format head (\ fs separator) head ".lux")))] (recur tail))))) (def: (execute! program fs sample) @@ -67,11 +67,11 @@ [home (\ program home [])] (do ///action.monad [#let [console (@version.echo "")] - _ (..make-sources! fs (get@ #///.sources sample)) + _ (..make_sources! fs (get@ #///.sources sample)) _ (: (Promise (Try Path)) - (file.make-directories promise.monad fs (///local.repository fs home))) + (file.make_directories promise.monad fs (///local.repository fs home))) _ (/.do! program console fs sample)] - (!.use (\ console read-line) [])))) + (!.use (\ console read_line) [])))) (def: #export test Test @@ -81,33 +81,33 @@ sample (\ ! map (set@ #///.identity (#.Some identity)) @profile.random) home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5)] + working_directory (random.ascii/alpha 5)] ($_ _.and (wrap (do {! promise.monad} [#let [fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working-directory))] + program (program.async (program.mock environment.empty home working_directory))] verdict (do ///action.monad [logging (..execute! program fs sample) - #let [artifact-path (format (///local.path fs home identity) + #let [artifact_path (format (///local.path fs home identity) (\ fs separator) (///artifact.identity identity)) - library-path (format artifact-path ///artifact/extension.lux-library) - pom-path (format artifact-path ///artifact/extension.pom)] + library_path (format artifact_path ///artifact/extension.lux_library) + pom_path (format artifact_path ///artifact/extension.pom)] - library-exists! (\ promise.monad map + library_exists! (\ promise.monad map exception.return - (file.file-exists? promise.monad fs library-path)) - pom-exists! (\ promise.monad map + (file.file_exists? promise.monad fs library_path)) + pom_exists! (\ promise.monad map exception.return - (file.file-exists? promise.monad fs pom-path))] + (file.file_exists? promise.monad fs pom_path))] (wrap (and (text\= //clean.success logging) - library-exists! - pom-exists!)))] + library_exists! + pom_exists!)))] (_.cover' [/.do!] (try.default false verdict)))) (wrap (do {! promise.monad} [#let [fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working-directory))] + program (program.async (program.mock environment.empty home working_directory))] logging (..execute! program fs (set@ #///.identity #.None sample))] (_.cover' [/.failure] (|> logging diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index d179031ea..33c102926 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -49,21 +49,21 @@ (try\map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))) (\ ! wrap)) file (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs path)) + (file.get_file promise.monad fs path)) actual (!.use (\ file content) []) logging! (\ ///action.monad map (text\= //clean.success) - (!.use (\ console read-line) [])) + (!.use (\ console read_line) [])) - #let [expected-path! + #let [expected_path! (text\= ///pom.file path) - expected-content! + expected_content! (\ binary.equivalence = expected actual)]] (wrap (and logging! - expected-path! - expected-content!)))] + expected_path! + expected_content!)))] (_.cover' [/.do!] (try.default false verdict))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index b63662bc0..2d077ab87 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -45,32 +45,32 @@ [program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) - working-directory (random.ascii/alpha 5) - #let [empty-profile (: Profile + working_directory (random.ascii/alpha 5) + #let [empty_profile (: Profile (\ ///.monoid identity)) - with-target (: (-> Profile Profile) + with_target (: (-> Profile Profile) (set@ #///.target (#.Some target))) - with-program (: (-> Profile Profile) + with_program (: (-> Profile Profile) (set@ #///.program (#.Some program))) - profile (|> empty-profile - with-program - with-target)] + profile (|> empty_profile + with_program + with_target)] resolution @build.resolution] ($_ _.and (let [fs (file.mock (\ file.default separator)) console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs (@build.good-shell []) resolution profile) - build-start (!.use (\ console read-line) []) - build-end (!.use (\ console read-line) []) - test-start (!.use (\ console read-line) []) - test-end (!.use (\ console read-line) [])] - (wrap (and (and (text\= //build.start build-start) - (text\= //build.success build-end)) - (and (text\= /.start test-start) - (text\= /.success test-end)))))] + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (@build.good_shell []) resolution profile) + build_start (!.use (\ console read_line) []) + build_end (!.use (\ console read_line) []) + test_start (!.use (\ console read_line) []) + test_end (!.use (\ console read_line) [])] + (wrap (and (and (text\= //build.start build_start) + (text\= //build.success build_end)) + (and (text\= /.start test_start) + (text\= /.success test_end)))))] (_.cover' [/.do! /.start /.success] (try.default false verdict))))) @@ -78,33 +78,33 @@ console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [#let [bad-shell (shell.mock - (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + [#let [bad_shell (shell.mock + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success (: (shell.Simulation []) (structure - (def: (on-read state) - (#try.Failure "on-read")) - (def: (on-error state) - (#try.Failure "on-error")) - (def: (on-write input state) - (#try.Failure "on-write")) - (def: (on-destroy state) - (#try.Failure "on-destroy")) - (def: (on-await state) - (#try.Success [state (if (text.ends-with? " build" actual-command) + (def: (on_read state) + (#try.Failure "on_read")) + (def: (on_error state) + (#try.Failure "on_error")) + (def: (on_write input state) + (#try.Failure "on_write")) + (def: (on_destroy state) + (#try.Failure "on_destroy")) + (def: (on_await state) + (#try.Success [state (if (text.ends_with? " build" actual_command) shell.normal shell.error)])))))) [])] - _ (/.do! console (program.async (program.mock environment.empty home working-directory)) fs bad-shell resolution profile) - build-start (!.use (\ console read-line) []) - build-end (!.use (\ console read-line) []) - test-start (!.use (\ console read-line) []) - test-end (!.use (\ console read-line) [])] - (wrap (and (and (text\= //build.start build-start) - (text\= //build.success build-end)) - (and (text\= /.start test-start) - (text\= /.failure test-end)))))] + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs bad_shell resolution profile) + build_start (!.use (\ console read_line) []) + build_end (!.use (\ console read_line) []) + test_start (!.use (\ console read_line) []) + test_end (!.use (\ console read_line) [])] + (wrap (and (and (text\= //build.start build_start) + (text\= //build.success build_end)) + (and (text\= /.start test_start) + (text\= /.failure test_end)))))] (_.cover' [/.failure] (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index 5e60f6b9b..ee26b3b5d 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -29,34 +29,34 @@ {#program ["." /]}) -(exception: #export console-is-closed!) +(exception: #export console_is_closed!) (structure: simulation (Simulation [Bit Text]) - (def: (on-read [open? state]) + (def: (on_read [open? state]) (if open? - (try.from-maybe + (try.from_maybe (do maybe.monad [head (text.nth 0 state) [_ tail] (text.split 1 state)] (wrap [[open? tail] head]))) - (exception.throw ..console-is-closed! []))) - (def: (on-read-line [open? state]) + (exception.throw ..console_is_closed! []))) + (def: (on_read_line [open? state]) (if open? - (try.from-maybe + (try.from_maybe (do maybe.monad - [[output state] (text.split-with text.new-line state)] + [[output state] (text.split_with text.new_line state)] (wrap [[open? state] output]))) - (exception.throw ..console-is-closed! []))) - (def: (on-write input [open? state]) + (exception.throw ..console_is_closed! []))) + (def: (on_write input [open? state]) (if open? (#try.Success [open? (format state input)]) - (exception.throw ..console-is-closed! []))) - (def: (on-close [open? buffer]) + (exception.throw ..console_is_closed! []))) + (def: (on_close [open? buffer]) (if open? (#try.Success [false buffer]) - (exception.throw ..console-is-closed! [])))) + (exception.throw ..console_is_closed! [])))) (def: #export echo (-> Text (Console Promise)) @@ -71,7 +71,7 @@ [#let [console (..echo "")] verdict (do (try.with promise.monad) [_ (/.do! console profile) - logging (!.use (\ console read-line) [])] + logging (!.use (\ console read_line) [])] (wrap (text\= (version.format language/lux.version) logging)))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 92ced9e74..5f262bce4 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -52,260 +52,260 @@ [artifact $///artifact.random [_ package] $///package.random] (wrap (dictionary.put {#///dependency.artifact artifact - #///dependency.type ///artifact/type.lux-library} + #///dependency.type ///artifact/type.lux_library} package /.empty)))) (def: #export (single artifact package) (-> Artifact Package (Simulation Any)) (structure - (def: (on-download uri state) + (def: (on_download uri state) (if (text.contains? (///artifact.uri artifact) uri) - (cond (text.ends-with? ///artifact/extension.lux-library uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> package (get@ #///package.library) product.left)]) - (text.ends-with? ///artifact/extension.pom uri) + (text.ends_with? ///artifact/extension.pom uri) (#try.Success [state (|> package (get@ #///package.pom) product.left (\ xml.codec encode) (\ encoding.utf8 encode))]) - ## (text.ends-with? ///artifact/extension.sha-1 uri) + ## (text.ends_with? ///artifact/extension.sha-1 uri) ## (#try.Success [state (|> package ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1-codec encode) + ## (\ ///hash.sha-1_codec encode) ## (\ encoding.utf8 encode))]) - ## (text.ends-with? ///artifact/extension.md5 uri) + ## (text.ends_with? ///artifact/extension.md5 uri) ## (#try.Success [state (|> package ## (get@ #///package.md5) - ## (\ ///hash.md5-codec encode) + ## (\ ///hash.md5_codec encode) ## (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) (#try.Failure "NOPE"))) - (def: (on-upload uri binary state) + (def: (on_upload uri binary state) (#try.Failure "NOPE")))) (def: one Test (do {! random.monad} - [expected-artifact $///artifact.random - [_ expected-package] $///package.random - [_ dummy-package] (random.filter (|>> product.right - (set@ #///package.pom (get@ #///package.pom expected-package)) - (\ ///package.equivalence = expected-package) + [expected_artifact $///artifact.random + [_ expected_package] $///package.random + [_ dummy_package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected_package)) + (\ ///package.equivalence = expected_package) not) $///package.random) - #let [good (..single expected-artifact expected-package) - bad-sha-1 (: (Simulation Any) + #let [good (..single expected_artifact expected_package) + bad_sha-1 (: (Simulation Any) (structure - (def: (on-download uri state) - (if (text.contains? (///artifact.uri expected-artifact) uri) - (cond (text.ends-with? ///artifact/extension.lux-library uri) - (#try.Success [state (|> expected-package + (def: (on_download uri state) + (if (text.contains? (///artifact.uri expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package (get@ #///package.library) product.left)]) - (text.ends-with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected-package + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> dummy-package + ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1-codec encode) + ## (\ ///hash.sha-1_codec encode) ## (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> expected-package + ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) - ## (\ ///hash.md5-codec encode) + ## (\ ///hash.md5_codec encode) ## (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) (#try.Failure "NOPE"))) - (def: (on-upload uri binary state) + (def: (on_upload uri binary state) (#try.Failure "NOPE")))) - bad-md5 (: (Simulation Any) + bad_md5 (: (Simulation Any) (structure - (def: (on-download uri state) - (if (text.contains? (///artifact.uri expected-artifact) uri) - (cond (text.ends-with? ///artifact/extension.lux-library uri) - (#try.Success [state (|> expected-package + (def: (on_download uri state) + (if (text.contains? (///artifact.uri expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package (get@ #///package.library) product.left)]) - (text.ends-with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected-package + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> expected-package + ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1-codec encode) + ## (\ ///hash.sha-1_codec encode) ## (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> dummy-package + ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) - ## (\ ///hash.md5-codec encode) + ## (\ ///hash.md5_codec encode) ## (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) (#try.Failure "NOPE"))) - (def: (on-upload uri binary state) + (def: (on_upload uri binary state) (#try.Failure "NOPE"))))]] (`` ($_ _.and (wrap (do promise.monad - [actual-package (/.one (///repository.mock good []) - {#///dependency.artifact expected-artifact - #///dependency.type ///artifact/type.lux-library})] + [actual_package (/.one (///repository.mock good []) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] (_.cover' [/.one] - (case actual-package - (#try.Success actual-package) + (case actual_package + (#try.Success actual_package) (\ ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) + (set@ #///package.origin #///package.Remote expected_package) + actual_package) (#try.Failure _) false)))) (~~ (template [<exception> <bad>] [(wrap (do promise.monad - [actual-package (/.one (///repository.mock <bad> []) - {#///dependency.artifact expected-artifact - #///dependency.type ///artifact/type.lux-library})] + [actual_package (/.one (///repository.mock <bad> []) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] (_.cover' [<exception>] - (case actual-package + (case actual_package (#try.Failure error) (exception.match? <exception> error) (#try.Success _) false))))] - [/.sha-1-does-not-match bad-sha-1] - [/.md5-does-not-match bad-md5] + [/.sha-1_does_not_match bad_sha-1] + [/.md5_does_not_match bad_md5] )) )))) (def: any Test (do {! random.monad} - [expected-artifact $///artifact.random - [_ expected-package] $///package.random - [_ dummy-package] (random.filter (|>> product.right - (set@ #///package.pom (get@ #///package.pom expected-package)) - (\ ///package.equivalence = expected-package) + [expected_artifact $///artifact.random + [_ expected_package] $///package.random + [_ dummy_package] (random.filter (|>> product.right + (set@ #///package.pom (get@ #///package.pom expected_package)) + (\ ///package.equivalence = expected_package) not) $///package.random) - #let [good (..single expected-artifact expected-package) - bad-sha-1 (: (Simulation Any) + #let [good (..single expected_artifact expected_package) + bad_sha-1 (: (Simulation Any) (structure - (def: (on-download uri state) - (if (text.contains? (///artifact.uri expected-artifact) uri) - (cond (text.ends-with? ///artifact/extension.lux-library uri) - (#try.Success [state (|> expected-package + (def: (on_download uri state) + (if (text.contains? (///artifact.uri expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package (get@ #///package.library) product.left)]) - (text.ends-with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected-package + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> dummy-package + ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1-codec encode) + ## (\ ///hash.sha-1_codec encode) ## (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> expected-package + ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) - ## (\ ///hash.md5-codec encode) + ## (\ ///hash.md5_codec encode) ## (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) (#try.Failure "NOPE"))) - (def: (on-upload uri binary state) + (def: (on_upload uri binary state) (#try.Failure "NOPE")))) - bad-md5 (: (Simulation Any) + bad_md5 (: (Simulation Any) (structure - (def: (on-download uri state) - (if (text.contains? (///artifact.uri expected-artifact) uri) - (cond (text.ends-with? ///artifact/extension.lux-library uri) - (#try.Success [state (|> expected-package + (def: (on_download uri state) + (if (text.contains? (///artifact.uri expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package (get@ #///package.library) product.left)]) - (text.ends-with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected-package + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package (get@ #///package.pom) product.left (\ xml.codec encode) (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> expected-package + ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1-codec encode) + ## (\ ///hash.sha-1_codec encode) ## (\ encoding.utf8 encode))]) ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> dummy-package + ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) - ## (\ ///hash.md5-codec encode) + ## (\ ///hash.md5_codec encode) ## (\ encoding.utf8 encode))]) ## else (#try.Failure "NOPE")) (#try.Failure "NOPE"))) - (def: (on-upload uri binary state) + (def: (on_upload uri binary state) (#try.Failure "NOPE"))))]] ($_ _.and (wrap (do promise.monad - [actual-package (/.any (list (///repository.mock bad-sha-1 []) - (///repository.mock bad-md5 []) + [actual_package (/.any (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 []) (///repository.mock good [])) - {#///dependency.artifact expected-artifact - #///dependency.type ///artifact/type.lux-library})] + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] (_.cover' [/.any] - (case actual-package - (#try.Success actual-package) + (case actual_package + (#try.Success actual_package) (\ ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) + (set@ #///package.origin #///package.Remote expected_package) + actual_package) (#try.Failure _) false)))) (wrap (do promise.monad - [actual-package (/.any (list (///repository.mock bad-sha-1 []) - (///repository.mock bad-md5 [])) - {#///dependency.artifact expected-artifact - #///dependency.type ///artifact/type.lux-library})] - (_.cover' [/.cannot-resolve] - (case actual-package + [actual_package (/.any (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 [])) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] + (_.cover' [/.cannot_resolve] + (case actual_package (#try.Failure error) - (exception.match? /.cannot-resolve error) + (exception.match? /.cannot_resolve error) (#try.Success _) false)))) @@ -314,49 +314,49 @@ (def: all Test (do {! random.monad} - [dependee-artifact $///artifact.random - depender-artifact (random.filter (predicate.complement - (\ ///artifact.equivalence = dependee-artifact)) + [dependee_artifact $///artifact.random + depender_artifact (random.filter (predicate.complement + (\ ///artifact.equivalence = dependee_artifact)) $///artifact.random) - ignored-artifact (random.filter (predicate.complement - (predicate.unite (\ ///artifact.equivalence = dependee-artifact) - (\ ///artifact.equivalence = depender-artifact))) + ignored_artifact (random.filter (predicate.complement + (predicate.unite (\ ///artifact.equivalence = dependee_artifact) + (\ ///artifact.equivalence = depender_artifact))) $///artifact.random) - [_ dependee-package] $///package.random - [_ depender-package] $///package.random - [_ ignored-package] $///package.random + [_ dependee_package] $///package.random + [_ depender_package] $///package.random + [_ ignored_package] $///package.random - #let [dependee {#///dependency.artifact dependee-artifact - #///dependency.type ///artifact/type.lux-library} - depender {#///dependency.artifact depender-artifact - #///dependency.type ///artifact/type.lux-library} - ignored {#///dependency.artifact ignored-artifact - #///dependency.type ///artifact/type.lux-library} + #let [dependee {#///dependency.artifact dependee_artifact + #///dependency.type ///artifact/type.lux_library} + depender {#///dependency.artifact depender_artifact + #///dependency.type ///artifact/type.lux_library} + ignored {#///dependency.artifact ignored_artifact + #///dependency.type ///artifact/type.lux_library} - dependee-pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some dependee-artifact)) + dependee_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some dependee_artifact)) ///pom.write try.assume) - depender-pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some depender-artifact)) - (set@ #///.dependencies (set.from-list ///dependency.hash (list dependee))) + depender_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some depender_artifact)) + (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) ///pom.write try.assume) - ignored-pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some ignored-artifact)) + ignored_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some ignored_artifact)) ///pom.write try.assume) - dependee-package (set@ #///package.pom [dependee-pom #///dependency/status.Unverified] dependee-package) - depender-package (set@ #///package.pom [depender-pom #///dependency/status.Unverified] depender-package) - ignored-package (set@ #///package.pom [ignored-pom #///dependency/status.Unverified] ignored-package)]] + dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) + depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) + ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] ($_ _.and (wrap (do promise.monad - [resolution (/.all (list (///repository.mock (..single dependee-artifact dependee-package) []) - (///repository.mock (..single depender-artifact depender-package) []) - (///repository.mock (..single ignored-artifact ignored-package) [])) + [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) + (///repository.mock (..single depender_artifact depender_package) []) + (///repository.mock (..single ignored_artifact ignored_package) [])) (list depender) /.empty)] (_.cover' [/.all] diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index 455835b84..502130970 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -64,17 +64,17 @@ (#try.Failure error) (exception.match? <exception> error)))))] - [/.sha-1 /.as-sha-1 /.not-a-sha-1] - [/.md5 /.as-md5 /.not-a-md5] + [/.sha-1 /.as_sha-1 /.not_a_sha-1] + [/.md5 /.as_md5 /.not_a_md5] )))) (~~ (template [<codec> <hash>] [(_.for [<codec>] ($codec.spec /.equivalence <codec> (..random <hash>)))] - [/.sha-1-codec /.sha-1] - [/.md5-codec /.md5] + [/.sha-1_codec /.sha-1] + [/.md5_codec /.md5] )) - (_.for [/.not-a-hash] + (_.for [/.not_a_hash] ($_ _.and (~~ (template [<codec> <hash>] [(do random.monad @@ -87,9 +87,9 @@ false (#try.Failure error) - (exception.match? /.not-a-hash error))))] + (exception.match? /.not_a_hash error))))] - [/.sha-1-codec /.sha-1] - [/.md5-codec /.md5] + [/.sha-1_codec /.sha-1] + [/.md5_codec /.md5] )))) )))) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index a0db21ba6..e2751381a 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -30,10 +30,10 @@ ["#." action] ["#." format]]]}) -(def: (with-default-source sources) +(def: (with_default_source sources) (-> (Set //.Source) (Set //.Source)) (if (set.empty? sources) - (set.add //.default-source sources) + (set.add //.default_source sources) sources)) (def: #export test @@ -46,16 +46,16 @@ (wrap (do promise.monad [verdict (do //action.monad [file (: (Promise (Try (File Promise))) - (file.get-file promise.monad fs //project.file)) + (file.get_file promise.monad fs //project.file)) _ (|> expected //format.profile %.code (\ encoding.utf8 encode) - (!.use (\ file over-write))) + (!.use (\ file over_write))) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] (wrap (\ //.equivalence = - (update@ #//.sources ..with-default-source expected) + (update@ #//.sources ..with_default_source expected) actual)))] (_.cover' [/.read] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index b95bf2e19..7d0492815 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -30,8 +30,8 @@ ($_ _.and (_.cover [/.repository /.path] (let [path (/.path fs home sample)] - (and (text.starts-with? (/.repository fs home) + (and (text.starts_with? (/.repository fs home) path) - (text.ends-with? (//artifact.path fs sample) + (text.ends_with? (//artifact.path fs sample) path)))) )))) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 9dd3fac22..0cac022f8 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -24,9 +24,9 @@ [sample @artifact.random] ($_ _.and (_.cover [/.project] - (text.ends-with? /.file (/.project sample))) + (text.ends_with? /.file (/.project sample))) (_.cover [/.version] - (text.ends-with? /.file (/.version sample))) + (text.ends_with? /.file (/.version sample))) ))) /artifact.test diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index bb105f305..3177c6ff2 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -35,21 +35,21 @@ (do {! random.monad} [year (\ ! map (|>> (n.% 10,000) .int) random.nat) month (\ ! map (n.% 13) random.nat) - day-of-month (\ ! map (n.% 29) random.nat) + day_of_month (\ ! map (n.% 29) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] (wrap (try.assume (do try.monad [year (year.year year) - month (month.by-number month) - date (date.date year month day-of-month) + month (month.by_number month) + date (date.date year month day_of_month) time (time.time {#time.hour hour #time.minute minute #time.second second - #time.milli-second 0})] - (wrap (instant.from-date-time date time)))))))) + #time.milli_second 0})] + (wrap (instant.from_date_time date time)))))))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index e17765038..e9e42be9a 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -29,31 +29,31 @@ {#program ["." /]}) -(def: random-instant +(def: random_instant (Random Instant) (do {! random.monad} [year (\ ! map (|>> (n.% 10,000) .int) random.nat) month (\ ! map (n.% 13) random.nat) - day-of-month (\ ! map (n.% 29) random.nat) + day_of_month (\ ! map (n.% 29) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] (wrap (try.assume (do try.monad [year (year.year year) - month (month.by-number month) - date (date.date year month day-of-month) + month (month.by_number month) + date (date.date year month day_of_month) time (time.time {#time.hour hour #time.minute minute #time.second second - #time.milli-second 0})] - (wrap (instant.from-date-time date time))))))) + #time.milli_second 0})] + (wrap (instant.from_date_time date time))))))) -(def: random-versioning +(def: random_versioning (Random /.Versioning) ($_ random.and - ..random-instant + ..random_instant random.nat (random.list 5 $///type.random) )) @@ -64,7 +64,7 @@ (random.ascii/alpha 5) (random.ascii/alpha 5) (random.ascii/alpha 5) - ..random-versioning)) + ..random_versioning)) (def: #export test Test diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index 56169a766..7562547df 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -34,10 +34,10 @@ (def: #export random (Random [//.Profile /.Package]) (do {! random.monad} - [content-size (\ ! map (n.% 100) random.nat) - content (_binary.random content-size) + [content_size (\ ! map (n.% 100) random.nat) + content (_binary.random content_size) [profile pom] (random.one (function (_ profile) - (try.to-maybe + (try.to_maybe (do try.monad [pom (//pom.write profile)] (wrap [profile pom])))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 7aeff7a18..1eb62b75d 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -36,32 +36,32 @@ (Random //.Name) (random.ascii/alpha 1)) -(def: (list-of random) +(def: (list_of random) (All [a] (-> (Random a) (Random (List a)))) (do {! random.monad} [size (\ ! map (n.% 5) random.nat)] (random.list size random))) -(def: (dictionary-of key-hash key-random value-random) +(def: (dictionary_of key_hash key_random value_random) (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) (\ random.functor map - (dictionary.from-list key-hash) - (..list-of (random.and key-random value-random)))) + (dictionary.from_list key_hash) + (..list_of (random.and key_random value_random)))) (def: random (Random Project) - (..dictionary-of text.hash ..name @profile.random)) + (..dictionary_of text.hash ..name @profile.random)) -(def: with-default-sources +(def: with_default_sources (-> //.Profile //.Profile) (update@ #//.sources (: (-> (Set //.Source) (Set //.Source)) (function (_ sources) (if (set.empty? sources) - (set.from-list text.hash (list //.default-source)) + (set.from_list text.hash (list //.default_source)) sources))))) -(def: single-profile +(def: single_profile Test (do random.monad [expected @profile.random] @@ -72,20 +72,20 @@ (<c>.run /.project) (case> (#try.Success actual) (|> expected - ..with-default-sources + ..with_default_sources (//project.project //.default) (\ //project.equivalence = actual)) (#try.Failure error) false))))) -(def: (with-empty-profile project) +(def: (with_empty_profile project) (-> Project Project) (if (dictionary.empty? project) (//project.project //.default (\ //.monoid identity)) project)) -(def: multiple-profiles +(def: multiple_profiles Test (do random.monad [expected ..random] @@ -96,11 +96,11 @@ (<c>.run /.project) (case> (#try.Success actual) (|> expected - ..with-empty-profile + ..with_empty_profile dictionary.entries (list\map (function (_ [name profile]) - [name (..with-default-sources profile)])) - (dictionary.from-list text.hash) + [name (..with_default_sources profile)])) + (dictionary.from_list text.hash) (\ //project.equivalence = actual)) (#try.Failure error) @@ -113,6 +113,6 @@ (_.for [/.project //format.Format //format.profile //format.project] ($_ _.and - ..single-profile - ..multiple-profiles + ..single_profile + ..multiple_profiles )))) diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index fefdfb7bb..c87ff0590 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -42,7 +42,7 @@ [(#try.Failure error) #.None] - (exception.match? //.no-identity error) + (exception.match? //.no_identity error) _ false))))) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 1743a243a..9316fae66 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -69,23 +69,23 @@ (Random /.Contributor) ..developer) -(def: (list-of random) +(def: (list_of random) (All [a] (-> (Random a) (Random (List a)))) (do {! random.monad} [size (\ ! map (n.% 5) random.nat)] (random.list size random))) -(def: (set-of hash random) +(def: (set_of hash random) (All [a] (-> (Hash a) (Random a) (Random (Set a)))) (\ random.functor map - (set.from-list hash) - (..list-of random))) + (set.from_list hash) + (..list_of random))) -(def: (dictionary-of key-hash key-random value-random) +(def: (dictionary_of key_hash key_random value_random) (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) (\ random.functor map - (dictionary.from-list key-hash) - (..list-of (random.and key-random value-random)))) + (dictionary.from_list key_hash) + (..list_of (random.and key_random value_random)))) (def: info (Random /.Info) @@ -93,10 +93,10 @@ (random.maybe (random.ascii/alpha 1)) (random.maybe ..scm) (random.maybe (random.ascii/alpha 1)) - (..list-of ..license) + (..list_of ..license) (random.maybe ..organization) - (..list-of ..developer) - (..list-of ..contributor) + (..list_of ..developer) + (..list_of ..contributor) )) (def: name @@ -118,16 +118,16 @@ (def: #export random (Random /.Profile) ($_ random.and - (..list-of ..name) + (..list_of ..name) (random.maybe @artifact.random) (random.maybe ..info) - (..set-of text.hash ..repository) - (..set-of //dependency.hash @dependency.random) - (..set-of text.hash ..source) + (..set_of text.hash ..repository) + (..set_of //dependency.hash @dependency.random) + (..set_of text.hash ..source) (random.maybe ..target) (random.maybe (random.ascii/alpha 1)) (random.maybe (random.ascii/alpha 1)) - (..dictionary-of text.hash (random.ascii/alpha 1) ..repository) + (..dictionary_of text.hash (random.ascii/alpha 1) ..repository) )) (def: #export test diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index 4ea00a3c4..cec9c0cae 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -47,50 +47,50 @@ ($monoid.spec /.equivalence /.monoid ..random)) (do random.monad - [[super-name super-profile] ..profile - [dummy-name dummy-profile] (random.filter (|>> product.left (text\= super-name) not) + [[super_name super_profile] ..profile + [dummy_name dummy_profile] (random.filter (|>> product.left (text\= super_name) not) ..profile) - [sub-name sub-profile] (random.filter (function (_ [name profile]) - (and (not (text\= super-name name)) - (not (text\= dummy-name name)))) + [sub_name sub_profile] (random.filter (function (_ [name profile]) + (and (not (text\= super_name name)) + (not (text\= dummy_name name)))) ..profile) - fake-name (random.filter (function (_ name) - (and (not (text\= super-name name)) - (not (text\= dummy-name name)) - (not (text\= sub-name name)))) + fake_name (random.filter (function (_ name) + (and (not (text\= super_name name)) + (not (text\= dummy_name name)) + (not (text\= sub_name name)))) (random.ascii/alpha 1)) #let [project ($_ (\ /.monoid compose) - (/.project super-name super-profile) - (/.project dummy-name dummy-profile) - (/.project sub-name (set@ #//.parents (list super-name) sub-profile))) + (/.project super_name super_profile) + (/.project dummy_name dummy_profile) + (/.project sub_name (set@ #//.parents (list super_name) sub_profile))) circular ($_ (\ /.monoid compose) - (/.project super-name (set@ #//.parents (list sub-name) super-profile)) - (/.project dummy-name dummy-profile) - (/.project sub-name (set@ #//.parents (list super-name) sub-profile)))]] + (/.project super_name (set@ #//.parents (list sub_name) super_profile)) + (/.project dummy_name dummy_profile) + (/.project sub_name (set@ #//.parents (list super_name) sub_profile)))]] ($_ _.and (_.cover [/.profile] - (and (|> (/.profile super-name project) - (try\map (\ //.equivalence = super-profile)) + (and (|> (/.profile super_name project) + (try\map (\ //.equivalence = super_profile)) (try.default false)) - (|> (/.profile dummy-name project) - (try\map (\ //.equivalence = dummy-profile)) + (|> (/.profile dummy_name project) + (try\map (\ //.equivalence = dummy_profile)) (try.default false)) - (|> (/.profile sub-name project) - (try\map (\ //.equivalence = (\ //.monoid compose sub-profile super-profile))) + (|> (/.profile sub_name project) + (try\map (\ //.equivalence = (\ //.monoid compose sub_profile super_profile))) (try.default false)))) - (_.cover [/.unknown-profile] - (case (/.profile fake-name project) + (_.cover [/.unknown_profile] + (case (/.profile fake_name project) (#try.Success _) false (#try.Failure error) - (exception.match? /.unknown-profile error))) - (_.cover [/.circular-dependency] - (case (/.profile sub-name circular) + (exception.match? /.unknown_profile error))) + (_.cover [/.circular_dependency] + (case (/.profile sub_name circular) (#try.Success _) false (#try.Failure error) - (exception.match? /.circular-dependency error))) + (exception.match? /.circular_dependency error))) )) )))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index af96bc572..7b99d080f 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -37,7 +37,7 @@ (-> Version Artifact) (|>> ["com.github.luxlang" "test-artifact"])) -(exception: (not-found {uri URI}) +(exception: (not_found {uri URI}) (exception.report ["URI" (%.text uri)])) @@ -51,14 +51,14 @@ (structure: #export simulation (/.Simulation Store) - (def: (on-download uri state) + (def: (on_download uri state) (case (dictionary.get uri state) (#.Some content) (exception.return [state content]) #.None - (exception.throw ..not-found [uri]))) - (def: (on-upload uri content state) + (exception.throw ..not_found [uri]))) + (def: (on_upload uri content state) (exception.return (dictionary.put uri content state)))) (def: #export test diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux index e1c0a77c1..17b3428d2 100644 --- a/stdlib/source/test/aedifex/runtime.lux +++ b/stdlib/source/test/aedifex/runtime.lux @@ -19,8 +19,8 @@ (~~ (template [<command>] [(_.cover [<command>] (let [command (<command> path)] - (and (text.starts-with? (<command> "") command) - (text.ends-with? path command))))] + (and (text.starts_with? (<command> "") command) + (text.ends_with? path command))))] [/.java] [/.node] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 7caf3eba1..c00ef0964 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -60,7 +60,7 @@ (not (is? self other)))) ))) -(def: increment-and-decrement +(def: increment_and_decrement Test (do random.monad [value random.i64] @@ -72,15 +72,15 @@ (and (|> (inc value) (n.- value) (n.= 1)) (|> value (n.- (dec value)) (n.= 1))))))) -(def: (check-neighbors has-property? value) +(def: (check_neighbors has_property? value) (All [a] (-> (Predicate (I64 a)) (I64 a) Bit)) - (and (|> value inc has-property?) - (|> value dec has-property?))) + (and (|> value inc has_property?) + (|> value dec has_property?))) -(def: (even-or-odd rand-gen even? odd?) +(def: (even_or_odd rand_gen even? odd?) (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) (do random.monad - [value rand-gen] + [value rand_gen] ($_ _.and (_.test "Every number is either even or odd." (if (even? value) @@ -88,8 +88,8 @@ (odd? value))) (_.test "Every odd/even number is surrounded by two of the other kind." (if (even? value) - (check-neighbors odd? value) - (check-neighbors even? value)))))) + (check_neighbors odd? value) + (check_neighbors even? value)))))) (type: (Choice a) (-> a a a)) @@ -100,11 +100,11 @@ (type: (Equivalence a) (-> a a Bit)) -(def: (choice rand-gen = [< choose]) +(def: (choice rand_gen = [< choose]) (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) (do random.monad - [left rand-gen - right rand-gen + [left rand_gen + right rand_gen #let [choice (choose left right)]] ($_ _.and (_.test "The choice between 2 values is one of them." @@ -115,27 +115,27 @@ (< right choice) (< left choice)))))) -(def: (minimum-and-maximum rand-gen = min' max') +(def: (minimum_and_maximum rand_gen = min' max') (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test)) ($_ _.and (<| (_.context "Minimum.") - (choice rand-gen = min')) + (choice rand_gen = min')) (<| (_.context "Maximum.") - (choice rand-gen = max')))) + (choice rand_gen = max')))) -(def: (conversion rand-gen forward backward =) +(def: (conversion rand_gen forward backward =) (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) (do random.monad - [value rand-gen] + [value rand_gen] (_.test "Can convert between types in a lossless way." (|> value forward backward (= value))))) -(def: frac-rev +(def: frac_rev (Random Rev) - (let [bits-to-ignore 11] - (\ random.functor map (i64.left-shift bits-to-ignore) random.rev))) + (let [bits_to_ignore 11] + (\ random.functor map (i64.left_shift bits_to_ignore) random.rev))) -(def: prelude-macros +(def: prelude_macros Test ($_ _.and (do random.monad @@ -193,27 +193,27 @@ (n.= (n.+ (n.* cat0 cat0) (n.* cat1 cat1)) (quadrance cat0 cat1))))) -(def: cross-platform-support +(def: cross_platform_support Test (do random.monad - [on-default random.nat - on-fake-host random.nat - on-valid-host random.nat] + [on_default random.nat + on_fake_host random.nat + on_valid_host random.nat] ($_ _.and (_.test "Can provide default in case there is no particular host/platform support." - (n.= on-default - (for {"" on-fake-host} - on-default))) + (n.= on_default + (for {"" on_fake_host} + on_default))) (_.test "Can pick code depending on the host/platform being targeted." - (n.= on-valid-host - (for {@.old on-valid-host - @.jvm on-valid-host - @.js on-valid-host} - on-default)))))) + (n.= on_valid_host + (for {@.old on_valid_host + @.jvm on_valid_host + @.js on_valid_host} + on_default)))))) -(def: sub-tests +(def: sub_tests Test - (_.in-parallel (list& /abstract.test + (_.in_parallel (list& /abstract.test /control.test /data.test /locale.test @@ -231,50 +231,50 @@ ))) (def: test - (<| (_.context (name.module (name-of /._))) - (_.in-parallel + (<| (_.context (name.module (name_of /._))) + (_.in_parallel (list (!bundle ($_ _.and (<| (_.context "Identity.") ..identity) (<| (_.context "Increment & decrement.") - ..increment-and-decrement) + ..increment_and_decrement) (<| (_.context "Even or odd.") ($_ _.and (<| (_.context "Natural numbers.") - (..even-or-odd random.nat n.even? n.odd?)) + (..even_or_odd random.nat n.even? n.odd?)) (<| (_.context "Integers.") - (..even-or-odd random.int i.even? i.odd?)))) + (..even_or_odd random.int i.even? i.odd?)))) (<| (_.context "Minimum and maximum.") (`` ($_ _.and (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>] [(<| (_.context <context>) - (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] + (..minimum_and_maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] [i.= i.< i.min i.> i.max random.int "Integers."] [n.= n.< n.min n.> n.max random.nat "Natural numbers."] [r.= r.< r.min r.> r.max random.rev "Revolutions."] - [f.= f.< f.min f.> f.max random.safe-frac "Fractions."] + [f.= f.< f.min f.> f.max random.safe_frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and (~~ (template [<=> <forward> <backward> <gen>] - [(<| (_.context (format (%.name (name-of <forward>)) - " " (%.name (name-of <backward>)))) + [(<| (_.context (format (%.name (name_of <forward>)) + " " (%.name (name_of <backward>)))) (..conversion <gen> <forward> <backward> <=>))] [i.= .nat .int (random\map (i.% +1,000,000) random.int)] [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)] [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)] - [r.= r.frac f.rev frac-rev] + [r.= r.frac f.rev frac_rev] ))))) (<| (_.context "Prelude macros.") - ..prelude-macros) + ..prelude_macros) (<| (_.context "Templates.") ..templates) (<| (_.context "Cross-platform support.") - ..cross-platform-support))) - ..sub-tests + ..cross_platform_support))) + ..sub_tests )))) (program: args diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index 8c68f4cc6..1bbbcf460 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -26,7 +26,7 @@ list json.object)) (def: decode - (json.get-boolean field))))) + (json.get_boolean field))))) (def: codec (Codec Text Bit) diff --git a/stdlib/source/test/lux/abstract/functor/contravariant.lux b/stdlib/source/test/lux/abstract/functor/contravariant.lux index 93d1f18ad..e6791756f 100644 --- a/stdlib/source/test/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/test/lux/abstract/functor/contravariant.lux @@ -7,4 +7,4 @@ (def: #export test Test (<| (_.covering /._) - (_.in-parallel (list)))) + (_.in_parallel (list)))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index a4e06fa3a..66d607ab8 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -73,10 +73,10 @@ (_.cover [/.between /.within?] (and (/.within? interval bottom) (/.within? interval top))) - (_.cover [/.starts-with?] - (/.starts-with? bottom interval)) - (_.cover [/.ends-with?] - (/.ends-with? top interval)) + (_.cover [/.starts_with?] + (/.starts_with? bottom interval)) + (_.cover [/.ends_with?] + (/.ends_with? top interval)) (_.cover [/.borders?] (and (/.borders? interval bottom) (/.borders? interval top))) @@ -85,61 +85,61 @@ (def: union Test (do random.monad - [some-interval ..interval - left-inner ..inner - right-inner ..inner - left-singleton ..singleton - right-singleton ..singleton - left-outer ..outer - right-outer ..outer] + [some_interval ..interval + left_inner ..inner + right_inner ..inner + left_singleton ..singleton + right_singleton ..singleton + left_outer ..outer + right_outer ..outer] ($_ _.and (_.test "The union of an interval to itself yields the same interval." - (\= some-interval (/.union some-interval some-interval))) + (\= some_interval (/.union some_interval some_interval))) (_.test "The union of 2 inner intervals is another inner interval." - (/.inner? (/.union left-inner right-inner))) + (/.inner? (/.union left_inner right_inner))) (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (/.overlaps? (/.complement left-outer) (/.complement right-outer)) - (/.outer? (/.union left-outer right-outer)) - (/.inner? (/.union left-outer right-outer)))) + (if (/.overlaps? (/.complement left_outer) (/.complement right_outer)) + (/.outer? (/.union left_outer right_outer)) + (/.inner? (/.union left_outer right_outer)))) ))) (def: intersection Test (do random.monad - [some-interval ..interval - left-inner ..inner - right-inner ..inner - left-singleton ..singleton - right-singleton ..singleton - left-outer ..outer - right-outer ..outer] + [some_interval ..interval + left_inner ..inner + right_inner ..inner + left_singleton ..singleton + right_singleton ..singleton + left_outer ..outer + right_outer ..outer] ($_ _.and (_.test "The intersection of an interval to itself yields the same interval." - (\= some-interval (/.intersection some-interval some-interval))) + (\= some_interval (/.intersection some_interval some_interval))) (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (/.overlaps? left-inner right-inner) - (/.inner? (/.intersection left-inner right-inner)) - (/.outer? (/.intersection left-inner right-inner)))) + (if (/.overlaps? left_inner right_inner) + (/.inner? (/.intersection left_inner right_inner)) + (/.outer? (/.intersection left_inner right_inner)))) (_.test "The intersection of 2 outer intervals is another outer interval." - (/.outer? (/.intersection left-outer right-outer))) + (/.outer? (/.intersection left_outer right_outer))) ))) (def: complement Test (do random.monad - [some-interval ..interval] + [some_interval ..interval] ($_ _.and (_.test "The complement of a complement is the same as the original." - (\= some-interval (|> some-interval /.complement /.complement))) + (\= some_interval (|> some_interval /.complement /.complement))) (_.test "The complement of an interval does not overlap it." - (not (/.overlaps? some-interval (/.complement some-interval)))) + (not (/.overlaps? some_interval (/.complement some_interval)))) ))) (def: location Test (do {! random.monad} [[l m r] (|> (random.set n.hash 3 random.nat) - (\ ! map (|>> set.to-list + (\ ! map (|>> set.to_list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -161,20 +161,20 @@ Test (do {! random.monad} [[b t1 t2] (|> (random.set n.hash 3 random.nat) - (\ ! map (|>> set.to-list + (\ ! map (|>> set.to_list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] _ (undefined))))) - #let [int-left (/.between n.enum t1 t2) - int-right (/.between n.enum b t1)]] + #let [int_left (/.between n.enum t1 t2) + int_right (/.between n.enum b t1)]] ($_ _.and (_.cover [/.meets?] - (/.meets? int-left int-right)) + (/.meets? int_left int_right)) (_.cover [/.touches?] - (/.touches? int-left int-right)) + (/.touches? int_left int_right)) (_.cover [/.starts?] (/.starts? (/.between n.enum b t2) (/.between n.enum b t1))) @@ -186,9 +186,9 @@ (def: nested Test (do {! random.monad} - [some-interval ..interval + [some_interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (\ ! map (|>> set.to-list + (\ ! map (|>> set.to_list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -197,31 +197,31 @@ (undefined)))))] ($_ _.and (_.test "Every interval is nested into itself." - (/.nested? some-interval some-interval)) - (let [small-inner (/.between n.enum x1 x2) - large-inner (/.between n.enum x0 x3)] + (/.nested? some_interval some_interval)) + (let [small_inner (/.between n.enum x1 x2) + large_inner (/.between n.enum x0 x3)] (_.test "Inner intervals can be nested inside one another." - (and (/.nested? large-inner small-inner) - (not (/.nested? small-inner large-inner))))) - (let [small-outer (/.between n.enum x2 x1) - large-outer (/.between n.enum x3 x0)] + (and (/.nested? large_inner small_inner) + (not (/.nested? small_inner large_inner))))) + (let [small_outer (/.between n.enum x2 x1) + large_outer (/.between n.enum x3 x0)] (_.test "Outer intervals can be nested inside one another." - (and (/.nested? small-outer large-outer) - (not (/.nested? large-outer small-outer))))) - (let [left-inner (/.between n.enum x0 x1) - right-inner (/.between n.enum x2 x3) + (and (/.nested? small_outer large_outer) + (not (/.nested? large_outer small_outer))))) + (let [left_inner (/.between n.enum x0 x1) + right_inner (/.between n.enum x2 x3) outer (/.between n.enum x0 x3)] (_.test "Inners can be nested inside outers." - (and (/.nested? outer left-inner) - (/.nested? outer right-inner)))) + (and (/.nested? outer left_inner) + (/.nested? outer right_inner)))) ))) (def: overlap Test (do {! random.monad} - [some-interval ..interval + [some_interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (\ ! map (|>> set.to-list + (\ ! map (|>> set.to_list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -230,18 +230,18 @@ (undefined)))))] ($_ _.and (_.test "No interval overlaps with itself." - (not (/.overlaps? some-interval some-interval))) - (let [left-inner (/.between n.enum x0 x2) - right-inner (/.between n.enum x1 x3)] + (not (/.overlaps? some_interval some_interval))) + (let [left_inner (/.between n.enum x0 x2) + right_inner (/.between n.enum x1 x3)] (_.test "Inner intervals can overlap one another." - (and (/.overlaps? left-inner right-inner) - (/.overlaps? right-inner left-inner)))) - (let [left-inner (/.between n.enum x0 x2) - right-inner (/.between n.enum x1 x3) + (and (/.overlaps? left_inner right_inner) + (/.overlaps? right_inner left_inner)))) + (let [left_inner (/.between n.enum x0 x2) + right_inner (/.between n.enum x1 x3) outer (/.between n.enum x1 x2)] (_.test "Inners can overlap outers." - (and (/.overlaps? outer left-inner) - (/.overlaps? outer right-inner)))) + (and (/.overlaps? outer left_inner) + (/.overlaps? outer right_inner)))) ))) (def: #export test diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 8d6ed4e87..b01981730 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -21,7 +21,7 @@ {1 ["." / (#+ word: => ||>)]}) -(def: stack-shuffling +(def: stack_shuffling Test (do random.monad [sample random.nat @@ -95,7 +95,7 @@ (template: (!numerical <=> <generator> <filter> <arithmetic> <order>) (: Test - (with-expansions [<arithmetic>' (template.splice <arithmetic>) + (with_expansions [<arithmetic>' (template.splice <arithmetic>) <order>' (template.splice <order>)] (do random.monad [parameter (|> <generator> (random.filter <filter>)) @@ -131,12 +131,12 @@ (!numerical r.= random.rev (|>> (r.= .0) not) [[/.r/+ r.+] [/.r/- r.-] [/.r/* r.*] [/.r// r./] [/.r/% r.%]] [[/.r/= r.=] [/.r/< r.<] [/.r/<= r.<=] [/.r/> r.>] [/.r/>= r.>=]]) - (!numerical f.= random.safe-frac (|>> (f.= +0.0) not) + (!numerical f.= random.safe_frac (|>> (f.= +0.0) not) [[/.f/+ f.+] [/.f/- f.-] [/.f/* f.*] [/.f// f./] [/.f/% f.%]] [[/.f/= f.=] [/.f/< f.<] [/.f/<= f.<=] [/.f/> f.>] [/.f/>= f.>=]]) )) -(def: control-flow +(def: control_flow Test (do random.monad [choice random.bit @@ -311,8 +311,8 @@ Test (<| (_.covering /._) ($_ _.and - ..stack-shuffling + ..stack_shuffling ..numerical - ..control-flow + ..control_flow ..definition ))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 0b750b9cc..7a94c72aa 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -24,15 +24,15 @@ ["." promise (#+ Promise Resolver) ("#\." monad)] ["." frp]]]}) -(exception: got-wrecked) +(exception: got_wrecked) (actor: counter Nat - ((on-mail message state self) + ((on_mail message state self) (message state self)) - ((on-stop cause state) + ((on_stop cause state) (promise\wrap [])) (message: (count! {increment Nat} state self Nat) @@ -49,13 +49,13 @@ (def: #export test Test (do {! random.monad} - [initial-state random.nat - #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a))) + [initial_state random.nat + #let [as_mail (: (All [a] (-> (-> a a) (/.Mail a))) (function (_ transform) (function (_ state actor) (|> state transform #try.Success promise\wrap)))) - inc! (: (/.Mail Nat) (as-mail inc)) - dec! (: (/.Mail Nat) (as-mail dec))]] + inc! (: (/.Mail Nat) (as_mail inc)) + dec! (: (/.Mail Nat) (as_mail dec))]] (<| (_.covering /._) (_.for [/.Actor]) ($_ _.and @@ -65,7 +65,7 @@ (/.alive? actor)))) (_.cover [/.poison!] - (let [poisoned-actors-die! + (let [poisoned_actors_die! (io.run (do io.monad [actor (/.spawn! /.default 0) poisoned? (/.poison! actor) @@ -73,25 +73,25 @@ (wrap (and (..mailed? poisoned?) (not alive?))))) - cannot-poison-more-than-once! + cannot_poison_more_than_once! (io.run (do io.monad [actor (/.spawn! /.default 0) - first-time? (/.poison! actor) - second-time? (/.poison! actor)] - (wrap (and (..mailed? first-time?) - (not (..mailed? second-time?))))))] - (and poisoned-actors-die! - cannot-poison-more-than-once!))) + first_time? (/.poison! actor) + second_time? (/.poison! actor)] + (wrap (and (..mailed? first_time?) + (not (..mailed? second_time?))))))] + (and poisoned_actors_die! + cannot_poison_more_than_once!))) (let [[read write] (: [(Promise Text) (Resolver Text)] (promise.promise []))] (wrap (do promise.monad [_ (promise.future (do io.monad [actor (/.spawn! (: (/.Behavior Any Any) - {#/.on-init (|>>) - #/.on-mail (function (_ message state self) + {#/.on_init (|>>) + #/.on_mail (function (_ message state self) (message state self)) - #/.on-stop (function (_ cause state) + #/.on_stop (function (_ cause state) (promise.future (write cause)))}) [])] (/.poison! actor))) @@ -129,22 +129,22 @@ (let [die! (: (/.Mail Nat) (function (_ state actor) - (promise\wrap (exception.throw ..got-wrecked []))))] + (promise\wrap (exception.throw ..got_wrecked []))))] (wrap (do promise.monad [result (promise.future (do io.monad - [actor (/.spawn! /.default initial-state) + [actor (/.spawn! /.default initial_state) sent? (/.mail! die! actor) alive? (/.alive? actor) obituary (/.obituary actor)] (wrap (#try.Success [actor sent? alive? obituary]))))] (_.cover' [/.Obituary /.obituary] (case result - (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single_pending_message)])])) (and (..mailed? sent?) (not alive?) - (exception.match? ..got-wrecked error) - (n.= initial-state state) - (is? die! single-pending-message)) + (exception.match? ..got_wrecked error) + (n.= initial_state state) + (is? die! single_pending_message)) _ false))))) @@ -152,12 +152,12 @@ (wrap (do promise.monad [counter (promise.future (/.spawn! ..counter 0)) result (do (try.with promise.monad) - [output-1 (/.tell! (count! 1) counter) - output-2 (/.tell! (count! 1) counter) - output-3 (/.tell! (count! 1) counter)] - (wrap (and (n.= 1 output-1) - (n.= 2 output-2) - (n.= 3 output-3))))] + [output_1 (/.tell! (count! 1) counter) + output_2 (/.tell! (count! 1) counter) + output_3 (/.tell! (count! 1) counter)] + (wrap (and (n.= 1 output_1) + (n.= 2 output_2) + (n.= 3 output_3))))] (_.cover' [/.Message /.actor: /.message: /.tell!] (case result (#try.Success outcome) @@ -170,11 +170,11 @@ [verdict (promise.future (do io.monad [anonymous (/.actor {Nat - initial-state} - ((on-mail message state self) + initial_state} + ((on_mail message state self) (message (inc state) self)) - ((on-stop cause state) + ((on_stop cause state) (promise\wrap (exec (%.nat state) [])))) sent/inc? (/.mail! inc! anonymous) @@ -185,10 +185,10 @@ (..mailed? sent/dec?) (..mailed? poisoned?) (case obituary - (^ (#.Some [error final-state (list poison-pill)])) + (^ (#.Some [error final_state (list poison_pill)])) (and (exception.match? /.poisoned error) - (n.= (inc (inc initial-state)) - final-state)) + (n.= (inc (inc initial_state)) + final_state)) _ false)))))] @@ -196,10 +196,10 @@ verdict))) (do ! - [num-events (\ ! map (|>> (n.% 10) inc) random.nat) - events (random.list num-events random.nat) - num-observations (\ ! map (n.% num-events) random.nat) - #let [expected (list.take num-observations events) + [num_events (\ ! map (|>> (n.% 10) inc) random.nat) + events (random.list num_events random.nat) + num_observations (\ ! map (n.% num_events) random.nat) + #let [expected (list.take num_observations events) sink (: (Atom (Row Nat)) (atom.atom row.empty))]] (wrap (do promise.monad @@ -207,12 +207,12 @@ (do {! io.monad} [agent (/.actor {Nat 0}) _ (/.observe (function (_ event stop) - (function (_ events-seen self) + (function (_ events_seen self) (promise.future - (if (n.< num-observations events-seen) + (if (n.< num_observations events_seen) (do ! [_ (atom.update (row.add event) sink)] - (wrap (#try.Success (inc events-seen)))) + (wrap (#try.Success (inc events_seen)))) (do ! [_ stop] (wrap (#try.Failure "YOLO"))))))) @@ -222,5 +222,5 @@ _ (/.await agent) actual (promise.future (atom.read sink))] (_.cover' [/.Stop /.observe /.await] - (\ (list.equivalence n.equivalence) = expected (row.to-list actual)))))) + (\ (list.equivalence n.equivalence) = expected (row.to_list actual)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index 8902f0a8f..bdc56521a 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -18,23 +18,23 @@ (<| (_.covering /._) (do random.monad [value random.nat - swap-value random.nat - set-value random.nat + swap_value random.nat + set_value random.nat #let [box (/.atom value)]] ($_ _.and (_.cover [/.Atom /.atom /.read] (n.= value (io.run (/.read box)))) - (_.cover [/.compare-and-swap] - (and (io.run (/.compare-and-swap value swap-value box)) - (n.= swap-value + (_.cover [/.compare_and_swap] + (and (io.run (/.compare_and_swap value swap_value box)) + (n.= swap_value (io.run (/.read box))))) (_.cover [/.update] (exec (io.run (/.update inc box)) - (n.= (inc swap-value) + (n.= (inc swap_value) (io.run (/.read box))))) (_.cover [/.write] - (exec (io.run (/.write set-value box)) - (n.= set-value + (exec (io.run (/.write set_value box)) + (n.= set_value (io.run (/.read box))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 03cc9613d..2652be103 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -32,7 +32,7 @@ (def: injection (Injection /.Channel) (|>> promise.resolved - /.from-promise)) + /.from_promise)) (def: comparison (Comparison /.Channel) @@ -90,7 +90,7 @@ (#try.Failure error) false)) - (_.cover [/.channel-is-already-closed] + (_.cover [/.channel_is_already_closed] (case (io.run (do (try.with io.monad) [#let [[channel sink] (/.channel [])] @@ -100,13 +100,13 @@ false (#try.Failure error) - (exception.match? /.channel-is-already-closed error))) + (exception.match? /.channel_is_already_closed error))) (wrap (do promise.monad [output (|> sample promise.resolved - /.from-promise + /.from_promise /.consume)] - (_.cover' [/.from-promise /.consume] + (_.cover' [/.from_promise /.consume] (list\= (list sample) output)))) (wrap (do promise.monad @@ -141,7 +141,7 @@ listened (|> sink atom.read promise.future - (\ ! map row.to-list))] + (\ ! map row.to_list))] (_.cover' [/.Subscriber /.subscribe] (list\= inputs listened)))) (wrap (do promise.monad @@ -172,48 +172,48 @@ (_.cover' [/.distinct] (list\= (list distint/0 distint/1 distint/2) actual)))) - (let [polling-delay 1 - amount-of-polls 5 - wiggle-room ($_ n.* - (i64.left-shift 6 1) - amount-of-polls - polling-delay) - total-delay (|> polling-delay - (n.* amount-of-polls) - (n.+ wiggle-room))] + (let [polling_delay 1 + amount_of_polls 5 + wiggle_room ($_ n.* + (i64.left_shift 6 1) + amount_of_polls + polling_delay) + total_delay (|> polling_delay + (n.* amount_of_polls) + (n.+ wiggle_room))] ($_ _.and (wrap (do promise.monad - [#let [[channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))] - _ (promise.delay total-delay []) + [#let [[channel sink] (/.poll polling_delay (: (IO Nat) (io.io sample)))] + _ (promise.delay total_delay []) _ (promise.future (\ sink close)) actual (/.consume channel) - #let [correct-values! + #let [correct_values! (list.every? (n.= sample) actual) - enough-polls! - (n.>= amount-of-polls (list.size actual))]] + enough_polls! + (n.>= amount_of_polls (list.size actual))]] (_.cover' [/.poll] - (and correct-values! - enough-polls!)))) + (and correct_values! + enough_polls!)))) (wrap (do promise.monad - [#let [[channel sink] (/.periodic polling-delay)] - _ (promise.delay total-delay []) + [#let [[channel sink] (/.periodic polling_delay)] + _ (promise.delay total_delay []) _ (promise.future (\ sink close)) actual (/.consume channel)] (_.cover' [/.periodic] - (n.>= amount-of-polls (list.size actual))))))) + (n.>= amount_of_polls (list.size actual))))))) (wrap (do promise.monad - [#let [max-iterations 10] + [#let [max_iterations 10] actual (|> [0 sample] (/.iterate (function (_ [iterations current]) (promise.resolved - (if (n.< max-iterations iterations) + (if (n.< max_iterations iterations) (#.Some [[(inc iterations) (n.+ shift current)] current]) #.None)))) /.consume)] (_.cover' [/.iterate] - (and (n.= max-iterations (list.size actual)) - (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + (and (n.= max_iterations (list.size actual)) + (list\= (list.folds n.+ sample (list.repeat (dec max_iterations) shift)) actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 51908a257..21633f293 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -48,12 +48,12 @@ Test (<| (_.covering /._) (do {! random.monad} - [to-wait (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) + [to_wait (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) expected random.nat dummy random.nat - #let [not-dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] - leftE not-dummy - rightE not-dummy] + #let [not_dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] + leftE not_dummy + rightE not_dummy] ($_ _.and (_.for [/.functor] ($functor.spec ..injection ..comparison /.functor)) @@ -80,19 +80,19 @@ (n.= expected actual)))) (wrap (do /.monad [pre (/.future instant.now) - actual (/.schedule to-wait (io.io expected)) + actual (/.schedule to_wait (io.io expected)) post (/.future instant.now)] (_.cover' [/.schedule] (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post))))))) (wrap (do /.monad [pre (/.future instant.now) - _ (/.wait to-wait) + _ (/.wait to_wait) post (/.future instant.now)] (_.cover' [/.wait] - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post)))))) + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post)))))) (wrap (do /.monad [[leftA rightA] (/.and (/.future (io.io leftE)) (/.future (io.io rightE)))] @@ -101,16 +101,16 @@ (n.+ leftA rightA))))) (wrap (do /.monad [pre (/.future instant.now) - actual (/.delay to-wait expected) + actual (/.delay to_wait expected) post (/.future instant.now)] (_.cover' [/.delay] (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post))))))) (wrap (do /.monad [?left (/.or (wrap leftE) - (/.delay to-wait dummy)) - ?right (/.or (/.delay to-wait dummy) + (/.delay to_wait dummy)) + ?right (/.or (/.delay to_wait dummy) (wrap rightE))] (_.cover' [/.or] (case [?left ?right] @@ -122,8 +122,8 @@ false)))) (wrap (do /.monad [leftA (/.either (wrap leftE) - (/.delay to-wait dummy)) - rightA (/.either (/.delay to-wait dummy) + (/.delay to_wait dummy)) + rightA (/.either (/.delay to_wait dummy) (wrap rightE))] (_.cover' [/.either] (n.= (n.+ leftE rightE) @@ -149,9 +149,9 @@ (and yep (not nope))))) (wrap (do /.monad - [?none (/.time-out 0 (/.delay to-wait dummy)) - ?actual (/.time-out to-wait (wrap expected))] - (_.cover' [/.time-out] + [?none (/.time_out 0 (/.delay to_wait dummy)) + ?actual (/.time_out to_wait (wrap expected))] + (_.cover' [/.time_out] (case [?none ?actual] [#.None (#.Some actual)] (n.= expected actual) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 7e632b8cb..e30a930ac 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -31,10 +31,10 @@ (_.for [/.Semaphore] ($_ _.and (do {! random.monad} - [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [semaphore (/.semaphore initial-open-positions)]] + [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do promise.monad - [result (promise.time-out 10 (/.wait semaphore))] + [result (promise.time_out 10 (/.wait semaphore))] (_.cover' [/.semaphore] (case result (#.Some _) @@ -43,11 +43,11 @@ #.None false))))) (do {! random.monad} - [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [semaphore (/.semaphore initial-open-positions)]] + [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do {! promise.monad} - [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) - result (promise.time-out 10 (/.wait semaphore))] + [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) + result (promise.time_out 10 (/.wait semaphore))] (_.cover' [/.wait] (case result (#.Some _) @@ -56,30 +56,30 @@ #.None true))))) (do {! random.monad} - [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [semaphore (/.semaphore initial-open-positions)]] + [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do {! promise.monad} - [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) + [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) #let [block (/.wait semaphore)] - result/0 (promise.time-out 10 block) - open-positions (/.signal semaphore) - result/1 (promise.time-out 10 block)] + result/0 (promise.time_out 10 block) + open_positions (/.signal semaphore) + result/1 (promise.time_out 10 block)] (_.cover' [/.signal] - (case [result/0 result/1 open-positions] + (case [result/0 result/1 open_positions] [#.None (#.Some _) (#try.Success +0)] true _ false))))) (do {! random.monad} - [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) - #let [semaphore (/.semaphore initial-open-positions)]] + [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do promise.monad [outcome (/.signal semaphore)] - (_.cover' [/.semaphore-is-maxed-out] + (_.cover' [/.semaphore_is_maxed_out] (case outcome (#try.Failure error) - (exception.match? /.semaphore-is-maxed-out error) + (exception.match? /.semaphore_is_maxed_out error) _ false))))) @@ -92,8 +92,8 @@ (do {! random.monad} [repetitions (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) #let [resource (atom.atom "") - expected-As (text.join-with "" (list.repeat repetitions "A")) - expected-Bs (text.join-with "" (list.repeat repetitions "B")) + expected_As (text.join_with "" (list.repeat repetitions "A")) + expected_Bs (text.join_with "" (list.repeat repetitions "B")) mutex (/.mutex []) processA (<| (/.synchronize mutex) io.io @@ -116,9 +116,9 @@ _ processB #let [outcome (io.run (atom.read resource))]] (_.cover' [/.mutex /.synchronize] - (or (text\= (format expected-As expected-Bs) + (or (text\= (format expected_As expected_Bs) outcome) - (text\= (format expected-Bs expected-As) + (text\= (format expected_Bs expected_As) outcome)))))) ))) @@ -142,7 +142,7 @@ [_ (#.Some limit)] (and (n.> 0 raw) - (n.= raw (refinement.un-refine limit))) + (n.= raw (refinement.un_refine limit))) _ false))) @@ -153,7 +153,7 @@ (wrap (do {! promise.monad} [#let [ending (|> "_" (list.repeat limit) - (text.join-with "")) + (text.join_with "")) ids (enum.range n.enum 0 (dec limit)) waiters (list\map (function (_ id) (exec (io.run (atom.update (|>> (format "_")) resource)) @@ -162,7 +162,7 @@ _ (monad.seq ! waiters) #let [outcome (io.run (atom.read resource))]] (_.cover' [/.barrier /.block] - (and (text.ends-with? ending outcome) + (and (text.ends_with? ending outcome) (list.every? (function (_ id) (text.contains? (%.nat id) outcome)) ids) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index f8abf6a84..04da97f17 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -32,21 +32,21 @@ (_.cover [/.parallelism] (n.> 0 /.parallelism)) (wrap (do promise.monad - [reference-time (promise.future instant.now) - #let [box (atom.atom [reference-time dummy])] + [reference_time (promise.future instant.now) + #let [box (atom.atom [reference_time dummy])] _ (promise.future (/.schedule delay (do io.monad - [execution-time instant.now] - (atom.write [execution-time expected] box)))) + [execution_time instant.now] + (atom.write [execution_time expected] box)))) _ (promise.wait (n.* 2 delay)) - [execution-time actual] (promise.future (atom.read box))] + [execution_time actual] (promise.future (atom.read box))] (_.cover' [/.schedule] - (let [expected-delay! + (let [expected_delay! (i.>= (.int delay) - (duration.to-millis (instant.span reference-time execution-time))) + (duration.to_millis (instant.span reference_time execution_time))) - correct-value! + correct_value! (n.= expected actual)] - (and expected-delay! - correct-value!))))) + (and expected_delay! + correct_value!))))) )))) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 66a0e13ef..8fad40d86 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -32,9 +32,9 @@ 0 (state\wrap 0) 1 (state\wrap 1) _ (do state.monad - [output-1 (recur (n.- 1 input)) - output-2 (recur (n.- 2 input))] - (wrap (n.+ output-1 output-2))))) + [output_1 (recur (n.- 1 input)) + output_2 (recur (n.- 2 input))] + (wrap (n.+ output_1 output_2))))) (def: (time function input) (All [i o] (-> (-> i o) i (IO [Duration o]))) @@ -45,15 +45,15 @@ (wrap [(instant.span before after) output]))) -(def: milli-seconds +(def: milli_seconds (-> Duration Nat) - (|>> (duration.query duration.milli-second) .nat)) + (|>> (duration.query duration.milli_second) .nat)) ## the wiggle room is there to account for GC pauses ## and other issues that might mess with duration -(def: wiggle-room +(def: wiggle_room Nat - (i64.left-shift 4 1)) + (i64.left_shift 4 1)) (def: #export test Test @@ -67,40 +67,40 @@ (do io.monad [#let [slow (/.none n.hash ..fibonacci) fast (/.closed n.hash fibonacci)] - [slow-time slow-output] (..time slow input) - [fast-time fast-output] (..time fast input) - #let [same-output! - (n.= slow-output - fast-output) + [slow_time slow_output] (..time slow input) + [fast_time fast_output] (..time fast input) + #let [same_output! + (n.= slow_output + fast_output) - memo-is-faster! - (n.< (n.+ ..wiggle-room (milli-seconds slow-time)) - (milli-seconds fast-time))]] - (wrap (and same-output! - memo-is-faster!))))) + memo_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds slow_time)) + (milli_seconds fast_time))]] + (wrap (and same_output! + memo_is_faster!))))) (_.cover [/.open] (io.run (do io.monad [#let [none (/.none n.hash ..fibonacci) memory (dictionary.new n.hash) open (/.open fibonacci)] - [none-time none-output] (..time none input) - [open-time [memory open-output]] (..time open [memory input]) - [open-time/+1 _] (..time open [memory (inc input)]) - #let [same-output! - (n.= none-output - open-output) + [none_time none_output] (..time none input) + [open_time [memory open_output]] (..time open [memory input]) + [open_time/+1 _] (..time open [memory (inc input)]) + #let [same_output! + (n.= none_output + open_output) - memo-is-faster! - (n.< (n.+ ..wiggle-room (milli-seconds none-time)) - (milli-seconds open-time)) + memo_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds none_time)) + (milli_seconds open_time)) - incrementalism-is-faster! - (n.< (n.+ ..wiggle-room (milli-seconds open-time)) - (milli-seconds open-time/+1))]] - (wrap (and same-output! - memo-is-faster! - incrementalism-is-faster!))))) + incrementalism_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds open_time)) + (milli_seconds open_time/+1))]] + (wrap (and same_output! + memo_is_faster! + incrementalism_is_faster!))))) (_.cover [/.memoization] (let [memo (<| //.mixin (//.inherit /.memoization) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 26cf4ebd1..6c2f739bb 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -40,7 +40,7 @@ ["#." type] ["#." xml]]) -(def: (should-fail expected input) +(def: (should_fail expected input) (All [a] (-> Text (Try a) Bit)) (case input (#try.Failure actual) @@ -84,7 +84,7 @@ (~' _) #0))))) -(def: combinators-0 +(def: combinators_0 Test (do {! random.monad} [expected0 random.nat @@ -175,7 +175,7 @@ (match [] #1)))) ))) -(def: combinators-1 +(def: combinators_1 Test (do {! random.monad} [variadic (\ ! map (|>> (n.max 1) (n.min 20)) random.nat) @@ -195,25 +195,25 @@ (|> (list\map code.nat expected+) (/.run (/.exactly (inc variadic) s.nat)) fails?))) - (_.cover [/.at-least] + (_.cover [/.at_least] (and (|> (list\map code.nat expected+) - (/.run (/.at-least times s.nat)) + (/.run (/.at_least times s.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ actual))) (|> (list\map code.nat expected+) - (/.run (/.at-least (inc variadic) s.nat)) + (/.run (/.at_least (inc variadic) s.nat)) fails?))) - (_.cover [/.at-most] + (_.cover [/.at_most] (and (|> (list\map code.nat expected+) - (/.run (/.at-most times s.nat)) + (/.run (/.at_most times s.nat)) (match actual (\ (list.equivalence n.equivalence) = (list.take times expected+) actual))) (|> (list\map code.nat expected+) - (/.run (/.at-most (inc variadic) s.nat)) + (/.run (/.at_most (inc variadic) s.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ @@ -231,9 +231,9 @@ (\ (list.equivalence n.equivalence) = (list.take times expected+) actual))))) - (_.cover [/.sep-by] + (_.cover [/.sep_by] (|> (list.interpose (code.text separator) (list\map code.nat expected+)) - (/.run (/.sep-by (s.this! (code.text separator)) s.nat)) + (/.run (/.sep_by (s.this! (code.text separator)) s.nat)) (match actual (\ (list.equivalence n.equivalence) = expected+ @@ -255,7 +255,7 @@ )) ))) -(def: combinators-2 +(def: combinators_2 Test (do random.monad [expected random.nat @@ -269,16 +269,16 @@ (let [parser (/.rec (function (_ self) (/.either s.nat (s.tuple self)))) - level-0 (code.nat expected) - level-up (: (-> Code Code) + level_0 (code.nat expected) + level_up (: (-> Code Code) (|>> list code.tuple))] - (and (|> (list level-0) + (and (|> (list level_0) (/.run parser) (match actual (n.= expected actual))) - (|> (list (level-up level-0)) + (|> (list (level_up level_0)) (/.run parser) (match actual (n.= expected actual))) - (|> (list (level-up (level-up level-0))) + (|> (list (level_up (level_up level_0))) (/.run parser) (match actual (n.= expected actual)))))) (_.cover [/.after] @@ -310,19 +310,19 @@ (list (code.nat odd))) fails?))) (_.cover [/.speculative] - (let [happy-path! + (let [happy_path! (|> (/.run (/.and (/.speculative even^) nat^) (list (code.nat even))) (match [speculation actual] (and (n.= speculation actual) (n.= even actual)))) - sad-path! + sad_path! (|> (/.run (/.and (/.speculative even^) nat^) (list (code.nat odd))) fails?)] - (and happy-path! - sad-path!))) + (and happy_path! + sad_path!))) (_.cover [/.codec] (|> (/.run (/.codec n.decimal s.text) (list (code.text (%.nat expected)))) @@ -365,14 +365,14 @@ (_.cover [/.fail] (|> (list) (/.run (/.fail failure)) - (should-fail failure))) + (should_fail failure))) (_.cover [/.lift] (and (|> (list) (/.run (/.lift (#try.Success expected))) (match actual (n.= expected actual))) (|> (list) (/.run (/.lift (#try.Failure failure))) - (should-fail failure)))) + (should_fail failure)))) (_.cover [/.assert] (and (|> (list (code.bit #1) (code.int +123)) (/.run (/.assert assertion #1)) @@ -380,9 +380,9 @@ (|> (list (code.bit #1) (code.int +123)) (/.run (/.assert assertion #0)) fails?))) - ..combinators-0 - ..combinators-1 - ..combinators-2 + ..combinators_0 + ..combinators_1 + ..combinators_2 /analysis.test /binary.test diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index e089fb4d2..daf3632d6 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -81,7 +81,7 @@ [/.bit /.bit! random.bit analysis.bit bit\=] [/.nat /.nat! random.nat analysis.nat n.=] [/.int /.int! random.int analysis.int i.=] - [/.frac /.frac! random.safe-frac analysis.frac f.=] + [/.frac /.frac! random.safe_frac analysis.frac f.=] [/.rev /.rev! random.rev analysis.rev r.=] [/.text /.text! (random.unicode 10) analysis.text text\=] [/.local /.local! random.nat analysis.variable/local n.=] @@ -118,29 +118,29 @@ (!expect (#try.Failure _)))))) (do {! random.monad} [expected random.bit] - (_.cover [/.cannot-parse] + (_.cover [/.cannot_parse] (and (|> (list (analysis.bit expected)) (/.run /.nat) (case> (#try.Success _) false (#try.Failure error) - (exception.match? /.cannot-parse error))) + (exception.match? /.cannot_parse error))) (|> (list) (/.run /.bit) (case> (#try.Success _) false (#try.Failure error) - (exception.match? /.cannot-parse error)))))) + (exception.match? /.cannot_parse error)))))) (do {! random.monad} [expected random.bit] - (_.cover [/.unconsumed-input] + (_.cover [/.unconsumed_input] (|> (list (analysis.bit expected) (analysis.bit expected)) (/.run /.bit) (case> (#try.Success _) false (#try.Failure error) - (exception.match? /.unconsumed-input error))))) + (exception.match? /.unconsumed_input error))))) ))))) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 88c4aafaa..2a29ba367 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -47,9 +47,9 @@ _ false)) -(def: segment-size 10) +(def: segment_size 10) -(def: (utf8-conversion-does-not-alter? value) +(def: (utf8_conversion_does_not_alter? value) (Predicate Text) (|> value (\ encoding.utf8 encode) @@ -60,58 +60,58 @@ (#try.Failure error) false))) -(def: random-text +(def: random_text (Random Text) - (random.filter ..utf8-conversion-does-not-alter? - (random.unicode ..segment-size))) + (random.filter ..utf8_conversion_does_not_alter? + (random.unicode ..segment_size))) -(def: random-name +(def: random_name (Random Name) - (random.and ..random-text ..random-text)) + (random.and ..random_text ..random_text)) -(structure: location-equivalence +(structure: location_equivalence (Equivalence Location) - (def: (= [expected-module expected-line expected-column] - [sample-module sample-line sample-column]) - (and (text\= expected-module sample-module) - (n.= expected-line sample-line) - (n.= expected-column sample-column)))) + (def: (= [expected_module expected_line expected_column] + [sample_module sample_line sample_column]) + (and (text\= expected_module sample_module) + (n.= expected_line sample_line) + (n.= expected_column sample_column)))) -(def: random-location +(def: random_location (Random Location) ($_ random.and - ..random-text + ..random_text random.nat random.nat)) -(def: random-code +(def: random_code (Random Code) (random.rec (function (_ recur) - (let [random-sequence (do {! random.monad} + (let [random_sequence (do {! random.monad} [size (\ ! map (n.% 2) random.nat)] (random.list size recur))] ($_ random.and - ..random-location + ..random_location (: (Random (Code' (Ann Location))) ($_ random.or random.bit random.nat random.int random.rev - random.safe-frac - ..random-text - ..random-name - ..random-name - random-sequence - random-sequence + random.safe_frac + ..random_text + ..random_name + ..random_name + random_sequence + random_sequence (do {! random.monad} [size (\ ! map (n.% 2) random.nat)] (random.list size (random.and recur recur))) ))))))) -(def: random-type +(def: random_type (Random Type) (let [(^open ".") random.monad] ($_ random.either @@ -146,7 +146,7 @@ (`` ($_ _.and (~~ (template [<parser> <format>] [(do {! random.monad} - [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] + [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] (_.cover [<parser> <format>] (|> (format.run <format> expected) (/.run <parser>) @@ -164,7 +164,7 @@ (`` ($_ _.and (~~ (template [<parser> <format>] [(do {! random.monad} - [expected (random.ascii ..segment-size)] + [expected (random.ascii ..segment_size)] (_.cover [<parser> <format>] (|> (format.run <format> expected) (/.run <parser>) @@ -183,7 +183,7 @@ (`` ($_ _.and (~~ (template [<parser> <format>] [(do {! random.monad} - [expected (random.row ..segment-size random.nat)] + [expected (random.row ..segment_size random.nat)] (_.cover [<parser> <format>] (|> expected (format.run (<format> format.nat)) @@ -222,18 +222,18 @@ (/.run /.frac) (!expect (^multi (#try.Success actual) (or (\ frac.equivalence = expected actual) - (and (frac.not-a-number? expected) - (frac.not-a-number? actual)))))))) + (and (frac.not_a_number? expected) + (frac.not_a_number? actual)))))))) (do {! random.monad} [expected (\ ! map (|>> (i64.and (i64.mask /.size/8)) (n.max 2)) random.nat)] - (_.cover [/.not-a-bit] + (_.cover [/.not_a_bit] (|> expected (format.run format.bits/8) (/.run /.bit) (!expect (^multi (#try.Failure error) - (exception.match? /.not-a-bit error)))))) + (exception.match? /.not_a_bit error)))))) ))) (def: complex @@ -249,14 +249,14 @@ (!expect (^multi (#try.Success actual) (\ <equivalence> = expected actual))))))] - [/.location format.location random-location location-equivalence] - [/.code format.code random-code code.equivalence] - [/.type format.type random-type type.equivalence] + [/.location format.location random_location location_equivalence] + [/.code format.code random_code code.equivalence] + [/.type format.type random_type type.equivalence] )) - (~~ (template [<parser-coverage> <parser> <format-coverage> <format> <random> <equivalence>] + (~~ (template [<parser_coverage> <parser> <format_coverage> <format> <random> <equivalence>] [(do {! random.monad} [expected <random>] - (_.cover [<parser-coverage> <format-coverage>] + (_.cover [<parser_coverage> <format_coverage>] (|> expected (format.run <format>) (/.run <parser>) @@ -264,17 +264,17 @@ (\ <equivalence> = expected actual))))))] [/.maybe (/.maybe /.nat) format.maybe (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)] - [/.list (/.list /.nat) format.list (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)] - [/.set (/.set n.hash /.nat) format.set (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence] - [/.name /.name format.name format.name ..random-name name.equivalence])) + [/.list (/.list /.nat) format.list (format.list format.nat) (random.list ..segment_size random.nat) (list.equivalence n.equivalence)] + [/.set (/.set n.hash /.nat) format.set (format.set format.nat) (random.set n.hash ..segment_size random.nat) set.equivalence] + [/.name /.name format.name format.name ..random_name name.equivalence])) (do {! random.monad} - [expected (\ ! map (list.repeat ..segment-size) random.nat)] - (_.cover [/.set-elements-are-not-unique] + [expected (\ ! map (list.repeat ..segment_size) random.nat)] + (_.cover [/.set_elements_are_not_unique] (|> expected (format.run (format.list format.nat)) (/.run (/.set n.hash /.nat)) (!expect (^multi (#try.Failure error) - (exception.match? /.set-elements-are-not-unique error)))))) + (exception.match? /.set_elements_are_not_unique error)))))) (do {! random.monad} [expected (random.or random.bit random.nat)] (_.cover [/.or format.or] @@ -291,15 +291,15 @@ (n.max 2)) random.nat) value random.bit] - (_.cover [/.invalid-tag] + (_.cover [/.invalid_tag] (|> [tag value] (format.run (format.and format.bits/8 format.bit)) (/.run (: (/.Parser (Either Bit Nat)) (/.or /.bit /.nat))) (!expect (^multi (#try.Failure error) - (exception.match? /.invalid-tag error)))))) + (exception.match? /.invalid_tag error)))))) (do {! random.monad} - [expected (random.list ..segment-size random.nat)] + [expected (random.list ..segment_size random.nat)] (_.cover [/.rec format.rec format.and format.any] (|> expected (format.run (format.rec (|>> (format.and format.nat) @@ -322,64 +322,64 @@ (_.for [/.Parser]) (`` ($_ _.and (_.cover [/.run /.any - format.no-op format.instance] - (|> (format.instance format.no-op) + format.no_op format.instance] + (|> (format.instance format.no_op) (/.run /.any) (!expect (#try.Success _)))) (do {! random.monad} - [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] - (_.cover [/.binary-was-not-fully-read] + [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] + (_.cover [/.binary_was_not_fully_read] (|> data (/.run /.any) (!expect (^multi (#try.Failure error) - (exception.match? /.binary-was-not-fully-read error)))))) + (exception.match? /.binary_was_not_fully_read error)))))) (do {! random.monad} - [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] + [expected (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] (_.cover [/.segment format.segment format.run] (|> expected - (format.run (format.segment ..segment-size)) - (/.run (/.segment ..segment-size)) + (format.run (format.segment ..segment_size)) + (/.run (/.segment ..segment_size)) (!expect (^multi (#try.Success actual) (\ binary.equivalence = expected actual)))))) (do {! random.monad} - [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] + [data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] (_.cover [/.end?] (|> data (/.run (do <>.monad [pre /.end? - _ (/.segment ..segment-size) + _ (/.segment ..segment_size) post /.end?] (wrap (and (not pre) post)))) (!expect (#try.Success #1))))) (do {! random.monad} - [to-read (\ ! map (n.% (inc ..segment-size)) random.nat) - data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] + [to_read (\ ! map (n.% (inc ..segment_size)) random.nat) + data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] (_.cover [/.Offset /.offset] (|> data (/.run (do <>.monad [start /.offset - _ (/.segment to-read) + _ (/.segment to_read) offset /.offset - _ (/.segment (n.- to-read ..segment-size)) - nothing-left /.offset] + _ (/.segment (n.- to_read ..segment_size)) + nothing_left /.offset] (wrap (and (n.= 0 start) - (n.= to-read offset) - (n.= ..segment-size nothing-left))))) + (n.= to_read offset) + (n.= ..segment_size nothing_left))))) (!expect (#try.Success #1))))) (do {! random.monad} - [to-read (\ ! map (n.% (inc ..segment-size)) random.nat) - data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment-size))] + [to_read (\ ! map (n.% (inc ..segment_size)) random.nat) + data (\ ! map (\ encoding.utf8 encode) (random.ascii ..segment_size))] (_.cover [/.remaining] (|> data (/.run (do <>.monad - [_ (/.segment to-read) + [_ (/.segment to_read) remaining /.remaining - _ (/.segment (n.- to-read ..segment-size)) - nothing-left /.remaining] - (wrap (and (n.= ..segment-size - (n.+ to-read remaining)) - (n.= 0 nothing-left))))) + _ (/.segment (n.- to_read ..segment_size)) + nothing_left /.remaining] + (wrap (and (n.= ..segment_size + (n.+ to_read remaining)) + (n.= 0 nothing_left))))) (!expect (#try.Success #1))))) ..size ..binary diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 0c2c42c8e..71aa8f39d 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -33,7 +33,7 @@ _ false)) -(def: random-name +(def: random_name (Random Name) (random.and (random.unicode 1) (random.unicode 1))) @@ -71,48 +71,48 @@ [/.nat /.nat! random.nat code.nat nat.equivalence] [/.int /.int! random.int code.int int.equivalence] [/.rev /.rev! random.rev code.rev rev.equivalence] - [/.frac /.frac! random.safe-frac code.frac frac.equivalence] + [/.frac /.frac! random.safe_frac code.frac frac.equivalence] [/.text /.text! (random.unicode 1) code.text text.equivalence] - [/.identifier /.identifier! ..random-name code.identifier name.equivalence] - [/.tag /.tag! ..random-name code.tag name.equivalence] - [/.local-identifier /.local-identifier! (random.unicode 1) code.local-identifier text.equivalence] - [/.local-tag /.local-tag! (random.unicode 1) code.local-tag text.equivalence] + [/.identifier /.identifier! ..random_name code.identifier name.equivalence] + [/.tag /.tag! ..random_name code.tag name.equivalence] + [/.local_identifier /.local_identifier! (random.unicode 1) code.local_identifier text.equivalence] + [/.local_tag /.local_tag! (random.unicode 1) code.local_tag text.equivalence] )) (~~ (template [<query> <code>] [(do {! random.monad} - [expected-left random.nat - expected-right random.int] + [expected_left random.nat + expected_right random.int] (_.cover [<query>] (|> (/.run (<query> (<>.and /.nat /.int)) - (list (<code> (list (code.nat expected-left) - (code.int expected-right))))) - (!expect (^multi (#try.Success [actual-left actual-right]) - (and (\ nat.equivalence = expected-left actual-left) - (\ int.equivalence = expected-right actual-right)))))))] + (list (<code> (list (code.nat expected_left) + (code.int expected_right))))) + (!expect (^multi (#try.Success [actual_left actual_right]) + (and (\ nat.equivalence = expected_left actual_left) + (\ int.equivalence = expected_right actual_right)))))))] [/.form code.form] [/.tuple code.tuple] )) (do {! random.monad} - [expected-left random.nat - expected-right random.int] + [expected_left random.nat + expected_right random.int] (_.cover [/.record] (|> (/.run (/.record (<>.and /.nat /.int)) - (list (code.record (list [(code.nat expected-left) - (code.int expected-right)])))) - (!expect (^multi (#try.Success [actual-left actual-right]) - (and (\ nat.equivalence = expected-left actual-left) - (\ int.equivalence = expected-right actual-right))))))) + (list (code.record (list [(code.nat expected_left) + (code.int expected_right)])))) + (!expect (^multi (#try.Success [actual_left actual_right]) + (and (\ nat.equivalence = expected_left actual_left) + (\ int.equivalence = expected_right actual_right))))))) (do {! random.monad} - [expected-local random.nat - expected-global random.int] + [expected_local random.nat + expected_global random.int] (_.cover [/.local] - (|> (/.run (<>.and (/.local (list (code.nat expected-local)) /.nat) + (|> (/.run (<>.and (/.local (list (code.nat expected_local)) /.nat) /.int) - (list (code.int expected-global))) - (!expect (^multi (#try.Success [actual-local actual-global]) - (and (\ nat.equivalence = expected-local actual-local) - (\ int.equivalence = expected-global actual-global))))))) + (list (code.int expected_global))) + (!expect (^multi (#try.Success [actual_local actual_global]) + (and (\ nat.equivalence = expected_local actual_local) + (\ int.equivalence = expected_global actual_global))))))) (do {! random.monad} [dummy (\ ! map code.bit random.bit)] (_.cover [/.end?] diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index cb6928062..b9d111eff 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -35,9 +35,9 @@ _ false)) -(def: safe-frac +(def: safe_frac (Random Frac) - (random.filter (|>> frac.not-a-number? not) random.frac)) + (random.filter (|>> frac.not_a_number? not) random.frac)) (def: #export test Test @@ -74,23 +74,23 @@ (!expect (#try.Failure _)))))))] [/.boolean /.boolean? /.boolean! random.bit #json.Boolean bit.equivalence] - [/.number /.number? /.number! ..safe-frac #json.Number frac.equivalence] + [/.number /.number? /.number! ..safe_frac #json.Number frac.equivalence] [/.string /.string? /.string! (random.unicode 1) #json.String text.equivalence] )) (do {! random.monad} [expected (random.unicode 1) dummy random.bit] - (_.cover [/.unexpected-value] + (_.cover [/.unexpected_value] (|> (/.run /.string (#json.Boolean dummy)) (!expect (^multi (#try.Failure error) - (exception.match? /.unexpected-value error)))))) + (exception.match? /.unexpected_value error)))))) (do {! random.monad} [expected (random.unicode 1) dummy (|> (random.unicode 1) (random.filter (|>> (\ text.equivalence = expected) not)))] - (_.cover [/.value-mismatch] + (_.cover [/.value_mismatch] (|> (/.run (/.string! expected) (#json.String dummy)) (!expect (^multi (#try.Failure error) - (exception.match? /.value-mismatch error)))))) + (exception.match? /.value_mismatch error)))))) (do {! random.monad} [expected (random.unicode 1)] (_.cover [/.nullable] @@ -104,59 +104,59 @@ [size (\ ! map (n.% 10) random.nat) expected (|> (random.unicode 1) (random.list size) - (\ ! map row.from-list))] + (\ ! map row.from_list))] (_.cover [/.array] (|> (/.run (/.array (<>.some /.string)) (#json.Array (row\map (|>> #json.String) expected))) (!expect (^multi (#try.Success actual) - (\ (row.equivalence text.equivalence) = expected (row.from-list actual))))))) + (\ (row.equivalence text.equivalence) = expected (row.from_list actual))))))) (do {! random.monad} [expected (\ ! map (|>> #json.String) (random.unicode 1))] - (_.cover [/.unconsumed-input] + (_.cover [/.unconsumed_input] (|> (/.run (/.array /.any) (#json.Array (row expected expected))) (!expect (^multi (#try.Failure error) - (exception.match? /.unconsumed-input error)))))) - (_.cover [/.empty-input] + (exception.match? /.unconsumed_input error)))))) + (_.cover [/.empty_input] (|> (/.run (/.array /.any) (#json.Array (row))) (!expect (^multi (#try.Failure error) - (exception.match? /.empty-input error))))) + (exception.match? /.empty_input error))))) (do {! random.monad} - [expected-boolean random.bit - expected-number ..safe-frac - expected-string (random.unicode 1) - [boolean-field number-field string-field] (|> (random.set text.hash 3 (random.unicode 3)) - (\ ! map (|>> set.to-list - (case> (^ (list boolean-field number-field string-field)) - [boolean-field number-field string-field] + [expected_boolean random.bit + expected_number ..safe_frac + expected_string (random.unicode 1) + [boolean_field number_field string_field] (|> (random.set text.hash 3 (random.unicode 3)) + (\ ! map (|>> set.to_list + (case> (^ (list boolean_field number_field string_field)) + [boolean_field number_field string_field] _ (undefined)))))] (_.cover [/.object /.field] (|> (/.run (/.object ($_ <>.and - (/.field boolean-field /.boolean) - (/.field number-field /.number) - (/.field string-field /.string))) + (/.field boolean_field /.boolean) + (/.field number_field /.number) + (/.field string_field /.string))) (#json.Object - (dictionary.from-list text.hash - (list [boolean-field (#json.Boolean expected-boolean)] - [number-field (#json.Number expected-number)] - [string-field (#json.String expected-string)])))) - (!expect (^multi (#try.Success [actual-boolean actual-number actual-string]) - (and (\ bit.equivalence = expected-boolean actual-boolean) - (\ frac.equivalence = expected-number actual-number) - (\ text.equivalence = expected-string actual-string))))))) + (dictionary.from_list text.hash + (list [boolean_field (#json.Boolean expected_boolean)] + [number_field (#json.Number expected_number)] + [string_field (#json.String expected_string)])))) + (!expect (^multi (#try.Success [actual_boolean actual_number actual_string]) + (and (\ bit.equivalence = expected_boolean actual_boolean) + (\ frac.equivalence = expected_number actual_number) + (\ text.equivalence = expected_string actual_string))))))) (do {! random.monad} [size (\ ! map (n.% 10) random.nat) keys (random.list size (random.unicode 1)) values (random.list size (random.unicode 1)) - #let [expected (dictionary.from-list text.hash (list.zip/2 keys values))]] + #let [expected (dictionary.from_list text.hash (list.zip/2 keys values))]] (_.cover [/.dictionary] (|> (/.run (/.dictionary /.string) (#json.Object (|> values (list\map (|>> #json.String)) (list.zip/2 keys) - (dictionary.from-list text.hash)))) + (dictionary.from_list text.hash)))) (!expect (^multi (#try.Success actual) (\ (dictionary.equivalence text.equivalence) = expected actual)))))) )))) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index daf44e7ae..b47f8338c 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -39,21 +39,21 @@ _ false)) -(def: random-constant +(def: random_constant (Random Name) (random.and (random.unicode 1) (random.unicode 1))) -(def: random-variable +(def: random_variable (Random Variable) (random.or random.nat random.nat)) -(def: random-environment +(def: random_environment (Random (Environment Synthesis)) (do {! random.monad} [size (\ ! map (n.% 5) random.nat)] - (|> ..random-variable + (|> ..random_variable (\ ! map (|>> synthesis.variable)) (random.list size)))) @@ -74,15 +74,16 @@ (!expect (#try.Success _))) (|> (/.run (<check> expected) (list (<synthesis> dummy))) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))))] + (exception.match? /.cannot_parse error)))))) + ))] [/.bit /.bit! random.bit synthesis.bit bit.equivalence] [/.i64 /.i64! (\ ! map .i64 random.nat) synthesis.i64 i64.equivalence] - [/.f64 /.f64! random.safe-frac synthesis.f64 frac.equivalence] + [/.f64 /.f64! random.safe_frac synthesis.f64 frac.equivalence] [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.constant! ..random-constant synthesis.constant name.equivalence] + [/.constant /.constant! ..random_constant synthesis.constant name.equivalence] )) ))) @@ -90,70 +91,70 @@ Test ($_ _.and (do {! random.monad} - [expected-bit random.bit - expected-i64 (\ ! map .i64 random.nat) - expected-f64 random.safe-frac - expected-text (random.unicode 1)] + [expected_bit random.bit + expected_i64 (\ ! map .i64 random.nat) + expected_f64 random.safe_frac + expected_text (random.unicode 1)] (_.cover [/.tuple] (and (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.tuple (list (synthesis.bit expected-bit) - (synthesis.i64 expected-i64) - (synthesis.f64 expected-f64) - (synthesis.text expected-text))))) - (!expect (^multi (#try.Success [actual-bit actual-i64 actual-f64 actual-text]) - (and (\ bit.equivalence = expected-bit actual-bit) - (\ i64.equivalence = expected-i64 actual-i64) - (\ frac.equivalence = expected-f64 actual-f64) - (\ text.equivalence = expected-text actual-text))))) + (list (synthesis.tuple (list (synthesis.bit expected_bit) + (synthesis.i64 expected_i64) + (synthesis.f64 expected_f64) + (synthesis.text expected_text))))) + (!expect (^multi (#try.Success [actual_bit actual_i64 actual_f64 actual_text]) + (and (\ bit.equivalence = expected_bit actual_bit) + (\ i64.equivalence = expected_i64 actual_i64) + (\ frac.equivalence = expected_f64 actual_f64) + (\ text.equivalence = expected_text actual_text))))) (|> (/.run (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.text expected-text))) + (list (synthesis.text expected_text))) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) + (exception.match? /.cannot_parse error))))))) (do {! random.monad} [arity random.nat - expected-environment ..random-environment - expected-body (random.unicode 1)] + expected_environment ..random_environment + expected_body (random.unicode 1)] (_.cover [/.function] (and (|> (/.run (/.function arity /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) - (!expect (^multi (#try.Success [actual-environment actual-body]) + (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) + (!expect (^multi (#try.Success [actual_environment actual_body]) (and (\ (list.equivalence synthesis.equivalence) = - expected-environment - actual-environment) - (\ text.equivalence = expected-body actual-body))))) + expected_environment + actual_environment) + (\ text.equivalence = expected_body actual_body))))) (|> (/.run (/.function arity /.text) - (list (synthesis.text expected-body))) + (list (synthesis.text expected_body))) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) + (exception.match? /.cannot_parse error))))))) (do {! random.monad} [arity random.nat - expected-environment ..random-environment - expected-body (random.unicode 1)] - (_.cover [/.wrong-arity] + expected_environment ..random_environment + expected_body (random.unicode 1)] + (_.cover [/.wrong_arity] (|> (/.run (/.function (inc arity) /.text) - (list (synthesis.function/abstraction [expected-environment arity (synthesis.text expected-body)]))) + (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) (!expect (^multi (#try.Failure error) - (exception.match? /.wrong-arity error)))))) + (exception.match? /.wrong_arity error)))))) (do {! random.monad} [arity (\ ! map (|>> (n.% 10) inc) random.nat) - expected-offset random.nat - expected-inits (random.list arity random.bit) - expected-body (random.unicode 1)] + expected_offset random.nat + expected_inits (random.list arity random.bit) + expected_body (random.unicode 1)] (_.cover [/.loop] (and (|> (/.run (/.loop (<>.many /.bit) /.text) - (list (synthesis.loop/scope [expected-offset - (list\map (|>> synthesis.bit) expected-inits) - (synthesis.text expected-body)]))) - (!expect (^multi (#try.Success [actual-offset actual-inits actual-body]) - (and (\ n.equivalence = expected-offset actual-offset) + (list (synthesis.loop/scope [expected_offset + (list\map (|>> synthesis.bit) expected_inits) + (synthesis.text expected_body)]))) + (!expect (^multi (#try.Success [actual_offset actual_inits actual_body]) + (and (\ n.equivalence = expected_offset actual_offset) (\ (list.equivalence bit.equivalence) = - expected-inits - actual-inits) - (\ text.equivalence = expected-body actual-body))))) + expected_inits + actual_inits) + (\ text.equivalence = expected_body actual_body))))) (|> (/.run (/.loop (<>.many /.bit) /.text) - (list (synthesis.text expected-body))) + (list (synthesis.text expected_body))) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) + (exception.match? /.cannot_parse error))))))) )) (def: #export test @@ -167,24 +168,24 @@ (|> (/.run /.any (list expected)) (!expect (^multi (#try.Success actual) (\ synthesis.equivalence = expected actual)))))) - (_.cover [/.empty-input] + (_.cover [/.empty_input] (|> (/.run /.any (list)) (!expect (^multi (#try.Failure error) - (exception.match? /.empty-input error))))) + (exception.match? /.empty_input error))))) (do {! random.monad} [expected (\ ! map (|>> synthesis.i64) random.nat)] - (_.cover [/.unconsumed-input] + (_.cover [/.unconsumed_input] (|> (/.run /.any (list expected expected)) (!expect (^multi (#try.Failure error) - (exception.match? /.unconsumed-input error)))))) + (exception.match? /.unconsumed_input error)))))) (do {! random.monad} [dummy (\ ! map (|>> synthesis.i64) random.nat)] - (_.cover [/.end! /.expected-empty-input] + (_.cover [/.end! /.expected_empty_input] (and (|> (/.run /.end! (list)) (!expect (#try.Success _))) (|> (/.run /.end! (list dummy)) (!expect (^multi (#try.Failure error) - (exception.match? /.expected-empty-input error))))))) + (exception.match? /.expected_empty_input error))))))) (do {! random.monad} [dummy (\ ! map (|>> synthesis.i64) random.nat)] (_.cover [/.end?] @@ -192,7 +193,7 @@ (!expect (#try.Success #1))) (|> (/.run (<>.before /.any /.end?) (list dummy)) (!expect (#try.Success #0)))))) - (_.for [/.cannot-parse] + (_.for [/.cannot_parse] ($_ _.and ..simple ..complex diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 8436e30ca..8465393de 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -38,7 +38,7 @@ _ false)) -(def: (should-fail' sample parser exception) +(def: (should_fail' sample parser exception) (All [a e] (-> Text (/.Parser a) (Exception e) Bit)) (case (/.run parser sample) (#try.Failure error) @@ -47,7 +47,7 @@ _ false)) -(def: (should-fail sample parser) +(def: (should_fail sample parser) (All [a] (-> Text (/.Parser a) Bit)) (case (/.run parser sample) (#try.Failure _) @@ -56,157 +56,157 @@ _ false)) -(def: (should-pass expected parser) +(def: (should_pass expected parser) (-> Text (/.Parser Text) Bit) (|> expected (/.run parser) (\ try.functor map (text\= expected)) (try.default false))) -(def: (should-pass! expected parser) +(def: (should_pass! expected parser) (-> Text (/.Parser /.Slice) Bit) - (..should-pass expected (/.slice parser))) + (..should_pass expected (/.slice parser))) -(def: character-classes +(def: character_classes Test ($_ _.and (do {! random.monad} [offset (\ ! map (n.% 50) random.nat) range (\ ! map (|>> (n.% 50) (n.+ 10)) random.nat) #let [limit (n.+ offset range)] - expected (\ ! map (|>> (n.% range) (n.+ offset) text.from-code) random.nat) - out-of-range (case offset - 0 (\ ! map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat) - _ (\ ! map (|>> (n.% offset) text.from-code) random.nat))] + expected (\ ! map (|>> (n.% range) (n.+ offset) text.from_code) random.nat) + out_of_range (case offset + 0 (\ ! map (|>> (n.% 10) inc (n.+ limit) text.from_code) random.nat) + _ (\ ! map (|>> (n.% offset) text.from_code) random.nat))] (_.cover [/.range] - (and (..should-pass expected (/.range offset limit)) - (..should-fail out-of-range (/.range offset limit))))) + (and (..should_pass expected (/.range offset limit)) + (..should_fail out_of_range (/.range offset limit))))) (do {! random.monad} - [expected (random.char unicode.ascii/upper-alpha) - invalid (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/upper-alpha) not) + [expected (random.char unicode.ascii/upper_alpha) + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper_alpha) not) (random.char unicode.character))] (_.cover [/.upper] - (and (..should-pass (text.from-code expected) /.upper) - (..should-fail (text.from-code invalid) /.upper)))) + (and (..should_pass (text.from_code expected) /.upper) + (..should_fail (text.from_code invalid) /.upper)))) (do {! random.monad} - [expected (random.char unicode.ascii/lower-alpha) - invalid (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/lower-alpha) not) + [expected (random.char unicode.ascii/lower_alpha) + invalid (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/lower_alpha) not) (random.char unicode.character))] (_.cover [/.lower] - (and (..should-pass (text.from-code expected) /.lower) - (..should-fail (text.from-code invalid) /.lower)))) + (and (..should_pass (text.from_code expected) /.lower) + (..should_fail (text.from_code invalid) /.lower)))) (do {! random.monad} [expected (\ ! map (n.% 10) random.nat) - invalid (random.char (unicode.set [unicode/block.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] (_.cover [/.decimal] - (and (..should-pass (\ n.decimal encode expected) /.decimal) - (..should-fail (text.from-code invalid) /.decimal)))) + (and (..should_pass (\ n.decimal encode expected) /.decimal) + (..should_fail (text.from_code invalid) /.decimal)))) (do {! random.monad} [expected (\ ! map (n.% 8) random.nat) - invalid (random.char (unicode.set [unicode/block.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] (_.cover [/.octal] - (and (..should-pass (\ n.octal encode expected) /.octal) - (..should-fail (text.from-code invalid) /.octal)))) + (and (..should_pass (\ n.octal encode expected) /.octal) + (..should_fail (text.from_code invalid) /.octal)))) (do {! random.monad} [expected (\ ! map (n.% 16) random.nat) - invalid (random.char (unicode.set [unicode/block.number-forms (list)]))] + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] (_.cover [/.hexadecimal] - (and (..should-pass (\ n.hex encode expected) /.hexadecimal) - (..should-fail (text.from-code invalid) /.hexadecimal)))) + (and (..should_pass (\ n.hex encode expected) /.hexadecimal) + (..should_fail (text.from_code invalid) /.hexadecimal)))) (do {! random.monad} [expected (random.char unicode.ascii/alpha) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) - (unicode/block.within? unicode/block.basic-latin/lower-alpha char)))) + (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) + (unicode/block.within? unicode/block.basic_latin/lower_alpha char)))) (random.char unicode.character))] (_.cover [/.alpha] - (and (..should-pass (text.from-code expected) /.alpha) - (..should-fail (text.from-code invalid) /.alpha)))) + (and (..should_pass (text.from_code expected) /.alpha) + (..should_fail (text.from_code invalid) /.alpha)))) (do {! random.monad} - [expected (random.char unicode.ascii/alpha-num) + [expected (random.char unicode.ascii/alpha_num) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) - (unicode/block.within? unicode/block.basic-latin/lower-alpha char) - (unicode/block.within? unicode/block.basic-latin/decimal char)))) + (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) + (unicode/block.within? unicode/block.basic_latin/lower_alpha char) + (unicode/block.within? unicode/block.basic_latin/decimal char)))) (random.char unicode.character))] - (_.cover [/.alpha-num] - (and (..should-pass (text.from-code expected) /.alpha-num) - (..should-fail (text.from-code invalid) /.alpha-num)))) + (_.cover [/.alpha_num] + (and (..should_pass (text.from_code expected) /.alpha_num) + (..should_fail (text.from_code invalid) /.alpha_num)))) (do {! random.monad} [expected ($_ random.either (wrap text.tab) - (wrap text.vertical-tab) + (wrap text.vertical_tab) (wrap text.space) - (wrap text.new-line) - (wrap text.carriage-return) - (wrap text.form-feed)) + (wrap text.new_line) + (wrap text.carriage_return) + (wrap text.form_feed)) invalid (|> (random.unicode 1) (random.filter (function (_ char) (not (or (text\= text.tab char) - (text\= text.vertical-tab char) + (text\= text.vertical_tab char) (text\= text.space char) - (text\= text.new-line char) - (text\= text.carriage-return char) - (text\= text.form-feed char))))))] + (text\= text.new_line char) + (text\= text.carriage_return char) + (text\= text.form_feed char))))))] (_.cover [/.space] - (and (..should-pass expected /.space) - (..should-fail invalid /.space)))) + (and (..should_pass expected /.space) + (..should_fail invalid /.space)))) (do {! random.monad} - [#let [num-options 3] + [#let [num_options 3] options (|> (random.char unicode.character) - (random.set n.hash num-options) - (\ ! map (|>> set.to-list - (list\map text.from-code) - (text.join-with "")))) + (random.set n.hash num_options) + (\ ! map (|>> set.to_list + (list\map text.from_code) + (text.join_with "")))) expected (\ ! map (function (_ value) (|> options - (text.nth (n.% num-options value)) + (text.nth (n.% num_options value)) maybe.assume)) random.nat) invalid (random.filter (function (_ char) - (not (text.contains? (text.from-code char) options))) + (not (text.contains? (text.from_code char) options))) (random.char unicode.character))] - (_.cover [/.one-of /.one-of! /.character-should-be] - (and (..should-pass (text.from-code expected) (/.one-of options)) - (..should-fail (text.from-code invalid) (/.one-of options)) - (..should-fail' (text.from-code invalid) (/.one-of options) - /.character-should-be) + (_.cover [/.one_of /.one_of! /.character_should_be] + (and (..should_pass (text.from_code expected) (/.one_of options)) + (..should_fail (text.from_code invalid) (/.one_of options)) + (..should_fail' (text.from_code invalid) (/.one_of options) + /.character_should_be) - (..should-pass! (text.from-code expected) (/.one-of! options)) - (..should-fail (text.from-code invalid) (/.one-of! options)) - (..should-fail' (text.from-code invalid) (/.one-of! options) - /.character-should-be) + (..should_pass! (text.from_code expected) (/.one_of! options)) + (..should_fail (text.from_code invalid) (/.one_of! options)) + (..should_fail' (text.from_code invalid) (/.one_of! options) + /.character_should_be) ))) (do {! random.monad} - [#let [num-options 3] + [#let [num_options 3] options (|> (random.char unicode.character) - (random.set n.hash num-options) - (\ ! map (|>> set.to-list - (list\map text.from-code) - (text.join-with "")))) + (random.set n.hash num_options) + (\ ! map (|>> set.to_list + (list\map text.from_code) + (text.join_with "")))) invalid (\ ! map (function (_ value) (|> options - (text.nth (n.% num-options value)) + (text.nth (n.% num_options value)) maybe.assume)) random.nat) expected (random.filter (function (_ char) - (not (text.contains? (text.from-code char) options))) + (not (text.contains? (text.from_code char) options))) (random.char unicode.character))] - (_.cover [/.none-of /.none-of! /.character-should-not-be] - (and (..should-pass (text.from-code expected) (/.none-of options)) - (..should-fail (text.from-code invalid) (/.none-of options)) - (..should-fail' (text.from-code invalid) (/.none-of options) - /.character-should-not-be) + (_.cover [/.none_of /.none_of! /.character_should_not_be] + (and (..should_pass (text.from_code expected) (/.none_of options)) + (..should_fail (text.from_code invalid) (/.none_of options)) + (..should_fail' (text.from_code invalid) (/.none_of options) + /.character_should_not_be) - (..should-pass! (text.from-code expected) (/.none-of! options)) - (..should-fail (text.from-code invalid) (/.none-of! options)) - (..should-fail' (text.from-code invalid) (/.none-of! options) - /.character-should-not-be) + (..should_pass! (text.from_code expected) (/.none_of! options)) + (..should_fail (text.from_code invalid) (/.none_of! options)) + (..should_fail' (text.from_code invalid) (/.none_of! options) + /.character_should_not_be) ))) )) (def: runs Test - (let [octal! (/.one-of! "01234567")] + (let [octal! (/.one_of! "01234567")] ($_ _.and (do {! random.monad} [left (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat) @@ -217,10 +217,10 @@ (random.filter (n.>= 8)) (\ ! map (\ n.hex encode)))] (_.cover [/.many /.many!] - (and (..should-pass expected (/.many /.octal)) - (..should-fail invalid (/.many /.octal)) + (and (..should_pass expected (/.many /.octal)) + (..should_fail invalid (/.many /.octal)) - (..should-pass! expected (/.many! octal!))))) + (..should_pass! expected (/.many! octal!))))) (do {! random.monad} [left (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat) right (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat) @@ -230,64 +230,64 @@ (random.filter (n.>= 8)) (\ ! map (\ n.hex encode)))] (_.cover [/.some /.some!] - (and (..should-pass expected (/.some /.octal)) - (..should-pass "" (/.some /.octal)) - (..should-fail invalid (/.some /.octal)) + (and (..should_pass expected (/.some /.octal)) + (..should_pass "" (/.some /.octal)) + (..should_fail invalid (/.some /.octal)) - (..should-pass! expected (/.some! octal!)) - (..should-pass! "" (/.some! octal!))))) + (..should_pass! expected (/.some! octal!)) + (..should_pass! "" (/.some! octal!))))) (do {! random.monad} [#let [octal (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat)] first octal second octal third octal] (_.cover [/.exactly /.exactly!] - (and (..should-pass (format first second) (/.exactly 2 /.octal)) - (..should-fail (format first second third) (/.exactly 2 /.octal)) - (..should-fail (format first) (/.exactly 2 /.octal)) + (and (..should_pass (format first second) (/.exactly 2 /.octal)) + (..should_fail (format first second third) (/.exactly 2 /.octal)) + (..should_fail (format first) (/.exactly 2 /.octal)) - (..should-pass! (format first second) (/.exactly! 2 octal!)) - (..should-fail (format first second third) (/.exactly! 2 octal!)) - (..should-fail (format first) (/.exactly! 2 octal!))))) + (..should_pass! (format first second) (/.exactly! 2 octal!)) + (..should_fail (format first second third) (/.exactly! 2 octal!)) + (..should_fail (format first) (/.exactly! 2 octal!))))) (do {! random.monad} [#let [octal (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat)] first octal second octal third octal] - (_.cover [/.at-most /.at-most!] - (and (..should-pass (format first second) (/.at-most 2 /.octal)) - (..should-pass (format first) (/.at-most 2 /.octal)) - (..should-fail (format first second third) (/.at-most 2 /.octal)) + (_.cover [/.at_most /.at_most!] + (and (..should_pass (format first second) (/.at_most 2 /.octal)) + (..should_pass (format first) (/.at_most 2 /.octal)) + (..should_fail (format first second third) (/.at_most 2 /.octal)) - (..should-pass! (format first second) (/.at-most! 2 octal!)) - (..should-pass! (format first) (/.at-most! 2 octal!)) - (..should-fail (format first second third) (/.at-most! 2 octal!))))) + (..should_pass! (format first second) (/.at_most! 2 octal!)) + (..should_pass! (format first) (/.at_most! 2 octal!)) + (..should_fail (format first second third) (/.at_most! 2 octal!))))) (do {! random.monad} [#let [octal (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat)] first octal second octal third octal] - (_.cover [/.at-least /.at-least!] - (and (..should-pass (format first second) (/.at-least 2 /.octal)) - (..should-pass (format first second third) (/.at-least 2 /.octal)) - (..should-fail (format first) (/.at-least 2 /.octal)) + (_.cover [/.at_least /.at_least!] + (and (..should_pass (format first second) (/.at_least 2 /.octal)) + (..should_pass (format first second third) (/.at_least 2 /.octal)) + (..should_fail (format first) (/.at_least 2 /.octal)) - (..should-pass! (format first second) (/.at-least! 2 octal!)) - (..should-pass! (format first second third) (/.at-least! 2 octal!)) - (..should-fail (format first) (/.at-least! 2 octal!))))) + (..should_pass! (format first second) (/.at_least! 2 octal!)) + (..should_pass! (format first second third) (/.at_least! 2 octal!)) + (..should_fail (format first) (/.at_least! 2 octal!))))) (do {! random.monad} [#let [octal (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat)] first octal second octal third octal] (_.cover [/.between /.between!] - (and (..should-pass (format first second) (/.between 2 3 /.octal)) - (..should-pass (format first second third) (/.between 2 3 /.octal)) - (..should-fail (format first) (/.between 2 3 /.octal)) + (and (..should_pass (format first second) (/.between 2 3 /.octal)) + (..should_pass (format first second third) (/.between 2 3 /.octal)) + (..should_fail (format first) (/.between 2 3 /.octal)) - (..should-pass! (format first second) (/.between! 2 3 octal!)) - (..should-pass! (format first second third) (/.between! 2 3 octal!)) - (..should-fail (format first) (/.between! 2 3 octal!))))) + (..should_pass! (format first second) (/.between! 2 3 octal!)) + (..should_pass! (format first second third) (/.between! 2 3 octal!)) + (..should_fail (format first) (/.between! 2 3 octal!))))) ))) (def: #export test @@ -309,42 +309,42 @@ expected (random.unicode size) dummy (|> (random.unicode size) (random.filter (|>> (text\= expected) not)))] - (_.cover [/.this /.cannot-match] + (_.cover [/.this /.cannot_match] (and (|> (/.run (/.this expected) expected) (!expect (#try.Success []))) (|> (/.run (/.this expected) dummy) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-match error))))))) - (_.cover [/.Slice /.slice /.cannot-slice] + (exception.match? /.cannot_match error))))))) + (_.cover [/.Slice /.slice /.cannot_slice] (|> "" (/.run (/.slice /.any!)) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-slice error))))) + (exception.match? /.cannot_slice error))))) (do {! random.monad} [expected (random.unicode 1)] (_.cover [/.any /.any!] - (and (..should-pass expected /.any) - (..should-fail "" /.any) + (and (..should_pass expected /.any) + (..should_fail "" /.any) - (..should-pass! expected /.any!) - (..should-fail "" /.any!)))) + (..should_pass! expected /.any!) + (..should_fail "" /.any!)))) (do {! random.monad} [expected (random.unicode 1)] - (_.cover [/.peek /.cannot-parse] - (and (..should-pass expected (<>.before /.any /.peek)) + (_.cover [/.peek /.cannot_parse] + (and (..should_pass expected (<>.before /.any /.peek)) (|> "" (/.run (<>.before /.any /.peek)) (!expect (^multi (#try.Failure error) - (exception.match? /.cannot-parse error))))))) + (exception.match? /.cannot_parse error))))))) (do {! random.monad} [dummy (random.unicode 1)] - (_.cover [/.unconsumed-input] + (_.cover [/.unconsumed_input] (|> (format dummy dummy) (/.run /.any) (!expect (^multi (#try.Failure error) - (exception.match? /.unconsumed-input error)))))) + (exception.match? /.unconsumed_input error)))))) (do {! random.monad} [sample (random.unicode 1)] (_.cover [/.Offset /.offset] @@ -359,12 +359,12 @@ [left (random.unicode 1) right (random.unicode 1) #let [input (format left right)]] - (_.cover [/.get-input] + (_.cover [/.get_input] (|> input (/.run (do <>.monad - [pre /.get-input + [pre /.get_input _ /.any - post /.get-input + post /.get_input _ /.any] (wrap (and (text\= input pre) (text\= right post))))) @@ -395,47 +395,47 @@ (!expect (^multi (#try.Success actual) (text\= expected actual)))))) (do {! random.monad} - [invalid (random.ascii/upper-alpha 1) - expected (random.filter (|>> (unicode/block.within? unicode/block.basic-latin/upper-alpha) + [invalid (random.ascii/upper_alpha 1) + expected (random.filter (|>> (unicode/block.within? unicode/block.basic_latin/upper_alpha) not) (random.char unicode.character)) - #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] - (_.cover [/.not /.not! /.expected-to-fail] - (and (..should-pass (text.from-code expected) (/.not /.upper)) + #let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] + (_.cover [/.not /.not! /.expected_to_fail] + (and (..should_pass (text.from_code expected) (/.not /.upper)) (|> invalid (/.run (/.not /.upper)) (!expect (^multi (#try.Failure error) - (exception.match? /.expected-to-fail error)))) + (exception.match? /.expected_to_fail error)))) - (..should-pass! (text.from-code expected) (/.not! upper!)) + (..should_pass! (text.from_code expected) (/.not! upper!)) (|> invalid (/.run (/.not! upper!)) (!expect (^multi (#try.Failure error) - (exception.match? /.expected-to-fail error))))))) + (exception.match? /.expected_to_fail error))))))) (do {! random.monad} - [upper (random.ascii/upper-alpha 1) - lower (random.ascii/lower-alpha 1) + [upper (random.ascii/upper_alpha 1) + lower (random.ascii/lower_alpha 1) invalid (random.filter (function (_ char) - (not (or (unicode/block.within? unicode/block.basic-latin/upper-alpha char) - (unicode/block.within? unicode/block.basic-latin/lower-alpha char)))) + (not (or (unicode/block.within? unicode/block.basic_latin/upper_alpha char) + (unicode/block.within? unicode/block.basic_latin/lower_alpha char)))) (random.char unicode.character)) - #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - lower! (/.one-of! "abcdefghijklmnopqrstuvwxyz")]] + #let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + lower! (/.one_of! "abcdefghijklmnopqrstuvwxyz")]] (_.cover [/.and /.and!] - (and (..should-pass (format upper lower) (/.and /.upper /.lower)) - (..should-fail (format (text.from-code invalid) lower) (/.and /.upper /.lower)) - (..should-fail (format upper (text.from-code invalid)) (/.and /.upper /.lower)) + (and (..should_pass (format upper lower) (/.and /.upper /.lower)) + (..should_fail (format (text.from_code invalid) lower) (/.and /.upper /.lower)) + (..should_fail (format upper (text.from_code invalid)) (/.and /.upper /.lower)) - (..should-pass! (format upper lower) (/.and! upper! lower!)) - (..should-fail (format (text.from-code invalid) lower) (/.and! upper! lower!)) - (..should-fail (format upper (text.from-code invalid)) (/.and! upper! lower!))))) + (..should_pass! (format upper lower) (/.and! upper! lower!)) + (..should_fail (format (text.from_code invalid) lower) (/.and! upper! lower!)) + (..should_fail (format upper (text.from_code invalid)) (/.and! upper! lower!))))) (do {! random.monad} [expected (random.unicode 1) invalid (random.unicode 1)] - (_.cover [/.satisfies /.character-does-not-satisfy-predicate] - (and (..should-pass expected (/.satisfies (function.constant true))) - (..should-fail' invalid (/.satisfies (function.constant false)) - /.character-does-not-satisfy-predicate)))) - ..character-classes + (_.cover [/.satisfies /.character_does_not_satisfy_predicate] + (and (..should_pass expected (/.satisfies (function.constant true))) + (..should_fail' invalid (/.satisfies (function.constant false)) + /.character_does_not_satisfy_predicate)))) + ..character_classes ..runs ))) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index f703d38a7..47cdac08f 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -29,13 +29,13 @@ (def: primitive (Random Type) - (|> (random.ascii/alpha-num 1) + (|> (random.ascii/alpha_num 1) (\ random.monad map (function (_ name) (#.Primitive name (list)))))) (def: matches Test - (<| (_.for [/.types-do-not-match]) + (<| (_.for [/.types_do_not_match]) (do {! random.monad} [expected ..primitive dummy (random.filter (|>> (type\= expected) not) @@ -46,7 +46,7 @@ (!expect (#try.Success []))) (|> (/.run (/.exactly expected) dummy) (!expect (^multi (#try.Failure error) - (exception.match? /.types-do-not-match error)))))) + (exception.match? /.types_do_not_match error)))))) (_.cover [/.sub] (and (|> (/.run (/.sub expected) expected) (!expect (#try.Success []))) @@ -56,7 +56,7 @@ (!expect (#try.Success []))) (|> (/.run (/.sub expected) dummy) (!expect (^multi (#try.Failure error) - (exception.match? /.types-do-not-match error)))))) + (exception.match? /.types_do_not_match error)))))) (_.cover [/.super] (and (|> (/.run (/.super expected) expected) (!expect (#try.Success []))) @@ -66,55 +66,55 @@ (!expect (#try.Success []))) (|> (/.run (/.super expected) dummy) (!expect (^multi (#try.Failure error) - (exception.match? /.types-do-not-match error)))))) + (exception.match? /.types_do_not_match error)))))) ))) (def: aggregate Test (do {! random.monad} - [expected-left ..primitive - expected-middle ..primitive - expected-right ..primitive] + [expected_left ..primitive + expected_middle ..primitive + expected_right ..primitive] (`` ($_ _.and - (~~ (template [<parser> <exception> <good-constructor> <bad-constructor>] + (~~ (template [<parser> <exception> <good_constructor> <bad_constructor>] [(_.cover [<parser> <exception>] (and (|> (/.run (<parser> ($_ //.and /.any /.any /.any)) - (<good-constructor> (list expected-left expected-middle expected-right))) - (!expect (^multi (#try.Success [actual-left actual-middle actual-right]) - (and (type\= expected-left actual-left) - (type\= expected-middle actual-middle) - (type\= expected-right actual-right))))) + (<good_constructor> (list expected_left expected_middle expected_right))) + (!expect (^multi (#try.Success [actual_left actual_middle actual_right]) + (and (type\= expected_left actual_left) + (type\= expected_middle actual_middle) + (type\= expected_right actual_right))))) (|> (/.run (<parser> ($_ //.and /.any /.any /.any)) - (<bad-constructor> (list expected-left expected-middle expected-right))) + (<bad_constructor> (list expected_left expected_middle expected_right))) (!expect (^multi (#try.Failure error) (exception.match? <exception> error))))))] - [/.variant /.not-variant type.variant type.tuple] - [/.tuple /.not-tuple type.tuple type.variant] + [/.variant /.not_variant type.variant type.tuple] + [/.tuple /.not_tuple type.tuple type.variant] )) - (_.cover [/.function /.not-function] + (_.cover [/.function /.not_function] (and (|> (/.run (/.function ($_ //.and /.any /.any) /.any) - (type.function (list expected-left expected-middle) expected-right)) - (!expect (^multi (#try.Success [[actual-left actual-middle] actual-right]) - (and (type\= expected-left actual-left) - (type\= expected-middle actual-middle) - (type\= expected-right actual-right))))) + (type.function (list expected_left expected_middle) expected_right)) + (!expect (^multi (#try.Success [[actual_left actual_middle] actual_right]) + (and (type\= expected_left actual_left) + (type\= expected_middle actual_middle) + (type\= expected_right actual_right))))) (|> (/.run (/.function ($_ //.and /.any /.any) /.any) - (type.variant (list expected-left expected-middle expected-right))) + (type.variant (list expected_left expected_middle expected_right))) (!expect (^multi (#try.Failure error) - (exception.match? /.not-function error)))))) - (_.cover [/.apply /.not-application] + (exception.match? /.not_function error)))))) + (_.cover [/.apply /.not_application] (and (|> (/.run (/.apply ($_ //.and /.any /.any /.any)) - (type.application (list expected-middle expected-right) expected-left)) - (!expect (^multi (#try.Success [actual-left actual-middle actual-right]) - (and (type\= expected-left actual-left) - (type\= expected-middle actual-middle) - (type\= expected-right actual-right))))) + (type.application (list expected_middle expected_right) expected_left)) + (!expect (^multi (#try.Success [actual_left actual_middle actual_right]) + (and (type\= expected_left actual_left) + (type\= expected_middle actual_middle) + (type\= expected_right actual_right))))) (|> (/.run (/.apply ($_ //.and /.any /.any /.any)) - (type.variant (list expected-left expected-middle expected-right))) + (type.variant (list expected_left expected_middle expected_right))) (!expect (^multi (#try.Failure error) - (exception.match? /.not-application error)))))) + (exception.match? /.not_application error)))))) )))) (def: parameter @@ -122,40 +122,40 @@ (do random.monad [quantification ..primitive argument ..primitive - not-parameter ..primitive + not_parameter ..primitive parameter random.nat] ($_ _.and - (_.cover [/.not-parameter] - (|> (/.run /.parameter not-parameter) + (_.cover [/.not_parameter] + (|> (/.run /.parameter not_parameter) (!expect (^multi (#try.Failure error) - (exception.match? /.not-parameter error))))) - (_.cover [/.unknown-parameter] + (exception.match? /.not_parameter error))))) + (_.cover [/.unknown_parameter] (|> (/.run /.parameter (#.Parameter parameter)) (!expect (^multi (#try.Failure error) - (exception.match? /.unknown-parameter error))))) - (_.cover [/.with-extension] - (|> (/.run (<| (/.with-extension quantification) - (/.with-extension argument) + (exception.match? /.unknown_parameter error))))) + (_.cover [/.with_extension] + (|> (/.run (<| (/.with_extension quantification) + (/.with_extension argument) /.any) - not-parameter) + not_parameter) (!expect (^multi (#try.Success [quantification\\binding argument\\binding actual]) - (is? not-parameter actual))))) + (is? not_parameter actual))))) (_.cover [/.parameter] - (|> (/.run (<| (/.with-extension quantification) - (/.with-extension argument) + (|> (/.run (<| (/.with_extension quantification) + (/.with_extension argument) /.parameter) (#.Parameter 0)) (!expect (#try.Success [quantification\\binding argument\\binding _])))) - (_.cover [/.wrong-parameter] - (|> (/.run (<| (/.with-extension quantification) - (/.with-extension argument) + (_.cover [/.wrong_parameter] + (|> (/.run (<| (/.with_extension quantification) + (/.with_extension argument) (/.parameter! 1)) (#.Parameter 0)) (!expect (^multi (#try.Failure error) - (exception.match? /.wrong-parameter error))))) + (exception.match? /.wrong_parameter error))))) (_.cover [/.parameter!] - (|> (/.run (<| (/.with-extension quantification) - (/.with-extension argument) + (|> (/.run (<| (/.with_extension quantification) + (/.with_extension argument) (/.parameter! 0)) (#.Parameter 0)) (!expect (#try.Success [quantification\\binding argument\\binding _])))) @@ -164,24 +164,24 @@ (def: polymorphic Test (do {! random.monad} - [not-polymorphic ..primitive - expected-inputs (\ ! map (|>> (n.% 10) inc) random.nat)] + [not_polymorphic ..primitive + expected_inputs (\ ! map (|>> (n.% 10) inc) random.nat)] ($_ _.and - (_.cover [/.not-polymorphic] + (_.cover [/.not_polymorphic] (and (|> (/.run (/.polymorphic /.any) - not-polymorphic) + not_polymorphic) (!expect (^multi (#try.Failure error) - (exception.match? /.not-polymorphic error)))) + (exception.match? /.not_polymorphic error)))) (|> (/.run (/.polymorphic /.any) - (type.univ-q 0 not-polymorphic)) + (type.univ_q 0 not_polymorphic)) (!expect (^multi (#try.Failure error) - (exception.match? /.not-polymorphic error)))))) + (exception.match? /.not_polymorphic error)))))) (_.cover [/.polymorphic] (|> (/.run (/.polymorphic /.any) - (type.univ-q expected-inputs not-polymorphic)) - (!expect (^multi (#try.Success [g!poly actual-inputs bodyT]) - (and (n.= expected-inputs (list.size actual-inputs)) - (is? not-polymorphic bodyT)))))) + (type.univ_q expected_inputs not_polymorphic)) + (!expect (^multi (#try.Success [g!poly actual_inputs bodyT]) + (and (n.= expected_inputs (list.size actual_inputs)) + (is? not_polymorphic bodyT)))))) ))) (def: #export test @@ -197,7 +197,7 @@ (type\= expected actual)))))) (do {! random.monad} [expected ..primitive] - (_.cover [/.peek /.unconsumed-input] + (_.cover [/.peek /.unconsumed_input] (and (|> (/.run (do //.monad [actual /.peek _ /.any] @@ -207,17 +207,17 @@ (type\= expected actual)))) (|> (/.run /.peek expected) (!expect (^multi (#try.Failure error) - (exception.match? /.unconsumed-input error))))))) + (exception.match? /.unconsumed_input error))))))) (do {! random.monad} [expected ..primitive] - (_.cover [/.empty-input] + (_.cover [/.empty_input] (`` (and (~~ (template [<parser>] [(|> (/.run (do //.monad [_ /.any] <parser>) expected) (!expect (^multi (#try.Failure error) - (exception.match? /.empty-input error))))] + (exception.match? /.empty_input error))))] [/.any] [/.peek] @@ -246,21 +246,21 @@ (type\= expected actual)))))) (do {! random.monad} [expected random.nat] - (_.cover [/.existential /.not-existential] + (_.cover [/.existential /.not_existential] (|> (/.run /.existential (#.Ex expected)) (!expect (^multi (#try.Success actual) (n.= expected actual)))))) (do {! random.monad} - [expected-name (random.and (random.ascii/alpha-num 1) - (random.ascii/alpha-num 1)) - expected-type ..primitive] - (_.cover [/.named /.not-named] + [expected_name (random.and (random.ascii/alpha_num 1) + (random.ascii/alpha_num 1)) + expected_type ..primitive] + (_.cover [/.named /.not_named] (|> (/.run /.named - (#.Named expected-name expected-type)) - (!expect (^multi (#try.Success [actual-name actual-type]) - (and (name\= expected-name actual-name) - (type\= expected-type actual-type))))))) + (#.Named expected_name expected_type)) + (!expect (^multi (#try.Success [actual_name actual_type]) + (and (name\= expected_name actual_name) + (type\= expected_type actual_type))))))) ..aggregate ..matches ..parameter diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index c17faa6b0..6d6126e8f 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -34,7 +34,7 @@ false)) (template: (!failure <exception> <cases>) - (with-expansions [<<cases>> (template.splice <cases>)] + (with_expansions [<<cases>> (template.splice <cases>)] (do {! random.monad} [expected (random.ascii/alpha 1)] (_.cover [<exception>] @@ -45,13 +45,13 @@ <<cases>>)))))))) -(def: random-label +(def: random_label (Random Name) (random.and (random.ascii/alpha 1) (random.ascii/alpha 1))) -(def: random-tag ..random-label) -(def: random-attribute ..random-label) +(def: random_tag ..random_label) +(def: random_attribute ..random_label) (def: #export test Test @@ -64,7 +64,7 @@ (|> (/.run /.text (#xml.Text expected)) (!expect (^multi (#try.Success actual) (text\= expected actual)))))) - (!failure /.unconsumed-inputs + (!failure /.unconsumed_inputs [[(//\wrap expected) (#xml.Text expected)]]) (do {! random.monad} @@ -73,7 +73,7 @@ (|> (/.run /.ignore (#xml.Text expected)) (!expect (#try.Success []))))) (do {! random.monad} - [expected ..random-tag] + [expected ..random_tag] (_.cover [/.tag] (|> (/.run (do //.monad [actual /.tag @@ -82,31 +82,31 @@ (#xml.Node expected (dictionary.new name.hash) (list))) (!expect (#try.Success #1))))) (do {! random.monad} - [expected ..random-tag] + [expected ..random_tag] (_.cover [/.node] (|> (/.run (do //.monad [_ (/.node expected)] /.ignore) (#xml.Node expected (dictionary.new name.hash) (list))) (!expect (#try.Success []))))) - (!failure /.wrong-tag + (!failure /.wrong_tag [[(/.node ["" expected]) (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) (do {! random.monad} - [expected-tag ..random-tag - expected-attribute ..random-attribute - expected-value (random.ascii/alpha 1)] + [expected_tag ..random_tag + expected_attribute ..random_attribute + expected_value (random.ascii/alpha 1)] (_.cover [/.attribute] (|> (/.run (do //.monad - [_ (/.node expected-tag) - _ (/.attribute expected-attribute)] + [_ (/.node expected_tag) + _ (/.attribute expected_attribute)] /.ignore) - (#xml.Node expected-tag + (#xml.Node expected_tag (|> (dictionary.new name.hash) - (dictionary.put expected-attribute expected-value)) + (dictionary.put expected_attribute expected_value)) (list))) (!expect (#try.Success []))))) - (!failure /.unknown-attribute + (!failure /.unknown_attribute [[(do //.monad [_ (/.attribute ["" expected])] /.ignore) @@ -115,7 +115,7 @@ (dictionary.put [expected ""] expected)) (list))]]) (do {! random.monad} - [expected ..random-tag] + [expected ..random_tag] (_.cover [/.children] (|> (/.run (do {! //.monad} [_ (/.node expected)] @@ -129,7 +129,7 @@ (dictionary.new name.hash) (list))))) (!expect (#try.Success []))))) - (!failure /.empty-input + (!failure /.empty_input [[(do //.monad [_ /.ignore] /.ignore) @@ -160,7 +160,7 @@ (list (#xml.Node [expected expected] (dictionary.new name.hash) (list))))]]) - (!failure /.unexpected-input + (!failure /.unexpected_input [[/.text (#xml.Node [expected expected] (dictionary.new name.hash) (list))] [(do //.monad @@ -182,10 +182,10 @@ [#let [node (: (-> xml.Tag (List xml.XML) xml.XML) (function (_ tag children) (#xml.Node tag (dictionary.new name.hash) children)))] - parent ..random-tag - right ..random-tag + parent ..random_tag + right ..random_tag wrong (random.filter (|>> (name\= right) not) - ..random-tag) + ..random_tag) #let [parser (/.children (do //.monad [_ (/.somewhere (/.node right)) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index cfdbf5148..b9389dbdf 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -79,7 +79,7 @@ (<| (_.covering /._) (_.for [/.Region]) (do {! random.monad} - [expected-clean-ups (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1))))] + [expected_clean_ups (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1))))] ($_ _.and (_.for [/.functor] ($functor.spec ..injection ..comparison (: (All [! r] @@ -97,90 +97,90 @@ (_.cover [/.run] (thread.run (do {! thread.monad} - [clean-up-counter (thread.box 0) + [clean_up_counter (thread.box 0) #let [//@ ! - count-clean-up (function (_ value) + count_clean_up (function (_ value) (do ! - [_ (thread.update inc clean-up-counter)] + [_ (thread.update inc clean_up_counter)] (wrap (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} - [_ (monad.map ! (/.acquire //@ count-clean-up) - (enum.range n.enum 1 expected-clean-ups))] + [_ (monad.map ! (/.acquire //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups))] (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] + actual_clean_ups (thread.read clean_up_counter)] (wrap (and (..success? outcome) - (n.= expected-clean-ups - actual-clean-ups)))))) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.fail] (thread.run (do {! thread.monad} - [clean-up-counter (thread.box 0) + [clean_up_counter (thread.box 0) #let [//@ ! - count-clean-up (function (_ value) + count_clean_up (function (_ value) (do ! - [_ (thread.update inc clean-up-counter)] + [_ (thread.update inc clean_up_counter)] (wrap (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} - [_ (monad.map ! (/.acquire //@ count-clean-up) - (enum.range n.enum 1 expected-clean-ups)) + [_ (monad.map ! (/.acquire //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups)) _ (/.fail //@ (exception.construct ..oops []))] (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] + actual_clean_ups (thread.read clean_up_counter)] (wrap (and (..throws? ..oops outcome) - (n.= expected-clean-ups - actual-clean-ups)))))) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.throw] (thread.run (do {! thread.monad} - [clean-up-counter (thread.box 0) + [clean_up_counter (thread.box 0) #let [//@ ! - count-clean-up (function (_ value) + count_clean_up (function (_ value) (do ! - [_ (thread.update inc clean-up-counter)] + [_ (thread.update inc clean_up_counter)] (wrap (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} - [_ (monad.map ! (/.acquire //@ count-clean-up) - (enum.range n.enum 1 expected-clean-ups)) + [_ (monad.map ! (/.acquire //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups)) _ (/.throw //@ ..oops [])] (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] + actual_clean_ups (thread.read clean_up_counter)] (wrap (and (..throws? ..oops outcome) - (n.= expected-clean-ups - actual-clean-ups)))))) - (_.cover [/.acquire /.clean-up-error] + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.acquire /.clean_up_error] (thread.run (do {! thread.monad} - [clean-up-counter (thread.box 0) + [clean_up_counter (thread.box 0) #let [//@ ! - count-clean-up (function (_ value) + count_clean_up (function (_ value) (do ! - [_ (thread.update inc clean-up-counter)] + [_ (thread.update inc clean_up_counter)] (wrap (: (Try Any) (exception.throw ..oops [])))))] outcome (/.run ! (do {! (/.monad !)} - [_ (monad.map ! (/.acquire //@ count-clean-up) - (enum.range n.enum 1 expected-clean-ups))] + [_ (monad.map ! (/.acquire //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups))] (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (or (n.= 0 expected-clean-ups) - (..throws? /.clean-up-error outcome)) - (n.= expected-clean-ups - actual-clean-ups)))))) + actual_clean_ups (thread.read clean_up_counter)] + (wrap (and (or (n.= 0 expected_clean_ups) + (..throws? /.clean_up_error outcome)) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.lift] (thread.run (do {! thread.monad} - [clean-up-counter (thread.box 0) + [clean_up_counter (thread.box 0) #let [//@ !] outcome (/.run ! (do (/.monad !) - [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))] + [_ (/.lift //@ (thread.write expected_clean_ups clean_up_counter))] (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] + actual_clean_ups (thread.read clean_up_counter)] (wrap (and (..success? outcome) - (n.= expected-clean-ups - actual-clean-ups)))))) + (n.= expected_clean_ups + actual_clean_ups)))))) )))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 5de61eed9..19c8f44f9 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -28,9 +28,9 @@ (def: deadline (Random Date) random.date) (def: message (Random Text) (random\map %.nat random.nat)) -(def: focus (Random Code) (random\map code.text (random.ascii/upper-alpha 10))) +(def: focus (Random Code) (random\map code.text (random.ascii/upper_alpha 10))) -(def: (to-remember macro deadline message focus) +(def: (to_remember macro deadline message focus) (-> Name Date Text (Maybe Code) Code) (` ((~ (code.identifier macro)) (~ (code.text (%.date deadline))) @@ -49,7 +49,7 @@ (#try.Failure error) (#try.Success [compiler (#try.Failure error)])))) -(def: (test-failure deadline message focus failure) +(def: (test_failure deadline message focus failure) (-> Date Text (Maybe Code) Text Bit) (and (text.contains? (%.date deadline) failure) (text.contains? message failure) @@ -60,40 +60,40 @@ (#.Some focus) (text.contains? (%.code focus) failure)))) -(syntax: (test-macro {macro <c>.identifier} {extra <c>.text}) +(syntax: (test_macro {macro <c>.identifier} {extra <c>.text}) (let [now (io.run instant.now) today (instant.date now) yesterday (instant.date (instant.shift (duration.inverse duration.week) now)) tomorrow (instant.date (instant.shift duration.week now)) - prng (random.pcg-32 [123 (instant.to-millis now)]) + prng (random.pcg_32 [123 (instant.to_millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] (do meta.monad - [should-fail0 (..try (meta.expand (to-remember macro yesterday message #.None))) - should-fail1 (..try (meta.expand (to-remember macro yesterday message (#.Some expected)))) - should-succeed0 (..try (meta.expand (to-remember macro tomorrow message #.None))) - should-succeed1 (..try (meta.expand (to-remember macro tomorrow message (#.Some expected))))] - (wrap (list (code.bit (and (case should-fail0 + [should_fail0 (..try (meta.expand (to_remember macro yesterday message #.None))) + should_fail1 (..try (meta.expand (to_remember macro yesterday message (#.Some expected)))) + should_succeed0 (..try (meta.expand (to_remember macro tomorrow message #.None))) + should_succeed1 (..try (meta.expand (to_remember macro tomorrow message (#.Some expected))))] + (wrap (list (code.bit (and (case should_fail0 (#try.Failure error) - (and (test-failure yesterday message #.None error) + (and (test_failure yesterday message #.None error) (text.contains? extra error)) _ false) - (case should-fail1 + (case should_fail1 (#try.Failure error) - (and (test-failure yesterday message (#.Some expected) error) + (and (test_failure yesterday message (#.Some expected) error) (text.contains? extra error)) _ false) - (case should-succeed0 + (case should_succeed0 (^ (#try.Success (list))) true _ false) - (case should-succeed1 + (case should_succeed1 (^ (#try.Success (list actual))) (is? expected actual) @@ -109,15 +109,15 @@ message ..message focus ..focus] ($_ _.and - (_.cover [/.must-remember] - (and (test-failure deadline message #.None - (exception.construct /.must-remember [deadline deadline message #.None])) - (test-failure deadline message (#.Some focus) - (exception.construct /.must-remember [deadline deadline message (#.Some focus)])))) + (_.cover [/.must_remember] + (and (test_failure deadline message #.None + (exception.construct /.must_remember [deadline deadline message #.None])) + (test_failure deadline message (#.Some focus) + (exception.construct /.must_remember [deadline deadline message (#.Some focus)])))) (_.cover [/.remember] - (..test-macro /.remember "")) - (_.cover [/.to-do] - (..test-macro /.to-do "TODO")) - (_.cover [/.fix-me] - (..test-macro /.fix-me "FIXME")) + (..test_macro /.remember "")) + (_.cover [/.to_do] + (..test_macro /.to_do "TODO")) + (_.cover [/.fix_me] + (..test_macro /.fix_me "FIXME")) )))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index b907e8e54..55e928d52 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -19,19 +19,19 @@ [math ["." random]]] {1 - ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private)]}) + ["." / (#+ Context Privacy Can_Conceal Can_Reveal Privilege Private)]}) -(def: (injection can-conceal) +(def: (injection can_conceal) (All [label] - (-> (Can-Conceal label) (Injection (All [value] (Private value label))))) - (!.use can-conceal)) + (-> (Can_Conceal label) (Injection (All [value] (Private value label))))) + (!.use can_conceal)) -(def: (comparison can-reveal) +(def: (comparison can_reveal) (All [label] - (-> (Can-Reveal label) (Comparison (All [value] (Private value label))))) + (-> (Can_Reveal label) (Comparison (All [value] (Private value label))))) (function (_ == left right) - (== (!.use can-reveal left) - (!.use can-reveal right)))) + (== (!.use can_reveal left) + (!.use can_reveal right)))) (type: Password (Private Text)) @@ -47,7 +47,7 @@ (def: (policy _) (Ex [%] (-> Any (Policy %))) - (/.with-policy + (/.with_policy (: (Context Privacy Policy) (function (_ (^@ privilege (^open "%\."))) (structure @@ -55,14 +55,14 @@ (structure (def: &equivalence (structure (def: (= reference sample) - (text\= (!.use %\can-downgrade reference) - (!.use %\can-downgrade sample))))) + (text\= (!.use %\can_downgrade reference) + (!.use %\can_downgrade sample))))) (def: hash - (|>> (!.use %\can-downgrade) + (|>> (!.use %\can_downgrade) (\ text.hash hash))))) (def: password - (!.use %\can-upgrade)) + (!.use %\can_upgrade)) (def: privilege privilege)))))) @@ -71,28 +71,28 @@ Test (<| (_.covering /._) (_.for [/.Policy - /.Can-Upgrade /.Can-Downgrade]) + /.Can_Upgrade /.Can_Downgrade]) (do random.monad - [#let [policy-0 (policy [])] - raw-password (random.ascii 10) - #let [password (\ policy-0 password raw-password)]] + [#let [policy_0 (policy [])] + raw_password (random.ascii 10) + #let [password (\ policy_0 password raw_password)]] ($_ _.and - (_.for [/.Privacy /.Private /.Can-Conceal /.Can-Reveal - /.Safety /.Safe /.Can-Trust /.Can-Distrust] + (_.for [/.Privacy /.Private /.Can_Conceal /.Can_Reveal + /.Safety /.Safe /.Can_Trust /.Can_Distrust] ($_ _.and (_.for [/.functor] - ($functor.spec (..injection (\ policy-0 can-upgrade)) (..comparison (\ policy-0 can-downgrade)) /.functor)) + ($functor.spec (..injection (\ policy_0 can_upgrade)) (..comparison (\ policy_0 can_downgrade)) /.functor)) (_.for [/.apply] - ($apply.spec (..injection (\ policy-0 can-upgrade)) (..comparison (\ policy-0 can-downgrade)) /.apply)) + ($apply.spec (..injection (\ policy_0 can_upgrade)) (..comparison (\ policy_0 can_downgrade)) /.apply)) (_.for [/.monad] - ($monad.spec (..injection (\ policy-0 can-upgrade)) (..comparison (\ policy-0 can-downgrade)) /.monad)))) + ($monad.spec (..injection (\ policy_0 can_upgrade)) (..comparison (\ policy_0 can_downgrade)) /.monad)))) - (_.cover [/.Privilege /.Context /.with-policy] - (and (\ policy-0 = password password) - (n.= (\ text.hash hash raw-password) - (\ policy-0 hash password)))) - (let [policy-1 (policy []) - delegate (/.delegation (\ policy-0 can-downgrade) (\ policy-1 can-upgrade))] + (_.cover [/.Privilege /.Context /.with_policy] + (and (\ policy_0 = password password) + (n.= (\ text.hash hash raw_password) + (\ policy_0 hash password)))) + (let [policy_1 (policy []) + delegate (/.delegation (\ policy_0 can_downgrade) (\ policy_1 can_upgrade))] (_.cover [/.Delegation /.delegation] - (\ policy-1 = (delegate password) (delegate password)))) + (\ policy_1 = (delegate password) (delegate password)))) )))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 4238980d9..9993a3f70 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -72,17 +72,17 @@ (_.cover [/.assume] (n.= expected (/.assume (/.succeed expected)))) - (_.cover [/.from-maybe] - (case [(/.from-maybe (#.Some expected)) - (/.from-maybe #.None)] + (_.cover [/.from_maybe] + (case [(/.from_maybe (#.Some expected)) + (/.from_maybe #.None)] [(#/.Success actual) (#/.Failure _)] (n.= expected actual) _ false)) - (_.cover [/.to-maybe] - (case [(/.to-maybe (/.succeed expected)) - (/.to-maybe (/.fail error))] + (_.cover [/.to_maybe] + (case [(/.to_maybe (/.succeed expected)) + (/.to_maybe (/.fail error))] [(#.Some actual) #.None] (n.= expected actual) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index ce286a113..3d828dbb2 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -51,24 +51,24 @@ (#try.Success _) false)) -(def: (binary-io bytes read write value) +(def: (binary_io bytes read write value) (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) (let [binary (/.create bytes) cap (case bytes 8 (dec 0) - _ (|> 1 (i64.left-shift (n.* 8 bytes)) dec)) - capped-value (i64.and cap value)] + _ (|> 1 (i64.left_shift (n.* 8 bytes)) dec)) + capped_value (i64.and cap value)] (and (succeed (do try.monad [pre (read 0 binary) _ (write 0 value binary) post (read 0 binary)] (wrap (and (n.= 0 pre) - (n.= capped-value post))))) - (throws? /.index-out-of-bounds (read 1 binary)) - (throws? /.index-out-of-bounds (write 1 value binary))))) + (n.= capped_value post))))) + (throws? /.index_out_of_bounds (read 1 binary)) + (throws? /.index_out_of_bounds (write 1 value binary))))) -(def: as-list +(def: as_list (-> /.Binary (List Nat)) (/.fold (function (_ head tail) (#.Cons head tail)) @@ -78,12 +78,12 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [gen-size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 8))))] - size gen-size + [#let [gen_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 8))))] + size gen_size sample (..random size) value random.nat - #let [gen-idx (|> random.nat (\ ! map (n.% size)))] - [from to] (random.and gen-idx gen-idx) + #let [gen_idx (|> random.nat (\ ! map (n.% size)))] + [from to] (random.and gen_idx gen_idx) #let [[from to] [(n.min from to) (n.max from to)]]] (_.for [/.Binary] ($_ _.and @@ -92,7 +92,7 @@ (_.for [/.monoid] ($monoid.spec /.equivalence /.monoid (..random size))) (_.cover [/.fold] - (n.= (\ list.fold fold n.+ 0 (..as-list sample)) + (n.= (\ list.fold fold n.+ 0 (..as_list sample)) (/.fold n.+ 0 sample))) (_.cover [/.create] @@ -101,39 +101,39 @@ (/.create size))) (_.cover [/.size] (|> (/.create size) /.size (n.= size))) - (_.for [/.index-out-of-bounds] + (_.for [/.index_out_of_bounds] ($_ _.and (_.cover [/.read/8 /.write/8] - (..binary-io 1 /.read/8 /.write/8 value)) + (..binary_io 1 /.read/8 /.write/8 value)) (_.cover [/.read/16 /.write/16] - (..binary-io 2 /.read/16 /.write/16 value)) + (..binary_io 2 /.read/16 /.write/16 value)) (_.cover [/.read/32 /.write/32] - (..binary-io 4 /.read/32 /.write/32 value)) + (..binary_io 4 /.read/32 /.write/32 value)) (_.cover [/.read/64 /.write/64] - (..binary-io 8 /.read/64 /.write/64 value)))) + (..binary_io 8 /.read/64 /.write/64 value)))) (_.cover [/.slice] - (let [slice-size (|> to (n.- from) inc) - random-slice (try.assume (/.slice from to sample)) - idxs (enum.range n.enum 0 (dec slice-size)) + (let [slice_size (|> to (n.- from) inc) + random_slice (try.assume (/.slice from to sample)) + idxs (enum.range n.enum 0 (dec slice_size)) reader (function (_ binary idx) (/.read/8 idx binary))] - (and (n.= slice-size (/.size random-slice)) - (case [(monad.map try.monad (reader random-slice) idxs) + (and (n.= slice_size (/.size random_slice)) + (case [(monad.map try.monad (reader random_slice) idxs) (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)] - [(#try.Success slice-vals) (#try.Success binary-vals)] - (\ (list.equivalence n.equivalence) = slice-vals binary-vals) + [(#try.Success slice_vals) (#try.Success binary_vals)] + (\ (list.equivalence n.equivalence) = slice_vals binary_vals) _ #0)))) - (_.cover [/.slice-out-of-bounds] - (and (throws? /.slice-out-of-bounds (/.slice size size sample)) - (throws? /.slice-out-of-bounds (/.slice from size sample)))) - (_.cover [/.inverted-slice] - (or (throws? /.inverted-slice (/.slice to from sample)) + (_.cover [/.slice_out_of_bounds] + (and (throws? /.slice_out_of_bounds (/.slice size size sample)) + (throws? /.slice_out_of_bounds (/.slice from size sample)))) + (_.cover [/.inverted_slice] + (or (throws? /.inverted_slice (/.slice to from sample)) (n.= to from))) (_.cover [/.drop] (and (\ /.equivalence = sample (/.drop 0 sample)) (\ /.equivalence = (/.create 0) (/.drop size sample)) - (case (list.reverse (..as-list sample)) + (case (list.reverse (..as_list sample)) #.Nil false diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index d47defeaf..ab1b1f04c 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -26,9 +26,9 @@ (def: injection (Injection Array) - (|>> list /.from-list)) + (|>> list /.from_list)) -(def: bounded-size +(def: bounded_size (Random Nat) (\ random.monad map (|>> (n.% 100) (n.+ 1)) random.nat)) @@ -36,7 +36,7 @@ (def: structures Test (do {! random.monad} - [size ..bounded-size] + [size ..bounded_size] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) @@ -51,23 +51,23 @@ (def: search Test (do {! random.monad} - [size ..bounded-size + [size ..bounded_size base random.nat shift random.nat #let [expected (n.+ base shift)] - the-array (random.array size random.nat)] + the_array (random.array size random.nat)] ($_ _.and (_.cover [/.find] (\ (maybe.equivalence n.equivalence) = - (/.find n.even? the-array) - (list.find n.even? (/.to-list the-array)))) + (/.find n.even? the_array) + (list.find n.even? (/.to_list the_array)))) (_.cover [/.find+] - (case [(/.find n.even? the-array) + (case [(/.find n.even? the_array) (/.find+ (function (_ idx member) (n.even? member)) - the-array)] + the_array)] [(#.Some expected) (#.Some [idx actual])] - (case (/.read idx the-array) + (case (/.read idx the_array) (#.Some again) (and (n.= expected actual) (n.= actual again)) @@ -79,12 +79,12 @@ true)) (_.cover [/.every?] (\ bit.equivalence = - (list.every? n.even? (/.to-list the-array)) - (/.every? n.even? the-array))) + (list.every? n.even? (/.to_list the_array)) + (/.every? n.even? the_array))) (_.cover [/.any?] (\ bit.equivalence = - (list.any? n.even? (/.to-list the-array)) - (/.any? n.even? the-array))) + (list.any? n.even? (/.to_list the_array)) + (/.any? n.even? the_array))) ))) (def: #export test @@ -92,12 +92,12 @@ (<| (_.covering /._) (_.for [/.Array]) (do {! random.monad} - [size ..bounded-size + [size ..bounded_size base random.nat shift random.nat dummy (random.filter (|>> (n.= base) not) random.nat) #let [expected (n.+ base shift)] - the-array (random.array size random.nat)] + the_array (random.array size random.nat)] ($_ _.and ..structures ..search @@ -105,61 +105,61 @@ (_.cover [/.new /.size] (n.= size (/.size (: (Array Nat) (/.new size))))) - (_.cover [/.type-name] + (_.cover [/.type_name] (case (:of (/.new size)) - (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal-type (list (#.Parameter 1)))))))) - (text\= /.type-name nominal-type) + (^ (#.UnivQ _ (#.Apply _ (#.Named _ (#.UnivQ _ (#.Primitive nominal_type (list (#.Parameter 1)))))))) + (text\= /.type_name nominal_type) _ false)) (_.cover [/.read /.write!] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 expected))] - (case [(/.read 0 the-array) - (/.read 1 the-array)] + (case [(/.read 0 the_array) + (/.read 1 the_array)] [(#.Some actual) #.None] (n.= expected actual) _ false))) (_.cover [/.delete!] - (let [the-array (|> (/.new 1) + (let [the_array (|> (/.new 1) (: (Array Nat)) (/.write! 0 expected))] - (case [(/.read 0 the-array) - (/.read 0 (/.delete! 0 the-array))] + (case [(/.read 0 the_array) + (/.read 0 (/.delete! 0 the_array))] [(#.Some actual) #.None] (n.= expected actual) _ false))) (_.cover [/.contains?] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 expected))] - (and (/.contains? 0 the-array) - (not (/.contains? 1 the-array))))) + (and (/.contains? 0 the_array) + (not (/.contains? 1 the_array))))) (_.cover [/.update!] - (let [the-array (|> (/.new 1) + (let [the_array (|> (/.new 1) (: (Array Nat)) (/.write! 0 base) (/.update! 0 (n.+ shift)))] - (case (/.read 0 the-array) + (case (/.read 0 the_array) (#.Some actual) (n.= expected actual) _ false))) (_.cover [/.upsert!] - (let [the-array (|> (/.new 2) + (let [the_array (|> (/.new 2) (: (Array Nat)) (/.write! 0 base) (/.upsert! 0 dummy (n.+ shift)) (/.upsert! 1 base (n.+ shift)))] - (case [(/.read 0 the-array) - (/.read 1 the-array)] + (case [(/.read 0 the_array) + (/.read 1 the_array)] [(#.Some actual/0) (#.Some actual/1)] (and (n.= expected actual/0) (n.= expected actual/1)) @@ -169,55 +169,55 @@ (do ! [occupancy (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.occupancy /.vacancy] - (let [the-array (loop [output (: (Array Nat) + (let [the_array (loop [output (: (Array Nat) (/.new size)) idx 0] (if (n.< occupancy idx) (recur (/.write! idx expected output) (inc idx)) output))] - (and (n.= occupancy (/.occupancy the-array)) - (n.= size (n.+ (/.occupancy the-array) - (/.vacancy the-array))))))) + (and (n.= occupancy (/.occupancy the_array)) + (n.= size (n.+ (/.occupancy the_array) + (/.vacancy the_array))))))) (do ! - [the-list (random.list size random.nat)] - (_.cover [/.from-list /.to-list] - (and (|> the-list /.from-list /.to-list - (\ (list.equivalence n.equivalence) = the-list)) - (|> the-array /.to-list /.from-list - (\ (/.equivalence n.equivalence) = the-array))))) + [the_list (random.list size random.nat)] + (_.cover [/.from_list /.to_list] + (and (|> the_list /.from_list /.to_list + (\ (list.equivalence n.equivalence) = the_list)) + (|> the_array /.to_list /.from_list + (\ (/.equivalence n.equivalence) = the_array))))) (do ! [amount (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.new size))] - (exec (/.copy! amount 0 the-array 0 copy) + (exec (/.copy! amount 0 the_array 0 copy) (\ (list.equivalence n.equivalence) = - (list.take amount (/.to-list the-array)) - (/.to-list copy)))))) + (list.take amount (/.to_list the_array)) + (/.to_list copy)))))) (_.cover [/.clone] - (let [clone (/.clone the-array)] - (and (not (is? the-array clone)) - (\ (/.equivalence n.equivalence) = the-array clone)))) - (let [the-array (/.clone the-array) - evens (|> the-array /.to-list (list.filter n.even?)) - odds (|> the-array /.to-list (list.filter n.odd?))] + (let [clone (/.clone the_array)] + (and (not (is? the_array clone)) + (\ (/.equivalence n.equivalence) = the_array clone)))) + (let [the_array (/.clone the_array) + evens (|> the_array /.to_list (list.filter n.even?)) + odds (|> the_array /.to_list (list.filter n.odd?))] (_.cover [/.filter!] - (exec (/.filter! n.even? the-array) - (and (n.= (list.size evens) (/.occupancy the-array)) - (n.= (list.size odds) (/.vacancy the-array)) - (|> the-array /.to-list (\ (list.equivalence n.equivalence) = evens)))))) + (exec (/.filter! n.even? the_array) + (and (n.= (list.size evens) (/.occupancy the_array)) + (n.= (list.size odds) (/.vacancy the_array)) + (|> the_array /.to_list (\ (list.equivalence n.equivalence) = evens)))))) (do ! - [#let [the-array (/.clone the-array) - members (|> the-array /.to-list (set.from-list n.hash))] + [#let [the_array (/.clone the_array) + members (|> the_array /.to_list (set.from_list n.hash))] default (random.filter (function (_ value) (not (or (n.even? value) (set.member? members value)))) random.nat)] - (_.cover [/.to-list'] - (exec (/.filter! n.even? the-array) + (_.cover [/.to_list'] + (exec (/.filter! n.even? the_array) (list.every? (function (_ value) (or (n.even? value) (is? default value))) - (/.to-list' default the-array))))) + (/.to_list' default the_array))))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 2080e387a..0de661e64 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -25,17 +25,17 @@ (def: injection (Injection (/.Dictionary Nat)) - (|>> [0] list (/.from-list n.hash))) + (|>> [0] list (/.from_list n.hash))) -(def: for-dictionaries +(def: for_dictionaries Test (do {! random.monad} - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.cover [/.size] @@ -58,8 +58,8 @@ (def: &equivalence n.equivalence) (def: (hash _) constant)))]] - (_.cover [/.key-hash] - (is? hash (/.key-hash (/.new hash))))) + (_.cover [/.key_hash] + (is? hash (/.key_hash (/.new hash))))) (_.cover [/.entries /.keys /.values] (\ (list.equivalence (product.equivalence n.equivalence n.equivalence)) = @@ -68,36 +68,36 @@ (/.values dict)))) (_.cover [/.merge] - (let [merging-with-oneself (let [(^open ".") (/.equivalence n.equivalence)] + (let [merging_with_oneself (let [(^open ".") (/.equivalence n.equivalence)] (= dict (/.merge dict dict))) - overwritting-keys (let [dict' (|> dict /.entries + overwritting_keys (let [dict' (|> dict /.entries (list\map (function (_ [k v]) [k (inc v)])) - (/.from-list n.hash)) + (/.from_list n.hash)) (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merge dict' dict)))] - (and merging-with-oneself - overwritting-keys))) + (and merging_with_oneself + overwritting_keys))) - (_.cover [/.merge-with] + (_.cover [/.merge_with] (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) (list.zip/2 (/.values dict) - (/.values (/.merge-with n.+ dict dict))))) + (/.values (/.merge_with n.+ dict dict))))) - (_.cover [/.from-list] + (_.cover [/.from_list] (let [(^open ".") (/.equivalence n.equivalence)] (and (= dict dict) - (|> dict /.entries (/.from-list n.hash) (= dict))))) + (|> dict /.entries (/.from_list n.hash) (= dict))))) ))) -(def: for-entries +(def: for_entries Test (do random.monad - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.cover [/.key?] @@ -109,56 +109,56 @@ (#.Some _) true _ false)) (/.keys dict)) - (case (/.get non-key dict) + (case (/.get non_key dict) (#.Some _) false _ true))) (_.cover [/.put] (and (n.= (inc (/.size dict)) - (/.size (/.put non-key test-val dict))) - (case (/.get non-key (/.put non-key test-val dict)) - (#.Some v) (n.= test-val v) + (/.size (/.put non_key test_val dict))) + (case (/.get non_key (/.put non_key test_val dict)) + (#.Some v) (n.= test_val v) _ true))) - (_.cover [/.try-put /.key-already-exists] - (let [can-put-new-keys! - (case (/.try-put non-key test-val dict) + (_.cover [/.try_put /.key_already_exists] + (let [can_put_new_keys! + (case (/.try_put non_key test_val dict) (#try.Success dict) - (case (/.get non-key dict) - (#.Some v) (n.= test-val v) + (case (/.get non_key dict) + (#.Some v) (n.= test_val v) _ true) (#try.Failure _) false) - cannot-put-old-keys! + cannot_put_old_keys! (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume)] - (case (/.try-put first-key test-val dict) + (let [first_key (|> dict /.keys list.head maybe.assume)] + (case (/.try_put first_key test_val dict) (#try.Success _) false (#try.Failure error) - (exception.match? /.key-already-exists error))))] - (and can-put-new-keys! - cannot-put-old-keys!))) + (exception.match? /.key_already_exists error))))] + (and can_put_new_keys! + cannot_put_old_keys!))) (_.cover [/.remove] - (and (let [base (/.put non-key test-val dict)] - (and (/.key? base non-key) - (not (/.key? (/.remove non-key base) non-key)))) + (and (let [base (/.put non_key test_val dict)] + (and (/.key? base non_key) + (not (/.key? (/.remove non_key base) non_key)))) (case (list.head (/.keys dict)) #.None true - (#.Some known-key) + (#.Some known_key) (n.= (dec (/.size dict)) - (/.size (/.remove known-key dict)))))) + (/.size (/.remove known_key dict)))))) (_.cover [/.update] - (let [base (/.put non-key test-val dict) - updt (/.update non-key inc base)] - (case [(/.get non-key base) (/.get non-key updt)] + (let [base (/.put non_key test_val dict) + updt (/.update non_key inc base)] + (case [(/.get non_key base) (/.get non_key updt)] [(#.Some x) (#.Some y)] (n.= (inc x) y) @@ -166,45 +166,45 @@ false))) (_.cover [/.upsert] - (let [can-upsert-new-key! - (case (/.get non-key (/.upsert non-key test-val inc dict)) + (let [can_upsert_new_key! + (case (/.get non_key (/.upsert non_key test_val inc dict)) (#.Some inserted) - (n.= (inc test-val) inserted) + (n.= (inc test_val) inserted) #.None false) - can-upsert-old-key! + can_upsert_old_key! (case (list.head (/.entries dict)) #.None true - (#.Some [known-key known-value]) - (case (/.get known-key (/.upsert known-key test-val inc dict)) + (#.Some [known_key known_value]) + (case (/.get known_key (/.upsert known_key test_val inc dict)) (#.Some updated) - (n.= (inc known-value) updated) + (n.= (inc known_value) updated) #.None false))] - (and can-upsert-new-key! - can-upsert-old-key!))) + (and can_upsert_new_key! + can_upsert_old_key!))) (_.cover [/.select] (|> dict - (/.put non-key test-val) - (/.select (list non-key)) + (/.put non_key test_val) + (/.select (list non_key)) /.size (n.= 1))) - (_.cover [/.re-bind] + (_.cover [/.re_bind] (or (n.= 0 size) - (let [first-key (|> dict /.keys list.head maybe.assume) - rebound (/.re-bind first-key non-key dict)] + (let [first_key (|> dict /.keys list.head maybe.assume) + rebound (/.re_bind first_key non_key dict)] (and (n.= (/.size dict) (/.size rebound)) - (/.key? rebound non-key) - (not (/.key? rebound first-key)) - (n.= (maybe.assume (/.get first-key dict)) - (maybe.assume (/.get non-key rebound))))))) + (/.key? rebound non_key) + (not (/.key? rebound first_key)) + (n.= (maybe.assume (/.get first_key dict)) + (maybe.assume (/.get non_key rebound))))))) ))) (def: #export test @@ -212,12 +212,12 @@ (<| (_.covering /._) (_.for [/.Dictionary]) (do random.monad - [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] - size capped-nat - dict (random.dictionary n.hash size random.nat capped-nat) - non-key (random.filter (|>> (/.key? dict) not) + [#let [capped_nat (\ random.monad map (n.% 100) random.nat)] + size capped_nat + dict (random.dictionary n.hash size random.nat capped_nat) + non_key (random.filter (|>> (/.key? dict) not) random.nat) - test-val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) + test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] ($_ _.and (_.for [/.equivalence] @@ -227,6 +227,6 @@ (_.for [/.functor] ($functor.spec ..injection /.equivalence /.functor)) - ..for-dictionaries - ..for-entries + ..for_dictionaries + ..for_entries )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 1553f2266..a44b5c295 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -22,7 +22,7 @@ {1 ["." /]}) -(def: #export (dictionary order gen-key gen-value size) +(def: #export (dictionary order gen_key gen_value size) (All [k v] (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size @@ -31,10 +31,10 @@ _ (do random.monad - [partial (dictionary order gen-key gen-value (dec size)) + [partial (dictionary order gen_key gen_value (dec size)) key (random.filter (|>> (/.key? partial) not) - gen-key) - value gen-value] + gen_key) + value gen_value] (wrap (/.put key value partial))))) (def: #export test @@ -45,17 +45,17 @@ [size (\ ! map (n.% 100) random.nat) keys (random.set n.hash size random.nat) values (random.set n.hash size random.nat) - extra-key (random.filter (|>> (set.member? keys) not) + extra_key (random.filter (|>> (set.member? keys) not) random.nat) - extra-value random.nat + extra_value random.nat shift random.nat - #let [pairs (list.zip/2 (set.to-list keys) - (set.to-list values)) - sample (/.from-list n.order pairs) - sorted-pairs (list.sort (function (_ [left _] [right _]) + #let [pairs (list.zip/2 (set.to_list keys) + (set.to_list values)) + sample (/.from_list n.order pairs) + sorted_pairs (list.sort (function (_ [left _] [right _]) (n.< left right)) pairs) - sorted-values (list\map product.right sorted-pairs) + sorted_values (list\map product.right sorted_pairs) (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) (and (n.= kr ks) @@ -73,7 +73,7 @@ (_.cover [/.new] (/.empty? (/.new n.order))) (_.cover [/.min] - (case [(/.min sample) (list.head sorted-values)] + (case [(/.min sample) (list.head sorted_values)] [#.None #.None] #1 @@ -83,7 +83,7 @@ _ #0)) (_.cover [/.max] - (case [(/.max sample) (list.last sorted-values)] + (case [(/.max sample) (list.last sorted_values)] [#.None #.None] #1 @@ -94,43 +94,43 @@ #0)) (_.cover [/.entries] (list\= (/.entries sample) - sorted-pairs)) + sorted_pairs)) (_.cover [/.keys /.values] (list\= (/.entries sample) (list.zip/2 (/.keys sample) (/.values sample)))) - (_.cover [/.from-list] + (_.cover [/.from_list] (|> sample - /.entries (/.from-list n.order) + /.entries (/.from_list n.order) (/\= sample))) (_.cover [/.key?] (and (list.every? (/.key? sample) (/.keys sample)) - (not (/.key? sample extra-key)))) + (not (/.key? sample extra_key)))) (_.cover [/.put] - (and (not (/.key? sample extra-key)) - (let [sample+ (/.put extra-key extra-value sample)] - (and (/.key? sample+ extra-key) + (and (not (/.key? sample extra_key)) + (let [sample+ (/.put extra_key extra_value sample)] + (and (/.key? sample+ extra_key) (n.= (inc (/.size sample)) (/.size sample+)))))) (_.cover [/.get] - (let [sample+ (/.put extra-key extra-value sample)] - (case [(/.get extra-key sample) - (/.get extra-key sample+)] + (let [sample+ (/.put extra_key extra_value sample)] + (case [(/.get extra_key sample) + (/.get extra_key sample+)] [#.None (#.Some actual)] - (n.= extra-value actual) + (n.= extra_value actual) _ false))) (_.cover [/.remove] (|> sample - (/.put extra-key extra-value) - (/.remove extra-key) + (/.put extra_key extra_value) + (/.remove extra_key) (/\= sample))) (_.cover [/.update] (|> sample - (/.put extra-key extra-value) - (/.update extra-key (n.+ shift)) - (/.get extra-key) - (maybe\map (n.= (n.+ shift extra-value))) + (/.put extra_key extra_value) + (/.update extra_key (n.+ shift)) + (/.get extra_key) + (maybe\map (n.= (n.+ shift extra_value))) (maybe.default false))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 2a92e28db..753b8db8a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -20,32 +20,32 @@ {1 ["." /]}) -(def: #export (random size gen-key gen-value) +(def: #export (random size gen_key gen_value) (All [v] (-> Nat (Random Text) (Random v) (Random (/.PList v)))) (do random.monad - [keys (random.set text.hash size gen-key) - values (random.list size gen-value)] - (wrap (list.zip/2 (set.to-list keys) values)))) + [keys (random.set text.hash size gen_key) + values (random.list size gen_value)] + (wrap (list.zip/2 (set.to_list keys) values)))) (def: #export test Test (<| (_.covering /._) (_.for [/.PList]) (do {! random.monad} - [#let [gen-key (random.ascii/alpha 10)] + [#let [gen_key (random.ascii/alpha 10)] size (\ ! map (n.% 100) random.nat) - sample (..random size gen-key random.nat) + sample (..random size gen_key random.nat) - #let [keys (|> sample /.keys (set.from-list text.hash))] - extra-key (random.filter (|>> (set.member? keys) not) - gen-key) - extra-value random.nat + #let [keys (|> sample /.keys (set.from_list text.hash))] + extra_key (random.filter (|>> (set.member? keys) not) + gen_key) + extra_value random.nat shift random.nat] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) - (..random size gen-key random.nat))) + (..random size gen_key random.nat))) (_.cover [/.size] (n.= size (/.size sample))) @@ -63,29 +63,29 @@ (and (list.every? (function (_ key) (/.contains? key sample)) (/.keys sample)) - (not (/.contains? extra-key sample)))) + (not (/.contains? extra_key sample)))) (_.cover [/.put] - (let [sample+ (/.put extra-key extra-value sample)] - (and (not (/.contains? extra-key sample)) - (/.contains? extra-key sample+) + (let [sample+ (/.put extra_key extra_value sample)] + (and (not (/.contains? extra_key sample)) + (/.contains? extra_key sample+) (n.= (inc (/.size sample)) (/.size sample+))))) (_.cover [/.get] (|> sample - (/.put extra-key extra-value) - (/.get extra-key) - (maybe\map (n.= extra-value)) + (/.put extra_key extra_value) + (/.get extra_key) + (maybe\map (n.= extra_value)) (maybe.default false))) (_.cover [/.update] (|> sample - (/.put extra-key extra-value) - (/.update extra-key (n.+ shift)) - (/.get extra-key) - (maybe\map (n.= (n.+ shift extra-value))) + (/.put extra_key extra_value) + (/.update extra_key (n.+ shift)) + (/.get extra_key) + (maybe\map (n.= (n.+ shift extra_value))) (maybe.default false))) (_.cover [/.remove] (|> sample - (/.put extra-key extra-value) - (/.remove extra-key) + (/.put extra_key extra_value) + (/.remove extra_key) (\ (/.equivalence n.equivalence) = sample))) )))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index ffde9bcf4..b2d35b1f4 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -31,7 +31,7 @@ {1 ["." / ("#\." monad)]}) -(def: bounded-size +(def: bounded_size (Random Nat) (\ random.monad map (n.% 100) random.nat)) @@ -39,10 +39,10 @@ (def: random (Random (List Nat)) (do {! random.monad} - [size ..bounded-size] + [size ..bounded_size] (|> random.nat (random.set n.hash size) - (\ ! map set.to-list)))) + (\ ! map set.to_list)))) (def: signatures Test @@ -81,9 +81,9 @@ (def: whole Test (do {! random.monad} - [size ..bounded-size + [size ..bounded_size #let [(^open "/\.") (/.equivalence n.equivalence)] - sample (\ ! map set.to-list (random.set n.hash size random.nat))] + sample (\ ! map set.to_list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -95,15 +95,15 @@ (n.= size (/.size (/.repeat size [])))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) - (let [not-same! + (let [not_same! (not (/\= sample (/.reverse sample))) - self-symmetry! + self_symmetry! (/\= sample (/.reverse (/.reverse sample)))] - (and not-same! - self-symmetry!)))) + (and not_same! + self_symmetry!)))) (_.cover [/.every? /.any?] (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) @@ -111,14 +111,14 @@ (_.cover [/.sort] (let [<<< n.< - size-preservation! + size_preservation! (n.= (/.size sample) (/.size (/.sort <<< sample))) symmetry! (/\= (/.sort <<< sample) (/.reverse (/.sort (function.flip <<<) sample)))] - (and size-preservation! + (and size_preservation! symmetry!))) ))) @@ -133,33 +133,33 @@ (_.cover [/.indices] (let [indices (/.indices size) - expected-amount! + expected_amount! (n.= size (/.size indices)) - already-sorted! + already_sorted! (/\= indices (/.sort n.< indices)) - expected-numbers! + expected_numbers! (/.every? (n.= (dec size)) - (/.zip-with/2 n.+ + (/.zip_with/2 n.+ indices (/.sort n.> indices)))] - (and expected-amount! - already-sorted! - expected-numbers!))) + (and expected_amount! + already_sorted! + expected_numbers!))) (_.cover [/.enumeration] (let [enumeration (/.enumeration sample) - has-correct-indices! + has_correct_indices! (/\= (/.indices (/.size enumeration)) (/\map product.left enumeration)) - has-correct-values! + has_correct_values! (/\= sample (/\map product.right enumeration))] - (and has-correct-indices! - has-correct-values!))) + (and has_correct_indices! + has_correct_values!))) (_.cover [/.nth] (/.every? (function (_ [index expected]) (case (/.nth index sample) @@ -180,7 +180,7 @@ ..random) #let [size (/.size sample)] idx (\ ! map (n.% size) random.nat) - chunk-size (\ ! map (|>> (n.% size) inc) random.nat)] + chunk_size (\ ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.filter] (let [positives (/.filter n.even? sample) @@ -201,21 +201,21 @@ (let [[left right] (/.split idx sample)] (/\= sample (/\compose left right)))) - (_.cover [/.split-with] - (let [[left right] (/.split-with n.even? sample)] + (_.cover [/.split_with] + (let [[left right] (/.split_with n.even? sample)] (/\= sample (/\compose left right)))) (_.cover [/.take /.drop] (/\= sample (/\compose (/.take idx sample) (/.drop idx sample)))) - (_.cover [/.take-while /.drop-while] + (_.cover [/.take_while /.drop_while] (/\= sample - (/\compose (/.take-while n.even? sample) - (/.drop-while n.even? sample)))) + (/\compose (/.take_while n.even? sample) + (/.drop_while n.even? sample)))) (_.cover [/.chunk] - (let [chunks (/.chunk chunk-size sample)] - (and (/.every? (|>> /.size (n.<= chunk-size)) chunks) + (let [chunks (/.chunk chunk_size sample)] + (and (/.every? (|>> /.size (n.<= chunk_size)) chunks) (/\= sample (/.concat chunks))))) )))) @@ -275,44 +275,44 @@ sample/1 ..random sample/2 ..random] ($_ _.and - (_.cover [/.as-pairs] + (_.cover [/.as_pairs] (n.= (n./ 2 (/.size sample/0)) - (/.size (/.as-pairs sample/0)))) + (/.size (/.as_pairs sample/0)))) (_.cover [/.zip/2] (let [zipped (/.zip/2 sample/0 sample/1) zipped::size (/.size zipped) - size-of-smaller-list! + size_of_smaller_list! (n.= zipped::size (n.min (/.size sample/0) (/.size sample/1))) - can-extract-values! + can_extract_values! (and (/\= (/.take zipped::size sample/0) (/\map product.left zipped)) (/\= (/.take zipped::size sample/1) (/\map product.right zipped)))] - (and size-of-smaller-list! - can-extract-values!))) + (and size_of_smaller_list! + can_extract_values!))) (_.cover [/.zip/3] (let [zipped (/.zip/3 sample/0 sample/1 sample/2) zipped::size (/.size zipped) - size-of-smaller-list! + size_of_smaller_list! (n.= zipped::size ($_ n.min (/.size sample/0) (/.size sample/1) (/.size sample/2))) - can-extract-values! + can_extract_values! (and (/\= (/.take zipped::size sample/0) (/\map product.left zipped)) (/\= (/.take zipped::size sample/1) (/\map (|>> product.right product.left) zipped)) (/\= (/.take zipped::size sample/2) (/\map (|>> product.right product.right) zipped)))] - (and size-of-smaller-list! - can-extract-values!))) + (and size_of_smaller_list! + can_extract_values!))) (_.cover [/.zip] (and (\ (/.equivalence (product.equivalence n.equivalence n.equivalence)) = (/.zip/2 sample/0 sample/1) @@ -321,21 +321,21 @@ (/.zip/3 sample/0 sample/1 sample/2) ((/.zip 3) sample/0 sample/1 sample/2)))) - (_.cover [/.zip-with/2] + (_.cover [/.zip_with/2] (/\= (/\map (function (_ [left right]) (+/2 left right)) (/.zip/2 sample/0 sample/1)) - (/.zip-with/2 +/2 sample/0 sample/1))) - (_.cover [/.zip-with/3] + (/.zip_with/2 +/2 sample/0 sample/1))) + (_.cover [/.zip_with/3] (/\= (/\map (function (_ [left mid right]) (+/3 left mid right)) (/.zip/3 sample/0 sample/1 sample/2)) - (/.zip-with/3 +/3 sample/0 sample/1 sample/2))) - (_.cover [/.zip-with] - (and (/\= (/.zip-with/2 +/2 sample/0 sample/1) - ((/.zip-with 2) +/2 sample/0 sample/1)) - (/\= (/.zip-with/3 +/3 sample/0 sample/1 sample/2) - ((/.zip-with 3) +/3 sample/0 sample/1 sample/2)))) + (/.zip_with/3 +/3 sample/0 sample/1 sample/2))) + (_.cover [/.zip_with] + (and (/\= (/.zip_with/2 +/2 sample/0 sample/1) + ((/.zip_with 2) +/2 sample/0 sample/1)) + (/\= (/.zip_with/3 +/3 sample/0 sample/1 sample/2) + ((/.zip_with 3) +/3 sample/0 sample/1 sample/2)))) (_.cover [/.concat] (and (/\= (/\compose sample/0 sample/1) (/.concat (list sample/0 sample/1))) @@ -407,7 +407,7 @@ (let [sample+ (/.interpose separator sample)] (and (n.= (|> (/.size sample) (n.* 2) dec) (/.size sample+)) - (|> sample+ /.as-pairs (/.every? (|>> product.right (n.= separator)))))))) + (|> sample+ /.as_pairs (/.every? (|>> product.right (n.= separator)))))))) (_.cover [/.iterate] (or (/.empty? sample) (let [size (/.size sample)] diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index aed90ebf9..3e532a66e 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -22,7 +22,7 @@ (def: injection (Injection /.Queue) - (|>> list /.from-list)) + (|>> list /.from_list)) (def: #export test Test @@ -31,34 +31,34 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? members) not) + non_member (random.filter (|>> (set.member? members) not) random.nat) - #let [members (set.to-list members) - sample (/.from-list members)]] + #let [members (set.to_list members) + sample (/.from_list members)]] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) (_.for [/.functor] ($functor.spec ..injection /.equivalence /.functor)) - (_.cover [/.from-list /.to-list] - (|> members /.from-list /.to-list + (_.cover [/.from_list /.to_list] + (|> members /.from_list /.to_list (\ (list.equivalence n.equivalence) = members))) (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] (bit\= (n.= 0 size) (/.empty? sample))) (_.cover [/.empty] - (let [empty-is-empty! + (let [empty_is_empty! (/.empty? /.empty) - all-empty-queues-look-the-same! + all_empty_queues_look_the_same! (bit\= (/.empty? sample) (\ (/.equivalence n.equivalence) = sample /.empty))] - (and empty-is-empty! - all-empty-queues-look-the-same!))) + (and empty_is_empty! + all_empty_queues_look_the_same!))) (_.cover [/.peek] (case [members (/.peek sample)] [(#.Cons head tail) (#.Some first)] @@ -70,49 +70,49 @@ _ false)) (_.cover [/.member?] - (let [every-member-is-identified! + (let [every_member_is_identified! (list.every? (/.member? n.equivalence sample) - (/.to-list sample)) + (/.to_list sample)) - non-member-is-not-identified! - (not (/.member? n.equivalence sample non-member))] - (and every-member-is-identified! - non-member-is-not-identified!))) + non_member_is_not_identified! + (not (/.member? n.equivalence sample non_member))] + (and every_member_is_identified! + non_member_is_not_identified!))) (_.cover [/.push] - (let [pushed (/.push non-member sample) + (let [pushed (/.push non_member sample) - size-increases! + size_increases! (n.= (inc (/.size sample)) (/.size pushed)) - new-member-is-identified! - (/.member? n.equivalence pushed non-member) + new_member_is_identified! + (/.member? n.equivalence pushed non_member) - has-expected-order! + has_expected_order! (\ (list.equivalence n.equivalence) = - (list\compose (/.to-list sample) (list non-member)) - (/.to-list pushed))] - (and size-increases! - new-member-is-identified! - has-expected-order!))) + (list\compose (/.to_list sample) (list non_member)) + (/.to_list pushed))] + (and size_increases! + new_member_is_identified! + has_expected_order!))) (_.cover [/.pop] (case members (#.Cons target expected) (let [popped (/.pop sample) - size-decreases! + size_decreases! (n.= (dec (/.size sample)) (/.size popped)) - popped-member-is-not-identified! + popped_member_is_not_identified! (not (/.member? n.equivalence popped target)) - has-expected-order! + has_expected_order! (\ (list.equivalence n.equivalence) = expected - (/.to-list popped))] - (and size-decreases! - popped-member-is-not-identified! - has-expected-order!)) + (/.to_list popped))] + (and size_decreases! + popped_member_is_not_identified! + has_expected_order!)) #.Nil (and (/.empty? sample) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 46e305b8d..13ed9af28 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -50,7 +50,7 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) - #let [sample (|> sample set.to-list /.from-list)] + #let [sample (|> sample set.to_list /.from_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (_.cover [/.size] @@ -59,40 +59,40 @@ (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? /.empty)) - (_.cover [/.to-list /.from-list] - (|> sample /.to-list /.from-list (/\= sample))) + (_.cover [/.to_list /.from_list] + (|> sample /.to_list /.from_list (/\= sample))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) - (let [not-same! + (let [not_same! (not (/\= sample (/.reverse sample))) - self-symmetry! + self_symmetry! (/\= sample (/.reverse (/.reverse sample)))] - (and not-same! - self-symmetry!)))) + (and not_same! + self_symmetry!)))) (_.cover [/.every? /.any?] (if (/.every? n.even? sample) (not (/.any? (bit.complement n.even?) sample)) (/.any? (bit.complement n.even?) sample))) ))) -(def: index-based +(def: index_based Test (do {! random.monad} [size (\ ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and (do ! - [good-index (|> random.nat (\ ! map (n.% size))) - #let [bad-index (n.+ size good-index)] + [good_index (|> random.nat (\ ! map (n.% size))) + #let [bad_index (n.+ size good_index)] sample (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? sample) not) + non_member (random.filter (|>> (set.member? sample) not) random.nat) - #let [sample (|> sample set.to-list /.from-list)]] + #let [sample (|> sample set.to_list /.from_list)]] ($_ _.and (_.cover [/.nth] - (case (/.nth good-index sample) + (case (/.nth good_index sample) (#try.Success member) (/.member? n.equivalence sample member) @@ -101,20 +101,20 @@ (_.cover [/.put] (<| (try.default false) (do try.monad - [sample (/.put good-index non-member sample) - actual (/.nth good-index sample)] - (wrap (is? non-member actual))))) + [sample (/.put good_index non_member sample) + actual (/.nth good_index sample)] + (wrap (is? non_member actual))))) (_.cover [/.update] (<| (try.default false) (do try.monad - [sample (/.put good-index non-member sample) - sample (/.update good-index inc sample) - actual (/.nth good-index sample)] - (wrap (n.= (inc non-member) actual))))) - (_.cover [/.within-bounds?] - (and (/.within-bounds? sample good-index) - (not (/.within-bounds? sample bad-index)))) - (_.cover [/.index-out-of-bounds] + [sample (/.put good_index non_member sample) + sample (/.update good_index inc sample) + actual (/.nth good_index sample)] + (wrap (n.= (inc non_member) actual))))) + (_.cover [/.within_bounds?] + (and (/.within_bounds? sample good_index) + (not (/.within_bounds? sample bad_index)))) + (_.cover [/.index_out_of_bounds] (let [fails! (: (All [a] (-> (Try a) Bit)) (function (_ situation) (case situation @@ -122,10 +122,10 @@ false (#try.Failure error) - (exception.match? /.index-out-of-bounds error))))] - (and (fails! (/.nth bad-index sample)) - (fails! (/.put bad-index non-member sample)) - (fails! (/.update bad-index inc sample))))) + (exception.match? /.index_out_of_bounds error))))] + (and (fails! (/.nth bad_index sample)) + (fails! (/.put bad_index non_member sample)) + (fails! (/.update bad_index inc sample))))) )) ))) @@ -138,13 +138,13 @@ ($_ _.and ..signatures ..whole - ..index-based + ..index_based (do ! [sample (random.set n.hash size random.nat) - non-member (random.filter (|>> (set.member? sample) not) + non_member (random.filter (|>> (set.member? sample) not) random.nat) - #let [sample (|> sample set.to-list /.from-list)] + #let [sample (|> sample set.to_list /.from_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (do ! @@ -152,36 +152,36 @@ value/1 random.nat value/2 random.nat] (_.cover [/.row] - (/\= (/.from-list (list value/0 value/1 value/2)) + (/\= (/.from_list (list value/0 value/1 value/2)) (/.row value/0 value/1 value/2)))) (_.cover [/.member?] (and (list.every? (/.member? n.equivalence sample) - (/.to-list sample)) - (not (/.member? n.equivalence sample non-member)))) + (/.to_list sample)) + (not (/.member? n.equivalence sample non_member)))) (_.cover [/.add] - (let [added (/.add non-member sample) + (let [added (/.add non_member sample) - size-increases! + size_increases! (n.= (inc (/.size sample)) (/.size added)) - is-a-member! - (/.member? n.equivalence added non-member)] - (and size-increases! - is-a-member!))) + is_a_member! + (/.member? n.equivalence added non_member)] + (and size_increases! + is_a_member!))) (_.cover [/.pop] (if (/.empty? sample) (/.empty? (/.pop sample)) - (let [expected-size! + (let [expected_size! (n.= (dec (/.size sample)) (/.size (/.pop sample))) symmetry! (|> sample - (/.add non-member) + (/.add non_member) /.pop (/\= sample))] - (and expected-size! + (and expected_size! symmetry!)))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index b21741752..b97e1f7d2 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -39,8 +39,8 @@ index (\ ! map (n.% 100) random.nat) size (\ ! map (|>> (n.% 10) inc) random.nat) offset (\ ! map (n.% 100) random.nat) - cycle-start random.nat - cycle-next (random.list size random.nat)] + cycle_start random.nat + cycle_next (random.list size random.nat)] ($_ _.and (_.for [/.functor] ($functor.spec /.repeat ..equivalence /.functor)) @@ -65,19 +65,19 @@ drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.take size takes))))) - (_.cover [/.take-while] + (_.cover [/.take_while] (list\= (enum.range n.enum 0 (dec size)) - (/.take-while (n.< size) (/.iterate inc 0)))) - (_.cover [/.drop-while] + (/.take_while (n.< size) (/.iterate inc 0)))) + (_.cover [/.drop_while] (list\= (enum.range n.enum offset (dec (n.+ size offset))) - (/.take-while (n.< (n.+ size offset)) - (/.drop-while (n.< offset) (/.iterate inc 0))))) - (_.cover [/.split-while] - (let [[drops takes] (/.split-while (n.< size) (/.iterate inc 0))] + (/.take_while (n.< (n.+ size offset)) + (/.drop_while (n.< offset) (/.iterate inc 0))))) + (_.cover [/.split_while] + (let [[drops takes] (/.split_while (n.< size) (/.iterate inc 0))] (and (list\= (enum.range n.enum 0 (dec size)) drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) - (/.take-while (n.< (n.* 2 size)) takes))))) + (/.take_while (n.< (n.* 2 size)) takes))))) (_.cover [/.head] (n.= offset (/.head (/.iterate inc offset)))) @@ -102,10 +102,10 @@ (/.unfold (function (_ n) [(inc n) (%.nat n)]) offset))))) (_.cover [/.cycle] - (let [cycle (list& cycle-start cycle-next)] + (let [cycle (list& cycle_start cycle_next)] (list\= (list.concat (list.repeat size cycle)) (/.take (n.* size (list.size cycle)) - (/.cycle [cycle-start cycle-next]))))) + (/.cycle [cycle_start cycle_next]))))) (_.cover [/.^sequence&] (let [(/.^sequence& first second third next) (/.iterate inc offset)] (and (n.= offset first) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 024a41e39..a58627cde 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -19,7 +19,7 @@ {1 ["." / ("\." equivalence)]}) -(def: gen-nat +(def: gen_nat (Random Nat) (\ random.monad map (n.% 100) random.nat)) @@ -29,7 +29,7 @@ (<| (_.covering /._) (_.for [/.Set]) (do {! random.monad} - [size ..gen-nat] + [size ..gen_nat] ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) @@ -37,11 +37,11 @@ ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) (do ! - [sizeL ..gen-nat - sizeR ..gen-nat + [sizeL ..gen_nat + sizeR ..gen_nat setL (random.set n.hash sizeL random.nat) setR (random.set n.hash sizeR random.nat) - non-memberL (random.filter (|>> (/.member? setL) not) + non_memberL (random.filter (|>> (/.member? setL) not) random.nat)] ($_ _.and (_.cover [/.new] @@ -55,74 +55,74 @@ (def: (hash _) constant)))) random.nat)] - (_.cover [/.member-hash] - (is? hash (/.member-hash (/.new hash))))) + (_.cover [/.member_hash] + (is? hash (/.member_hash (/.new hash))))) (_.cover [/.size] (n.= sizeL (/.size setL))) (_.cover [/.empty?] (bit\= (/.empty? setL) (n.= 0 (/.size setL)))) - (_.cover [/.to-list /.from-list] - (|> setL /.to-list (/.from-list n.hash) (\= setL))) + (_.cover [/.to_list /.from_list] + (|> setL /.to_list (/.from_list n.hash) (\= setL))) (_.cover [/.member?] - (and (list.every? (/.member? setL) (/.to-list setL)) - (not (/.member? setL non-memberL)))) + (and (list.every? (/.member? setL) (/.to_list setL)) + (not (/.member? setL non_memberL)))) (_.cover [/.add] - (let [before-addition! - (not (/.member? setL non-memberL)) + (let [before_addition! + (not (/.member? setL non_memberL)) - after-addition! - (/.member? (/.add non-memberL setL) non-memberL) + after_addition! + (/.member? (/.add non_memberL setL) non_memberL) - size-increase! + size_increase! (n.= (inc (/.size setL)) - (/.size (/.add non-memberL setL)))] - (and before-addition! - after-addition!))) + (/.size (/.add non_memberL setL)))] + (and before_addition! + after_addition!))) (_.cover [/.remove] (let [symmetry! (|> setL - (/.add non-memberL) - (/.remove non-memberL) + (/.add non_memberL) + (/.remove non_memberL) (\= setL)) idempotency! (|> setL - (/.remove non-memberL) + (/.remove non_memberL) (\= setL))] (and symmetry! idempotency!))) (_.cover [/.union /.sub?] (let [setLR (/.union setL setR) - sets-are-subs-of-their-unions! + sets_are_subs_of_their_unions! (and (/.sub? setLR setL) (/.sub? setLR setR)) - union-with-empty-set! + union_with_empty_set! (|> setL (/.union (/.new n.hash)) (\= setL))] - (and sets-are-subs-of-their-unions! - union-with-empty-set!))) + (and sets_are_subs_of_their_unions! + union_with_empty_set!))) (_.cover [/.intersection /.super?] (let [setLR (/.intersection setL setR) - sets-are-supers-of-their-intersections! + sets_are_supers_of_their_intersections! (and (/.super? setLR setL) (/.super? setLR setR)) - intersection-with-empty-set! + intersection_with_empty_set! (|> setL (/.intersection (/.new n.hash)) /.empty?)] - (and sets-are-supers-of-their-intersections! - intersection-with-empty-set!))) + (and sets_are_supers_of_their_intersections! + intersection_with_empty_set!))) (_.cover [/.difference] (let [setL+R (/.union setR setL) - setL-R (/.difference setR setL+R)] - (and (list.every? (/.member? setL+R) (/.to-list setR)) - (not (list.any? (/.member? setL-R) (/.to-list setR)))))) + setL_R (/.difference setR setL+R)] + (and (list.every? (/.member? setL+R) (/.to_list setR)) + (not (list.any? (/.member? setL_R) (/.to_list setR)))))) (_.cover [/.predicate] - (list.every? (/.predicate setL) (/.to-list setL))) + (list.every? (/.predicate setL) (/.to_list setL))) )))))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 98877583f..8d6d5aa22 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -28,12 +28,12 @@ (All [a] (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) (do {! random.monad} [elements (random.set hash size element) - element-counts (random.list size ..count)] + element_counts (random.list size ..count)] (wrap (list\fold (function (_ [count element] set) (/.add count element set)) (/.new hash) - (list.zip/2 element-counts - (set.to-list elements)))))) + (list.zip/2 element_counts + (set.to_list elements)))))) (def: #export test Test @@ -42,22 +42,22 @@ (do {! random.monad} [diversity (\ ! map (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) - non-member (random.filter (predicate.complement (set.member? (/.support sample))) + non_member (random.filter (predicate.complement (set.member? (/.support sample))) random.nat) - addition-count ..count - partial-removal-count (\ ! map (n.% addition-count) random.nat) + addition_count ..count + partial_removal_count (\ ! map (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] (`` ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.cover [/.to-list /.from-list] + (_.cover [/.to_list /.from_list] (|> sample - /.to-list - (/.from-list n.hash) + /.to_list + (/.from_list n.hash) (\ /.equivalence = sample))) (_.cover [/.size] - (n.= (list.size (/.to-list sample)) + (n.= (list.size (/.to_list sample)) (/.size sample))) (_.cover [/.empty?] (bit\= (/.empty? sample) @@ -66,75 +66,75 @@ (/.empty? (/.new n.hash))) (_.cover [/.support] (list.every? (set.member? (/.support sample)) - (/.to-list sample))) + (/.to_list sample))) (_.cover [/.member?] - (let [non-member-is-not-identified! - (not (/.member? sample non-member)) + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - all-members-are-identified! + all_members_are_identified! (list.every? (/.member? sample) - (/.to-list sample))] - (and non-member-is-not-identified! - all-members-are-identified!))) + (/.to_list sample))] + (and non_member_is_not_identified! + all_members_are_identified!))) (_.cover [/.multiplicity] - (let [non-members-have-0-multiplicity! - (n.= 0 (/.multiplicity sample non-member)) + (let [non_members_have_0_multiplicity! + (n.= 0 (/.multiplicity sample non_member)) - every-member-has-positive-multiplicity! + every_member_has_positive_multiplicity! (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.to-list sample))] - (and non-members-have-0-multiplicity! - every-member-has-positive-multiplicity!))) + (/.to_list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) (_.cover [/.add] - (let [null-scenario! + (let [null_scenario! (|> sample - (/.add 0 non-member) + (/.add 0 non_member) (\ /.equivalence = sample)) - normal-scenario! - (let [sample+ (/.add addition-count non-member sample)] - (and (not (/.member? sample non-member)) - (/.member? sample+ non-member) - (n.= addition-count (/.multiplicity sample+ non-member))))] - (and null-scenario! - normal-scenario!))) + normal_scenario! + (let [sample+ (/.add addition_count non_member sample)] + (and (not (/.member? sample non_member)) + (/.member? sample+ non_member) + (n.= addition_count (/.multiplicity sample+ non_member))))] + (and null_scenario! + normal_scenario!))) (_.cover [/.remove] - (let [null-scenario! + (let [null_scenario! (\ /.equivalence = (|> sample - (/.add addition-count non-member)) + (/.add addition_count non_member)) (|> sample - (/.add addition-count non-member) - (/.remove 0 non-member))) + (/.add addition_count non_member) + (/.remove 0 non_member))) - partial-scenario! + partial_scenario! (let [sample* (|> sample - (/.add addition-count non-member) - (/.remove partial-removal-count non-member))] - (and (/.member? sample* non-member) - (n.= (n.- partial-removal-count - addition-count) - (/.multiplicity sample* non-member)))) + (/.add addition_count non_member) + (/.remove partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) - total-scenario! + total_scenario! (|> sample - (/.add addition-count non-member) - (/.remove addition-count non-member) + (/.add addition_count non_member) + (/.remove addition_count non_member) (\ /.equivalence = sample))] - (and null-scenario! - partial-scenario! - total-scenario!))) - (_.cover [/.from-set] - (let [unary (|> sample /.support /.from-set)] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.from_set] + (let [unary (|> sample /.support /.from_set)] (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.to-list unary)))) + (/.to_list unary)))) (_.cover [/.sub?] - (let [unary (|> sample /.support /.from-set)] + (let [unary (|> sample /.support /.from_set)] (and (/.sub? sample unary) (or (not (/.sub? unary sample)) (\ /.equivalence = sample unary))))) (_.cover [/.super?] - (let [unary (|> sample /.support /.from-set)] + (let [unary (|> sample /.support /.from_set)] (and (/.super? unary sample) (or (not (/.super? sample unary)) (\ /.equivalence = sample unary))))) @@ -142,27 +142,27 @@ [(_.cover [<name>] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (<name> sample another) - no-left-changes! (list.every? (function (_ member) + no_left_changes! (list.every? (function (_ member) (n.= (/.multiplicity sample member) (/.multiplicity composed member))) - (set.to-list sample-only)) - no-right-changes! (list.every? (function (_ member) + (set.to_list sample_only)) + no_right_changes! (list.every? (function (_ member) (n.= (/.multiplicity another member) (/.multiplicity composed member))) - (set.to-list another-only)) - common-changes! (list.every? (function (_ member) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) (n.= (<composition> (/.multiplicity sample member) (/.multiplicity another member)) (/.multiplicity composed member))) - (set.to-list common))] - (and no-left-changes! - no-right-changes! - common-changes!)))] + (set.to_list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] [/.sum n.+] [/.union n.max] @@ -170,46 +170,46 @@ (_.cover [/.intersection] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (/.intersection sample another) - left-removals! (list.every? (|>> (/.member? composed) not) - (set.to-list sample-only)) - right-removals! (list.every? (|>> (/.member? composed) not) - (set.to-list another-only)) - common-changes! (list.every? (function (_ member) + left_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.to_list another_only)) + common_changes! (list.every? (function (_ member) (n.= (n.min (/.multiplicity sample member) (/.multiplicity another member)) (/.multiplicity composed member))) - (set.to-list common))] - (and left-removals! - right-removals! - common-changes!))) + (set.to_list common))] + (and left_removals! + right_removals! + common_changes!))) (_.cover [/.difference] (let [|sample| (/.support sample) |another| (/.support another) - sample-only (set.difference |another| |sample|) - another-only (set.difference |sample| |another|) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) common (set.intersection |sample| |another|) composed (/.difference sample another) ommissions! (list.every? (|>> (/.member? composed) not) - (set.to-list sample-only)) + (set.to_list sample_only)) intact! (list.every? (function (_ member) (n.= (/.multiplicity another member) (/.multiplicity composed member))) - (set.to-list another-only)) + (set.to_list another_only)) subtractions! (list.every? (function (_ member) - (let [sample-multiplicity (/.multiplicity sample member) - another-multiplicity (/.multiplicity another member)] - (n.= (if (n.> another-multiplicity sample-multiplicity) + (let [sample_multiplicity (/.multiplicity sample member) + another_multiplicity (/.multiplicity another member)] + (n.= (if (n.> another_multiplicity sample_multiplicity) 0 - (n.- sample-multiplicity - another-multiplicity)) + (n.- sample_multiplicity + another_multiplicity)) (/.multiplicity composed member)))) - (set.to-list common))] + (set.to_list common))] (and ommissions! intact! subtractions!))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 25c645651..6c0e75b3d 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -23,7 +23,7 @@ (random.Random Nat) (\ random.monad map (n.% 100) random.nat)) -(def: #export (random size &order gen-value) +(def: #export (random size &order gen_value) (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 @@ -31,9 +31,9 @@ _ (do random.monad - [partial (random (dec size) &order gen-value) + [partial (random (dec size) &order gen_value) value (random.filter (|>> (/.member? partial) not) - gen-value)] + gen_value)] (wrap (/.add value partial))))) (def: #export test @@ -44,13 +44,13 @@ [sizeL ..size sizeR ..size usetL (random.set n.hash sizeL random.nat) - non-memberL (random.filter (|>> (//.member? usetL) not) + non_memberL (random.filter (|>> (//.member? usetL) not) random.nat) - #let [listL (//.to-list usetL)] - listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.to-list)) + #let [listL (//.to_list usetL)] + listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.to_list)) #let [(^open "/\.") /.equivalence - setL (/.from-list n.order listL) - setR (/.from-list n.order listR) + setL (/.from_list n.order listL) + setR (/.from_list n.order listR) empty (/.new n.order)]] (`` ($_ _.and (_.for [/.equivalence] @@ -63,19 +63,19 @@ (/.empty? setL))) (_.cover [/.new] (/.empty? (/.new n.order))) - (_.cover [/.to-list] + (_.cover [/.to_list] (\ (list.equivalence n.equivalence) = - (/.to-list (/.from-list n.order listL)) + (/.to_list (/.from_list n.order listL)) (list.sort (\ n.order <) listL))) - (_.cover [/.from-list] + (_.cover [/.from_list] (|> setL - /.to-list (/.from-list n.order) + /.to_list (/.from_list n.order) (/\= setL))) (~~ (template [<coverage> <comparison>] [(_.cover [<coverage>] (case (<coverage> setL) (#.Some value) - (|> setL /.to-list (list.every? (<comparison> value))) + (|> setL /.to_list (list.every? (<comparison> value))) #.None (/.empty? setL)))] @@ -84,23 +84,23 @@ [/.max n.<=] )) (_.cover [/.member?] - (let [members-are-identified! - (list.every? (/.member? setL) (/.to-list setL)) + (let [members_are_identified! + (list.every? (/.member? setL) (/.to_list setL)) - non-members-are-not-identified! - (not (/.member? setL non-memberL))] - (and members-are-identified! - non-members-are-not-identified!))) + non_members_are_not_identified! + (not (/.member? setL non_memberL))] + (and members_are_identified! + non_members_are_not_identified!))) (_.cover [/.add] - (let [setL+ (/.add non-memberL setL)] - (and (not (/.member? setL non-memberL)) - (/.member? setL+ non-memberL) + (let [setL+ (/.add non_memberL setL)] + (and (not (/.member? setL non_memberL)) + (/.member? setL+ non_memberL) (n.= (inc (/.size setL)) (/.size setL+))))) (_.cover [/.remove] (|> setL - (/.add non-memberL) - (/.remove non-memberL) + (/.add non_memberL) + (/.remove non_memberL) (\ /.equivalence = setL))) (_.cover [/.sub?] (let [self! @@ -164,7 +164,7 @@ difference! (not (list.any? (/.member? (/.difference setL setR)) - (/.to-list setL))) + (/.to_list setL))) idempotence! (\ /.equivalence = diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 3c1325d4e..f169d8a5d 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -12,7 +12,7 @@ ["." list ("#\." fold)]]] [math ["." random]] - [type (#+ :by-example)]] + [type (#+ :by_example)]] {1 ["." /]}) @@ -20,7 +20,7 @@ (/.builder text.monoid)) (def: :@: - (:by-example [@] + (:by_example [@] {(/.Builder @ Text) ..builder} @)) @@ -30,56 +30,56 @@ (<| (_.covering /._) (_.for [/.Tree]) (do {! random.monad} - [tag-left (random.ascii/alpha-num 1) - tag-right (random.filter (|>> (text\= tag-left) not) - (random.ascii/alpha-num 1)) - expected-left random.nat - expected-right random.nat] + [tag_left (random.ascii/alpha_num 1) + tag_right (random.filter (|>> (text\= tag_left) not) + (random.ascii/alpha_num 1)) + expected_left random.nat + expected_right random.nat] ($_ _.and (_.cover [/.Builder /.builder] (exec (/.builder text.monoid) true)) (_.cover [/.tag] - (and (text\= tag-left - (/.tag (\ ..builder leaf tag-left expected-left))) - (text\= (text\compose tag-left tag-right) + (and (text\= tag_left + (/.tag (\ ..builder leaf tag_left expected_left))) + (text\= (text\compose tag_left tag_right) (/.tag (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))))) (_.cover [/.root] - (and (case (/.root (\ ..builder leaf tag-left expected-left)) + (and (case (/.root (\ ..builder leaf tag_left expected_left)) (#.Left actual) - (n.= expected-left actual) + (n.= expected_left actual) (#.Right _) false) (case (/.root (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right))) (#.Left _) false (#.Right [left right]) (case [(/.root left) (/.root right)] - [(#.Left actual-left) (#.Left actual-right)] - (and (n.= expected-left actual-left) - (n.= expected-right actual-right)) + [(#.Left actual_left) (#.Left actual_right)] + (and (n.= expected_left actual_left) + (n.= expected_right actual_right)) _ false)))) (_.cover [/.value] - (and (n.= expected-left - (/.value (\ ..builder leaf tag-left expected-left))) - (n.= expected-left + (and (n.= expected_left + (/.value (\ ..builder leaf tag_left expected_left))) + (n.= expected_left (/.value (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))))) (do random.monad - [#let [tags-equivalence (list.equivalence text.equivalence) - values-equivalence (list.equivalence n.equivalence)] - tags/H (random.ascii/alpha-num 1) - tags/T (random.list 5 (random.ascii/alpha-num 1)) + [#let [tags_equivalence (list.equivalence text.equivalence) + values_equivalence (list.equivalence n.equivalence)] + tags/H (random.ascii/alpha_num 1) + tags/T (random.list 5 (random.ascii/alpha_num 1)) values/H random.nat values/T (random.list 5 random.nat)] (_.cover [/.tags /.values] @@ -87,63 +87,63 @@ (\ builder branch tree (\ builder leaf tag value))) (\ builder leaf tags/H values/H) (list.zip/2 tags/T values/T))] - (and (\ tags-equivalence = (list& tags/H tags/T) (/.tags tree)) - (\ values-equivalence = (list& values/H values/T) (/.values tree)))))) + (and (\ tags_equivalence = (list& tags/H tags/T) (/.tags tree)) + (\ values_equivalence = (list& values/H values/T) (/.values tree)))))) (_.cover [/.search] - (let [can-find-correct-one! - (|> (\ ..builder leaf tag-left expected-left) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + (let [can_find_correct_one! + (|> (\ ..builder leaf tag_left expected_left) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false)) - cannot-find-incorrect-one! - (|> (\ ..builder leaf tag-right expected-right) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + cannot_find_incorrect_one! + (|> (\ ..builder leaf tag_right expected_right) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false) not) - can-find-left! + can_find_left! (|> (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)) - (/.search (text.contains? tag-left)) - (maybe\map (n.= expected-left)) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)) + (/.search (text.contains? tag_left)) + (maybe\map (n.= expected_left)) (maybe.default false)) - can-find-right! + can_find_right! (|> (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)) - (/.search (text.contains? tag-right)) - (maybe\map (n.= expected-right)) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)) + (/.search (text.contains? tag_right)) + (maybe\map (n.= expected_right)) (maybe.default false))] - (and can-find-correct-one! - cannot-find-incorrect-one! - can-find-left! - can-find-right!))) + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) (_.cover [/.found?] - (let [can-find-correct-one! - (/.found? (text.contains? tag-left) - (\ ..builder leaf tag-left expected-left)) + (let [can_find_correct_one! + (/.found? (text.contains? tag_left) + (\ ..builder leaf tag_left expected_left)) - cannot-find-incorrect-one! - (not (/.found? (text.contains? tag-left) - (\ ..builder leaf tag-right expected-right))) + cannot_find_incorrect_one! + (not (/.found? (text.contains? tag_left) + (\ ..builder leaf tag_right expected_right))) - can-find-left! - (/.found? (text.contains? tag-left) + can_find_left! + (/.found? (text.contains? tag_left) (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right))) - can-find-right! - (/.found? (text.contains? tag-right) + can_find_right! + (/.found? (text.contains? tag_right) (\ ..builder branch - (\ ..builder leaf tag-left expected-left) - (\ ..builder leaf tag-right expected-right)))] - (and can-find-correct-one! - cannot-find-incorrect-one! - can-find-left! - can-find-right!))) + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))] + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 76075ba0b..c0ea5e699 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -26,37 +26,37 @@ (def: #export random (Random Color) (|> ($_ random.and random.nat random.nat random.nat) - (\ random.monad map /.from-rgb))) + (\ random.monad map /.from_rgb))) (def: scale (-> Nat Frac) (|>> .int int.frac)) (def: square (-> Frac Frac) (math.pow +2.0)) -(def: square-root (-> Frac Frac) (math.pow +0.5)) +(def: square_root (-> Frac Frac) (math.pow +0.5)) (def: (distance/1 from to) (-> Frac Frac Frac) - (square-root + (square_root (square (f.- from to)))) (def: (distance/3 from to) (-> Color Color Frac) - (let [[fr fg fb] (/.to-rgb from) - [tr tg tb] (/.to-rgb to)] - (square-root + (let [[fr fg fb] (/.to_rgb from) + [tr tg tb] (/.to_rgb to)] + (square_root ($_ f.+ (|> (scale tr) (f.- (scale fr)) square) (|> (scale tg) (f.- (scale fg)) square) (|> (scale tb) (f.- (scale fb)) square))))) -(def: rgb-error-margin +1.8) +(def: rgb_error_margin +1.8) (template [<field>] [(def: (<field> color) (-> Color Frac) - (let [[hue saturation luminance] (/.to-hsl color)] + (let [[hue saturation luminance] (/.to_hsl color)] <field>))] [saturation] @@ -66,21 +66,21 @@ (def: (encoding expected) (-> /.Color Test) ($_ _.and - (_.cover [/.RGB /.to-rgb /.from-rgb] - (|> expected /.to-rgb /.from-rgb + (_.cover [/.RGB /.to_rgb /.from_rgb] + (|> expected /.to_rgb /.from_rgb (\ /.equivalence = expected))) - (_.cover [/.HSL /.to-hsl /.from-hsl] - (|> expected /.to-hsl /.from-hsl + (_.cover [/.HSL /.to_hsl /.from_hsl] + (|> expected /.to_hsl /.from_hsl (distance/3 expected) - (f.<= ..rgb-error-margin))) - (_.cover [/.HSB /.to-hsb /.from-hsb] - (|> expected /.to-hsb /.from-hsb + (f.<= ..rgb_error_margin))) + (_.cover [/.HSB /.to_hsb /.from_hsb] + (|> expected /.to_hsb /.from_hsb (distance/3 expected) - (f.<= ..rgb-error-margin))) - (_.cover [/.CMYK /.to-cmyk /.from-cmyk] - (|> expected /.to-cmyk /.from-cmyk + (f.<= ..rgb_error_margin))) + (_.cover [/.CMYK /.to_cmyk /.from_cmyk] + (|> expected /.to_cmyk /.from_cmyk (distance/3 expected) - (f.<= ..rgb-error-margin))) + (f.<= ..rgb_error_margin))) )) (def: transformation @@ -94,7 +94,7 @@ ((function (_ saturation) (and (f.>= +0.25 saturation) (f.<= +0.75 saturation))))))) - ratio (|> random.safe-frac (random.filter (f.>= +0.5)))] + ratio (|> random.safe_frac (random.filter (f.>= +0.5)))] ($_ _.and (_.cover [/.darker /.brighter] (and (f.<= (distance/3 colorful /.black) @@ -109,17 +109,17 @@ (_.cover [/.saturate] (f.> (saturation mediocre) (saturation (/.saturate ratio mediocre)))) - (_.cover [/.de-saturate] + (_.cover [/.de_saturate] (f.< (saturation mediocre) - (saturation (/.de-saturate ratio mediocre)))) - (_.cover [/.gray-scale] - (let [gray'ed (/.gray-scale mediocre)] + (saturation (/.de_saturate ratio mediocre)))) + (_.cover [/.gray_scale] + (let [gray'ed (/.gray_scale mediocre)] (and (f.= +0.0 (saturation gray'ed)) (|> (luminance gray'ed) (f.- (luminance mediocre)) f.abs - (f.<= ..rgb-error-margin))))) + (f.<= ..rgb_error_margin))))) ))) (def: palette @@ -127,20 +127,20 @@ (_.for [/.Spread /.Palette] (do {! random.monad} [eH (\ ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) - random.safe-frac) + random.safe_frac) #let [eS +0.5] variations (\ ! map (|>> (n.% 3) (n.+ 2)) random.nat) - #let [max-spread (f./ (|> variations inc .int int.frac) + #let [max_spread (f./ (|> variations inc .int int.frac) +1.0) - min-spread (f./ +2.0 max-spread) - spread-space (f.- min-spread max-spread)] - spread (\ ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) - random.safe-frac)] + min_spread (f./ +2.0 max_spread) + spread_space (f.- min_spread max_spread)] + spread (\ ! map (|>> f.abs (f.% spread_space) (f.+ min_spread)) + random.safe_frac)] (`` ($_ _.and (~~ (template [<brightness> <palette>] [(_.cover [<palette>] (let [eB <brightness> - expected (/.from-hsb [eH eS eB]) + expected (/.from_hsb [eH eS eB]) palette (<palette> spread variations expected)] (and (n.= variations (list.size palette)) (not (list.any? (\ /.equivalence = expected) palette)))))] @@ -149,7 +149,7 @@ )) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from-hsb [eH eS +0.5]) + (let [expected (/.from_hsb [eH eS +0.5]) [c0 c1 c2] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) @@ -157,10 +157,10 @@ [/.triad] [/.clash] - [/.split-complement])) + [/.split_complement])) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from-hsb [eH eS +0.5]) + (let [expected (/.from_hsb [eH eS +0.5]) [c0 c1 c2 c3] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 0420eed19..062ba560b 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -17,9 +17,9 @@ ["." / ["/#" //]]}) -(with-expansions [<colors> (as-is [letter/a - [/.alice-blue - /.antique-white +(with_expansions [<colors> (as_is [letter/a + [/.alice_blue + /.antique_white ## /.aqua /.aquamarine /.azure]] @@ -28,67 +28,67 @@ [/.beige /.bisque /.black - /.blanched-almond + /.blanched_almond /.blue - /.blue-violet + /.blue_violet /.brown - /.burly-wood]] + /.burly_wood]] [letter/c - [/.cadet-blue + [/.cadet_blue /.chartreuse /.chocolate /.coral - /.cornflower-blue + /.cornflower_blue /.cornsilk /.crimson /.cyan]] [letter/d - [/.dark-blue - /.dark-cyan - /.dark-goldenrod - /.dark-gray - /.dark-green - /.dark-khaki - /.dark-magenta - /.dark-olive-green - /.dark-orange - /.dark-orchid - /.dark-red - /.dark-salmon - /.dark-sea-green - /.dark-slate-blue - /.dark-slate-gray - /.dark-turquoise - /.dark-violet - /.deep-pink - /.deep-sky-blue - /.dim-gray - /.dodger-blue]] + [/.dark_blue + /.dark_cyan + /.dark_goldenrod + /.dark_gray + /.dark_green + /.dark_khaki + /.dark_magenta + /.dark_olive_green + /.dark_orange + /.dark_orchid + /.dark_red + /.dark_salmon + /.dark_sea_green + /.dark_slate_blue + /.dark_slate_gray + /.dark_turquoise + /.dark_violet + /.deep_pink + /.deep_sky_blue + /.dim_gray + /.dodger_blue]] [letter/f - [/.fire-brick - /.floral-white - /.forest-green + [/.fire_brick + /.floral_white + /.forest_green ## /.fuchsia ]] [letter/g [/.gainsboro - /.ghost-white + /.ghost_white /.gold /.goldenrod /.gray /.green - /.green-yellow]] + /.green_yellow]] [letter/h - [/.honey-dew - /.hot-pink]] + [/.honey_dew + /.hot_pink]] [letter/i - [/.indian-red + [/.indian_red /.indigo /.ivory]] @@ -97,88 +97,88 @@ [letter/l [/.lavender - /.lavender-blush - /.lawn-green - /.lemon-chiffon - /.light-blue - /.light-coral - /.light-cyan - /.light-goldenrod-yellow - /.light-gray - /.light-green - /.light-pink - /.light-salmon - /.light-sea-green - /.light-sky-blue - /.light-slate-gray - /.light-steel-blue - /.light-yellow + /.lavender_blush + /.lawn_green + /.lemon_chiffon + /.light_blue + /.light_coral + /.light_cyan + /.light_goldenrod_yellow + /.light_gray + /.light_green + /.light_pink + /.light_salmon + /.light_sea_green + /.light_sky_blue + /.light_slate_gray + /.light_steel_blue + /.light_yellow /.lime - /.lime-green + /.lime_green /.linen]] [letter/m [/.magenta /.maroon - /.medium-aquamarine - /.medium-blue - /.medium-orchid - /.medium-purple - /.medium-sea-green - /.medium-slate-blue - /.medium-spring-green - /.medium-turquoise - /.medium-violet-red - /.midnight-blue - /.mint-cream - /.misty-rose + /.medium_aquamarine + /.medium_blue + /.medium_orchid + /.medium_purple + /.medium_sea_green + /.medium_slate_blue + /.medium_spring_green + /.medium_turquoise + /.medium_violet_red + /.midnight_blue + /.mint_cream + /.misty_rose /.moccasin]] [letter/n - [/.navajo-white + [/.navajo_white /.navy]] [letter/o - [/.old-lace + [/.old_lace /.olive - /.olive-drab + /.olive_drab /.orange - /.orange-red + /.orange_red /.orchid]] [letter/p - [/.pale-goldenrod - /.pale-green - /.pale-turquoise - /.pale-violet-red - /.papaya-whip - /.peach-puff + [/.pale_goldenrod + /.pale_green + /.pale_turquoise + /.pale_violet_red + /.papaya_whip + /.peach_puff /.peru /.pink /.plum - /.powder-blue + /.powder_blue /.purple]] [letter/r - [/.rebecca-purple + [/.rebecca_purple /.red - /.rosy-brown - /.royal-blue]] + /.rosy_brown + /.royal_blue]] [letter/s - [/.saddle-brown + [/.saddle_brown /.salmon - /.sandy-brown - /.sea-green - /.sea-shell + /.sandy_brown + /.sea_green + /.sea_shell /.sienna /.silver - /.sky-blue - /.slate-blue - /.slate-gray + /.sky_blue + /.slate_blue + /.slate_gray /.snow - /.spring-green - /.steel-blue]] + /.spring_green + /.steel_blue]] [letter/t [/.tan @@ -193,33 +193,33 @@ [letter/w [/.wheat /.white - /.white-smoke]] + /.white_smoke]] [letter/y [/.yellow - /.yellow-green]] + /.yellow_green]] ) - <named> (template [<definition> <by-letter>] + <named> (template [<definition> <by_letter>] [((: (-> Any (List //.Color)) (function (_ _) - (`` (list (~~ (template.splice <by-letter>)))))) + (`` (list (~~ (template.splice <by_letter>)))))) 123)] <colors>)] - (def: all-colors + (def: all_colors (list.concat (list <named>))) - (def: unique-colors - (set.from-list //.hash ..all-colors)) + (def: unique_colors + (set.from_list //.hash ..all_colors)) (def: verdict - (n.= (list.size ..all-colors) - (set.size ..unique-colors))) + (n.= (list.size ..all_colors) + (set.size ..unique_colors))) - (template [<definition> <by-letter>] + (template [<definition> <by_letter>] [(def: <definition> Test - (_.cover <by-letter> + (_.cover <by_letter> ..verdict))] <colors>) @@ -228,7 +228,7 @@ Test (<| (_.covering /._) (`` ($_ _.and - (~~ (template [<definition> <by-letter>] + (~~ (template [<definition> <by_letter>] [<definition>] <colors>)) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 09f608543..2d38b8988 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -40,7 +40,7 @@ ($_ random.or (\ ! wrap []) random.bit - random.safe-frac + random.safe_frac (random.unicode size) (random.row size recur) (random.dictionary text.hash size (random.unicode size) recur) @@ -89,9 +89,9 @@ (try.default false)))) (do random.monad [keys (random.set text.hash 3 (random.ascii/alpha 1)) - values (random.set frac.hash 3 random.safe-frac) - #let [expected (list.zip/2 (set.to-list keys) - (list\map (|>> #/.Number) (set.to-list values))) + values (random.set frac.hash 3 random.safe_frac) + #let [expected (list.zip/2 (set.to_list keys) + (list\map (|>> #/.Number) (set.to_list values))) object (/.object expected)]] ($_ _.and (_.cover [/.object /.fields] @@ -114,26 +114,26 @@ [key (random.ascii/alpha 1) unknown (random.filter (|>> (\ text.equivalence = key) not) (random.ascii/alpha 1)) - expected random.safe-frac] + expected random.safe_frac] (_.cover [/.set] (<| (try.default false) (do try.monad [object (/.set key (#/.Number expected) (/.object (list))) - #let [can-find-known-key! + #let [can_find_known_key! (|> object (/.get key) (try\map (\= (#/.Number expected))) (try.default false)) - cannot-find-unknown-key! + cannot_find_unknown_key! (case (/.get unknown object) (#try.Success _) false (#try.Failure error) true)]] - (wrap (and can-find-known-key! - cannot-find-unknown-key!)))))) + (wrap (and can_find_known_key! + cannot_find_unknown_key!)))))) (~~ (template [<type> <get> <tag> <random> <equivalence>] [(do random.monad [key (random.ascii/alpha 1) @@ -144,16 +144,16 @@ (try\map (\ <equivalence> = value)) (try.default false))))] - [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] - [/.Number /.get-number #/.Number random.safe-frac frac.equivalence] - [/.String /.get-string #/.String (random.ascii/alpha 1) text.equivalence] - [/.Array /.get-array #/.Array (random.row 3 ..random) (row.equivalence /.equivalence)] - [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] + [/.Boolean /.get_boolean #/.Boolean random.bit bit.equivalence] + [/.Number /.get_number #/.Number random.safe_frac frac.equivalence] + [/.String /.get_string #/.String (random.ascii/alpha 1) text.equivalence] + [/.Array /.get_array #/.Array (random.row 3 ..random) (row.equivalence /.equivalence)] + [/.Object /.get_object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] )) - (with-expansions [<boolean> (boolean) + (with_expansions [<boolean> (boolean) <number> (number) <string> (string) - <array-row> (row.row #/.Null + <array_row> (row.row #/.Null (#/.Boolean <boolean>) (#/.Number <number>) (#/.String <string>)) @@ -173,7 +173,7 @@ [#/.Number <number>] [#/.String <string>] )) - (\= (#/.Array <array-row>) (/.json [#null <boolean> <number> <string>])) + (\= (#/.Array <array_row>) (/.json [#null <boolean> <number> <string>])) (let [object (/.json {<key0> #null <key1> <boolean> <key2> <number> @@ -193,7 +193,7 @@ (\= (#/.Boolean <boolean>) value1) (\= (#/.Number <number>) value2) (\= (#/.String <string>) value3) - (\= (#/.Array <array-row>) value4) + (\= (#/.Array <array_row>) value4) (\= (#/.Number <number>) value6)))))) ))) )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 7f271de05..72024ba29 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -38,148 +38,148 @@ Test (_.for [/.Path] (do {! random.monad} - [expected (random.ascii/lower-alpha /.path-size) - invalid (random.ascii/lower-alpha (inc /.path-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.path-size)] + [expected (random.ascii/lower_alpha /.path_size) + invalid (random.ascii/lower_alpha (inc /.path_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.path_size)] (`` ($_ _.and - (_.cover [/.path /.from-path] + (_.cover [/.path /.from_path] (case (/.path expected) (#try.Success actual) (text\= expected - (/.from-path actual)) + (/.from_path actual)) (#try.Failure error) false)) - (_.cover [/.path-size /.path-is-too-long] + (_.cover [/.path_size /.path_is_too_long] (case (/.path invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.path-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.path not-ascii) + (exception.match? /.path_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.path not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) + (exception.match? /.not_ascii error))) ))))) (def: name Test (_.for [/.Name] (do {! random.monad} - [expected (random.ascii/lower-alpha /.name-size) - invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.name-size)] + [expected (random.ascii/lower_alpha /.name_size) + invalid (random.ascii/lower_alpha (inc /.name_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.name_size)] (`` ($_ _.and - (_.cover [/.name /.from-name] + (_.cover [/.name /.from_name] (case (/.name expected) (#try.Success actual) (text\= expected - (/.from-name actual)) + (/.from_name actual)) (#try.Failure error) false)) - (_.cover [/.name-size /.name-is-too-long] + (_.cover [/.name_size /.name_is_too_long] (case (/.name invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.name-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.name not-ascii) + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) + (exception.match? /.not_ascii error))) ))))) (def: small Test (_.for [/.Small] (do {! random.monad} - [expected (|> random.nat (\ ! map (n.% /.small-limit))) - invalid (|> random.nat (\ ! map (n.max /.small-limit)))] + [expected (|> random.nat (\ ! map (n.% /.small_limit))) + invalid (|> random.nat (\ ! map (n.max /.small_limit)))] (`` ($_ _.and - (_.cover [/.small /.from-small] + (_.cover [/.small /.from_small] (case (/.small expected) (#try.Success actual) (n.= expected - (/.from-small actual)) + (/.from_small actual)) (#try.Failure error) false)) - (_.cover [/.small-limit /.not-a-small-number] + (_.cover [/.small_limit /.not_a_small_number] (case (/.small invalid) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-a-small-number error))) + (exception.match? /.not_a_small_number error))) ))))) (def: big Test (_.for [/.Big] (do {! random.monad} - [expected (|> random.nat (\ ! map (n.% /.big-limit))) - invalid (|> random.nat (\ ! map (n.max /.big-limit)))] + [expected (|> random.nat (\ ! map (n.% /.big_limit))) + invalid (|> random.nat (\ ! map (n.max /.big_limit)))] (`` ($_ _.and - (_.cover [/.big /.from-big] + (_.cover [/.big /.from_big] (case (/.big expected) (#try.Success actual) (n.= expected - (/.from-big actual)) + (/.from_big actual)) (#try.Failure error) false)) - (_.cover [/.big-limit /.not-a-big-number] + (_.cover [/.big_limit /.not_a_big_number] (case (/.big invalid) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-a-big-number error))) + (exception.match? /.not_a_big_number error))) ))))) -(def: chunk-size 32) +(def: chunk_size 32) (def: entry Test (do {! random.monad} - [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) + [expected_path (random.ascii/lower_alpha (dec /.path_size)) + expected_moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from_millis) random.nat) - chunk (random.ascii/lower-alpha chunk-size) + chunk (random.ascii/lower_alpha chunk_size) chunks (\ ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) - (text.join-with "") + (text.join_with "") (\ encoding.utf8 encode))]] (`` ($_ _.and (~~ (template [<type> <tag>] [(_.cover [<type>] (|> (do try.monad - [expected-path (/.path expected-path) - tar (|> (row.row (<tag> expected-path)) + [expected_path (/.path expected_path) + tar (|> (row.row (<tag> expected_path)) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (<tag> actual-path))) - (text\= (/.from-path expected-path) - (/.from-path actual-path)) + (wrap (case (row.to_list tar) + (^ (list (<tag> actual_path))) + (text\= (/.from_path expected_path) + (/.from_path actual_path)) _ false))) (try.default false)))] - [/.Symbolic-Link #/.Symbolic-Link] + [/.Symbolic_Link #/.Symbolic_Link] [/.Directory #/.Directory] )) (_.for [/.File /.Content /.content /.data] @@ -187,28 +187,28 @@ (~~ (template [<type> <tag>] [(_.cover [<type>] (|> (do try.monad - [expected-path (/.path expected-path) - expected-content (/.content content) - tar (|> (row.row (<tag> [expected-path - expected-moment + [expected_path (/.path expected_path) + expected_content (/.content content) + tar (|> (row.row (<tag> [expected_path + expected_moment /.none {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} - expected-content])) + #/.id /.no_id}} + expected_content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (<tag> [actual-path actual-moment actual-mode actual-ownership actual-content]))) + (wrap (case (row.to_list tar) + (^ (list (<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]))) (let [seconds (: (-> Instant Int) (|>> instant.relative (duration.query duration.second)))] - (and (text\= (/.from-path expected-path) - (/.from-path actual-path)) - (i.= (seconds expected-moment) - (seconds actual-moment)) - (binary\= (/.data expected-content) - (/.data actual-content)))) + (and (text\= (/.from_path expected_path) + (/.from_path actual_path)) + (i.= (seconds expected_moment) + (seconds actual_moment)) + (binary\= (/.data expected_content) + (/.data actual_content)))) _ false))) @@ -218,72 +218,72 @@ [/.Contiguous #/.Contiguous] )))))))) -(def: random-mode +(def: random_mode (Random /.Mode) (do {! random.monad} [] - (random.either (random.either (random.either (wrap /.execute-by-other) - (wrap /.write-by-other)) - (random.either (wrap /.read-by-other) - (wrap /.execute-by-group))) - (random.either (random.either (random.either (wrap /.write-by-group) - (wrap /.read-by-group)) - (random.either (wrap /.execute-by-owner) - (wrap /.write-by-owner))) - (random.either (random.either (wrap /.read-by-owner) - (wrap /.save-text)) - (random.either (wrap /.set-group-id-on-execution) - (wrap /.set-user-id-on-execution))))))) + (random.either (random.either (random.either (wrap /.execute_by_other) + (wrap /.write_by_other)) + (random.either (wrap /.read_by_other) + (wrap /.execute_by_group))) + (random.either (random.either (random.either (wrap /.write_by_group) + (wrap /.read_by_group)) + (random.either (wrap /.execute_by_owner) + (wrap /.write_by_owner))) + (random.either (random.either (wrap /.read_by_owner) + (wrap /.save_text)) + (random.either (wrap /.set_group_id_on_execution) + (wrap /.set_user_id_on_execution))))))) (def: mode Test (_.for [/.Mode /.mode] (do {! random.monad} - [path (random.ascii/lower-alpha 10) - modes (random.list 4 ..random-mode) - #let [expected-mode (list\fold /.and /.none modes)]] + [path (random.ascii/lower_alpha 10) + modes (random.list 4 ..random_mode) + #let [expected_mode (list\fold /.and /.none modes)]] (`` ($_ _.and (_.cover [/.and] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) - expected-mode + (instant.from_millis +0) + expected_mode {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ actual-mode _ _]))) - (n.= (/.mode expected-mode) - (/.mode actual-mode)) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode expected_mode) + (/.mode actual_mode)) _ false))) (try.default false))) - (~~ (template [<expected-mode>] - [(_.cover [<expected-mode>] + (~~ (template [<expected_mode>] + [(_.cover [<expected_mode>] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) - <expected-mode> + (instant.from_millis +0) + <expected_mode> {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ actual-mode _ _]))) - (n.= (/.mode <expected-mode>) - (/.mode actual-mode)) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode <expected_mode>) + (/.mode actual_mode)) _ false))) @@ -291,96 +291,96 @@ [/.none] - [/.execute-by-other] - [/.write-by-other] - [/.read-by-other] + [/.execute_by_other] + [/.write_by_other] + [/.read_by_other] - [/.execute-by-group] - [/.write-by-group] - [/.read-by-group] + [/.execute_by_group] + [/.write_by_group] + [/.read_by_group] - [/.execute-by-owner] - [/.write-by-owner] - [/.read-by-owner] + [/.execute_by_owner] + [/.write_by_owner] + [/.read_by_owner] - [/.save-text] - [/.set-group-id-on-execution] - [/.set-user-id-on-execution] + [/.save_text] + [/.set_group_id_on_execution] + [/.set_user_id_on_execution] ))))))) (def: ownership Test (do {! random.monad} - [path (random.ascii/lower-alpha /.path-size) - expected (random.ascii/lower-alpha /.name-size) - invalid (random.ascii/lower-alpha (inc /.name-size)) - not-ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) - /.name-size)] + [path (random.ascii/lower_alpha /.path_size) + expected (random.ascii/lower_alpha /.name_size) + invalid (random.ascii/lower_alpha (inc /.name_size)) + not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) + /.name_size)] (_.for [/.Ownership /.Owner /.ID] ($_ _.and - (_.cover [/.name-size /.name-is-too-long] + (_.cover [/.name_size /.name_is_too_long] (case (/.name invalid) (#try.Success _) false (#try.Failure error) - (exception.match? /.name-is-too-long error))) - (_.cover [/.not-ascii] - (case (/.name not-ascii) + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) (#try.Success actual) false (#try.Failure error) - (exception.match? /.not-ascii error))) - (_.cover [/.Name /.name /.from-name] + (exception.match? /.not_ascii error))) + (_.cover [/.Name /.name /.from_name] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) expected (/.name expected) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) + (instant.from_millis +0) /.none {#/.user {#/.name expected - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ _ actual-ownership _]))) - (and (text\= (/.from-name expected) - (/.from-name (get@ [#/.user #/.name] actual-ownership))) - (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.group #/.name] actual-ownership)))) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name expected) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership)))) _ false))) (try.default false))) - (_.cover [/.anonymous /.no-id] + (_.cover [/.anonymous /.no_id] (|> (do try.monad [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from-millis +0) + (instant.from_millis +0) /.none {#/.user {#/.name /.anonymous - #/.id /.no-id} + #/.id /.no_id} #/.group {#/.name /.anonymous - #/.id /.no-id}} + #/.id /.no_id}} content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to-list tar) - (^ (list (#/.Normal [_ _ _ actual-ownership _]))) - (and (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.user #/.name] actual-ownership))) - (n.= (/.from-small /.no-id) - (/.from-small (get@ [#/.user #/.id] actual-ownership))) - (text\= (/.from-name /.anonymous) - (/.from-name (get@ [#/.group #/.name] actual-ownership))) - (n.= (/.from-small /.no-id) - (/.from-small (get@ [#/.group #/.id] actual-ownership)))) + (wrap (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.user #/.id] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.group #/.id] actual_ownership)))) _ false))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index e95b843d2..57958281c 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -27,7 +27,7 @@ {1 ["." / (#+ XML)]}) -(def: char-range +(def: char_range Text (format "_" "abcdefghijklmnopqrstuvwxyz" @@ -36,8 +36,8 @@ (def: char (Random Nat) (do {! random.monad} - [idx (|> random.nat (\ ! map (n.% (text.size char-range))))] - (wrap (maybe.assume (text.nth idx char-range))))) + [idx (|> random.nat (\ ! map (n.% (text.size char_range))))] + (wrap (maybe.assume (text.nth idx char_range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) @@ -83,8 +83,8 @@ [(_.cover [<type> <format>] (and (text\= name (<format> ["" name])) (let [identifier (<format> identifier)] - (and (text.starts-with? namespace identifier) - (text.ends-with? name identifier)))))] + (and (text.starts_with? namespace identifier) + (text.ends_with? name identifier)))))] [/.Tag /.tag] [/.Attribute /.attribute] diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index dd5238aa4..08fd3065e 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -24,10 +24,10 @@ (random.filter (|>> (text.contains? ".") not) (random.unicode size))) -(def: #export (random module-size short-size) +(def: #export (random module_size short_size) (-> Nat Nat (Random Name)) - (random.and (..part module-size) - (..part short-size))) + (random.and (..part module_size) + (..part short_size))) (def: #export test Test @@ -59,17 +59,17 @@ (and (is? module1 (/.module name1)) (is? short1 (/.short name1)))) - (_.for [.name-of] + (_.for [.name_of] (let [(^open "/\.") /.equivalence] ($_ _.and (_.test "Can obtain Name from identifier." - (and (/\= ["lux" "yolo"] (.name-of .yolo)) - (/\= ["test/lux/data/name" "yolo"] (.name-of ..yolo)) - (/\= ["" "yolo"] (.name-of yolo)) - (/\= ["lux/test" "yolo"] (.name-of lux/test.yolo)))) + (and (/\= ["lux" "yolo"] (.name_of .yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name_of ..yolo)) + (/\= ["" "yolo"] (.name_of yolo)) + (/\= ["lux/test" "yolo"] (.name_of lux/test.yolo)))) (_.test "Can obtain Name from tag." - (and (/\= ["lux" "yolo"] (.name-of #.yolo)) - (/\= ["test/lux/data/name" "yolo"] (.name-of #..yolo)) - (/\= ["" "yolo"] (.name-of #yolo)) - (/\= ["lux/test" "yolo"] (.name-of #lux/test.yolo))))))) + (and (/\= ["lux" "yolo"] (.name_of #.yolo)) + (/\= ["test/lux/data/name" "yolo"] (.name_of #..yolo)) + (/\= ["" "yolo"] (.name_of #yolo)) + (/\= ["lux/test" "yolo"] (.name_of #lux/test.yolo))))))) ))))) diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux index d1d812aa9..d8e769369 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/data/number.lux @@ -25,9 +25,9 @@ ["#." ratio] ["#." complex]]) -(def: clean-commas +(def: clean_commas (-> Text Text) - (text.replace-all "," "")) + (text.replace_all "," "")) (def: #export test Test @@ -35,7 +35,7 @@ ($_ _.and (_.cover [/.bin] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.bin <number>) actual) @@ -56,7 +56,7 @@ ))))) (_.cover [/.oct] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.oct <number>) actual) @@ -77,7 +77,7 @@ ))))) (_.cover [/.hex] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean_commas <number>)) (#try.Success actual) (<=> (/.hex <number>) actual) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 2d5865e3d..fc83ddb51 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -21,14 +21,14 @@ {1 ["." /]}) -(def: margin-of-error +(def: margin_of_error +0.000000001) (def: dimension (Random Frac) (do {! random.monad} [factor (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1)))) - measure (|> random.safe-frac (random.filter (f.> +0.0)))] + measure (|> random.safe_frac (random.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -60,12 +60,12 @@ (and (f.= real (get@ #/.real r+i)) (f.= +0.0 (get@ #/.imaginary r+i)))))) (_.cover [/.within?] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (/.complex real imaginary) (/.complex real imaginary))) - (_.cover [/.not-a-number?] - (and (/.not-a-number? (/.complex f.not-a-number imaginary)) - (/.not-a-number? (/.complex real f.not-a-number)))) + (_.cover [/.not_a_number?] + (and (/.not_a_number? (/.complex f.not_a_number imaginary)) + (/.not_a_number? (/.complex real f.not_a_number)))) ))) (def: constant @@ -90,7 +90,7 @@ (/.* /.i (/.* /.i sample))))) ))) -(def: absolute-value&argument +(def: absolute_value&argument Test (do random.monad [real ..dimension @@ -102,23 +102,23 @@ (and (f.>= (f.abs real) (/.abs r+i)) (f.>= (f.abs imaginary) (/.abs r+i)))) - not-a-number! - (and (f.not-a-number? (/.abs (/.complex f.not-a-number imaginary))) - (f.not-a-number? (/.abs (/.complex real f.not-a-number)))) + not_a_number! + (and (f.not_a_number? (/.abs (/.complex f.not_a_number imaginary))) + (f.not_a_number? (/.abs (/.complex real f.not_a_number)))) infinity! - (and (f.= f.positive-infinity (/.abs (/.complex f.positive-infinity imaginary))) - (f.= f.positive-infinity (/.abs (/.complex real f.positive-infinity))) - (f.= f.positive-infinity (/.abs (/.complex f.negative-infinity imaginary))) - (f.= f.positive-infinity (/.abs (/.complex real f.negative-infinity))))] + (and (f.= f.positive_infinity (/.abs (/.complex f.positive_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.positive_infinity))) + (f.= f.positive_infinity (/.abs (/.complex f.negative_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.negative_infinity))))] (and normal! - not-a-number! + not_a_number! infinity!))) ## https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities (_.cover [/.argument] (let [sample (/.complex real imaginary)] (or (/.= /.zero sample) - (/.within? ..margin-of-error + (/.within? ..margin_of_error sample (/.*' (/.abs sample) (/.exp (/.* /.i (/.complex (/.argument sample))))))))) @@ -148,14 +148,14 @@ (get@ #/.imaginary x)))))) inverse! - (and (|> x (/.+ y) (/.- y) (/.within? ..margin-of-error x)) - (|> x (/.- y) (/.+ y) (/.within? ..margin-of-error x)))] + (and (|> x (/.+ y) (/.- y) (/.within? ..margin_of_error x)) + (|> x (/.- y) (/.+ y) (/.within? ..margin_of_error x)))] (and normal! inverse!))) (_.cover [/.* /./] - (|> x (/.* y) (/./ y) (/.within? ..margin-of-error x))) + (|> x (/.* y) (/./ y) (/.within? ..margin_of_error x))) (_.cover [/.*' /./'] - (|> x (/.*' factor) (/./' factor) (/.within? ..margin-of-error x))) + (|> x (/.*' factor) (/./' factor) (/.within? ..margin_of_error x))) (_.cover [/.%] (let [rem (/.% y x) quotient (|> x (/.- rem) (/./ y)) @@ -180,36 +180,36 @@ (get@ #/.imaginary cx))))) (_.cover [/.reciprocal] (let [reciprocal! - (|> x (/.* (/.reciprocal x)) (/.within? ..margin-of-error /.+one)) + (|> x (/.* (/.reciprocal x)) (/.within? ..margin_of_error /.+one)) - own-inverse! - (|> x /.reciprocal /.reciprocal (/.within? ..margin-of-error x))] + own_inverse! + (|> x /.reciprocal /.reciprocal (/.within? ..margin_of_error x))] (and reciprocal! - own-inverse!))) + own_inverse!))) (_.cover [/.signum] ## Absolute value of signum is always root/2(2), 1 or 0. - (let [signum-abs (|> x /.signum /.abs)] - (or (f.= +0.0 signum-abs) - (f.= +1.0 signum-abs) - (f.= (math.pow +0.5 +2.0) signum-abs)))) + (let [signum_abs (|> x /.signum /.abs)] + (or (f.= +0.0 signum_abs) + (f.= +1.0 signum_abs) + (f.= (math.pow +0.5 +2.0) signum_abs)))) (_.cover [/.negate] - (let [own-inverse! + (let [own_inverse! (let [there (/.negate x) - back-again (/.negate there)] + back_again (/.negate there)] (and (not (/.= there x)) - (/.= back-again x))) + (/.= back_again x))) absolute! (f.= (/.abs x) (/.abs (/.negate x)))] - (and own-inverse! + (and own_inverse! absolute!))) ))) -(def: (trigonometric-symmetry forward backward angle) +(def: (trigonometric_symmetry forward backward angle) (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit) (let [normal (|> angle forward backward)] - (|> normal forward backward (/.within? ..margin-of-error normal)))) + (|> normal forward backward (/.within? ..margin_of_error normal)))) (def: trigonometry Test @@ -217,11 +217,11 @@ [angle ..angle] ($_ _.and (_.cover [/.sin /.asin] - (trigonometric-symmetry /.sin /.asin angle)) + (trigonometric_symmetry /.sin /.asin angle)) (_.cover [/.cos /.acos] - (trigonometric-symmetry /.cos /.acos angle)) + (trigonometric_symmetry /.cos /.acos angle)) (_.cover [/.tan /.atan] - (trigonometric-symmetry /.tan /.atan angle))))) + (trigonometric_symmetry /.tan /.atan angle))))) (def: hyperbolic Test @@ -229,15 +229,15 @@ [angle ..angle] ($_ _.and (_.cover [/.sinh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one)) (/.sinh angle))) (_.cover [/.cosh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.cos) (/.cosh angle))) (_.cover [/.tanh] - (/.within? ..margin-of-error + (/.within? ..margin_of_error (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one)) (/.tanh angle))) ))) @@ -248,11 +248,11 @@ [x ..random] ($_ _.and (_.cover [/.pow /.root/2] - (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin-of-error x))) + (|> x (/.pow (/.complex +2.0)) /.root/2 (/.within? ..margin_of_error x))) (_.cover [/.pow'] - (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin-of-error x))) + (|> x (/.pow' +2.0) (/.pow' +0.5) (/.within? ..margin_of_error x))) (_.cover [/.log /.exp] - (|> x /.log /.exp (/.within? ..margin-of-error x))) + (|> x /.log /.exp (/.within? ..margin_of_error x))) ))) (def: root @@ -264,7 +264,7 @@ (|> sample (/.roots degree) (list\map (/.pow' (|> degree .int int.frac))) - (list.every? (/.within? ..margin-of-error sample)))))) + (list.every? (/.within? ..margin_of_error sample)))))) (def: #export test Test @@ -276,7 +276,7 @@ ..construction ..constant - ..absolute-value&argument + ..absolute_value&argument ..number ..conjugate&reciprocal&signum&negation ..trigonometry diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index d982b6492..dcaa417ed 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -31,21 +31,21 @@ (def: constant Test (do random.monad - [sample random.safe-frac] + [sample random.safe_frac] ($_ _.and (_.cover [/.biggest] (/.<= /.biggest sample)) - (_.cover [/.positive-infinity] - (/.< /.positive-infinity sample)) + (_.cover [/.positive_infinity] + (/.< /.positive_infinity sample)) (_.cover [/.smallest] (bit\= (/.positive? sample) (/.>= /.smallest sample))) - (_.cover [/.negative-infinity] - (/.> /.negative-infinity sample)) - (_.cover [/.not-a-number /.not-a-number?] - (and (/.not-a-number? /.not-a-number) - (not (or (/.= /.not-a-number sample) - (/.not-a-number? sample))))) + (_.cover [/.negative_infinity] + (/.> /.negative_infinity sample)) + (_.cover [/.not_a_number /.not_a_number?] + (and (/.not_a_number? /.not_a_number) + (not (or (/.= /.not_a_number sample) + (/.not_a_number? sample))))) ))) (def: predicate @@ -67,9 +67,9 @@ (and (/.within? /.smallest sample sample) (/.within? (/.+ +1.0 shift) sample (/.+ shift sample)))) (_.cover [/.number?] - (and (not (/.number? /.not-a-number)) - (not (/.number? /.positive-infinity)) - (not (/.number? /.negative-infinity)) + (and (not (/.number? /.not_a_number)) + (not (/.number? /.positive_infinity)) + (not (/.number? /.negative_infinity)) (/.number? sample))) ))) @@ -85,7 +85,7 @@ (_.cover [/.int] (|> expected i.frac /.int (i.= expected)))) (do {! random.monad} - [expected (\ ! map (|>> (i64.left-shift 52) .rev) + [expected (\ ! map (|>> (i64.left_shift 52) .rev) random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) @@ -95,11 +95,11 @@ Test (`` ($_ _.and (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.safe-frac)) + ($equivalence.spec /.equivalence random.safe_frac)) (_.for [/.hash] ($hash.spec /.hash random.frac)) (_.for [/.order /.<] - ($order.spec /.order random.safe-frac)) + ($order.spec /.order random.safe_frac)) (~~ (template [<compose> <monoid>] [(_.for [<monoid> <compose>] ($monoid.spec /.equivalence <monoid> ..random))] @@ -112,18 +112,18 @@ )) (~~ (template [<codec>] [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.safe-frac))] + ($codec.spec /.equivalence <codec> random.safe_frac))] [/.binary] [/.octal] [/.decimal] [/.hex] )) ))) -(with-expansions [<jvm> (as-is (host.import: java/lang/Double +(with_expansions [<jvm> (as_is (host.import: java/lang/Double ["#::." (#static doubleToRawLongBits #manual [double] long) (#static longBitsToDouble #manual [long] double)]))] - (for {@.old (as-is <jvm>) - @.jvm (as-is <jvm>)})) + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})) (def: #export test Test @@ -131,8 +131,8 @@ (_.for [.Frac]) ($_ _.and (do random.monad - [left random.safe-frac - right random.safe-frac] + [left random.safe_frac + right random.safe_frac] ($_ _.and (_.cover [/.>] (bit\= (/.> left right) @@ -142,7 +142,7 @@ (/.>= right left))) )) (do random.monad - [sample random.safe-frac] + [sample random.safe_frac] ($_ _.and (_.cover [/.-] (and (/.= +0.0 (/.- sample sample)) @@ -186,48 +186,48 @@ (/.= (/.+ left (/.% left right)) (/.mod left right)))))) )) - (with-expansions [<jvm> ($_ _.and + (with_expansions [<jvm> ($_ _.and (let [test (: (-> Frac Bit) (function (_ value) (n.= (.nat (java/lang/Double::doubleToRawLongBits value)) - (/.to-bits value))))] + (/.to_bits value))))] (do random.monad [sample random.frac] - (_.cover [/.to-bits] + (_.cover [/.to_bits] (and (test sample) (test /.biggest) (test /.smallest) - (test /.not-a-number) - (test /.positive-infinity) - (test /.negative-infinity))))) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))) (do random.monad [sample random.i64] - (_.cover [/.from-bits] + (_.cover [/.from_bits] (let [expected (java/lang/Double::longBitsToDouble sample) - actual (/.from-bits sample)] + actual (/.from_bits sample)] (or (/.= expected actual) - (and (/.not-a-number? expected) - (/.not-a-number? actual)))))) + (and (/.not_a_number? expected) + (/.not_a_number? actual)))))) )] (for {@.old <jvm> @.jvm <jvm>} (let [test (: (-> Frac Bit) (function (_ expected) - (let [actual (|> expected /.to-bits /.from-bits)] + (let [actual (|> expected /.to_bits /.from_bits)] (or (/.= expected actual) - (and (/.not-a-number? expected) - (/.not-a-number? actual))))))] + (and (/.not_a_number? expected) + (/.not_a_number? actual))))))] (do random.monad [sample random.frac] - (_.cover [/.to-bits /.from-bits] + (_.cover [/.to_bits /.from_bits] (and (test sample) (test /.biggest) (test /.smallest) - (test /.not-a-number) - (test /.positive-infinity) - (test /.negative-infinity))))))) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))))) (do random.monad - [expected random.safe-frac] + [expected random.safe_frac] (_.cover [/.negate] (let [subtraction! (/.= +0.0 (/.+ (/.negate expected) expected)) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 78b293fd5..45e644ab2 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -49,38 +49,38 @@ ($_ _.and (do ! [idx (\ ! map (n.% /.width) random.nat)] - (_.cover [/.arithmetic-right-shift] + (_.cover [/.arithmetic_right_shift] (let [value (.int pattern) nullity! - (\= pattern (/.arithmetic-right-shift 0 pattern)) + (\= pattern (/.arithmetic_right_shift 0 pattern)) idempotency! - (\= value (/.arithmetic-right-shift /.width value)) + (\= value (/.arithmetic_right_shift /.width value)) - sign-preservation! + sign_preservation! (bit\= (i.negative? value) - (i.negative? (/.arithmetic-right-shift idx value)))] + (i.negative? (/.arithmetic_right_shift idx value)))] (and nullity! idempotency! - sign-preservation!)))) + sign_preservation!)))) (do ! [idx (\ ! map (|>> (n.% (dec /.width)) inc) random.nat)] - (_.cover [/.left-shift /.logic-right-shift] + (_.cover [/.left_shift /.logic_right_shift] (let [nullity! - (and (\= pattern (/.left-shift 0 pattern)) - (\= pattern (/.logic-right-shift 0 pattern))) + (and (\= pattern (/.left_shift 0 pattern)) + (\= pattern (/.logic_right_shift 0 pattern))) idempotency! - (and (\= pattern (/.left-shift /.width pattern)) - (\= pattern (/.logic-right-shift /.width pattern))) + (and (\= pattern (/.left_shift /.width pattern)) + (\= pattern (/.logic_right_shift /.width pattern))) movement! (let [shift (n.- idx /.width)] (\= (/.and (/.mask idx) pattern) (|> pattern - (/.left-shift shift) - (/.logic-right-shift shift))))] + (/.left_shift shift) + (/.logic_right_shift shift))))] (and nullity! idempotency! movement!)))) @@ -123,13 +123,13 @@ 0 (\= /.false (/.region size offset)) _ (\= (|> pattern ## NNNNYYYYNNNN - (/.logic-right-shift offset) + (/.logic_right_shift offset) ## ____NNNNYYYY - (/.left-shift spare) + (/.left_shift spare) ## YYYY________ - (/.logic-right-shift spare) + (/.logic_right_shift spare) ## ________YYYY - (/.left-shift offset) + (/.left_shift offset) ## ____YYYY____ ) (/.and (/.region size offset) pattern))))) @@ -184,11 +184,11 @@ [pattern random.nat idx (\ ! map (n.% /.width) random.nat)] ($_ _.and - (_.cover [/.width /.bits-per-byte /.bytes-per-i64] - (and (n.= /.bytes-per-i64 - (n./ /.bits-per-byte /.width)) - (n.= /.bits-per-byte - (n./ /.bytes-per-i64 /.width)))) + (_.cover [/.width /.bits_per_byte /.bytes_per_i64] + (and (n.= /.bytes_per_i64 + (n./ /.bits_per_byte /.width)) + (n.= /.bits_per_byte + (n./ /.bytes_per_i64 /.width)))) (_.cover [/.false] (n.= 0 (/.count /.false))) (_.cover [/.or] @@ -225,39 +225,39 @@ (/.count (/.not pattern))))] (and clear&set! complementarity!))) - (_.cover [/.rotate-left /.rotate-right] + (_.cover [/.rotate_left /.rotate_right] (let [false! - (and (\= /.false (/.rotate-left idx /.false)) - (\= /.false (/.rotate-right idx /.false))) + (and (\= /.false (/.rotate_left idx /.false)) + (\= /.false (/.rotate_right idx /.false))) true! - (and (\= /.true (/.rotate-left idx /.true)) - (\= /.true (/.rotate-right idx /.true))) + (and (\= /.true (/.rotate_left idx /.true)) + (\= /.true (/.rotate_right idx /.true))) inverse! (and (|> pattern - (/.rotate-left idx) - (/.rotate-right idx) + (/.rotate_left idx) + (/.rotate_right idx) (\= pattern)) (|> pattern - (/.rotate-right idx) - (/.rotate-left idx) + (/.rotate_right idx) + (/.rotate_left idx) (\= pattern))) nullity! (and (|> pattern - (/.rotate-left 0) + (/.rotate_left 0) (\= pattern)) (|> pattern - (/.rotate-right 0) + (/.rotate_right 0) (\= pattern))) futility! (and (|> pattern - (/.rotate-left /.width) + (/.rotate_left /.width) (\= pattern)) (|> pattern - (/.rotate-right /.width) + (/.rotate_right /.width) (\= pattern)))] (and false! true! diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index 294d8b97a..2e75eb874 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -92,7 +92,7 @@ random.rev) divisor (\ ! map (|>> (i64.and (hex "F")) (i64.or (hex "1")) - (i64.rotate-right 8) + (i64.rotate_right 8) .rev) random.nat)] dividend (random.filter (/.> .0) dividend) @@ -116,14 +116,14 @@ (/.down scale) (/.= dividend)) - discrete-division! + discrete_division! (/.= (/.% (.rev scale) dividend) (/.- (|> dividend (/.down scale) (/.up scale)) dividend))] (and symmetry! - discrete-division!))) + discrete_division!))) (_.cover [/.ratio] (|> dividend (/.up scale) @@ -156,7 +156,7 @@ (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) (do {! random.monad} [expected (\ ! map (|>> f.abs (f.% +1.0)) - random.safe-frac)] + random.safe_frac)] (_.cover [/.frac] (|> expected f.rev /.frac (f.= expected)))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index c751e6a78..4100d5f0d 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -29,7 +29,7 @@ {1 ["." /]}) -(def: bounded-size +(def: bounded_size (random.Random Nat) (|> random.nat (\ random.monad map (|>> (n.% 20) (n.+ 1))))) @@ -55,23 +55,23 @@ left (random.unicode 1) right (random.unicode 1) #let [full (\ /.monoid compose inner outer) - fake-index (.nat -1)]] + fake_index (.nat -1)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] [(_.cover [<affix> <predicate>] (<predicate> outer (<affix> outer inner)))] - [/.prefix /.starts-with?] - [/.suffix /.ends-with?] + [/.prefix /.starts_with?] + [/.suffix /.ends_with?] [/.enclose' /.encloses?] )) (_.cover [/.enclose] (let [value (/.enclose [left right] inner)] - (and (/.starts-with? left value) - (/.ends-with? right value)))) + (and (/.starts_with? left value) + (/.ends_with? right value)))) (_.cover [/.encode] (let [sample (/.encode inner)] - (and (/.encloses? /.double-quote sample) + (and (/.encloses? /.double_quote sample) (/.contains? inner sample)))) )))) @@ -81,69 +81,69 @@ [inner (random.unicode 1) outer (random.filter (|>> (\ /.equivalence = inner) not) (random.unicode 1)) - #let [fake-index (.nat -1)]] + #let [fake_index (.nat -1)]] ($_ _.and (_.cover [/.contains?] (let [full (\ /.monoid compose inner outer)] (and (/.contains? inner full) (/.contains? outer full)))) - (_.cover [/.index-of] - (and (|> (/.index-of inner (\ /.monoid compose inner outer)) - (maybe.default fake-index) + (_.cover [/.index_of] + (and (|> (/.index_of inner (\ /.monoid compose inner outer)) + (maybe.default fake_index) (n.= 0)) - (|> (/.index-of outer (\ /.monoid compose inner outer)) - (maybe.default fake-index) + (|> (/.index_of outer (\ /.monoid compose inner outer)) + (maybe.default fake_index) (n.= 1)))) - (_.cover [/.index-of'] + (_.cover [/.index_of'] (let [full (\ /.monoid compose inner outer)] - (and (|> (/.index-of' inner 0 full) - (maybe.default fake-index) + (and (|> (/.index_of' inner 0 full) + (maybe.default fake_index) (n.= 0)) - (|> (/.index-of' inner 1 full) - (maybe.default fake-index) - (n.= fake-index)) + (|> (/.index_of' inner 1 full) + (maybe.default fake_index) + (n.= fake_index)) - (|> (/.index-of' outer 0 full) - (maybe.default fake-index) + (|> (/.index_of' outer 0 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.index-of' outer 1 full) - (maybe.default fake-index) + (|> (/.index_of' outer 1 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.index-of' outer 2 full) - (maybe.default fake-index) - (n.= fake-index))))) - (_.cover [/.last-index-of] + (|> (/.index_of' outer 2 full) + (maybe.default fake_index) + (n.= fake_index))))) + (_.cover [/.last_index_of] (let [full ($_ (\ /.monoid compose) outer inner outer)] - (and (|> (/.last-index-of inner full) - (maybe.default fake-index) + (and (|> (/.last_index_of inner full) + (maybe.default fake_index) (n.= 1)) - (|> (/.last-index-of outer full) - (maybe.default fake-index) + (|> (/.last_index_of outer full) + (maybe.default fake_index) (n.= 2))))) - (_.cover [/.last-index-of'] + (_.cover [/.last_index_of'] (let [full ($_ (\ /.monoid compose) outer inner outer)] - (and (|> (/.last-index-of' inner 0 full) - (maybe.default fake-index) + (and (|> (/.last_index_of' inner 0 full) + (maybe.default fake_index) (n.= 1)) - (|> (/.last-index-of' inner 2 full) - (maybe.default fake-index) - (n.= fake-index)) + (|> (/.last_index_of' inner 2 full) + (maybe.default fake_index) + (n.= fake_index)) - (|> (/.last-index-of' outer 0 full) - (maybe.default fake-index) + (|> (/.last_index_of' outer 0 full) + (maybe.default fake_index) (n.= 2)) - (|> (/.last-index-of' outer 2 full) - (maybe.default fake-index) + (|> (/.last_index_of' outer 2 full) + (maybe.default fake_index) (n.= 2)) - (|> (/.last-index-of' outer 3 full) - (maybe.default fake-index) - (n.= fake-index))))) + (|> (/.last_index_of' outer 3 full) + (maybe.default fake_index) + (n.= fake_index))))) ))) (def: char Test ($_ _.and - (_.for [/.Char /.from-code] + (_.for [/.Char /.from_code] (`` ($_ _.and (~~ (template [<short> <long>] [(_.cover [<short> <long>] @@ -151,25 +151,25 @@ [/.\0 /.null] [/.\a /.alarm] - [/.\b /.back-space] + [/.\b /.back_space] [/.\t /.tab] - [/.\n /.new-line] - [/.\v /.vertical-tab] - [/.\f /.form-feed] - [/.\r /.carriage-return] - [/.\'' /.double-quote])) - (_.cover [/.line-feed] - (\ /.equivalence = /.new-line /.line-feed)) + [/.\n /.new_line] + [/.\v /.vertical_tab] + [/.\f /.form_feed] + [/.\r /.carriage_return] + [/.\'' /.double_quote])) + (_.cover [/.line_feed] + (\ /.equivalence = /.new_line /.line_feed)) ))) (do {! random.monad} [size (\ ! map (|>> (n.% 10) inc) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) - #let [sample (|> characters set.to-list /.concat)] + #let [sample (|> characters set.to_list /.concat)] expected (\ ! map (n.% size) random.nat)] (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) - (case (/.index-of (/.from-code char) sample) + (case (/.index_of (/.from_code char) sample) (#.Some actual) (n.= expected actual) @@ -183,11 +183,11 @@ [(/.space? (`` (.char (~~ (static <char>)))))] [/.tab] - [/.vertical-tab] + [/.vertical_tab] [/.space] - [/.new-line] - [/.carriage-return] - [/.form-feed] + [/.new_line] + [/.carriage_return] + [/.form_feed] ))))) )) @@ -198,7 +198,7 @@ characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.filter (|>> (set.member? characters) not) (random.ascii/alpha 1)) - #let [with-no-separator (|> characters set.to-list /.concat)] + #let [with_no_separator (|> characters set.to_list /.concat)] static (random.ascii/alpha 1) #let [dynamic (random.filter (|>> (\ /.equivalence = static) not) (random.ascii/alpha 1))] @@ -207,22 +207,22 @@ ($_ _.and (_.cover [/.concat] (n.= (set.size characters) - (/.size (/.concat (set.to-list characters))))) - (_.cover [/.join-with /.split-all-with] - (and (|> (set.to-list characters) - (/.join-with separator) - (/.split-all-with separator) - (set.from-list /.hash) + (/.size (/.concat (set.to_list characters))))) + (_.cover [/.join_with /.split_all_with] + (and (|> (set.to_list characters) + (/.join_with separator) + (/.split_all_with separator) + (set.from_list /.hash) (\ set.equivalence = characters)) (\ /.equivalence = - (/.concat (set.to-list characters)) - (/.join-with "" (set.to-list characters))))) - (_.cover [/.replace-once] + (/.concat (set.to_list characters)) + (/.join_with "" (set.to_list characters))))) + (_.cover [/.replace_once] (\ /.equivalence = (\ /.monoid compose post static) - (/.replace-once pre post (\ /.monoid compose pre static)))) - (_.cover [/.split-with] - (case (/.split-with static ($_ (\ /.monoid compose) pre static post)) + (/.replace_once pre post (\ /.monoid compose pre static)))) + (_.cover [/.split_with] + (case (/.split_with static ($_ (\ /.monoid compose) pre static post)) (#.Some [left right]) (and (\ /.equivalence = pre left) (\ /.equivalence = post right)) @@ -250,8 +250,8 @@ ..manipulation (do random.monad - [sizeL bounded-size - sizeR bounded-size + [sizeL bounded_size + sizeR bounded_size sampleL (random.unicode sizeL) sampleR (random.unicode sizeR) middle (random.unicode 1) @@ -282,23 +282,23 @@ #0))) )) (do {! random.monad} - [sizeP bounded-size - sizeL bounded-size + [sizeP bounded_size + sizeL bounded_size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> random.nat (\ ! map (|>> (n.% 128) (n.max 1))))] - sep1 (random.text normal-char-gen 1) - sep2 (random.text normal-char-gen 1) - #let [part-gen (|> (random.text normal-char-gen sizeP) + normal_char_gen (|> random.nat (\ ! map (|>> (n.% 128) (n.max 1))))] + sep1 (random.text normal_char_gen 1) + sep2 (random.text normal_char_gen 1) + #let [part_gen (|> (random.text normal_char_gen sizeP) (random.filter (|>> (/.contains? sep1) not)))] - parts (random.list sizeL part-gen) + parts (random.list sizeL part_gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) (^open "/\.") /.equivalence]] - (_.cover [/.replace-all] + (_.cover [/.replace_all] (/\= sample2 - (/.replace-all sep1 sep2 sample1)))) + (/.replace_all sep1 sep2 sample1)))) /buffer.test /encoding.test diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index fcf01e93d..2e61159dc 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -23,190 +23,190 @@ {1 ["." /]}) -(with-expansions [<encodings> (as-is [all/a +(with_expansions [<encodings> (as_is [all/a [/.ascii]] [all/ibm<1000 - [/.ibm-37 - /.ibm-273 - /.ibm-277 - /.ibm-278 - /.ibm-280 - /.ibm-284 - /.ibm-285 - /.ibm-290 - /.ibm-297 - /.ibm-300 - /.ibm-420 - /.ibm-424 - /.ibm-437 - /.ibm-500 - /.ibm-737 - /.ibm-775 - /.ibm-833 - /.ibm-834 - /.ibm-838 - /.ibm-850 - /.ibm-852 - /.ibm-855 - /.ibm-856 - /.ibm-857 - /.ibm-858 - /.ibm-860 - /.ibm-861 - /.ibm-862 - /.ibm-863 - /.ibm-864 - /.ibm-865 - /.ibm-866 - /.ibm-868 - /.ibm-869 - /.ibm-870 - /.ibm-871 - /.ibm-874 - /.ibm-875 - /.ibm-918 - /.ibm-921 - /.ibm-922 - /.ibm-930 - /.ibm-933 - /.ibm-935 - /.ibm-937 - /.ibm-939 - /.ibm-942 - /.ibm-942c - /.ibm-943 - /.ibm-943c - /.ibm-948 - /.ibm-949 - /.ibm-949c - /.ibm-950 - /.ibm-964 - /.ibm-970]] + [/.ibm_37 + /.ibm_273 + /.ibm_277 + /.ibm_278 + /.ibm_280 + /.ibm_284 + /.ibm_285 + /.ibm_290 + /.ibm_297 + /.ibm_300 + /.ibm_420 + /.ibm_424 + /.ibm_437 + /.ibm_500 + /.ibm_737 + /.ibm_775 + /.ibm_833 + /.ibm_834 + /.ibm_838 + /.ibm_850 + /.ibm_852 + /.ibm_855 + /.ibm_856 + /.ibm_857 + /.ibm_858 + /.ibm_860 + /.ibm_861 + /.ibm_862 + /.ibm_863 + /.ibm_864 + /.ibm_865 + /.ibm_866 + /.ibm_868 + /.ibm_869 + /.ibm_870 + /.ibm_871 + /.ibm_874 + /.ibm_875 + /.ibm_918 + /.ibm_921 + /.ibm_922 + /.ibm_930 + /.ibm_933 + /.ibm_935 + /.ibm_937 + /.ibm_939 + /.ibm_942 + /.ibm_942c + /.ibm_943 + /.ibm_943c + /.ibm_948 + /.ibm_949 + /.ibm_949c + /.ibm_950 + /.ibm_964 + /.ibm_970]] [all/ibm>1000 - [/.ibm-1006 - /.ibm-1025 - /.ibm-1026 - /.ibm-1046 - /.ibm-1047 - /.ibm-1097 - /.ibm-1098 - /.ibm-1112 - /.ibm-1122 - /.ibm-1123 - /.ibm-1124 - /.ibm-1140 - /.ibm-1141 - /.ibm-1142 - /.ibm-1143 - /.ibm-1144 - /.ibm-1145 - /.ibm-1146 - /.ibm-1147 - /.ibm-1148 - /.ibm-1149 - /.ibm-1166 - /.ibm-1364 - /.ibm-1381 - /.ibm-1383 - /.ibm-33722]] + [/.ibm_1006 + /.ibm_1025 + /.ibm_1026 + /.ibm_1046 + /.ibm_1047 + /.ibm_1097 + /.ibm_1098 + /.ibm_1112 + /.ibm_1122 + /.ibm_1123 + /.ibm_1124 + /.ibm_1140 + /.ibm_1141 + /.ibm_1142 + /.ibm_1143 + /.ibm_1144 + /.ibm_1145 + /.ibm_1146 + /.ibm_1147 + /.ibm_1148 + /.ibm_1149 + /.ibm_1166 + /.ibm_1364 + /.ibm_1381 + /.ibm_1383 + /.ibm_33722]] [all/iso - [/.iso-2022-cn - /.iso2022-cn-cns - /.iso2022-cn-gb - /.iso-2022-jp - /.iso-2022-jp-2 - /.iso-2022-kr - /.iso-8859-1 - /.iso-8859-2 - /.iso-8859-3 - /.iso-8859-4 - /.iso-8859-5 - /.iso-8859-6 - /.iso-8859-7 - /.iso-8859-8 - /.iso-8859-9 - /.iso-8859-11 - /.iso-8859-13 - /.iso-8859-15]] + [/.iso_2022_cn + /.iso2022_cn_cns + /.iso2022_cn_gb + /.iso_2022_jp + /.iso_2022_jp_2 + /.iso_2022_kr + /.iso_8859_1 + /.iso_8859_2 + /.iso_8859_3 + /.iso_8859_4 + /.iso_8859_5 + /.iso_8859_6 + /.iso_8859_7 + /.iso_8859_8 + /.iso_8859_9 + /.iso_8859_11 + /.iso_8859_13 + /.iso_8859_15]] [all/mac - [/.mac-arabic - /.mac-central-europe - /.mac-croatian - /.mac-cyrillic - /.mac-dingbat - /.mac-greek - /.mac-hebrew - /.mac-iceland - /.mac-roman - /.mac-romania - /.mac-symbol - /.mac-thai - /.mac-turkish - /.mac-ukraine]] + [/.mac_arabic + /.mac_central_europe + /.mac_croatian + /.mac_cyrillic + /.mac_dingbat + /.mac_greek + /.mac_hebrew + /.mac_iceland + /.mac_roman + /.mac_romania + /.mac_symbol + /.mac_thai + /.mac_turkish + /.mac_ukraine]] [all/utf - [/.utf-8 - /.utf-16 - /.utf-32]] + [/.utf_8 + /.utf_16 + /.utf_32]] [all/windows - [/.windows-31j - /.windows-874 - /.windows-949 - /.windows-950 - /.windows-1250 - /.windows-1252 - /.windows-1251 - /.windows-1253 - /.windows-1254 - /.windows-1255 - /.windows-1256 - /.windows-1257 - /.windows-1258 - /.windows-iso2022jp - /.windows-50220 - /.windows-50221]] + [/.windows_31j + /.windows_874 + /.windows_949 + /.windows_950 + /.windows_1250 + /.windows_1252 + /.windows_1251 + /.windows_1253 + /.windows_1254 + /.windows_1255 + /.windows_1256 + /.windows_1257 + /.windows_1258 + /.windows_iso2022jp + /.windows_50220 + /.windows_50221]] [all/others - [/.cesu-8 - /.koi8-r - /.koi8-u]] + [/.cesu_8 + /.koi8_r + /.koi8_u]] ) - <named> (template [<definition> <by-letter>] + <named> (template [<definition> <by_letter>] [((: (-> Any (List /.Encoding)) (function (_ _) - (`` (list (~~ (template.splice <by-letter>)))))) + (`` (list (~~ (template.splice <by_letter>)))))) 123)] <encodings>)] - (def: all-encodings + (def: all_encodings (list.concat (list <named>))) - (def: unique-encodings - (set.from-list text.hash (list\map /.name ..all-encodings))) + (def: unique_encodings + (set.from_list text.hash (list\map /.name ..all_encodings))) (def: verdict - (n.= (list.size ..all-encodings) - (set.size ..unique-encodings))) + (n.= (list.size ..all_encodings) + (set.size ..unique_encodings))) - (template [<definition> <by-letter>] + (template [<definition> <by_letter>] [(def: <definition> Test - (`` (_.cover [/.name (~~ (template.splice <by-letter>))] + (`` (_.cover [/.name (~~ (template.splice <by_letter>))] ..verdict)))] <encodings>) (def: #export random (Random /.Encoding) - (let [options (list.size ..all-encodings)] + (let [options (list.size ..all_encodings)] (do {! random.monad} [choice (\ ! map (n.% options) random.nat)] - (wrap (maybe.assume (list.nth choice ..all-encodings)))))) + (wrap (maybe.assume (list.nth choice ..all_encodings)))))) (def: #export test Test @@ -216,7 +216,7 @@ (_.for [/.utf8] ($codec.spec text.equivalence /.utf8 (random.unicode 5))) - (~~ (template [<definition> <by-letter>] + (~~ (template [<definition> <by_letter>] [<definition>] <encodings>)) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index cfad7f524..00df7058a 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -56,7 +56,7 @@ (def: (= reference subject) (text\= (reference example) (subject example)))) -(def: random-contravariant +(def: random_contravariant (Random (Ex [a] [(/.Format a) (Random a)])) ($_ random.either @@ -74,7 +74,7 @@ (`` ($_ _.and (_.for [/.functor] (do random.monad - [[format random] ..random-contravariant + [[format random] ..random_contravariant example random] ($contravariant.spec (..equivalence example) format @@ -149,12 +149,12 @@ (text\= (/.list /.nat members) (|> members (list\map /.nat) - (text.join-with " ") + (text.join_with " ") list (/.list (|>>)))))) (do {! random.monad} [modulus (random.one (|>> modulus.modulus - try.to-maybe) + try.to_maybe) random.int) sample (\ ! map (modular.modular modulus) random.int)] diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index f72c19030..3998f78f7 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -21,7 +21,7 @@ {1 ["." /]}) -(def: (should-pass regex input) +(def: (should_pass regex input) (-> (Parser Text) Text Bit) (|> input (<text>.run regex) @@ -31,7 +31,7 @@ _ #0))) -(def: (text-should-pass test regex input) +(def: (text_should_pass test regex input) (-> Text (Parser Text) Text Bit) (|> input (<text>.run regex) @@ -41,7 +41,7 @@ _ false))) -(def: (should-fail regex input) +(def: (should_fail regex input) (All [a] (-> (Parser a) Text Bit)) (|> input (<text>.run regex) @@ -51,220 +51,220 @@ _ false))) -(syntax: (should-check pattern regex input) - (meta.with-gensyms [g!message g!_] - (wrap (list (` (|> (~ input) - (<text>.run (~ regex)) - (case> (^ (#try.Success (~ pattern))) - true +(syntax: (should_check pattern regex input) + (meta.with_gensyms [g!message g!_] + (wrap (list (` (|> (~ input) + (<text>.run (~ regex)) + (case> (^ (#try.Success (~ pattern))) + true - (~ g!_) - false))))))) + (~ g!_) + false))))))) (def: basics Test (_.test "Can parse character literals." - (and (should-pass (/.regex "a") "a") - (should-fail (/.regex "a") ".") - (should-pass (/.regex "\.") ".") - (should-fail (/.regex "\.") "a")))) + (and (should_pass (/.regex "a") "a") + (should_fail (/.regex "a") ".") + (should_pass (/.regex "\.") ".") + (should_fail (/.regex "\.") "a")))) -(def: system-character-classes +(def: system_character_classes Test ($_ _.and (_.test "Can parse anything." - (should-pass (/.regex ".") "a")) + (should_pass (/.regex ".") "a")) (_.test "Can parse digits." - (and (should-pass (/.regex "\d") "0") - (should-fail (/.regex "\d") "m"))) + (and (should_pass (/.regex "\d") "0") + (should_fail (/.regex "\d") "m"))) (_.test "Can parse non digits." - (and (should-pass (/.regex "\D") "m") - (should-fail (/.regex "\D") "0"))) + (and (should_pass (/.regex "\D") "m") + (should_fail (/.regex "\D") "0"))) (_.test "Can parse white-space." - (and (should-pass (/.regex "\s") " ") - (should-fail (/.regex "\s") "m"))) + (and (should_pass (/.regex "\s") " ") + (should_fail (/.regex "\s") "m"))) (_.test "Can parse non white-space." - (and (should-pass (/.regex "\S") "m") - (should-fail (/.regex "\S") " "))) + (and (should_pass (/.regex "\S") "m") + (should_fail (/.regex "\S") " "))) (_.test "Can parse word characters." - (and (should-pass (/.regex "\w") "_") - (should-fail (/.regex "\w") "^"))) + (and (should_pass (/.regex "\w") "_") + (should_fail (/.regex "\w") "^"))) (_.test "Can parse non word characters." - (and (should-pass (/.regex "\W") ".") - (should-fail (/.regex "\W") "a"))) + (and (should_pass (/.regex "\W") ".") + (should_fail (/.regex "\W") "a"))) )) -(def: special-system-character-classes +(def: special_system_character_classes Test ($_ _.and (_.test "Lower-case." - (and (should-pass (/.regex "\p{Lower}") "m") - (should-fail (/.regex "\p{Lower}") "M"))) + (and (should_pass (/.regex "\p{Lower}") "m") + (should_fail (/.regex "\p{Lower}") "M"))) (_.test "Upper-case." - (and (should-pass (/.regex "\p{Upper}") "M") - (should-fail (/.regex "\p{Upper}") "m"))) + (and (should_pass (/.regex "\p{Upper}") "M") + (should_fail (/.regex "\p{Upper}") "m"))) (_.test "Alphabetic." - (and (should-pass (/.regex "\p{Alpha}") "M") - (should-fail (/.regex "\p{Alpha}") "0"))) + (and (should_pass (/.regex "\p{Alpha}") "M") + (should_fail (/.regex "\p{Alpha}") "0"))) (_.test "Numeric digits." - (and (should-pass (/.regex "\p{Digit}") "1") - (should-fail (/.regex "\p{Digit}") "n"))) + (and (should_pass (/.regex "\p{Digit}") "1") + (should_fail (/.regex "\p{Digit}") "n"))) (_.test "Alphanumeric." - (and (should-pass (/.regex "\p{Alnum}") "1") - (should-fail (/.regex "\p{Alnum}") "."))) + (and (should_pass (/.regex "\p{Alnum}") "1") + (should_fail (/.regex "\p{Alnum}") "."))) (_.test "Whitespace." - (and (should-pass (/.regex "\p{Space}") " ") - (should-fail (/.regex "\p{Space}") "."))) + (and (should_pass (/.regex "\p{Space}") " ") + (should_fail (/.regex "\p{Space}") "."))) (_.test "Hexadecimal." - (and (should-pass (/.regex "\p{HexDigit}") "a") - (should-fail (/.regex "\p{HexDigit}") "."))) + (and (should_pass (/.regex "\p{HexDigit}") "a") + (should_fail (/.regex "\p{HexDigit}") "."))) (_.test "Octal." - (and (should-pass (/.regex "\p{OctDigit}") "6") - (should-fail (/.regex "\p{OctDigit}") "."))) + (and (should_pass (/.regex "\p{OctDigit}") "6") + (should_fail (/.regex "\p{OctDigit}") "."))) (_.test "Blank." - (and (should-pass (/.regex "\p{Blank}") text.tab) - (should-fail (/.regex "\p{Blank}") "."))) + (and (should_pass (/.regex "\p{Blank}") text.tab) + (should_fail (/.regex "\p{Blank}") "."))) (_.test "ASCII." - (and (should-pass (/.regex "\p{ASCII}") text.tab) - (should-fail (/.regex "\p{ASCII}") (text.from-code (hex "1234"))))) + (and (should_pass (/.regex "\p{ASCII}") text.tab) + (should_fail (/.regex "\p{ASCII}") (text.from_code (hex "1234"))))) (_.test "Control characters." - (and (should-pass (/.regex "\p{Contrl}") (text.from-code (hex "12"))) - (should-fail (/.regex "\p{Contrl}") "a"))) + (and (should_pass (/.regex "\p{Contrl}") (text.from_code (hex "12"))) + (should_fail (/.regex "\p{Contrl}") "a"))) (_.test "Punctuation." - (and (should-pass (/.regex "\p{Punct}") "@") - (should-fail (/.regex "\p{Punct}") "a"))) + (and (should_pass (/.regex "\p{Punct}") "@") + (should_fail (/.regex "\p{Punct}") "a"))) (_.test "Graph." - (and (should-pass (/.regex "\p{Graph}") "@") - (should-fail (/.regex "\p{Graph}") " "))) + (and (should_pass (/.regex "\p{Graph}") "@") + (should_fail (/.regex "\p{Graph}") " "))) (_.test "Print." - (and (should-pass (/.regex "\p{Print}") (text.from-code (hex "20"))) - (should-fail (/.regex "\p{Print}") (text.from-code (hex "1234"))))) + (and (should_pass (/.regex "\p{Print}") (text.from_code (hex "20"))) + (should_fail (/.regex "\p{Print}") (text.from_code (hex "1234"))))) )) -(def: custom-character-classes +(def: custom_character_classes Test ($_ _.and (_.test "Can parse using custom character classes." - (and (should-pass (/.regex "[abc]") "a") - (should-fail (/.regex "[abc]") "m"))) + (and (should_pass (/.regex "[abc]") "a") + (should_fail (/.regex "[abc]") "m"))) (_.test "Can parse using character ranges." - (and (should-pass (/.regex "[a-z]") "a") - (should-pass (/.regex "[a-z]") "m") - (should-pass (/.regex "[a-z]") "z"))) + (and (should_pass (/.regex "[a-z]") "a") + (should_pass (/.regex "[a-z]") "m") + (should_pass (/.regex "[a-z]") "z"))) (_.test "Can combine character ranges." - (and (should-pass (/.regex "[a-zA-Z]") "a") - (should-pass (/.regex "[a-zA-Z]") "m") - (should-pass (/.regex "[a-zA-Z]") "z") - (should-pass (/.regex "[a-zA-Z]") "A") - (should-pass (/.regex "[a-zA-Z]") "M") - (should-pass (/.regex "[a-zA-Z]") "Z"))) + (and (should_pass (/.regex "[a-zA-Z]") "a") + (should_pass (/.regex "[a-zA-Z]") "m") + (should_pass (/.regex "[a-zA-Z]") "z") + (should_pass (/.regex "[a-zA-Z]") "A") + (should_pass (/.regex "[a-zA-Z]") "M") + (should_pass (/.regex "[a-zA-Z]") "Z"))) (_.test "Can negate custom character classes." - (and (should-fail (/.regex "[^abc]") "a") - (should-pass (/.regex "[^abc]") "m"))) + (and (should_fail (/.regex "[^abc]") "a") + (should_pass (/.regex "[^abc]") "m"))) (_.test "Can negate character ranges.." - (and (should-fail (/.regex "[^a-z]") "a") - (should-pass (/.regex "[^a-z]") "0"))) + (and (should_fail (/.regex "[^a-z]") "a") + (should_pass (/.regex "[^a-z]") "0"))) (_.test "Can parse negate combinations of character ranges." - (and (should-fail (/.regex "[^a-zA-Z]") "a") - (should-pass (/.regex "[^a-zA-Z]") "0"))) + (and (should_fail (/.regex "[^a-zA-Z]") "a") + (should_pass (/.regex "[^a-zA-Z]") "0"))) (_.test "Can make custom character classes more specific." (and (let [RE (/.regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) + (and (should_fail RE "a") + (should_pass RE "d"))) (let [RE (/.regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) + (and (should_pass RE "a") + (should_fail RE "b"))) (let [RE (/.regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) + (and (should_pass RE "a") + (should_fail RE "m") + (should_fail RE "p"))))) )) (def: references Test (let [number (/.regex "\d+")] (_.test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] + (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) -(def: fuzzy-quantifiers +(def: fuzzy_quantifiers Test ($_ _.and (_.test "Can sequentially combine patterns." - (text-should-pass "aa" (/.regex "aa") "aa")) + (text_should_pass "aa" (/.regex "aa") "aa")) (_.test "Can match patterns optionally." - (and (text-should-pass "a" (/.regex "a?") "a") - (text-should-pass "" (/.regex "a?") ""))) + (and (text_should_pass "a" (/.regex "a?") "a") + (text_should_pass "" (/.regex "a?") ""))) (_.test "Can match a pattern 0 or more times." - (and (text-should-pass "aaa" (/.regex "a*") "aaa") - (text-should-pass "" (/.regex "a*") ""))) + (and (text_should_pass "aaa" (/.regex "a*") "aaa") + (text_should_pass "" (/.regex "a*") ""))) (_.test "Can match a pattern 1 or more times." - (and (text-should-pass "aaa" (/.regex "a+") "aaa") - (text-should-pass "a" (/.regex "a+") "a") - (should-fail (/.regex "a+") ""))) + (and (text_should_pass "aaa" (/.regex "a+") "aaa") + (text_should_pass "a" (/.regex "a+") "a") + (should_fail (/.regex "a+") ""))) )) -(def: crisp-quantifiers +(def: crisp_quantifiers Test ($_ _.and (_.test "Can match a pattern N times." - (and (text-should-pass "aa" (/.regex "a{2}") "aa") - (text-should-pass "a" (/.regex "a{1}") "a") - (should-fail (/.regex "a{3}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{2}") "aa") + (text_should_pass "a" (/.regex "a{1}") "a") + (should_fail (/.regex "a{3}") "aa"))) (_.test "Can match a pattern at-least N times." - (and (text-should-pass "aa" (/.regex "a{1,}") "aa") - (text-should-pass "aa" (/.regex "a{2,}") "aa") - (should-fail (/.regex "a{3,}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{1,}") "aa") + (text_should_pass "aa" (/.regex "a{2,}") "aa") + (should_fail (/.regex "a{3,}") "aa"))) (_.test "Can match a pattern at-most N times." - (and (text-should-pass "aa" (/.regex "a{,2}") "aa") - (text-should-pass "aa" (/.regex "a{,3}") "aa"))) + (and (text_should_pass "aa" (/.regex "a{,2}") "aa") + (text_should_pass "aa" (/.regex "a{,3}") "aa"))) (_.test "Can match a pattern between N and M times." - (and (text-should-pass "a" (/.regex "a{1,2}") "a") - (text-should-pass "aa" (/.regex "a{1,2}") "aa"))) + (and (text_should_pass "a" (/.regex "a{1,2}") "a") + (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) )) (def: groups Test ($_ _.and (_.test "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (/.regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) + (and (should_check ["abc" "b"] (/.regex "a(.)c") "abc") + (should_check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") + (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") + (should_check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) (_.test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) + (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) (def: alternation Test ($_ _.and (_.test "Can specify alternative patterns." - (and (should-check ["a" (0 #0 [])] (/.regex "a|b") "a") - (should-check ["b" (0 #1 [])] (/.regex "a|b") "b") - (should-fail (/.regex "a|b") "c"))) + (and (should_check ["a" (0 #0 [])] (/.regex "a|b") "a") + (should_check ["b" (0 #1 [])] (/.regex "a|b") "b") + (should_fail (/.regex "a|b") "c"))) (_.test "Can have groups within alternations." - (and (should-check ["abc" (0 #0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (0 #1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (/.regex "a(.)(.)|b(.)(.)") "cde") + (and (should_check ["abc" (0 #0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc") + (should_check ["bcd" (0 #1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd") + (should_fail (/.regex "a(.)(.)|b(.)(.)") "cde") - (should-check ["123-456-7890" (0 #0 ["123" "456-7890" "456" "7890"])] + (should_check ["123-456-7890" (0 #0 ["123" "456-7890" "456" "7890"])] (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "123-456-7890"))) )) @@ -276,12 +276,12 @@ (_.for [/.regex] ($_ _.and ..basics - ..system-character-classes - ..special-system-character-classes - ..custom-character-classes + ..system_character_classes + ..special_system_character_classes + ..custom_character_classes ..references - ..fuzzy-quantifiers - ..crisp-quantifiers + ..fuzzy_quantifiers + ..crisp_quantifiers ..groups ..alternation )) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index eb55617ca..a575b4fc6 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -29,17 +29,17 @@ end random.nat] (wrap (/.block start end)))) -(with-expansions [<blocks> (as-is [blocks/0 - [/.basic-latin - /.latin-1-supplement - /.latin-extended-a - /.latin-extended-b - /.ipa-extensions - /.spacing-modifier-letters - /.combining-diacritical-marks - /.greek-and-coptic +(with_expansions [<blocks> (as_is [blocks/0 + [/.basic_latin + /.latin_1_supplement + /.latin_extended_a + /.latin_extended_b + /.ipa_extensions + /.spacing_modifier_letters + /.combining_diacritical_marks + /.greek_and_coptic /.cyrillic - /.cyrillic-supplementary + /.cyrillic_supplementary /.armenian /.hebrew /.arabic @@ -60,10 +60,10 @@ /.tibetan /.myanmar /.georgian - /.hangul-jamo + /.hangul_jamo /.ethiopic /.cherokee - /.unified-canadian-aboriginal-syllabics + /.unified_canadian_aboriginal_syllabics /.ogham /.runic /.tagalog @@ -74,74 +74,74 @@ /.mongolian]] [blocks/1 [/.limbu - /.tai-le - /.khmer-symbols - /.phonetic-extensions - /.latin-extended-additional - /.greek-extended - /.general-punctuation - /.superscripts-and-subscripts - /.currency-symbols - /.combining-diacritical-marks-for-symbols - /.letterlike-symbols - /.number-forms + /.tai_le + /.khmer_symbols + /.phonetic_extensions + /.latin_extended_additional + /.greek_extended + /.general_punctuation + /.superscripts_and_subscripts + /.currency_symbols + /.combining_diacritical_marks_for_symbols + /.letterlike_symbols + /.number_forms /.arrows - /.mathematical-operators - /.miscellaneous-technical - /.control-pictures - /.optical-character-recognition - /.enclosed-alphanumerics - /.box-drawing - /.block-elements - /.geometric-shapes - /.miscellaneous-symbols + /.mathematical_operators + /.miscellaneous_technical + /.control_pictures + /.optical_character_recognition + /.enclosed_alphanumerics + /.box_drawing + /.block_elements + /.geometric_shapes + /.miscellaneous_symbols /.dingbats - /.miscellaneous-mathematical-symbols-a - /.supplemental-arrows-a - /.braille-patterns - /.supplemental-arrows-b - /.miscellaneous-mathematical-symbols-b - /.supplemental-mathematical-operators - /.miscellaneous-symbols-and-arrows - /.cjk-radicals-supplement - /.kangxi-radicals - /.ideographic-description-characters - /.cjk-symbols-and-punctuation + /.miscellaneous_mathematical_symbols_a + /.supplemental_arrows_a + /.braille_patterns + /.supplemental_arrows_b + /.miscellaneous_mathematical_symbols_b + /.supplemental_mathematical_operators + /.miscellaneous_symbols_and_arrows + /.cjk_radicals_supplement + /.kangxi_radicals + /.ideographic_description_characters + /.cjk_symbols_and_punctuation /.hiragana /.katakana /.bopomofo - /.hangul-compatibility-jamo + /.hangul_compatibility_jamo /.kanbun - /.bopomofo-extended - /.katakana-phonetic-extensions - /.enclosed-cjk-letters-and-months - /.cjk-compatibility - /.cjk-unified-ideographs-extension-a - /.yijing-hexagram-symbols - /.cjk-unified-ideographs - /.yi-syllables - /.yi-radicals - /.hangul-syllables - /.high-surrogates - /.high-private-use-surrogates - /.low-surrogates - /.private-use-area - /.cjk-compatibility-ideographs - /.alphabetic-presentation-forms]] + /.bopomofo_extended + /.katakana_phonetic_extensions + /.enclosed_cjk_letters_and_months + /.cjk_compatibility + /.cjk_unified_ideographs_extension_a + /.yijing_hexagram_symbols + /.cjk_unified_ideographs + /.yi_syllables + /.yi_radicals + /.hangul_syllables + /.high_surrogates + /.high_private_use_surrogates + /.low_surrogates + /.private_use_area + /.cjk_compatibility_ideographs + /.alphabetic_presentation_forms]] [blocks/2 - [/.arabic-presentation-forms-a - /.variation-selectors - /.combining-half-marks - /.cjk-compatibility-forms - /.small-form-variants - /.arabic-presentation-forms-b - /.halfwidth-and-fullwidth-forms + [/.arabic_presentation_forms_a + /.variation_selectors + /.combining_half_marks + /.cjk_compatibility_forms + /.small_form_variants + /.arabic_presentation_forms_b + /.halfwidth_and_fullwidth_forms /.specials ## Specialized blocks - /.basic-latin/decimal - /.basic-latin/upper-alpha - /.basic-latin/lower-alpha]] + /.basic_latin/decimal + /.basic_latin/upper_alpha + /.basic_latin/lower_alpha]] ) <named> (template [<definition> <part>] [((: (-> Any (List /.Block)) @@ -155,7 +155,7 @@ Test (`` (_.cover [(~~ (template.splice <part>))] (let [all (list.concat (list <named>)) - unique (set.from-list /.hash all)] + unique (set.from_list /.hash all)] (n.= (list.size all) (set.size unique))))))] @@ -167,10 +167,10 @@ (<| (_.covering /._) (_.for [/.Block]) (do {! random.monad} - [#let [top-start (hex "AC00") - top-end (hex "D7AF")] - start (\ ! map (|>> (n.% top-start) inc) random.nat) - end (\ ! map (|>> (n.% top-end) inc) random.nat) + [#let [top_start (hex "AC00") + top_end (hex "D7AF")] + start (\ ! map (|>> (n.% top_start) inc) random.nat) + end (\ ! map (|>> (n.% top_end) inc) random.nat) #let [sample (/.block start end) size (/.size sample)] inside (\ ! map diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 16e29d368..e32c08bfd 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -83,11 +83,11 @@ [/.ascii] [/.ascii/alpha] - [/.ascii/alpha-num] - [/.ascii/lower-alpha] - [/.ascii/upper-alpha] + [/.ascii/alpha_num] + [/.ascii/lower_alpha] + [/.ascii/upper_alpha] [/.character] - [/.non-character] + [/.non_character] [/.full] )) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index f5ba58758..9e8699c55 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -31,30 +31,30 @@ {1 ["." / (#+ analysis: synthesis: generation: directive:)]}) -(def: my-analysis "my analysis") -(def: my-synthesis "my synthesis") -(def: my-generation "my generation") -(def: my-directive "my directive") +(def: my_analysis "my analysis") +(def: my_synthesis "my synthesis") +(def: my_generation "my generation") +(def: my_directive "my directive") ## Generation (for {@.old - (as-is)} + (as_is)} - (as-is (analysis: (..my-generation self phase archive {parameters (<>.some <c>.any)}) + (as_is (analysis: (..my_generation self phase archive {parameters (<>.some <c>.any)}) (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) - (synthesis: (..my-generation self phase archive {parameters (<>.some <a>.any)}) + (synthesis: (..my_generation self phase archive {parameters (<>.some <a>.any)}) (do phase.monad [] (wrap (#synthesis.Extension self (list))))) )) (for {@.old - (as-is)} + (as_is)} - (generation: (..my-generation self phase archive {parameters (<>.some <s>.any)}) + (generation: (..my_generation self phase archive {parameters (<>.some <s>.any)}) (do phase.monad [] (wrap (for {@.jvm @@ -64,31 +64,31 @@ (js.string self)}))))) (for {@.old - (as-is)} + (as_is)} - (as-is (analysis: (..my-analysis self phase archive {parameters (<>.some <c>.any)}) + (as_is (analysis: (..my_analysis self phase archive {parameters (<>.some <c>.any)}) (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Primitive (#analysis.Text self))))) ## Synthesis - (analysis: (..my-synthesis self phase archive {parameters (<>.some <c>.any)}) + (analysis: (..my_synthesis self phase archive {parameters (<>.some <c>.any)}) (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) - (synthesis: (..my-synthesis self phase archive {parameters (<>.some <a>.any)}) + (synthesis: (..my_synthesis self phase archive {parameters (<>.some <a>.any)}) (do phase.monad [] (wrap (synthesis.text self)))) ## Directive - (directive: (..my-directive self phase archive {parameters (<>.some <c>.any)}) + (directive: (..my_directive self phase archive {parameters (<>.some <c>.any)}) (do phase.monad [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] - (wrap directive.no-requirements))) + (wrap directive.no_requirements))) - (`` ((~~ (static ..my-directive)))) + (`` ((~~ (static ..my_directive)))) )) (def: #export test @@ -102,9 +102,9 @@ (text\= (`` ((~~ (static <extension>)))) <extension>)))] - [/.analysis: ..my-analysis] - [/.synthesis: ..my-synthesis] - [/.generation: ..my-generation])) + [/.analysis: ..my_analysis] + [/.synthesis: ..my_synthesis] + [/.generation: ..my_generation])) (_.cover [/.directive:] true) )))) diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index 179a8a3b7..c18ef1f1e 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -53,13 +53,13 @@ (java/lang/Runnable [] (run self) void [])) -(def: test-runnable +(def: test_runnable (object [] [java/lang/Runnable] [] (java/lang/Runnable [] (run self) void []))) -(def: test-callable +(def: test_callable (object [a] [(java/util/concurrent/Callable a)] [] (java/util/concurrent/Callable [] (call self) a @@ -76,15 +76,15 @@ (~~ (template [<to> <from> <message>] [(_.test <message> (or (|> sample <to> <from> (i.= sample)) - (let [capped-sample (|> sample <to> <from>)] - (|> capped-sample <to> <from> (i.= capped-sample)))))] - - [/.long-to-byte /.byte-to-long "Can succesfully convert to/from byte."] - [/.long-to-short /.short-to-long "Can succesfully convert to/from short."] - [/.long-to-int /.int-to-long "Can succesfully convert to/from int."] - [/.long-to-float /.float-to-long "Can succesfully convert to/from float."] - [/.long-to-double /.double-to-long "Can succesfully convert to/from double."] - [(<| /.int-to-char /.long-to-int) (<| /.int-to-long /.char-to-int) "Can succesfully convert to/from char."] + (let [capped_sample (|> sample <to> <from>)] + (|> capped_sample <to> <from> (i.= capped_sample)))))] + + [/.long_to_byte /.byte_to_long "Can succesfully convert to/from byte."] + [/.long_to_short /.short_to_long "Can succesfully convert to/from short."] + [/.long_to_int /.int_to_long "Can succesfully convert to/from int."] + [/.long_to_float /.float_to_long "Can succesfully convert to/from float."] + [/.long_to_double /.double_to_long "Can succesfully convert to/from double."] + [(<| /.int_to_char /.long_to_int) (<| /.int_to_long /.char_to_int) "Can succesfully convert to/from char."] )) )))) @@ -103,7 +103,7 @@ (/.synchronized sample #1)) (_.test "Can access Class instances." - (text\= "java.lang.Class" (java/lang/Class::getName (/.class-for java/lang/Class)))) + (text\= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class)))) (_.test "Can check if a value is null." (and (/.null? (/.null)) @@ -126,12 +126,12 @@ value r.int] ($_ _.and (_.test "Can create arrays of some length." - (n.= size (/.array-length (/.array java/lang/Long size)))) + (n.= size (/.array_length (/.array java/lang/Long size)))) (_.test "Can set and get array values." (let [arr (/.array java/lang/Long size)] - (exec (/.array-write idx value arr) - (i.= value (/.array-read idx arr))))) + (exec (/.array_write idx value arr) + (i.= value (/.array_read idx arr))))) ))) (def: #export test diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index b494779d3..5693eb2c4 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -21,27 +21,27 @@ ["." language (#+ Language)] ["." territory (#+ Territory)]]}) -(def: random-language +(def: random_language (Random Language) (random.either (random\wrap language.afar) (random\wrap language.zaza))) -(def: random-territory +(def: random_territory (Random Territory) (random.either (random\wrap territory.afghanistan) (random\wrap territory.zimbabwe))) -(def: random-encoding +(def: random_encoding (Random Encoding) (random.either (random\wrap encoding.ascii) - (random\wrap encoding.koi8-u))) + (random\wrap encoding.koi8_u))) -(def: random-locale +(def: random_locale (Random /.Locale) (do random.monad - [language ..random-language - territory ..random-territory - encoding ..random-encoding] + [language ..random_language + territory ..random_territory + encoding ..random_encoding] (wrap (/.locale language (#.Some territory) (#.Some encoding))))) (def: #export test @@ -50,28 +50,28 @@ (_.for [/.Locale]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random-locale)) + ($equivalence.spec /.equivalence ..random_locale)) (do random.monad - [language ..random-language - territory ..random-territory - encoding ..random-encoding - #let [l-locale (/.locale language #.None #.None) - lt-locale (/.locale language (#.Some territory) #.None) - le-locale (/.locale language #.None (#.Some encoding)) - lte-locale (/.locale language (#.Some territory) (#.Some encoding))] - #let [language-check (and (text\= (language.code language) - (/.code l-locale)) - (list.every? (|>> /.code (text.starts-with? (language.code language))) - (list lt-locale le-locale lte-locale))) - territory-check (list.every? (|>> /.code (text.contains? (territory.long-code territory))) - (list lt-locale lte-locale)) - encoding-check (list.every? (|>> /.code (text.ends-with? (encoding.name encoding))) - (list le-locale lte-locale))]] + [language ..random_language + territory ..random_territory + encoding ..random_encoding + #let [l_locale (/.locale language #.None #.None) + lt_locale (/.locale language (#.Some territory) #.None) + le_locale (/.locale language #.None (#.Some encoding)) + lte_locale (/.locale language (#.Some territory) (#.Some encoding))] + #let [language_check (and (text\= (language.code language) + (/.code l_locale)) + (list.every? (|>> /.code (text.starts_with? (language.code language))) + (list lt_locale le_locale lte_locale))) + territory_check (list.every? (|>> /.code (text.contains? (territory.long_code territory))) + (list lt_locale lte_locale)) + encoding_check (list.every? (|>> /.code (text.ends_with? (encoding.name encoding))) + (list le_locale lte_locale))]] (_.cover [/.locale /.code] - (and language-check - territory-check - encoding-check))) + (and language_check + territory_check + encoding_check))) /language.test /territory.test diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index fb31baa0e..6423b7627 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -36,17 +36,17 @@ languages (: (List /.Language) (`` (list (~~ (template.splice <languages>)))))] {#count count - #names (|> languages (list\map /.name) (set.from-list text.hash)) - #codes (|> languages (list\map /.code) (set.from-list text.hash)) - #languages (set.from-list /.hash languages) + #names (|> languages (list\map /.name) (set.from_list text.hash)) + #codes (|> languages (list\map /.code) (set.from_list text.hash)) + #languages (set.from_list /.hash languages) #test (_.cover <languages> true)}))] [languages/a [/.afar /.abkhazian /.achinese /.acoli /.adangme - /.adyghe /.afro-asiatic /.afrihili /.afrikaans /.ainu - /.akan /.akkadian /.aleut /.algonquian /.southern-altai - /.amharic /.old-english /.angika /.apache /.arabic - /.official-aramaic /.aragonese /.mapudungun /.arapaho /.artificial + /.adyghe /.afro_asiatic /.afrihili /.afrikaans /.ainu + /.akan /.akkadian /.aleut /.algonquian /.southern_altai + /.amharic /.old_english /.angika /.apache /.arabic + /.official_aramaic /.aragonese /.mapudungun /.arapaho /.artificial /.arawak /.assamese /.asturian /.athapascan /.australian /.avaric /.avestan /.awadhi /.aymara /.azerbaijani]] [languages/b [/.banda /.bamileke /.bashkir /.baluchi /.bambara @@ -55,87 +55,87 @@ /.bikol /.bini /.bislama /.siksika /.bantu /.tibetan /.bosnian /.braj /.breton /.batak /.buriat /.buginese /.bulgarian /.blin]] - [languages/c [/.caddo /.central-american-indian /.galibi-carib /.catalan /.caucasian + [languages/c [/.caddo /.central_american_indian /.galibi_carib /.catalan /.caucasian /.cebuano /.celtic /.czech /.chamorro /.chibcha /.chechen /.chagatai /.chuukese /.mari /.chinook - /.choctaw /.chipewyan /.cherokee /.church-slavic /.chuvash + /.choctaw /.chipewyan /.cherokee /.church_slavic /.chuvash /.cheyenne /.chamic /.montenegrin /.coptic /.cornish - /.corsican /.creoles-and-pidgins/english /.creoles-and-pidgins/french /.creoles-and-pidgins/portuguese /.cree - /.crimean /.creoles-and-pidgins /.kashubian /.cushitic /.welsh]] - [languages/d [/.dakota /.danish /.dargwa /.land-dayak /.delaware + /.corsican /.creoles_and_pidgins/english /.creoles_and_pidgins/french /.creoles_and_pidgins/portuguese /.cree + /.crimean /.creoles_and_pidgins /.kashubian /.cushitic /.welsh]] + [languages/d [/.dakota /.danish /.dargwa /.land_dayak /.delaware /.slavey /.dogrib /.dinka /.dhivehi /.dogri - /.dravidian /.lower-sorbian /.duala /.middle-dutch /.dyula + /.dravidian /.lower_sorbian /.duala /.middle_dutch /.dyula /.dzongkha]] [languages/e [/.efik /.egyptian /.ekajuk /.greek /.elamite - /.english /.middle-english /.esperanto /.estonian /.basque + /.english /.middle_english /.esperanto /.estonian /.basque /.ewe /.ewondo]] [languages/f [/.fang /.faroese /.persian /.fanti /.fijian - /.filipino /.finnish /.finno-ugrian /.fon /.french - /.middle-french /.old-french /.northern-frisian /.eastern-frisian /.western-frisian + /.filipino /.finnish /.finno_ugrian /.fon /.french + /.middle_french /.old_french /.northern_frisian /.eastern_frisian /.western_frisian /.fulah /.friulian]] [languages/g [/.ga /.gayo /.gbaya /.germanic /.german /.geez /.gilbertese /.gaelic /.irish /.galician - /.manx /.middle-high-german /.old-high-german /.gondi /.gorontalo - /.gothic /.grebo /.ancient-greek /.guarani /.swiss-german + /.manx /.middle_high_german /.old_high_german /.gondi /.gorontalo + /.gothic /.grebo /.ancient_greek /.guarani /.swiss_german /.gujarati /.gwich'in]] [languages/h [/.haida /.haitian /.hausa /.hawaiian /.hebrew /.herero /.hiligaynon /.himachali /.hindi /.hittite - /.hmong /.hiri-motu /.croatian /.upper-sorbian /.hungarian + /.hmong /.hiri_motu /.croatian /.upper_sorbian /.hungarian /.hupa /.armenian]] - [languages/i [/.iban /.igbo /.ido /.sichuan-yi /.ijo + [languages/i [/.iban /.igbo /.ido /.sichuan_yi /.ijo /.inuktitut /.interlingue /.iloko /.interlingua /.indic - /.indonesian /.indo-european /.ingush /.inupiaq /.iranian + /.indonesian /.indo_european /.ingush /.inupiaq /.iranian /.iroquoian /.icelandic /.italian]] - [languages/j [/.javanese /.lojban /.japanese /.judeo-persian /.judeo-arabic]] - [languages/k [/.kara-kalpak /.kabyle /.kachin /.kalaallisut /.kamba + [languages/j [/.javanese /.lojban /.japanese /.judeo_persian /.judeo_arabic]] + [languages/k [/.kara_kalpak /.kabyle /.kachin /.kalaallisut /.kamba /.kannada /.karen /.kashmiri /.georgian /.kanuri /.kawi /.kazakh /.kabardian /.khasi /.khoisan - /.central-khmer /.khotanese /.gikuyu /.kinyarwanda /.kyrgyz + /.central_khmer /.khotanese /.gikuyu /.kinyarwanda /.kyrgyz /.kimbundu /.konkani /.komi /.kongo /.korean - /.kosraean /.kpelle /.karachay-balkar /.karelian /.kru + /.kosraean /.kpelle /.karachay_balkar /.karelian /.kru /.kurukh /.kwanyama /.kumyk /.kurdish /.kutenai]] [languages/l [/.ladino /.lahnda /.lamba /.lao /.latin /.latvian /.lezghian /.limburgan /.lingala /.lithuanian - /.mongo /.lozi /.luxembourgish /.luba-lulua /.luba-katanga + /.mongo /.lozi /.luxembourgish /.luba_lulua /.luba_katanga /.ganda /.luiseno /.lunda /.luo /.lushai]] [languages/m [/.madurese /.magahi /.marshallese /.maithili /.makasar /.malayalam /.mandingo /.austronesian /.marathi /.masai - /.moksha /.mandar /.mende /.middle-irish /.mi'kmaq - /.minangkabau /.macedonian /.mon-khmer /.malagasy /.maltese + /.moksha /.mandar /.mende /.middle_irish /.mi'kmaq + /.minangkabau /.macedonian /.mon_khmer /.malagasy /.maltese /.manchu /.manipuri /.manobo /.mohawk /.mongolian /.mossi /.maori /.malay /.munda /.creek /.mirandese /.marwari /.burmese /.mayan /.erzya]] - [languages/n [/.nahuatl /.north-american-indian /.neapolitan /.nauru /.navajo - /.south-ndebele /.north-ndebele /.ndonga /.low-german /.nepali - /.newari /.nias /.niger-kordofanian /.niuean /.dutch - /.nynorsk /.bokmal /.nogai /.old-norse /.norwegian - /.n'ko /.northern-sotho /.nubian /.old-newari /.nyanja + [languages/n [/.nahuatl /.north_american_indian /.neapolitan /.nauru /.navajo + /.south_ndebele /.north_ndebele /.ndonga /.low_german /.nepali + /.newari /.nias /.niger_kordofanian /.niuean /.dutch + /.nynorsk /.bokmal /.nogai /.old_norse /.norwegian + /.n'ko /.northern_sotho /.nubian /.old_newari /.nyanja /.nyamwezi /.nyankole /.nyoro /.nzima]] [languages/o [/.occitan /.ojibwa /.oriya /.oromo /.osage - /.ossetic /.ottoman-turkish /.otomian]] + /.ossetic /.ottoman_turkish /.otomian]] [languages/p [/.papuan /.pangasinan /.pahlavi /.pampanga /.punjabi - /.papiamento /.palauan /.old-persian /.philippine /.phoenician + /.papiamento /.palauan /.old_persian /.philippine /.phoenician /.pali /.polish /.pohnpeian /.portuguese /.prakrit - /.old-provencal /.pashto]] + /.old_provencal /.pashto]] [languages/q [/.quechua]] [languages/r [/.rajasthani /.rapanui /.rarotongan /.romance /.romansh /.romany /.romanian /.rundi /.aromanian /.russian]] - [languages/s [/.sandawe /.sango /.yakut /.south-american-indian /.salishan - /.samaritan-aramaic /.sanskrit /.sasak /.santali /.sicilian - /.scots /.selkup /.semitic /.old-irish /.sign - /.shan /.sidamo /.sinhalese /.siouan /.sino-tibetan - /.slavic /.slovak /.slovenian /.southern-sami /.northern-sami - /.sami /.lule /.inari /.samoan /.skolt-sami + [languages/s [/.sandawe /.sango /.yakut /.south_american_indian /.salishan + /.samaritan_aramaic /.sanskrit /.sasak /.santali /.sicilian + /.scots /.selkup /.semitic /.old_irish /.sign + /.shan /.sidamo /.sinhalese /.siouan /.sino_tibetan + /.slavic /.slovak /.slovenian /.southern_sami /.northern_sami + /.sami /.lule /.inari /.samoan /.skolt_sami /.shona /.sindhi /.soninke /.sogdian /.somali - /.songhai /.southern-sotho /.spanish /.albanian /.sardinian - /.sranan-tongo /.serbian /.serer /.nilo-saharan /.swati + /.songhai /.southern_sotho /.spanish /.albanian /.sardinian + /.sranan_tongo /.serbian /.serer /.nilo_saharan /.swati /.sukuma /.sundanese /.susu /.sumerian /.swahili - /.swedish /.classical-syriac /.syriac]] + /.swedish /.classical_syriac /.syriac]] [languages/t [/.tahitian /.tai /.tamil /.tatar /.telugu /.timne /.tereno /.tetum /.tajik /.tagalog /.thai /.tigre /.tigrinya /.tiv /.tokelau /.klingon /.tlingit /.tamashek /.tonga /.tongan - /.tok-pisin /.tsimshian /.tswana /.tsonga /.turkmen + /.tok_pisin /.tsimshian /.tswana /.tsonga /.turkmen /.tumbuka /.tupi /.turkish /.altaic /.tuvalu /.twi /.tuvinian]] [languages/u [/.udmurt /.ugaritic /.uyghur /.ukrainian /.umbundu @@ -145,9 +145,9 @@ /.walloon /.wolof]] [languages/x [/.kalmyk /.xhosa]] [languages/y [/.yao /.yapese /.yiddish /.yoruba /.yupik]] - [languages/z [/.zapotec /.blissymbols /.zenaga /.standard-moroccan-tamazight /.zhuang + [languages/z [/.zapotec /.blissymbols /.zenaga /.standard_moroccan_tamazight /.zhuang /.chinese /.zande /.zulu /.zuni /.zaza]] - [languages/etc [/.uncoded /.multiple /.undetermined /.not-applicable]] + [languages/etc [/.uncoded /.multiple /.undetermined /.not_applicable]] ) (def: languages @@ -191,7 +191,7 @@ [0 (set.new hash)] territories)) -(def: languages-test +(def: languages_test Test (|> ..languages list.reverse @@ -214,24 +214,24 @@ (list.every? (\ /.equivalence = <reference>) (`` (list (~~ (template.splice <aliases>))))))) -(def: aliases-test +(def: aliases_test Test ($_ _.and ## A - (!aliases /.official-aramaic [/.imperial-aramaic]) + (!aliases /.official_aramaic [/.imperial_aramaic]) (!aliases /.asturian [/.bable /.leonese /.asturleonese]) ## B (!aliases /.bini [/.edo]) (!aliases /.blin [/.bilin]) ## C (!aliases /.catalan [/.valencian]) - (!aliases /.church-slavic [/.old-slavonic /.church-slavonic /.old-bulgarian /.old-church-slavonic]) + (!aliases /.church_slavic [/.old_slavonic /.church_slavonic /.old_bulgarian /.old_church_slavonic]) ## D (!aliases /.dhivehi [/.maldivian]) ## G - (!aliases /.swiss-german [/.alemannic /.alsatian]) + (!aliases /.swiss_german [/.alemannic /.alsatian]) ## I - (!aliases /.sichuan-yi [/.nuosu]) + (!aliases /.sichuan_yi [/.nuosu]) ## K (!aliases /.kachin [/.jingpho]) (!aliases /.kalaallisut [/.greenlandic]) @@ -239,19 +239,19 @@ ## M (!aliases /.mi'kmaq [/.micmac]) ## N - (!aliases /.newari [/.nepal-bhasa]) + (!aliases /.newari [/.nepal_bhasa]) (!aliases /.dutch [/.flemish]) - (!aliases /.northern-sotho [/.pedi /.sepedi]) - (!aliases /.old-newari [/.classical-newari /.classical-nepal-bhasa]) + (!aliases /.northern_sotho [/.pedi /.sepedi]) + (!aliases /.old_newari [/.classical_newari /.classical_nepal_bhasa]) (!aliases /.nyanja [/.chichewa /.chewa]) ## O (!aliases /.occitan [/.provencal]) ## P (!aliases /.pampanga [/.kapampangan]) ## R - (!aliases /.rarotongan [/.cook-islands-maori]) + (!aliases /.rarotongan [/.cook_islands_maori]) (!aliases /.romanian [/.moldavian /.moldovan]) - (!aliases /.aromanian [/.arumanian /.macedo-romanian]) + (!aliases /.aromanian [/.arumanian /.macedo_romanian]) ## S (!aliases /.spanish [/.castilian]) ## X @@ -263,7 +263,7 @@ (def: #export random (Random /.Language) (let [options (|> ..languages - (list\map (|>> (get@ #languages) set.to-list)) + (list\map (|>> (get@ #languages) set.to_list)) list.concat)] (do {! random.monad} [choice (\ ! map (n.% (list.size options)) @@ -278,6 +278,6 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - ..languages-test - ..aliases-test + ..languages_test + ..aliases_test ))) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 4fc425804..86a44cf3a 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -37,74 +37,74 @@ (let [count (template.count <territories>) territories (`` (list (~~ (template.splice <territories>))))] {#count count - #names (|> territories (list\map /.name) (set.from-list text.hash)) - #shorts (|> territories (list\map /.short-code) (set.from-list text.hash)) - #longs (|> territories (list\map /.long-code) (set.from-list text.hash)) - #numbers (|> territories (list\map /.numeric-code) (set.from-list n.hash)) - #territories (|> territories (set.from-list /.hash)) + #names (|> territories (list\map /.name) (set.from_list text.hash)) + #shorts (|> territories (list\map /.short_code) (set.from_list text.hash)) + #longs (|> territories (list\map /.long_code) (set.from_list text.hash)) + #numbers (|> territories (list\map /.numeric_code) (set.from_list n.hash)) + #territories (|> territories (set.from_list /.hash)) #test (_.cover <territories> true)}))] - [territories/a [/.afghanistan /.aland-islands /.albania /.algeria /.american-samoa + [territories/a [/.afghanistan /.aland_islands /.albania /.algeria /.american_samoa /.andorra /.angola /.anguilla /.antarctica /.antigua /.argentina /.armenia /.aruba /.australia /.austria /.azerbaijan]] - [territories/b [/.the-bahamas /.bahrain /.bangladesh /.barbados /.belarus + [territories/b [/.the_bahamas /.bahrain /.bangladesh /.barbados /.belarus /.belgium /.belize /.benin /.bermuda /.bhutan - /.bolivia /.bonaire /.bosnia /.botswana /.bouvet-island - /.brazil /.british-indian-ocean-territory /.brunei-darussalam /.bulgaria /.burkina-faso + /.bolivia /.bonaire /.bosnia /.botswana /.bouvet_island + /.brazil /.british_indian_ocean_territory /.brunei_darussalam /.bulgaria /.burkina_faso /.burundi]] - [territories/c [/.cape-verde /.cambodia /.cameroon /.canada /.cayman-islands - /.central-african-republic /.chad /.chile /.china /.christmas-island - /.cocos-islands /.colombia /.comoros /.congo /.democratic-republic-of-the-congo - /.cook-islands /.costa-rica /.ivory-coast /.croatia /.cuba - /.curacao /.cyprus /.czech-republic]] - [territories/d [/.denmark /.djibouti /.dominica /.dominican-republic]] - [territories/e [/.ecuador /.egypt /.el-salvador /.equatorial-guinea /.eritrea + [territories/c [/.cape_verde /.cambodia /.cameroon /.canada /.cayman_islands + /.central_african_republic /.chad /.chile /.china /.christmas_island + /.cocos_islands /.colombia /.comoros /.congo /.democratic_republic_of_the_congo + /.cook_islands /.costa_rica /.ivory_coast /.croatia /.cuba + /.curacao /.cyprus /.czech_republic]] + [territories/d [/.denmark /.djibouti /.dominica /.dominican_republic]] + [territories/e [/.ecuador /.egypt /.el_salvador /.equatorial_guinea /.eritrea /.estonia /.eswatini /.ethiopia]] - [territories/f [/.falkland-islands /.faroe-islands /.fiji /.finland /.france - /.french-guiana /.french-polynesia /.french-southern-territories]] - [territories/g [/.gabon /.the-gambia /.georgia /.germany /.ghana + [territories/f [/.falkland_islands /.faroe_islands /.fiji /.finland /.france + /.french_guiana /.french_polynesia /.french_southern_territories]] + [territories/g [/.gabon /.the_gambia /.georgia /.germany /.ghana /.gibraltar /.greece /.greenland /.grenada /.guadeloupe - /.guam /.guatemala /.guernsey /.guinea /.guinea-bissau + /.guam /.guatemala /.guernsey /.guinea /.guinea_bissau /.guyana]] - [territories/h [/.haiti /.heard-island /.honduras /.hong-kong + [territories/h [/.haiti /.heard_island /.honduras /.hong_kong /.hungary]] [territories/i [/.iceland /.india /.indonesia /.iran /.iraq - /.ireland /.isle-of-man /.israel /.italy]] + /.ireland /.isle_of_man /.israel /.italy]] [territories/j [/.jamaica /.japan /.jersey /.jordan]] - [territories/k [/.kazakhstan /.kenya /.kiribati /.north-korea /.south-korea + [territories/k [/.kazakhstan /.kenya /.kiribati /.north_korea /.south_korea /.kuwait /.kyrgyzstan]] [territories/l [/.laos /.latvia /.lebanon /.lesotho /.liberia /.libya /.liechtenstein /.lithuania /.luxembourg]] [territories/m [/.macau /.macedonia /.madagascar /.malawi /.malaysia - /.maldives /.mali /.malta /.marshall-islands /.martinique + /.maldives /.mali /.malta /.marshall_islands /.martinique /.mauritania /.mauritius /.mayotte /.mexico /.micronesia /.moldova /.monaco /.mongolia /.montenegro /.montserrat /.morocco /.mozambique /.myanmar]] - [territories/n [/.namibia /.nauru /.nepal /.netherlands /.new-caledonia - /.new-zealand /.nicaragua /.niger /.nigeria /.niue - /.norfolk-island /.northern-mariana-islands /.norway]] + [territories/n [/.namibia /.nauru /.nepal /.netherlands /.new_caledonia + /.new_zealand /.nicaragua /.niger /.nigeria /.niue + /.norfolk_island /.northern_mariana_islands /.norway]] [territories/o [/.oman]] - [territories/p [/.pakistan /.palau /.palestine /.panama /.papua-new-guinea - /.paraguay /.peru /.philippines /.pitcairn-islands /.poland - /.portugal /.puerto-rico]] + [territories/p [/.pakistan /.palau /.palestine /.panama /.papua_new_guinea + /.paraguay /.peru /.philippines /.pitcairn_islands /.poland + /.portugal /.puerto_rico]] [territories/q [/.qatar]] [territories/r [/.reunion /.romania /.russia /.rwanda]] - [territories/s [/.saint-barthelemy /.saint-helena /.saint-kitts /.saint-lucia /.saint-martin - /.saint-pierre /.saint-vincent /.samoa /.san-marino /.sao-tome - /.saudi-arabia /.senegal /.serbia /.seychelles /.sierra-leone - /.singapore /.sint-maarten /.slovakia /.slovenia /.solomon-islands - /.somalia /.south-africa /.south-georgia /.south-sudan /.spain - /.sri-lanka /.sudan /.suriname /.svalbard /.sweden + [territories/s [/.saint_barthelemy /.saint_helena /.saint_kitts /.saint_lucia /.saint_martin + /.saint_pierre /.saint_vincent /.samoa /.san_marino /.sao_tome + /.saudi_arabia /.senegal /.serbia /.seychelles /.sierra_leone + /.singapore /.sint_maarten /.slovakia /.slovenia /.solomon_islands + /.somalia /.south_africa /.south_georgia /.south_sudan /.spain + /.sri_lanka /.sudan /.suriname /.svalbard /.sweden /.switzerland /.syria]] - [territories/t [/.taiwan /.tajikistan /.tanzania /.thailand /.east-timor + [territories/t [/.taiwan /.tajikistan /.tanzania /.thailand /.east_timor /.togo /.tokelau /.tonga /.trinidad /.tunisia /.turkey /.turkmenistan /.turks /.tuvalu]] - [territories/u [/.uganda /.ukraine /.united-arab-emirates /.united-kingdom /.united-states-of-america - /.united-states-minor-outlying-islands /.uruguay /.uzbekistan]] - [territories/v [/.vanuatu /.vatican-city /.venezuela /.vietnam /.british-virgin-islands /.united-states-virgin-islands]] - [territories/w [/.wallis /.western-sahara]] + [territories/u [/.uganda /.ukraine /.united_arab_emirates /.united_kingdom /.united_states_of_america + /.united_states_minor_outlying_islands /.uruguay /.uzbekistan]] + [territories/v [/.vanuatu /.vatican_city /.venezuela /.vietnam /.british_virgin_islands /.united_states_virgin_islands]] + [territories/w [/.wallis /.western_sahara]] [territories/y [/.yemen]] [territories/z [/.zambia /.zimbabwe]] ) @@ -148,7 +148,7 @@ [0 (set.new hash)] territories)) -(def: territories-test +(def: territories_test Test (|> ..territories list.reverse @@ -161,9 +161,9 @@ (n.= count (set.size set))))] [/.name #names text.hash] - [/.short-code #shorts text.hash] - [/.long-code #longs text.hash] - [/.numeric-code #numbers n.hash] + [/.short_code #shorts text.hash] + [/.long_code #longs text.hash] + [/.numeric_code #numbers n.hash] [/.equivalence #territories /.hash] )) ))))) @@ -173,29 +173,29 @@ (list.every? (\ /.equivalence = <reference>) (`` (list (~~ (template.splice <aliases>))))))) -(def: aliases-test +(def: aliases_test Test ($_ _.and ## A (!aliases /.antigua [/.barbuda]) ## B - (!aliases /.bonaire [/.sint-eustatius /.saba]) + (!aliases /.bonaire [/.sint_eustatius /.saba]) (!aliases /.bosnia [/.herzegovina]) ## H - (!aliases /.heard-island [/.mcdonald-islands]) + (!aliases /.heard_island [/.mcdonald_islands]) ## S - (!aliases /.saint-helena [/.ascension /.tristan-da-cunha]) - (!aliases /.saint-kitts [/.nevis]) - (!aliases /.saint-pierre [/.miquelon]) - (!aliases /.saint-vincent [/.the-grenadines]) - (!aliases /.sao-tome [/.principe]) - (!aliases /.south-georgia [/.south-sandwich-islands]) - (!aliases /.svalbard [/.jan-mayen]) + (!aliases /.saint_helena [/.ascension /.tristan_da_cunha]) + (!aliases /.saint_kitts [/.nevis]) + (!aliases /.saint_pierre [/.miquelon]) + (!aliases /.saint_vincent [/.the_grenadines]) + (!aliases /.sao_tome [/.principe]) + (!aliases /.south_georgia [/.south_sandwich_islands]) + (!aliases /.svalbard [/.jan_mayen]) ## T (!aliases /.trinidad [/.tobago]) - (!aliases /.turks [/.caicos-islands]) + (!aliases /.turks [/.caicos_islands]) ## U - (!aliases /.united-kingdom [/.northern-ireland]) + (!aliases /.united_kingdom [/.northern_ireland]) ## W (!aliases /.wallis [/.futuna]) )) @@ -203,7 +203,7 @@ (def: #export random (Random /.Territory) (let [options (|> ..territories - (list\map (|>> (get@ #territories) set.to-list)) + (list\map (|>> (get@ #territories) set.to_list)) list.concat)] (do {! random.monad} [choice (\ ! map (n.% (list.size options)) @@ -218,6 +218,6 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - ..territories-test - ..aliases-test + ..territories_test + ..aliases_test ))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 8f6dc91d5..cbaa5aee7 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -27,21 +27,21 @@ {1 ["." /]}) -(def: random-text +(def: random_text (Random Text) (random.ascii/alpha 10)) -(def: random-name +(def: random_name (Random Name) - (random.and ..random-text ..random-text)) + (random.and ..random_text ..random_text)) -(def: (random-sequence random) +(def: (random_sequence random) (All [a] (-> (Random a) (Random (List a)))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3)))] (random.list size random))) -(def: (random-record random) +(def: (random_record random) (All [a] (-> (Random a) (Random (List [a a])))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3)))] @@ -56,39 +56,39 @@ (random\map /.nat random.nat) (random\map /.int random.int) (random\map /.rev random.rev) - (random\map /.frac random.safe-frac) - (random\map /.text ..random-text) - (random\map /.identifier ..random-name) - (random\map /.tag ..random-name) - (random\map /.form (..random-sequence random)) - (random\map /.tuple (..random-sequence random)) - (random\map /.record (..random-record random)) + (random\map /.frac random.safe_frac) + (random\map /.text ..random_text) + (random\map /.identifier ..random_name) + (random\map /.tag ..random_name) + (random\map /.form (..random_sequence random)) + (random\map /.tuple (..random_sequence random)) + (random\map /.record (..random_record random)) )))) -(def: (read source-code) +(def: (read source_code) (-> Text (Try Code)) (let [parse (syntax.parse "" - syntax.no-aliases - (text.size source-code)) + syntax.no_aliases + (text.size source_code)) start (: Source - [location.dummy 0 source-code])] + [location.dummy 0 source_code])] (case (parse start) (#.Left [end error]) (#try.Failure error) - (#.Right [end lux-code]) - (#try.Success lux-code)))) + (#.Right [end lux_code]) + (#try.Success lux_code)))) -(def: (replace-simulation [original substitute]) +(def: (replace_simulation [original substitute]) (-> [Code Code] (Random [Code Code])) (random.rec - (function (_ replace-simulation) - (let [for-sequence (: (-> (-> (List Code) Code) (Random [Code Code])) - (function (_ to-code) + (function (_ replace_simulation) + (let [for_sequence (: (-> (-> (List Code) Code) (Random [Code Code])) + (function (_ to_code) (do {! random.monad} - [parts (..random-sequence replace-simulation)] - (wrap [(to-code (list\map product.left parts)) - (to-code (list\map product.right parts))]))))] + [parts (..random_sequence replace_simulation)] + (wrap [(to_code (list\map product.left parts)) + (to_code (list\map product.right parts))]))))] ($_ random.either (random\wrap [original substitute]) (do {! random.monad} @@ -98,15 +98,15 @@ (random\map /.nat random.nat) (random\map /.int random.int) (random\map /.rev random.rev) - (random\map /.frac random.safe-frac) - (random\map /.text ..random-text) - (random\map /.identifier ..random-name) - (random\map /.tag ..random-name)))] + (random\map /.frac random.safe_frac) + (random\map /.text ..random_text) + (random\map /.identifier ..random_name) + (random\map /.tag ..random_name)))] (wrap [sample sample])) - (for-sequence /.form) - (for-sequence /.tuple) + (for_sequence /.form) + (for_sequence /.tuple) (do {! random.monad} - [parts (..random-sequence replace-simulation)] + [parts (..random_sequence replace_simulation)] (wrap [(/.record (let [parts' (list\map product.left parts)] (list.zip/2 parts' parts'))) (/.record (let [parts' (list\map product.right parts)] @@ -141,13 +141,13 @@ [/.nat random.nat #.Nat] [/.int random.int #.Int] [/.rev random.rev #.Rev] - [/.frac random.safe-frac #.Frac] - [/.text ..random-text #.Text] - [/.tag ..random-name #.Tag] - [/.identifier ..random-name #.Identifier] - [/.form (..random-sequence ..random) #.Form] - [/.tuple (..random-sequence ..random) #.Tuple] - [/.record (..random-record ..random) #.Record])) + [/.frac random.safe_frac #.Frac] + [/.text ..random_text #.Text] + [/.tag ..random_name #.Tag] + [/.identifier ..random_name #.Identifier] + [/.form (..random_sequence ..random) #.Form] + [/.tuple (..random_sequence ..random) #.Tuple] + [/.record (..random_record ..random) #.Record])) (~~ (template [<coverage> <random> <tag>] [(do {! random.monad} [expected <random>] @@ -165,12 +165,12 @@ (<coverage> expected))) ))] - [/.local-tag ..random-text #.Tag] - [/.local-identifier ..random-text #.Identifier] + [/.local_tag ..random_text #.Tag] + [/.local_identifier ..random_text #.Identifier] ))))) (do {! random.monad} [[original substitute] (random.and ..random ..random) - [sample expected] (..replace-simulation [original substitute])] + [sample expected] (..replace_simulation [original substitute])] (_.cover [/.replace] (\ /.equivalence = expected diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 16903ebc2..51315ec1e 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -41,43 +41,43 @@ #tuple [Int Frac Text] #recursive Recursive}) -(def: gen-recursive +(def: gen_recursive (Random Recursive) - (random.rec (function (_ gen-recursive) - (random.or random.safe-frac - (random.and random.safe-frac - gen-recursive))))) + (random.rec (function (_ gen_recursive) + (random.or random.safe_frac + (random.and random.safe_frac + gen_recursive))))) -(def: gen-record +(def: gen_record (Random Record) (do {! random.monad} [size (\ ! map (n.% 2) random.nat) - #let [gen-int (|> random.int (\ ! map (|>> i.abs (i.% +1,000,000))))]] + #let [gen_int (|> random.int (\ ! map (|>> i.abs (i.% +1,000,000))))]] ($_ random.and random.bit - gen-int - random.safe-frac + gen_int + random.safe_frac (random.unicode size) - (random.maybe gen-int) - (random.list size gen-int) + (random.maybe gen_int) + (random.list size gen_int) ($_ random.or random.bit - gen-int - random.safe-frac) + gen_int + random.safe_frac) ($_ random.and - gen-int - random.safe-frac + gen_int + random.safe_frac (random.unicode size)) - gen-recursive))) + gen_recursive))) (derived: equivalence (/.equivalence Record)) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (do random.monad - [sample gen-record + [sample gen_record #let [(^open "/\.") ..equivalence]] (_.test "Every instance equals itself." (/\= sample sample))))) diff --git a/stdlib/source/test/lux/macro/poly/functor.lux b/stdlib/source/test/lux/macro/poly/functor.lux index 85d24bc5b..3f2b4db50 100644 --- a/stdlib/source/test/lux/macro/poly/functor.lux +++ b/stdlib/source/test/lux/macro/poly/functor.lux @@ -15,13 +15,13 @@ [macro [poly (#+ derived:)]]]) -(derived: maybe-functor (/.functor .Maybe)) -(derived: list-functor (/.functor .List)) -(derived: state-functor (/.functor state.State)) -(derived: identity-functor (/.functor identity.Identity)) +(derived: maybe_functor (/.functor .Maybe)) +(derived: list_functor (/.functor .List)) +(derived: state_functor (/.functor state.State)) +(derived: identity_functor (/.functor identity.Identity)) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (_.test "Can derive functors automatically." true))) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 4b6718577..b6b3a29e2 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -75,32 +75,32 @@ #date tda.Date #grams (unit.Qty unit.Gram)}) -(def: gen-recursive +(def: gen_recursive (Random Recursive) (random.rec - (function (_ gen-recursive) - (random.or random.safe-frac - (random.and random.safe-frac - gen-recursive))))) + (function (_ gen_recursive) + (random.or random.safe_frac + (random.and random.safe_frac + gen_recursive))))) (def: qty (All [unit] (Random (unit.Qty unit))) (|> random.int (\ random.monad map unit.in))) -(def: gen-record +(def: gen_record (Random Record) (do {! random.monad} [size (\ ! map (n.% 2) random.nat)] ($_ random.and random.bit - random.safe-frac + random.safe_frac (random.unicode size) - (random.maybe random.safe-frac) - (random.list size random.safe-frac) - (random.dictionary text.hash size (random.unicode size) random.safe-frac) - ($_ random.or random.bit (random.unicode size) random.safe-frac) - ($_ random.and random.bit (random.unicode size) random.safe-frac) - ..gen-recursive + (random.maybe random.safe_frac) + (random.list size random.safe_frac) + (random.dictionary text.hash size (random.unicode size) random.safe_frac) + ($_ random.or random.bit (random.unicode size) random.safe_frac) + ($_ random.and random.bit (random.unicode size) random.safe_frac) + ..gen_recursive ## _instant.instant ## _duration.duration _date.date @@ -117,4 +117,4 @@ Test (<| (_.covering /._) (_.for [/.codec] - ($codec.spec ..equivalence ..codec ..gen-record)))) + ($codec.spec ..equivalence ..codec ..gen_record)))) diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 90efa671f..316734d36 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -68,7 +68,7 @@ (~' _) #0))))) -(def: simple-values +(def: simple_values Test (`` ($_ _.and (~~ (template [<assertion> <value> <ctor> <Equivalence> <get>] @@ -82,25 +82,25 @@ ["Can parse Int syntax." +123 code.int int.equivalence s.int] ["Can parse Rev syntax." .123 code.rev rev.equivalence s.rev] ["Can parse Frac syntax." +123.0 code.frac frac.equivalence s.frac] - ["Can parse Text syntax." text.new-line code.text text.equivalence s.text] + ["Can parse Text syntax." text.new_line code.text text.equivalence s.text] ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier] ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag] )) (_.test "Can parse identifiers belonging to the current namespace." (and (match "yolo" - (p.run s.local-identifier - (list (code.local-identifier "yolo")))) - (fails? (p.run s.local-identifier + (p.run s.local_identifier + (list (code.local_identifier "yolo")))) + (fails? (p.run s.local_identifier (list (code.identifier ["yolo" "lol"])))))) (_.test "Can parse tags belonging to the current namespace." (and (match "yolo" - (p.run s.local-tag - (list (code.local-tag "yolo")))) - (fails? (p.run s.local-tag + (p.run s.local_tag + (list (code.local_tag "yolo")))) + (fails? (p.run s.local_tag (list (code.tag ["yolo" "lol"])))))) ))) -(def: complex-values +(def: complex_values Test (`` ($_ _.and (~~ (template [<type> <parser> <ctor>] @@ -132,10 +132,10 @@ (def: #export test Test - (<| (_.context (name.module (name-of /._))) + (<| (_.context (name.module (name_of /._))) ($_ _.and - ..simple-values - ..complex-values + ..simple_values + ..complex_values ($_ _.and (_.test "Can parse any Code." (match [_ (#.Bit #1)] diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index 592baa036..769a28439 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -33,25 +33,25 @@ ["#." definition] ["#." export]]) -(def: annotations-equivalence +(def: annotations_equivalence (Equivalence /.Annotations) (list.equivalence (product.equivalence name.equivalence code.equivalence))) -(def: random-text +(def: random_text (Random Text) (random.ascii/alpha 10)) -(def: random-name +(def: random_name (Random Name) - (random.and ..random-text ..random-text)) + (random.and ..random_text ..random_text)) -(def: random-annotations +(def: random_annotations (Random /.Annotations) (do {! random.monad} [size (\ ! map (|>> (n.% 3)) random.nat)] - (random.list size (random.and random-name + (random.list size (random.and random_name ///code.random)))) (def: #export test @@ -63,33 +63,33 @@ (_.for [/.Annotations] ($_ _.and (do random.monad - [expected ..random-annotations] + [expected ..random_annotations] (_.cover [/reader.annotations /writer.annotations] (|> expected /writer.annotations list (<c>.run /reader.annotations) (case> (#try.Success actual) - (\ ..annotations-equivalence = expected actual) + (\ ..annotations_equivalence = expected actual) (#try.Failure error) false)))) - (_.cover [/.empty-annotations] - (|> /.empty-annotations + (_.cover [/.empty_annotations] + (|> /.empty_annotations /writer.annotations list (<c>.run /reader.annotations) (case> (#try.Success actual) - (\ ..annotations-equivalence = /.empty-annotations actual) + (\ ..annotations_equivalence = /.empty_annotations actual) (#try.Failure error) false))) )) (do {! random.monad} [size (\ ! map (|>> (n.% 3)) random.nat) - expected (random.list size ..random-text)] - (_.cover [/.Type-Var /reader.type-variables /writer.type-variables] + expected (random.list size ..random_text)] + (_.cover [/.Type_Var /reader.type_variables /writer.type_variables] (|> expected - /writer.type-variables - (<c>.run /reader.type-variables) + /writer.type_variables + (<c>.run /reader.type_variables) (case> (#try.Success actual) (\ (list.equivalence text.equivalence) = expected actual) @@ -98,8 +98,8 @@ (do {! random.monad} [size (\ ! map (|>> (n.% 3)) random.nat) expected (: (Random /.Declaration) - (random.and ..random-text - (random.list size ..random-text)))] + (random.and ..random_text + (random.list size ..random_text)))] (_.cover [/.Declaration /reader.declaration /writer.declaration] (|> expected /writer.declaration list @@ -112,13 +112,13 @@ (#try.Failure error) false)))) (do {! random.monad} - [expected (: (Random /.Typed-Input) + [expected (: (Random /.Typed_Input) (random.and ///code.random ///code.random))] - (_.cover [/.Typed-Input /reader.typed-input /writer.typed-input] + (_.cover [/.Typed_Input /reader.typed_input /writer.typed_input] (|> expected - /writer.typed-input list - (<c>.run /reader.typed-input) + /writer.typed_input list + (<c>.run /reader.typed_input) (case> (#try.Success actual) (let [equivalence (product.equivalence code.equivalence code.equivalence)] (\ equivalence = expected actual)) diff --git a/stdlib/source/test/lux/macro/syntax/common/definition.lux b/stdlib/source/test/lux/macro/syntax/common/definition.lux index 18af3edaa..937f5319a 100644 --- a/stdlib/source/test/lux/macro/syntax/common/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/common/definition.lux @@ -25,7 +25,7 @@ ["#//" /// #_ ["#." code]]]) -(def: random-annotations +(def: random_annotations (Random Annotations) (let [name (random.and (random.ascii/alpha 5) (random.ascii/alpha 5))] @@ -37,7 +37,7 @@ (random.ascii/alpha 5) (random.or $//check.random $////code.random) - ..random-annotations + ..random_annotations random.bit )) @@ -47,15 +47,15 @@ #.mode #.Build} #.source [location.dummy 0 ""] #.location location.dummy - #.current-module #.None + #.current_module #.None #.modules (list) #.scopes (list) - #.type-context {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)} + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} #.expected #.None #.seed 0 - #.scope-type-vars (list) + #.scope_type_vars (list) #.extensions [] #.host []}) @@ -71,7 +71,7 @@ [expected ..random type $////code.random - untyped-value $////code.random] + untyped_value $////code.random] ($_ _.and (_.cover [/.write /.parser] (case (<code>.run (/.parser compiler) @@ -82,7 +82,7 @@ (#try.Success actual) (\ /.equivalence = expected actual))) (_.cover [/.typed] - (let [expected (set@ #/.value (#.Left [type untyped-value]) expected)] + (let [expected (set@ #/.value (#.Left [type untyped_value]) expected)] (case (<code>.run (/.typed compiler) (list (/.write expected))) (#try.Failure error) @@ -90,12 +90,12 @@ (#try.Success actual) (\ /.equivalence = expected actual)))) - (_.cover [/.lacks-type!] - (let [expected (set@ #/.value (#.Right untyped-value) expected)] + (_.cover [/.lacks_type!] + (let [expected (set@ #/.value (#.Right untyped_value) expected)] (case (<code>.run (/.typed compiler) (list (/.write expected))) (#try.Failure error) - (exception.match? /.lacks-type! error) + (exception.match? /.lacks_type! error) (#try.Success actual) false))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 8fa6a00ca..902e84255 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -20,9 +20,9 @@ [left random.nat mid random.nat right random.nat] - (with-expansions [<module> (as-is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"]) + (with_expansions [<module> (as_is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"]) <module>' "-8.9+6.7.5-4+32#1#0cba" - <short> (as-is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9]) + <short> (as_is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9]) <short>' "abc#0#12+3-4.5+6.7-8.9"] ($_ _.and (_.cover [/.splice] @@ -38,23 +38,23 @@ <short>' true _ false)) (_.cover [/.identifier] - (and (case (`` (name-of (~~ (/.identifier <short>)))) + (and (case (`` (name_of (~~ (/.identifier <short>)))) ["" <short>'] true _ false) - (case (`` (name-of (~~ (/.identifier <module> <short>)))) + (case (`` (name_of (~~ (/.identifier <module> <short>)))) [<module>' <short>'] true _ false) )) (_.cover [/.tag] - (and (case (`` (name-of (~~ (/.tag <short>)))) + (and (case (`` (name_of (~~ (/.tag <short>)))) ["" <short>'] true _ false) - (case (`` (name-of (~~ (/.tag <module> <short>)))) + (case (`` (name_of (~~ (/.tag <module> <short>)))) [<module>' <short>'] true _ false) )) - (_.cover [/.with-locals] - (/.with-locals [var0 var1] + (_.cover [/.with_locals] + (/.with_locals [var0 var1] (let [var0 left var1 right] (and (nat.= left var0) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index bede0dd2c..d9741e6ad 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -19,36 +19,36 @@ ["#/." continuous] ["#/." fuzzy]]]) -(def: (within? margin-of-error standard value) +(def: (within? margin_of_error standard value) (-> Frac Frac Frac Bit) - (f.< margin-of-error + (f.< margin_of_error (f.abs (f.- standard value)))) (def: margin Frac +0.0000001) -(def: (trigonometric-symmetry forward backward angle) +(def: (trigonometric_symmetry forward backward angle) (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) (let [normal (|> angle forward backward)] (|> normal forward backward (within? margin normal)))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and (<| (_.context "Trigonometry") (do {! r.monad} - [angle (|> r.safe-frac (\ ! map (f.* /.tau)))] + [angle (|> r.safe_frac (\ ! map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." - (trigonometric-symmetry /.sin /.asin angle)) + (trigonometric_symmetry /.sin /.asin angle)) (_.test "Cosine and arc-cosine are inverse functions." - (trigonometric-symmetry /.cos /.acos angle)) + (trigonometric_symmetry /.cos /.acos angle)) (_.test "Tangent and arc-tangent are inverse functions." - (trigonometric-symmetry /.tan /.atan angle)) + (trigonometric_symmetry /.tan /.atan angle)) ))) (<| (_.context "Rounding") (do {! r.monad} - [sample (|> r.safe-frac (\ ! map (f.* +1000.0)))] + [sample (|> r.safe_frac (\ ! map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (/.ceil sample)] @@ -67,14 +67,14 @@ ))) (<| (_.context "Exponentials and logarithms") (do {! r.monad} - [sample (|> r.safe-frac (\ ! map (f.* +10.0)))] + [sample (|> r.safe_frac (\ ! map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") (do {! r.monad} - [#let [gen-nat (|> r.nat (\ ! map (|>> (n.% 1000) (n.max 1))))] - x gen-nat - y gen-nat] + [#let [gen_nat (|> r.nat (\ ! map (|>> (n.% 1000) (n.max 1))))] + x gen_nat + y gen_nat] ($_ _.and (_.test "GCD" (let [gcd (n.gcd x y)] diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index d9c15a2e5..f4a3552e9 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -21,43 +21,43 @@ [subject random.nat parameter random.nat extra random.nat - angle random.safe-frac + angle random.safe_frac factor random.nat] (_.cover [/.infix] - (let [constant-values! + (let [constant_values! (n.= subject (/.infix subject)) - unary-functions! + unary_functions! (f.= (//.sin angle) (/.infix [//.sin angle])) - binary-functions! + binary_functions! (n.= (n.gcd parameter subject) (/.infix [subject n.gcd parameter])) - multiple-binary-functions! + multiple_binary_functions! (n.= (n.* factor (n.gcd parameter subject)) (/.infix [subject n.gcd parameter n.* factor])) - function-call! + function_call! (n.= (n.gcd extra (n.* parameter subject)) (/.infix [(n.* parameter subject) n.gcd extra])) - non-numeric! + non_numeric! (bit\= (and (n.< parameter subject) (n.< extra parameter)) (/.infix [[subject n.< parameter] and [parameter n.< extra]])) - and-composition! + and_composition! (and (bit\= (and (n.< parameter subject) (n.< extra parameter)) (/.infix [#and subject n.< parameter n.< extra])) (bit\= (and (n.< parameter subject) (n.> extra parameter)) (/.infix [#and subject n.< parameter n.> extra])))] - (and constant-values! - unary-functions! - binary-functions! - multiple-binary-functions! - function-call! - non-numeric! - and-composition! + (and constant_values! + unary_functions! + binary_functions! + multiple_binary_functions! + function_call! + non_numeric! + and_composition! )))))) diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux index 6c4b8a721..dd18ad2d1 100644 --- a/stdlib/source/test/lux/math/logic/continuous.lux +++ b/stdlib/source/test/lux/math/logic/continuous.lux @@ -13,7 +13,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (do random.monad [left random.rev right random.rev] diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 731ee6865..476a40964 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -23,10 +23,10 @@ (template [<name> <desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>] [(def: <name> Test - (<| (_.context (%.name (name-of <triangle>))) + (<| (_.context (%.name (name_of <triangle>))) (do random.monad [values (random.set <hash> 3 <gen>) - #let [[x y z] (case (set.to-list values) + #let [[x y z] (case (set.to_list values) (^ (list x y z)) [x y z] @@ -56,40 +56,40 @@ (<gte> top sample)))) ))))] - [rev-triangles "Rev" r.hash random.rev /.triangle r.< r.<= r.> r.>=] + [rev_triangles "Rev" r.hash random.rev /.triangle r.< r.<= r.> r.>=] ) (template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] [(def: <name> Test - (<| (_.context (%.name (name-of <trapezoid>))) + (<| (_.context (%.name (name_of <trapezoid>))) (do random.monad [values (random.set <hash> 4 <gen>) - #let [[w x y z] (case (set.to-list values) + #let [[w x y z] (case (set.to_list values) (^ (list w x y z)) [w x y z] _ (undefined))] sample <gen> - #let [[bottom middle-bottom middle-top top] (case (list.sort <lt> (list w x y z)) - (^ (list bottom middle-bottom middle-top top)) - [bottom middle-bottom middle-top top] + #let [[bottom middle_bottom middle_top top] (case (list.sort <lt> (list w x y z)) + (^ (list bottom middle_bottom middle_top top)) + [bottom middle_bottom middle_top top] _ (undefined)) trapezoid (<trapezoid> w x y z)]] ($_ _.and (_.test "The middle values will always have maximum membership." - (and (r.= //.true (/.membership middle-bottom trapezoid)) - (r.= //.true (/.membership middle-top trapezoid)))) + (and (r.= //.true (/.membership middle_bottom trapezoid)) + (r.= //.true (/.membership middle_top trapezoid)))) (_.test "Boundary values will always have 0 membership." (and (r.= //.false (/.membership bottom trapezoid)) (r.= //.false (/.membership top trapezoid)))) (_.test "Values within inner range will have membership = 1" (bit\= (r.= //.true (/.membership sample trapezoid)) - (and (<gte> middle-bottom sample) - (<lte> middle-top sample)))) + (and (<gte> middle_bottom sample) + (<lte> middle_top sample)))) (_.test "Values within range, will have membership > 0." (bit\= (r.> //.false (/.membership sample trapezoid)) (and (<gt> bottom sample) @@ -100,7 +100,7 @@ (<gte> top sample)))) ))))] - [rev-trapezoids "Rev" r.hash random.rev /.trapezoid r.< r.<= r.> r.>=] + [rev_trapezoids "Rev" r.hash random.rev /.trapezoid r.< r.<= r.> r.>=] ) (def: #export triangle @@ -119,40 +119,40 @@ right ..triangle sample random.rev] ($_ _.and - (_.test (%.name (name-of /.union)) + (_.test (%.name (name_of /.union)) (let [combined (/.union left right) - combined-membership (/.membership sample combined)] + combined_membership (/.membership sample combined)] (and (r.>= (/.membership sample left) - combined-membership) + combined_membership) (r.>= (/.membership sample right) - combined-membership)))) - (_.test (%.name (name-of /.intersection)) + combined_membership)))) + (_.test (%.name (name_of /.intersection)) (let [combined (/.intersection left right) - combined-membership (/.membership sample combined)] + combined_membership (/.membership sample combined)] (and (r.<= (/.membership sample left) - combined-membership) + combined_membership) (r.<= (/.membership sample right) - combined-membership)))) - (_.test (%.name (name-of /.complement)) + combined_membership)))) + (_.test (%.name (name_of /.complement)) (r.= (/.membership sample left) (//.not (/.membership sample (/.complement left))))) - (_.test (%.name (name-of /.difference)) + (_.test (%.name (name_of /.difference)) (r.<= (/.membership sample right) (/.membership sample (/.difference left right)))) )))) -(def: predicates-and-sets +(def: predicates_and_sets Test (do {! random.monad} - [#let [set-10 (set.from-list n.hash (enum.range n.enum 0 10))] + [#let [set_10 (set.from_list n.hash (enum.range n.enum 0 10))] sample (|> random.nat (\ ! map (n.% 20)))] ($_ _.and - (_.test (%.name (name-of /.from-predicate)) - (bit\= (r.= //.true (/.membership sample (/.from-predicate n.even?))) + (_.test (%.name (name_of /.from_predicate)) + (bit\= (r.= //.true (/.membership sample (/.from_predicate n.even?))) (n.even? sample))) - (_.test (%.name (name-of /.from-set)) - (bit\= (r.= //.true (/.membership sample (/.from-set set-10))) - (set.member? set-10 sample))) + (_.test (%.name (name_of /.from_set)) + (bit\= (r.= //.true (/.membership sample (/.from_set set_10))) + (set.member? set_10 sample))) ))) (def: thresholds @@ -161,12 +161,12 @@ [fuzzy ..triangle sample random.rev threshold random.rev - #let [vip-fuzzy (/.cut threshold fuzzy) - member? (/.to-predicate threshold fuzzy)]] - (<| (_.context (%.name (name-of /.cut))) + #let [vip_fuzzy (/.cut threshold fuzzy) + member? (/.to_predicate threshold fuzzy)]] + (<| (_.context (%.name (name_of /.cut))) ($_ _.and (_.test "Can increase the threshold of membership of a fuzzy set." - (bit\= (r.> //.false (/.membership sample vip-fuzzy)) + (bit\= (r.> //.false (/.membership sample vip_fuzzy)) (r.> threshold (/.membership sample fuzzy)))) (_.test "Can turn fuzzy sets into predicates through a threshold." (bit\= (member? sample) @@ -175,11 +175,11 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and - ..rev-triangles - ..rev-trapezoids + ..rev_triangles + ..rev_trapezoids ..combinators - ..predicates-and-sets + ..predicates_and_sets ..thresholds ))) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 2bbcea587..66eb047fc 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -40,7 +40,7 @@ (def: value (All [m] (-> (/.Mod m) Int)) - (|>> /.un-modular product.right)) + (|>> /.un_modular product.right)) (def: (comparison m/? i/?) (All [m] diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 502948efa..58d16666f 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -31,7 +31,7 @@ (_.for [/.Modulus]) (do random.monad [divisor random.int - modulus (random.one (|>> /.modulus try.to-maybe) + modulus (random.one (|>> /.modulus try.to_maybe) random.int) dividend random.int] ($_ _.and @@ -42,15 +42,15 @@ (#try.Failure error) (i.= +0 divisor))) - (_.cover [/.zero-cannot-be-a-modulus] + (_.cover [/.zero_cannot_be_a_modulus] (case (/.modulus +0) (#try.Failure error) - (exception.match? /.zero-cannot-be-a-modulus error) + (exception.match? /.zero_cannot_be_a_modulus error) (#try.Success modulus) false)) (_.cover [/.literal] - (with-expansions [<divisor> (|divisor|)] + (with_expansions [<divisor> (|divisor|)] (i.= <divisor> (/.divisor (/.literal <divisor>))))) (_.cover [/.congruent?] (and (/.congruent? modulus dividend dividend) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index ef5be32b5..7428cae69 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -29,182 +29,182 @@ <pattern> true _ false)) -(def: compiler-related +(def: compiler_related Test (do random.monad - [target (random.ascii/upper-alpha 1) - version (random.ascii/upper-alpha 1) - source-code (random.ascii/upper-alpha 1) - expected-current-module (random.ascii/upper-alpha 1) - primitive-type (random.ascii/upper-alpha 1) - expected-seed random.nat + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + primitive_type (random.ascii/upper_alpha 1) + expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected-error (random.ascii/upper-alpha 1) - expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text\= expected-current-module) not) - (random.ascii/upper-alpha 1)) - expected-gensym (random.ascii/upper-alpha 1) - #let [expected-lux {#.info {#.target target + expected_error (random.ascii/upper_alpha 1) + expected_short (random.ascii/upper_alpha 1) + dummy_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_gensym (random.ascii/upper_alpha 1) + #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source-code] + #.source [location.dummy 0 source_code] #.location location.dummy - #.current-module (#.Some expected-current-module) + #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type-context {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)} - #.expected (#.Some (#.Primitive primitive-type (list))) - #.seed expected-seed - #.scope-type-vars (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some (#.Primitive primitive_type (list))) + #.seed expected_seed + #.scope_type_vars (list) #.extensions [] #.host []}]] ($_ _.and (_.cover [/.run] (|> (\ /.monad wrap expected) - (/.run expected-lux) + (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual))))) (_.cover [/.run'] (|> (\ /.monad wrap expected) - (/.run' expected-lux) - (!expect (^multi (#try.Success [actual-lux actual]) - (and (is? expected-lux actual-lux) + (/.run' expected_lux) + (!expect (^multi (#try.Success [actual_lux actual]) + (and (is? expected_lux actual_lux) (n.= expected actual)))))) - (_.cover [/.get-compiler] - (|> /.get-compiler - (/.run expected-lux) - (!expect (^multi (#try.Success actual-lux) - (is? expected-lux actual-lux))))) + (_.cover [/.get_compiler] + (|> /.get_compiler + (/.run expected_lux) + (!expect (^multi (#try.Success actual_lux) + (is? expected_lux actual_lux))))) ))) -(def: error-handling +(def: error_handling Test (do random.monad - [target (random.ascii/upper-alpha 1) - version (random.ascii/upper-alpha 1) - source-code (random.ascii/upper-alpha 1) - expected-current-module (random.ascii/upper-alpha 1) - primitive-type (random.ascii/upper-alpha 1) - expected-seed random.nat + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + primitive_type (random.ascii/upper_alpha 1) + expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected-error (random.ascii/upper-alpha 1) - #let [expected-lux {#.info {#.target target + expected_error (random.ascii/upper_alpha 1) + #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source-code] + #.source [location.dummy 0 source_code] #.location location.dummy - #.current-module (#.Some expected-current-module) + #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type-context {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)} - #.expected (#.Some (#.Primitive primitive-type (list))) - #.seed expected-seed - #.scope-type-vars (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some (#.Primitive primitive_type (list))) + #.seed expected_seed + #.scope_type_vars (list) #.extensions [] #.host []}]] ($_ _.and (_.cover [/.fail] - (|> (/.fail expected-error) + (|> (/.fail expected_error) (: (Meta Any)) - (/.run expected-lux) - (!expect (^multi (#try.Failure actual-error) - (text\= expected-error actual-error))))) + (/.run expected_lux) + (!expect (^multi (#try.Failure actual_error) + (text\= expected_error actual_error))))) (_.cover [/.assert] - (and (|> (/.assert expected-error true) + (and (|> (/.assert expected_error true) (: (Meta Any)) - (/.run expected-lux) + (/.run expected_lux) (!expect (#try.Success []))) - (|> (/.assert expected-error false) - (/.run expected-lux) - (!expect (^multi (#try.Failure actual-error) - (text\= expected-error actual-error)))))) + (|> (/.assert expected_error false) + (/.run expected_lux) + (!expect (^multi (#try.Failure actual_error) + (text\= expected_error actual_error)))))) (_.cover [/.either] (and (|> (/.either (\ /.monad wrap expected) (: (Meta Nat) - (/.fail expected-error))) - (/.run expected-lux) + (/.fail expected_error))) + (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual)))) (|> (/.either (: (Meta Nat) - (/.fail expected-error)) + (/.fail expected_error)) (\ /.monad wrap expected)) - (/.run expected-lux) + (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual)))) (|> (/.either (: (Meta Nat) - (/.fail expected-error)) + (/.fail expected_error)) (: (Meta Nat) - (/.fail expected-error))) - (/.run expected-lux) - (!expect (^multi (#try.Failure actual-error) - (text\= expected-error actual-error)))) + (/.fail expected_error))) + (/.run expected_lux) + (!expect (^multi (#try.Failure actual_error) + (text\= expected_error actual_error)))) (|> (/.either (\ /.monad wrap expected) (\ /.monad wrap dummy)) - (/.run expected-lux) + (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual)))))) ))) -(def: module-related +(def: module_related Test (do random.monad - [target (random.ascii/upper-alpha 1) - version (random.ascii/upper-alpha 1) - source-code (random.ascii/upper-alpha 1) - expected-current-module (random.ascii/upper-alpha 1) - primitive-type (random.ascii/upper-alpha 1) - expected-seed random.nat + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + primitive_type (random.ascii/upper_alpha 1) + expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected-error (random.ascii/upper-alpha 1) - expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text\= expected-current-module) not) - (random.ascii/upper-alpha 1)) - #let [expected-lux {#.info {#.target target + expected_error (random.ascii/upper_alpha 1) + expected_short (random.ascii/upper_alpha 1) + dummy_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source-code] + #.source [location.dummy 0 source_code] #.location location.dummy - #.current-module (#.Some expected-current-module) + #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type-context {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)} - #.expected (#.Some (#.Primitive primitive-type (list))) - #.seed expected-seed - #.scope-type-vars (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some (#.Primitive primitive_type (list))) + #.seed expected_seed + #.scope_type_vars (list) #.extensions [] #.host []}]] ($_ _.and - (_.cover [/.current-module-name] - (|> /.current-module-name - (/.run expected-lux) - (!expect (^multi (#try.Success actual-current-module) - (text\= expected-current-module actual-current-module))))) + (_.cover [/.current_module_name] + (|> /.current_module_name + (/.run expected_lux) + (!expect (^multi (#try.Success actual_current_module) + (text\= expected_current_module actual_current_module))))) (_.cover [/.normalize] - (and (|> (/.normalize ["" expected-short]) - (/.run expected-lux) - (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text\= expected-current-module actual-module) - (is? expected-short actual-short))))) - (|> (/.normalize [dummy-module expected-short]) - (/.run expected-lux) - (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text\= dummy-module actual-module) - (is? expected-short actual-short))))))) + (and (|> (/.normalize ["" expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success [actual_module actual_short]) + (and (text\= expected_current_module actual_module) + (is? expected_short actual_short))))) + (|> (/.normalize [dummy_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success [actual_module actual_short]) + (and (text\= dummy_module actual_module) + (is? expected_short actual_short))))))) ))) -(def: random-location +(def: random_location (Random Location) ($_ random.and - (random.ascii/upper-alpha 1) + (random.ascii/upper_alpha 1) random.nat random.nat)) @@ -228,75 +228,75 @@ (<| (_.covering /._) ($_ _.and (do {! random.monad} - [target (random.ascii/upper-alpha 1) - version (random.ascii/upper-alpha 1) - source-code (random.ascii/upper-alpha 1) - expected-current-module (random.ascii/upper-alpha 1) - expected-type (\ ! map (function (_ name) + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) (#.Primitive name (list))) - (random.ascii/upper-alpha 1)) - expected-seed random.nat + (random.ascii/upper_alpha 1)) + expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected-error (random.ascii/upper-alpha 1) - expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text\= expected-current-module) not) - (random.ascii/upper-alpha 1)) - expected-gensym (random.ascii/upper-alpha 1) - expected-location ..random-location - #let [expected-lux {#.info {#.target target + expected_error (random.ascii/upper_alpha 1) + expected_short (random.ascii/upper_alpha 1) + dummy_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_gensym (random.ascii/upper_alpha 1) + expected_location ..random_location + #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} - #.source [location.dummy 0 source-code] - #.location expected-location - #.current-module (#.Some expected-current-module) + #.source [location.dummy 0 source_code] + #.location expected_location + #.current_module (#.Some expected_current_module) #.modules (list) #.scopes (list) - #.type-context {#.ex-counter 0 - #.var-counter 0 - #.var-bindings (list)} - #.expected (#.Some expected-type) - #.seed expected-seed - #.scope-type-vars (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some expected_type) + #.seed expected_seed + #.scope_type_vars (list) #.extensions [] #.host []}]] ($_ _.and (_.for [/.functor] - ($functor.spec ..injection (..comparison expected-lux) /.functor)) + ($functor.spec ..injection (..comparison expected_lux) /.functor)) (_.for [/.apply] - ($apply.spec ..injection (..comparison expected-lux) /.apply)) + ($apply.spec ..injection (..comparison expected_lux) /.apply)) (_.for [/.monad] - ($monad.spec ..injection (..comparison expected-lux) /.monad)) + ($monad.spec ..injection (..comparison expected_lux) /.monad)) - ..compiler-related - ..error-handling - ..module-related + ..compiler_related + ..error_handling + ..module_related (_.cover [/.count] (|> (do /.monad [pre /.count post /.count] (wrap [pre post])) - (/.run expected-lux) - (!expect (^multi (#try.Success [actual-pre actual-post]) - (and (n.= expected-seed actual-pre) - (n.= (inc expected-seed) actual-post)))))) + (/.run expected_lux) + (!expect (^multi (#try.Success [actual_pre actual_post]) + (and (n.= expected_seed actual_pre) + (n.= (inc expected_seed) actual_post)))))) (_.cover [/.gensym] - (|> (/.gensym expected-gensym) + (|> (/.gensym expected_gensym) (\ /.monad map %.code) - (/.run expected-lux) - (!expect (^multi (#try.Success actual-gensym) - (and (text.contains? expected-gensym actual-gensym) - (text.contains? (%.nat expected-seed) actual-gensym)))))) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_gensym) + (and (text.contains? expected_gensym actual_gensym) + (text.contains? (%.nat expected_seed) actual_gensym)))))) (_.cover [/.location] (|> /.location - (/.run expected-lux) - (!expect (^multi (#try.Success actual-location) - (is? expected-location actual-location))))) - (_.cover [/.expected-type] - (|> /.expected-type - (/.run expected-lux) - (!expect (^multi (#try.Success actual-type) - (is? expected-type actual-type))))) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_location) + (is? expected_location actual_location))))) + (_.cover [/.expected_type] + (|> /.expected_type + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type))))) )) /annotation.test diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index af0ee2490..3718b8797 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -28,18 +28,18 @@ [macro ["_." code]]]) -(def: random-key +(def: random_key (Random Name) (random.and (random.ascii/alpha 1) (random.ascii/alpha 1))) -(def: (random-sequence random) +(def: (random_sequence random) (All [a] (-> (Random a) (Random (List a)))) (do {! random.monad} [size (|> random.nat (\ ! map (nat.% 3)))] (random.list size random))) -(def: (random-record random) +(def: (random_record random) (All [a] (-> (Random a) (Random (List [a a])))) (do {! random.monad} [size (|> random.nat (\ ! map (nat.% 3)))] @@ -55,10 +55,10 @@ (code.record (list [(code.tag key) value]))) -(def: typed-value +(def: typed_value Test (do {! random.monad} - [key ..random-key] + [key ..random_key] (`` ($_ _.and (~~ (template [<definition> <random> <constructor> <equivalence>] [(do {! random.monad} @@ -74,24 +74,24 @@ [/.nat random.nat code.nat nat.equivalence] [/.int random.int code.int int.equivalence] [/.rev random.rev code.rev rev.equivalence] - [/.frac random.safe-frac code.frac frac.equivalence] + [/.frac random.safe_frac code.frac frac.equivalence] [/.text (random.ascii/alpha 1) code.text text.equivalence] - [/.identifier ..random-key code.identifier name.equivalence] - [/.tag ..random-key code.tag name.equivalence] - [/.form (..random-sequence _code.random) code.form (list.equivalence code.equivalence)] - [/.tuple (..random-sequence _code.random) code.tuple (list.equivalence code.equivalence)] - [/.record (..random-record _code.random) code.record (list.equivalence (product.equivalence code.equivalence code.equivalence))] + [/.identifier ..random_key code.identifier name.equivalence] + [/.tag ..random_key code.tag name.equivalence] + [/.form (..random_sequence _code.random) code.form (list.equivalence code.equivalence)] + [/.tuple (..random_sequence _code.random) code.tuple (list.equivalence code.equivalence)] + [/.record (..random_record _code.random) code.record (list.equivalence (product.equivalence code.equivalence code.equivalence))] )) )))) (def: flag Test (do {! random.monad} - [key ..random-key] + [key ..random_key] (`` ($_ _.and (do ! [dummy (random.filter (|>> (name\= key) not) - ..random-key) + ..random_key) expected random.bit] (_.cover [/.flagged?] (and (|> expected code.bit @@ -106,7 +106,7 @@ [expected random.bit] (_.cover [<definition>] (and (|> expected code.bit - (..annotation (name-of <tag>)) + (..annotation (name_of <tag>)) <definition> (\ bit.equivalence = expected)) (not (|> expected code.bit @@ -114,7 +114,7 @@ <definition>)))))] [/.structure? #.struct?] - [/.recursive-type? #.type-rec?] + [/.recursive_type? #.type-rec?] [/.signature? #.sig?] )) )))) @@ -122,14 +122,14 @@ (def: arguments Test (do {! random.monad} - [key ..random-key] + [key ..random_key] (`` ($_ _.and (~~ (template [<definition> <tag>] [(do ! [expected (random.list 5 (random.ascii/alpha 1))] (_.cover [<definition>] (and (|> expected (list\map code.text) code.tuple - (..annotation (name-of <tag>)) + (..annotation (name_of <tag>)) <definition> (\ (list.equivalence text.equivalence) = expected)) (|> expected (list\map code.text) code.tuple @@ -137,8 +137,8 @@ <definition> (\ (list.equivalence text.equivalence) = (list))))))] - [/.function-arguments #.func-args] - [/.type-arguments #.type-args] + [/.function_arguments #.func-args] + [/.type_arguments #.type-args] )) )))) @@ -147,7 +147,7 @@ (<| (_.covering /._) (_.for [/.Annotation]) (do {! random.monad} - [key ..random-key] + [key ..random_key] ($_ _.and (do ! [expected _code.random] @@ -158,7 +158,7 @@ (!expect (^multi (#.Some actual) (code\= expected actual)))))) - ..typed-value + ..typed_value (do ! [expected (random.ascii/alpha 10)] @@ -169,7 +169,7 @@ (!expect (^multi (#.Some actual) (\ text.equivalence = expected actual))))) (|> expected code.text - (..annotation (name-of #.doc)) + (..annotation (name_of #.doc)) /.documentation (!expect (^multi (#.Some actual) (\ text.equivalence = expected actual))))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index cb3398720..42d4eba11 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -53,7 +53,7 @@ ["#." type (#+ Type) ["." category (#+ Value Object Class)]]]}) -(def: method-modifier +(def: method_modifier ($_ /modifier\compose /method.public /method.static)) @@ -83,17 +83,17 @@ (getClass [] (java/lang/Class java/lang/Object)) (toString [] java/lang/String)]) -(def: class-name +(def: class_name (Random Text) (do random.monad - [super-package (random.ascii/lower-alpha 10) - package (random.ascii/lower-alpha 10) - name (random.ascii/upper-alpha 10)] - (wrap (format super-package - /name.external-separator package - /name.external-separator name)))) + [super_package (random.ascii/lower_alpha 10) + package (random.ascii/lower_alpha 10) + name (random.ascii/upper_alpha 10)] + (wrap (format super_package + /name.external_separator package + /name.external_separator name)))) -(def: (get-method name class) +(def: (get_method name class) (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method) (java/lang/Class::getDeclaredMethod name (host.array (java/lang/Class java/lang/Object) 0) @@ -104,16 +104,16 @@ (def: (bytecode test bytecode) (-> (-> Any Bit) (Bytecode Any) (Random Bit)) (do random.monad - [class-name ..class-name - method-name (random.ascii/upper-alpha 10)] + [class_name ..class_name + method_name (random.ascii/upper_alpha 10)] (wrap (case (do try.monad [class (/class.class /version.v6_0 /class.public - (/name.internal class-name) + (/name.internal class_name) (/name.internal "java.lang.Object") (list) (list) - (list (/method.method ..method-modifier - method-name + (list (/method.method ..method_modifier + method_name (/type.method [(list) ..$Object (list)]) (list) (#.Some (do /.monad @@ -121,10 +121,10 @@ /.areturn)))) (row.row)) #let [bytecode (format.run /class.writer class) - loader (/loader.memory (/loader.new-library []))] - _ (/loader.define class-name bytecode loader) - class (io.run (/loader.load class-name loader)) - method (host.try (get-method method-name class))] + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run (/loader.load class_name loader)) + method (host.try (get_method method_name class))] (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)) (#try.Success actual) (test actual) @@ -165,10 +165,10 @@ (/.invokestatic ..$Byte "valueOf" (/type.method [(list /type.byte) ..$Byte (list)]))) (def: $Byte::random (Random java/lang/Byte) - (\ random.monad map (|>> (:coerce java/lang/Long) host.long-to-byte) random.int)) + (\ random.monad map (|>> (:coerce java/lang/Long) host.long_to_byte) random.int)) (def: $Byte::literal (-> java/lang/Byte (Bytecode Any)) - (|>> host.byte-to-long (:coerce I64) i32.i32 /.int)) + (|>> host.byte_to_long (:coerce I64) i32.i32 /.int)) (def: $Byte::primitive (Primitive java/lang/Byte) {#unboxed /type.byte @@ -183,10 +183,10 @@ (/.invokestatic ..$Short "valueOf" (/type.method [(list /type.short) ..$Short (list)]))) (def: $Short::random (Random java/lang/Short) - (\ random.monad map (|>> (:coerce java/lang/Long) host.long-to-short) random.int)) + (\ random.monad map (|>> (:coerce java/lang/Long) host.long_to_short) random.int)) (def: $Short::literal (-> java/lang/Short (Bytecode Any)) - (|>> host.short-to-long (:coerce I64) i32.i32 /.int)) + (|>> host.short_to_long (:coerce I64) i32.i32 /.int)) (def: $Short::primitive (Primitive java/lang/Short) {#unboxed /type.short @@ -201,10 +201,10 @@ (/.invokestatic ..$Integer "valueOf" (/type.method [(list /type.int) ..$Integer (list)]))) (def: $Integer::random (Random java/lang/Integer) - (\ random.monad map (|>> (:coerce java/lang/Long) host.long-to-int) random.int)) + (\ random.monad map (|>> (:coerce java/lang/Long) host.long_to_int) random.int)) (def: $Integer::literal (-> java/lang/Integer (Bytecode Any)) - (|>> host.int-to-long (:coerce I64) i32.i32 /.int)) + (|>> host.int_to_long (:coerce I64) i32.i32 /.int)) (def: $Integer::primitive (Primitive java/lang/Integer) {#unboxed /type.int @@ -230,19 +230,19 @@ (def: $Float::random (Random java/lang/Float) (\ random.monad map - (|>> (:coerce java/lang/Double) host.double-to-float) + (|>> (:coerce java/lang/Double) host.double_to_float) random.frac)) (def: $Float::literal /.float) -(def: valid-float +(def: valid_float (Random java/lang/Float) - (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + (random.filter (|>> host.float_to_double (:coerce Frac) f.not_a_number? not) ..$Float::random)) (def: $Float::primitive (Primitive java/lang/Float) {#unboxed /type.float #boxed ..$Float #wrap ..$Float::wrap - #random ..valid-float + #random ..valid_float #literal ..$Float::literal}) (def: $Double (/type.class "java.lang.Double" (list))) @@ -251,16 +251,16 @@ (def: $Double::literal (-> java/lang/Double (Bytecode Any)) (|>> (:coerce Frac) /.double)) -(def: valid-double +(def: valid_double (Random java/lang/Double) - (random.filter (|>> (:coerce Frac) f.not-a-number? not) + (random.filter (|>> (:coerce Frac) f.not_a_number? not) ..$Double::random)) (def: $Double::primitive (Primitive java/lang/Double) {#unboxed /type.double #boxed ..$Double #wrap ..$Double::wrap - #random ..valid-double + #random ..valid_double #literal ..$Double::literal}) (def: $Character @@ -269,10 +269,10 @@ (/.invokestatic ..$Character "valueOf" (/type.method [(list /type.char) ..$Character (list)]))) (def: $Character::random (Random java/lang/Character) - (\ random.monad map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-char) random.int)) + (\ random.monad map (|>> (:coerce java/lang/Long) host.long_to_int host.int_to_char) random.int)) (def: $Character::literal (-> java/lang/Character (Bytecode Any)) - (|>> host.char-to-long (:coerce I64) i32.i32 /.int)) + (|>> host.char_to_long (:coerce I64) i32.i32 /.int)) (def: $Character::primitive (Primitive java/lang/Character) {#unboxed /type.char @@ -300,34 +300,34 @@ #random ..$String::random #literal ..$String::literal}) -(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <signed>] +(template [<name> <bits> <type> <push> <wrap> <message> <to_long> <signed>] [(def: <name> Test (do {! random.monad} [expected (\ ! map (i64.and (i64.mask <bits>)) random.nat)] (<| (_.lift <message>) (..bytecode (for {@.old - (|>> (:coerce <type>) <to-long> ("jvm leq" expected)) + (|>> (:coerce <type>) <to_long> ("jvm leq" expected)) @.jvm - (|>> (:coerce <type>) <to-long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) + (|>> (:coerce <type>) <to_long> "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) (do /.monad [_ (<push> (|> expected .int <signed> try.assume))] <wrap>))))] - [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /signed.s1] - [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /signed.s2] + [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte_to_long /signed.s1] + [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short_to_long /signed.s2] ) (template [<name> <type>] - [(template: (<name> <old-extension> <new-extension>) + [(template: (<name> <old_extension> <new_extension>) (: (-> <type> <type> <type>) (function (_ parameter subject) (for {@.old - (<old-extension> subject parameter) + (<old_extension> subject parameter) @.jvm ("jvm object cast" - (<new-extension> ("jvm object cast" parameter) + (<new_extension> ("jvm object cast" parameter) ("jvm object cast" subject)))}))))] [int/2 java/lang/Integer] @@ -336,15 +336,15 @@ [double/2 java/lang/Double] ) -(template: (int+long/2 <old-extension> <new-extension>) +(template: (int+long/2 <old_extension> <new_extension>) (: (-> java/lang/Integer java/lang/Long java/lang/Long) (function (_ parameter subject) (for {@.old - (<old-extension> subject parameter) + (<old_extension> subject parameter) @.jvm ("jvm object cast" - (<new-extension> ("jvm object cast" parameter) + (<new_extension> ("jvm object cast" parameter) ("jvm object cast" subject)))})))) (def: int @@ -382,7 +382,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do {! random.monad} - [parameter (\ ! map (|>> (n.% 32) .int (:coerce java/lang/Long) host.long-to-int) random.nat) + [parameter (\ ! map (|>> (n.% 32) .int (:coerce java/lang/Long) host.long_to_int) random.nat) subject ..$Integer::random] (int (reference parameter subject) (do /.monad @@ -390,13 +390,13 @@ _ (..$Integer::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "ICONST_M1" (int (host.long-to-int (:coerce java/lang/Long -1)) /.iconst-m1)) - (_.lift "ICONST_0" (int (host.long-to-int (:coerce java/lang/Long +0)) /.iconst-0)) - (_.lift "ICONST_1" (int (host.long-to-int (:coerce java/lang/Long +1)) /.iconst-1)) - (_.lift "ICONST_2" (int (host.long-to-int (:coerce java/lang/Long +2)) /.iconst-2)) - (_.lift "ICONST_3" (int (host.long-to-int (:coerce java/lang/Long +3)) /.iconst-3)) - (_.lift "ICONST_4" (int (host.long-to-int (:coerce java/lang/Long +4)) /.iconst-4)) - (_.lift "ICONST_5" (int (host.long-to-int (:coerce java/lang/Long +5)) /.iconst-5)) + (_.lift "ICONST_M1" (int (host.long_to_int (:coerce java/lang/Long -1)) /.iconst_m1)) + (_.lift "ICONST_0" (int (host.long_to_int (:coerce java/lang/Long +0)) /.iconst_0)) + (_.lift "ICONST_1" (int (host.long_to_int (:coerce java/lang/Long +1)) /.iconst_1)) + (_.lift "ICONST_2" (int (host.long_to_int (:coerce java/lang/Long +2)) /.iconst_2)) + (_.lift "ICONST_3" (int (host.long_to_int (:coerce java/lang/Long +3)) /.iconst_3)) + (_.lift "ICONST_4" (int (host.long_to_int (:coerce java/lang/Long +4)) /.iconst_4)) + (_.lift "ICONST_5" (int (host.long_to_int (:coerce java/lang/Long +5)) /.iconst_5)) (_.lift "LDC_W/INTEGER" (do random.monad [expected ..$Integer::random] @@ -410,7 +410,7 @@ (_.lift "INEG" (unary (function (_ value) ((int/2 "jvm isub" "jvm int -") value - (host.long-to-int (:coerce java/lang/Long +0)))) + (host.long_to_int (:coerce java/lang/Long +0)))) /.ineg))) bitwise ($_ _.and (_.lift "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) @@ -463,14 +463,14 @@ (do {! random.monad} [parameter (\ ! map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) subject ..$Long::random] - (long (reference (host.long-to-int parameter) subject) + (long (reference (host.long_to_int parameter) subject) (do /.monad [_ (..$Long::literal subject) - _ (..$Integer::literal (host.long-to-int parameter))] + _ (..$Integer::literal (host.long_to_int parameter))] instruction))))) literal ($_ _.and - (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst-0)) - (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst-1)) + (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst_0)) + (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst_1)) (_.lift "LDC2_W/LONG" (do random.monad [expected ..$Long::random] @@ -534,14 +534,14 @@ (<| (..bytecode (for {@.old (function (_ actual) (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected)) - (and (f.not-a-number? (:coerce Frac (host.float-to-double expected))) - (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual))))))) + (and (f.not_a_number? (:coerce Frac (host.float_to_double expected))) + (f.not_a_number? (:coerce Frac (host.float_to_double (:coerce java/lang/Float actual))))))) @.jvm (function (_ actual) (or (|> actual (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) - (and (f.not-a-number? (:coerce Frac (host.float-to-double expected))) - (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual)))))))})) + (and (f.not_a_number? (:coerce Frac (host.float_to_double expected))) + (f.not_a_number? (:coerce Frac (host.float_to_double (:coerce java/lang/Float actual)))))))})) (do /.monad [_ bytecode] ..$Float::wrap)))) @@ -568,9 +568,9 @@ _ (..$Float::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0)) - (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1)) - (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2)) + (_.lift "FCONST_0" (float (host.double_to_float (:coerce java/lang/Double +0.0)) /.fconst_0)) + (_.lift "FCONST_1" (float (host.double_to_float (:coerce java/lang/Double +1.0)) /.fconst_1)) + (_.lift "FCONST_2" (float (host.double_to_float (:coerce java/lang/Double +2.0)) /.fconst_2)) (_.lift "LDC_W/FLOAT" (do random.monad [expected ..$Float::random] @@ -584,15 +584,15 @@ (_.lift "FNEG" (unary (function (_ value) ((float/2 "jvm fsub" "jvm float -") value - (host.double-to-float (:coerce java/lang/Double +0.0)))) + (host.double_to_float (:coerce java/lang/Double +0.0)))) /.fneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [#let [valid-float (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + [#let [valid_float (random.filter (|>> host.float_to_double (:coerce Frac) f.not_a_number? not) ..$Float::random)] - reference valid-float - subject valid-float + reference valid_float + subject valid_float #let [expected (if (for {@.old ("jvm feq" reference subject) @@ -609,7 +609,7 @@ _ instruction _ /.i2l] ..$Long::wrap))))) - comparison-standard (: (-> java/lang/Float java/lang/Float Bit) + comparison_standard (: (-> java/lang/Float java/lang/Float Bit) (function (_ reference subject) (for {@.old ("jvm fgt" subject reference) @@ -617,8 +617,8 @@ @.jvm ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))}))) comparison ($_ _.and - (_.lift "FCMPL" (comparison /.fcmpl comparison-standard)) - (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))] + (_.lift "FCMPL" (comparison /.fcmpl comparison_standard)) + (_.lift "FCMPG" (comparison /.fcmpg comparison_standard)))] ($_ _.and (<| (_.context "literal") literal) @@ -635,14 +635,14 @@ (<| (..bytecode (for {@.old (function (_ actual) (or (|> actual (:coerce java/lang/Double) ("jvm deq" expected)) - (and (f.not-a-number? (:coerce Frac expected)) - (f.not-a-number? (:coerce Frac actual))))) + (and (f.not_a_number? (:coerce Frac expected)) + (f.not_a_number? (:coerce Frac actual))))) @.jvm (function (_ actual) (or (|> actual (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) - (and (f.not-a-number? (:coerce Frac expected)) - (f.not-a-number? (:coerce Frac actual)))))})) + (and (f.not_a_number? (:coerce Frac expected)) + (f.not_a_number? (:coerce Frac actual)))))})) (do /.monad [_ bytecode] ..$Double::wrap)))) @@ -665,8 +665,8 @@ _ (..$Double::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst-0)) - (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst-1)) + (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst_0)) + (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst_1)) (_.lift "LDC2_W/DOUBLE" (do random.monad [expected ..$Double::random] @@ -685,8 +685,8 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [reference ..valid-double - subject ..valid-double + [reference ..valid_double + subject ..valid_double #let [expected (if (for {@.old ("jvm deq" reference subject) @@ -704,7 +704,7 @@ _ /.i2l] ..$Long::wrap))))) ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op - comparison-standard (: (-> java/lang/Double java/lang/Double Bit) + comparison_standard (: (-> java/lang/Double java/lang/Double Bit) (function (_ reference subject) (for {@.old ("jvm dgt" subject reference) @@ -712,8 +712,8 @@ @.jvm ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))}))) comparison ($_ _.and - (_.lift "DCMPL" (comparison /.dcmpl comparison-standard)) - (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))] + (_.lift "DCMPL" (comparison /.dcmpl comparison_standard)) + (_.lift "DCMPG" (comparison /.dcmpg comparison_standard)))] ($_ _.and (<| (_.context "literal") literal) @@ -751,7 +751,7 @@ (<| (_.lift "ACONST_NULL") (..bytecode (|>> (:coerce Bit) not)) (do /.monad - [_ /.aconst-null + [_ /.aconst_null _ (/.instanceof ..$String)] ..$Boolean::wrap)) (<| (_.lift "INSTANCEOF") @@ -786,7 +786,7 @@ ($_ _.and (<| (_.lift "INVOKESTATIC") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not) + [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) @@ -799,7 +799,7 @@ (<| (_.lift "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) - (..bytecode (|>> (:coerce Bit) (bit\= (f.not-a-number? (:coerce Frac expected))))) + (..bytecode (|>> (:coerce Bit) (bit\= (f.not_a_number? (:coerce Frac expected))))) (do /.monad [_ (/.double (:coerce Frac expected)) _ ..$Double::wrap @@ -807,7 +807,7 @@ ..$Boolean::wrap)) (<| (_.lift "INVOKESPECIAL") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not) + [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) @@ -833,7 +833,7 @@ (def: field Test (do random.monad - [class-name ..class-name + [class_name ..class_name part0 ..$Long::random part1 ..$Long::random #let [expected (: java/lang/Long @@ -843,35 +843,35 @@ @.jvm ("jvm object cast" ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))})) - $Self (/type.class class-name (list)) - class-field "class_field" - object-field "object_field" + $Self (/type.class class_name (list)) + class_field "class_field" + object_field "object_field" constructor "<init>" constructor::type (/type.method [(list /type.long) /type.void (list)]) - static-method "static_method" + static_method "static_method" bytecode (|> (/class.class /version.v6_0 /class.public - (/name.internal class-name) + (/name.internal class_name) (/name.internal "java.lang.Object") (list) - (list (/field.field /field.static class-field /type.long (row.row)) - (/field.field /field.public object-field /type.long (row.row))) + (list (/field.field /field.static class_field /type.long (row.row)) + (/field.field /field.public object_field /type.long (row.row))) (list (/method.method /method.private constructor constructor::type (list) (#.Some (do /.monad - [_ /.aload-0 + [_ /.aload_0 _ (/.invokespecial ..$Object constructor (/type.method [(list) /type.void (list)])) _ (..$Long::literal part0) - _ (/.putstatic $Self class-field /type.long) - _ /.aload-0 - _ /.lload-1 - _ (/.putfield $Self object-field /type.long)] + _ (/.putstatic $Self class_field /type.long) + _ /.aload_0 + _ /.lload_1 + _ (/.putfield $Self object_field /type.long)] /.return))) (/method.method ($_ /modifier\compose /method.public /method.static) - static-method + static_method (/type.method [(list) ..$Long (list)]) (list) (#.Some (do /.monad @@ -879,20 +879,20 @@ _ /.dup _ (..$Long::literal part1) _ (/.invokespecial $Self constructor constructor::type) - _ (/.getfield $Self object-field /type.long) - _ (/.getstatic $Self class-field /type.long) + _ (/.getfield $Self object_field /type.long) + _ (/.getstatic $Self class_field /type.long) _ /.ladd _ ..$Long::wrap] /.areturn)))) (row.row)) try.assume (format.run /class.writer)) - loader (/loader.memory (/loader.new-library []))]] + loader (/loader.memory (/loader.new_library []))]] (_.test "PUTSTATIC & PUTFIELD & GETFIELD & GETSTATIC" (case (do try.monad - [_ (/loader.define class-name bytecode loader) - class (io.run (/loader.load class-name loader)) - method (host.try (get-method static-method class)) + [_ (/loader.define class_name bytecode loader) + class (io.run (/loader.load class_name loader)) + method (host.try (get_method static_method class)) output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)] (wrap (:coerce Int output))) (#try.Success actual) @@ -920,14 +920,14 @@ _ constructor _ ?length] $Long::wrap)))) - write-and-read (: (All [a] + write_and_read (: (All [a] (-> Nat (Bytecode Any) a (-> a (Bytecode Any)) [(Bytecode Any) (Bytecode Any) (Bytecode Any)] (-> a Any Bit) (Random Bit))) (function (_ size constructor value literal [*store *load *wrap] test) - (let [!index ($Integer::literal (host.long-to-int (:coerce java/lang/Long +0)))] + (let [!index ($Integer::literal (host.long_to_int (:coerce java/lang/Long +0)))] (<| (..bytecode (test value)) (do /.monad [_ (!length size) @@ -948,29 +948,29 @@ (<| (_.lift "length") (length size constructor)) (<| (_.lift "write and read") - (write-and-read size constructor value literal [*store *load *wrap] test))))))] + (write_and_read size constructor value literal [*store *load *wrap] test))))))] ($_ _.and (_.context "boolean" - (array (/.newarray /instruction.t-boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] + (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] (function (_ expected) (|>> (:coerce Bit) (bit\= (:coerce Bit expected)))))) (_.context "byte" - (array (/.newarray /instruction.t-byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] + (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected))) + (|>> (:coerce java/lang/Byte) host.byte_to_long ("jvm leq" (host.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) host.byte-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte-to-long (:coerce java/lang/Byte expected)))))})))) + (|>> (:coerce java/lang/Byte) host.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte_to_long (:coerce java/lang/Byte expected)))))})))) (_.context "short" - (array (/.newarray /instruction.t-short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] + (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected))) + (|>> (:coerce java/lang/Short) host.short_to_long ("jvm leq" (host.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) host.short-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short-to-long (:coerce java/lang/Short expected)))))})))) + (|>> (:coerce java/lang/Short) host.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short_to_long (:coerce java/lang/Short expected)))))})))) (_.context "int" - (array (/.newarray /instruction.t-int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] + (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Integer) ("jvm ieq" (:coerce java/lang/Integer expected))) @@ -978,7 +978,7 @@ @.jvm (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:coerce java/lang/Integer expected))))})))) (_.context "long" - (array (/.newarray /instruction.t-long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] + (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Long) ("jvm leq" expected)) @@ -986,7 +986,7 @@ @.jvm (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})))) (_.context "float" - (array (/.newarray /instruction.t-float) ..valid-float $Float::literal [/.fastore /.faload $Float::wrap] + (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Float) ("jvm feq" expected)) @@ -994,7 +994,7 @@ @.jvm (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))})))) (_.context "double" - (array (/.newarray /instruction.t-double) ..valid-double $Double::literal [/.dastore /.daload $Double::wrap] + (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) @@ -1002,7 +1002,7 @@ @.jvm (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:coerce java/lang/Double expected))))})))) (_.context "char" - (array (/.newarray /instruction.t-char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] + (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Character) ("jvm ceq" expected)) @@ -1028,7 +1028,7 @@ (<| (_.lift "MULTIANEWARRAY") (..bytecode (|>> (:coerce Nat) (n.= sizesH))) (do {! /.monad} - [_ (monad.map ! (|>> (:coerce java/lang/Long) host.long-to-int ..$Integer::literal) + [_ (monad.map ! (|>> (:coerce java/lang/Long) host.long_to_int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) _ ?length] @@ -1064,40 +1064,40 @@ ($_ _.and (<| (_.context "int") ($_ _.and - (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> host.int-to-long) long::=)) - (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> host.int-to-float) float::=)) - (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> host.int-to-double) double::=)) - (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> host.int-to-byte) + (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> host.int_to_long) long::=)) + (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> host.int_to_float) float::=)) + (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> host.int_to_double) double::=)) + (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> host.int_to_byte) (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected))) + (|>> (:coerce java/lang/Byte) host.byte_to_long ("jvm leq" (host.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) host.byte-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte-to-long (:coerce java/lang/Byte expected)))))})))) - (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> host.int-to-char) + (|>> (:coerce java/lang/Byte) host.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte_to_long (:coerce java/lang/Byte expected)))))})))) + (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> host.int_to_char) (!::= java/lang/Character "jvm ceq" "jvm char ="))) - (_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> host.int-to-short) + (_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> host.int_to_short) (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected))) + (|>> (:coerce java/lang/Short) host.short_to_long ("jvm leq" (host.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) host.short-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short-to-long (:coerce java/lang/Short expected)))))})))))) + (|>> (:coerce java/lang/Short) host.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short_to_long (:coerce java/lang/Short expected)))))})))))) (<| (_.context "long") ($_ _.and - (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> host.long-to-int) int::=)) - (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> host.long-to-float) float::=)) - (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> host.long-to-double) double::=)))) + (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> host.long_to_int) int::=)) + (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> host.long_to_float) float::=)) + (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> host.long_to_double) double::=)))) (<| (_.context "float") ($_ _.and - (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> host.float-to-int) int::=)) - (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> host.float-to-long) long::=)) - (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> host.float-to-double) double::=)))) + (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> host.float_to_int) int::=)) + (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> host.float_to_long) long::=)) + (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> host.float_to_double) double::=)))) (<| (_.context "double") ($_ _.and - (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> host.double-to-int) int::=)) - (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> host.double-to-long) long::=)) - (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> host.double-to-float) float::=)))) + (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> host.double_to_int) int::=)) + (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> host.double_to_long) long::=)) + (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> host.double_to_float) float::=)))) ))) (def: value @@ -1119,14 +1119,14 @@ (def: registry Test - (let [store-and-load (: (All [a] + (let [store_and_load (: (All [a] (-> (Random a) (-> a (Bytecode Any)) (Bytecode Any) [(-> Nat (Bytecode Any)) (-> Nat (Bytecode Any))] (-> a (-> Any Bit)) (Random Bit))) - (function (_ random-value literal *wrap [store load] test) + (function (_ random_value literal *wrap [store load] test) (do {! random.monad} - [expected random-value + [expected random_value register (\ ! map (n.% 128) random.nat)] (<| (..bytecode (test expected)) (do /.monad @@ -1139,15 +1139,15 @@ (let [test (!::= java/lang/Integer "jvm ieq" "jvm int =")] ($_ _.and (_.lift "ISTORE_0/ILOAD_0" - (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore-0) (function.constant /.iload-0)] test)) + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) (_.lift "ISTORE_1/ILOAD_1" - (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore-1) (function.constant /.iload-1)] test)) + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) (_.lift "ISTORE_2/ILOAD_2" - (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore-2) (function.constant /.iload-2)] test)) + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) (_.lift "ISTORE_3/ILOAD_3" - (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore-3) (function.constant /.iload-3)] test)) + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) (_.lift "ISTORE/ILOAD" - (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) (_.lift "IINC" (do {! random.monad} [base ..$Byte::random @@ -1156,110 +1156,110 @@ #let [expected (: java/lang/Long (for {@.old ("jvm ladd" - (host.byte-to-long base) + (host.byte_to_long base) (.int (/unsigned.value increment))) @.jvm ("jvm object cast" ("jvm long +" - ("jvm object cast" (host.byte-to-long base)) + ("jvm object cast" (host.byte_to_long base)) ("jvm object cast" (:coerce java/lang/Long (/unsigned.value increment)))))}))]] (..bytecode (|>> (:coerce Int) (i.= (:coerce Int expected))) (do /.monad [_ (..$Byte::literal base) - _ /.istore-0 + _ /.istore_0 _ (/.iinc 0 increment) - _ /.iload-0 + _ /.iload_0 _ /.i2l] ..$Long::wrap))))))) (<| (_.context "long") (let [test (!::= java/lang/Long "jvm leq" "jvm long =")] ($_ _.and (_.lift "LSTORE_0/LLOAD_0" - (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore-0) (function.constant /.lload-0)] test)) + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) (_.lift "LSTORE_1/LLOAD_1" - (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore-1) (function.constant /.lload-1)] test)) + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) (_.lift "LSTORE_2/LLOAD_2" - (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore-2) (function.constant /.lload-2)] test)) + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) (_.lift "LSTORE_3/LLOAD_3" - (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore-3) (function.constant /.lload-3)] test)) + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) (_.lift "LSTORE/LLOAD" - (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) (<| (_.context "float") (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] ($_ _.and (_.lift "FSTORE_0/FLOAD_0" - (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) (_.lift "FSTORE_1/FLOAD_1" - (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) (_.lift "FSTORE_2/FLOAD_2" - (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) (_.lift "FSTORE_3/FLOAD_3" - (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) (_.lift "FSTORE/FLOAD" - (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) (<| (_.context "double") (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and (_.lift "DSTORE_0/DLOAD_0" - (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-0) (function.constant /.dload-0)] test)) + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) (_.lift "DSTORE_1/DLOAD_1" - (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-1) (function.constant /.dload-1)] test)) + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) (_.lift "DSTORE_2/DLOAD_2" - (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-2) (function.constant /.dload-2)] test)) + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) (_.lift "DSTORE_3/DLOAD_3" - (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [(function.constant /.dstore-3) (function.constant /.dload-3)] test)) + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) (_.lift "DSTORE/DLOAD" - (store-and-load ..valid-double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) (|> actual (:coerce Text) (text\= (:coerce Text expected)))))] ($_ _.and (_.lift "ASTORE_0/ALOAD_0" - (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-0) (function.constant /.aload-0)] test)) + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) (_.lift "ASTORE_1/ALOAD_1" - (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-1) (function.constant /.aload-1)] test)) + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) (_.lift "ASTORE_2/ALOAD_2" - (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-2) (function.constant /.aload-2)] test)) + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) (_.lift "ASTORE_3/ALOAD_3" - (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-3) (function.constant /.aload-3)] test)) + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) (_.lift "ASTORE/ALOAD" - (store-and-load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) + (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) ))) (def: stack Test (do random.monad [expected/1 $String::random - #let [object-test (: (-> Any Bit) + #let [object_test (: (-> Any Bit) (|>> (:coerce Text) (text\= (:coerce Text expected/1))))] dummy/1 $String::random #let [single ($_ _.and (<| (_.lift "DUP & POP") - (..bytecode object-test) + (..bytecode object_test) (do /.monad [_ ($String::literal expected/1) _ /.dup] /.pop)) (<| (_.lift "DUP_X1 & POP2") - (..bytecode object-test) + (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) _ ($String::literal expected/1) - _ /.dup-x1] + _ /.dup_x1] /.pop2)) (<| (_.lift "DUP_X2") - (..bytecode object-test) + (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) _ ($String::literal dummy/1) _ ($String::literal expected/1) - _ /.dup-x2 + _ /.dup_x2 _ /.pop2] /.pop)) (<| (_.lift "SWAP") - (..bytecode object-test) + (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) _ ($String::literal expected/1) @@ -1267,32 +1267,32 @@ /.pop)) )] expected/2 $Long::random - #let [long-test (: (-> Any Bit) + #let [long_test (: (-> Any Bit) (|>> (:coerce Int) (i.= (:coerce Int expected/2))))] dummy/2 $Long::random #let [double ($_ _.and (<| (_.lift "DUP2") - (..bytecode long-test) + (..bytecode long_test) (do /.monad [_ ($Long::literal expected/2) _ /.dup2 _ /.pop2] ..$Long::wrap)) (<| (_.lift "DUP2_X1") - (..bytecode long-test) + (..bytecode long_test) (do /.monad [_ ($String::literal dummy/1) _ ($Long::literal expected/2) - _ /.dup2-x1 + _ /.dup2_x1 _ /.pop2 _ /.pop] ..$Long::wrap)) (<| (_.lift "DUP2_X2") - (..bytecode long-test) + (..bytecode long_test) (do /.monad [_ ($Long::literal dummy/2) _ ($Long::literal expected/2) - _ /.dup2-x2 + _ /.dup2_x2 _ /.pop2 _ /.pop2] ..$Long::wrap)) @@ -1315,35 +1315,35 @@ (def: return Test - (let [primitive-return (: (All [a] (-> (Primitive a) (Bytecode Any) (Maybe (-> a (Bytecode Any))) (-> a Any Bit) (Random Bit))) + (let [primitive_return (: (All [a] (-> (Primitive a) (Bytecode Any) (Maybe (-> a (Bytecode Any))) (-> a Any Bit) (Random Bit))) (function (_ primitive return substitute test) (do random.monad - [class-name ..class-name - primitive-method-name (random.ascii/upper-alpha 10) - #let [primitive-method-type (/type.method [(list) (get@ #unboxed primitive) (list)])] - object-method-name (|> (random.ascii/upper-alpha 10) - (random.filter (|>> (text\= primitive-method-name) not))) + [class_name ..class_name + primitive_method_name (random.ascii/upper_alpha 10) + #let [primitive_method_type (/type.method [(list) (get@ #unboxed primitive) (list)])] + object_method_name (|> (random.ascii/upper_alpha 10) + (random.filter (|>> (text\= primitive_method_name) not))) expected (get@ #random primitive) - #let [$Self (/type.class class-name (list))]] + #let [$Self (/type.class class_name (list))]] (wrap (case (do try.monad [class (/class.class /version.v6_0 /class.public - (/name.internal class-name) + (/name.internal class_name) (/name.internal "java.lang.Object") (list) (list) - (list (/method.method ..method-modifier - primitive-method-name - primitive-method-type + (list (/method.method ..method_modifier + primitive_method_name + primitive_method_type (list) (#.Some (do /.monad [_ ((get@ #literal primitive) expected)] return))) - (/method.method ..method-modifier - object-method-name + (/method.method ..method_modifier + object_method_name (/type.method [(list) (get@ #boxed primitive) (list)]) (list) (#.Some (do /.monad - [_ (/.invokestatic $Self primitive-method-name primitive-method-type) + [_ (/.invokestatic $Self primitive_method_name primitive_method_type) _ (case substitute #.None (wrap []) @@ -1354,10 +1354,10 @@ /.areturn)))) (row.row)) #let [bytecode (format.run /class.writer class) - loader (/loader.memory (/loader.new-library []))] - _ (/loader.define class-name bytecode loader) - class (io.run (/loader.load class-name loader)) - method (host.try (get-method object-method-name class))] + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run (/loader.load class_name loader)) + method (host.try (get_method object_method_name class))] (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)) (#try.Success actual) (test expected actual) @@ -1366,12 +1366,12 @@ false) ))))] ($_ _.and - (_.lift "IRETURN" (primitive-return ..$Integer::primitive /.ireturn #.None (!::= java/lang/Integer "jvm ieq" "jvm int ="))) - (_.lift "LRETURN" (primitive-return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) - (_.lift "FRETURN" (primitive-return ..$Float::primitive /.freturn #.None (!::= java/lang/Float "jvm feq" "jvm float ="))) - (_.lift "DRETURN" (primitive-return ..$Double::primitive /.dreturn #.None (!::= java/lang/Double "jvm deq" "jvm double ="))) - (_.lift "ARETURN" (primitive-return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:coerce Text expected) (:coerce Text actual))))) - (_.lift "RETURN" (primitive-return (: (Primitive java/lang/String) + (_.lift "IRETURN" (primitive_return ..$Integer::primitive /.ireturn #.None (!::= java/lang/Integer "jvm ieq" "jvm int ="))) + (_.lift "LRETURN" (primitive_return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) + (_.lift "FRETURN" (primitive_return ..$Float::primitive /.freturn #.None (!::= java/lang/Float "jvm feq" "jvm float ="))) + (_.lift "DRETURN" (primitive_return ..$Double::primitive /.dreturn #.None (!::= java/lang/Double "jvm deq" "jvm double ="))) + (_.lift "ARETURN" (primitive_return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:coerce Text expected) (:coerce Text actual))))) + (_.lift "RETURN" (primitive_return (: (Primitive java/lang/String) {#unboxed /type.void #boxed ..$String #wrap /.nop @@ -1391,25 +1391,25 @@ (function (_ instruction prelude) (<| (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad - [@then /.new-label - @end /.new-label + [@then /.new_label + @end /.new_label _ prelude _ (instruction @then) _ (..$Long::literal dummy) _ (/.goto @end) - _ (/.set-label @then) + _ (/.set_label @then) _ (..$Long::literal expected) - _ (/.set-label @end)] + _ (/.set_label @end)] ..$Long::wrap)))) - comparison-against-zero ($_ _.and - (_.lift "IFEQ" (if! /.ifeq /.iconst-0)) - (_.lift "IFNE" (if! /.ifne /.iconst-1)) - (_.lift "IFLT" (if! /.iflt /.iconst-m1)) - (_.lift "IFLE" (if! /.ifle /.iconst-0)) - (_.lift "IFGT" (if! /.ifgt /.iconst-1)) - (_.lift "IFGE" (if! /.ifge /.iconst-0))) - null-test ($_ _.and - (_.lift "IFNULL" (if! /.ifnull /.aconst-null)) + comparison_against_zero ($_ _.and + (_.lift "IFEQ" (if! /.ifeq /.iconst_0)) + (_.lift "IFNE" (if! /.ifne /.iconst_1)) + (_.lift "IFLT" (if! /.iflt /.iconst_m1)) + (_.lift "IFLE" (if! /.ifle /.iconst_0)) + (_.lift "IFGT" (if! /.ifgt /.iconst_1)) + (_.lift "IFGE" (if! /.ifge /.iconst_0))) + null_test ($_ _.and + (_.lift "IFNULL" (if! /.ifnull /.aconst_null)) (_.lift "IFNONNULL" (if! /.ifnonnull (/.string ""))))] reference ..$Integer::random subject (|> ..$Integer::random @@ -1421,27 +1421,27 @@ ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))}) [reference subject] [subject reference]) - int-comparison ($_ _.and - (_.lift "IF_ICMPEQ" (if! /.if-icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) - (_.lift "IF_ICMPNE" (if! /.if-icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) - (_.lift "IF_ICMPLT" (if! /.if-icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lift "IF_ICMPLE" (if! /.if-icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lift "IF_ICMPGT" (if! /.if-icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) - (_.lift "IF_ICMPGE" (if! /.if-icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) - new-object (: (Bytecode Any) + int_comparison ($_ _.and + (_.lift "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) + (_.lift "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) + (_.lift "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lift "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lift "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) + (_.lift "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) + new_object (: (Bytecode Any) (do /.monad [_ (/.new ..$Object) _ /.dup] (/.invokespecial ..$Object "<init>" (/type.method [(list) /type.void (list)])))) - reference-comparison ($_ _.and - (_.lift "IF_ACMPEQ" (if! /.if-acmpeq (do /.monad [_ new-object] /.dup))) - (_.lift "IF_ACMPNE" (if! /.if-acmpne (do /.monad [_ new-object] new-object))) + reference_comparison ($_ _.and + (_.lift "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) + (_.lift "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) )]] ($_ _.and - comparison-against-zero - null-test - int-comparison - reference-comparison + comparison_against_zero + null_test + int_comparison + reference_comparison ))) (def: jump @@ -1453,20 +1453,20 @@ (function (_ goto) (<| (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad - [@skipped /.new-label - @value /.new-label - @end /.new-label + [@skipped /.new_label + @value /.new_label + @end /.new_label _ (goto @value) - _ (/.set-label @skipped) + _ (/.set_label @skipped) _ (..$Long::literal dummy) _ (goto @end) - _ (/.set-label @value) + _ (/.set_label @value) _ (..$Long::literal expected) - _ (/.set-label @end)] + _ (/.set_label @end)] ..$Long::wrap))))]] ($_ _.and (_.lift "GOTO" (jump /.goto)) - (_.lift "GOTO_W" (jump /.goto-w))))) + (_.lift "GOTO_W" (jump /.goto_w))))) (def: switch Test @@ -1480,17 +1480,17 @@ afterwards (\ ! map (n.% 10) random.nat)]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad - [@right /.new-label - @wrong /.new-label - @return /.new-label + [@right /.new_label + @wrong /.new_label + @return /.new_label _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.assume)) _ (/.tableswitch minimum @wrong [@right (list.repeat afterwards @wrong)]) - _ (/.set-label @wrong) + _ (/.set_label @wrong) _ (..$Long::literal dummy) _ (/.goto @return) - _ (/.set-label @right) + _ (/.set_label @right) _ (..$Long::literal expected) - _ (/.set-label @return)] + _ (/.set_label @return)] ..$Long::wrap)) (<| (_.lift "LOOKUPSWITCH") (do {! random.monad} @@ -1498,28 +1498,28 @@ random.nat) choice (\ ! map (n.% options) random.nat) options (|> random.int - (\ ! map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-long (:coerce Int))) + (\ ! map (|>> (:coerce java/lang/Long) host.long_to_int host.int_to_long (:coerce Int))) (random.set i.hash options) - (\ ! map set.to-list)) + (\ ! map set.to_list)) #let [choice (maybe.assume (list.nth choice options))] expected ..$Long::random dummy ..$Long::random]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad - [@right /.new-label - @wrong /.new-label - @return /.new-label - _ (..$Integer::literal (host.long-to-int (:coerce java/lang/Long choice))) + [@right /.new_label + @wrong /.new_label + @return /.new_label + _ (..$Integer::literal (host.long_to_int (:coerce java/lang/Long choice))) _ (/.lookupswitch @wrong (list\map (function (_ option) [(|> option /signed.s4 try.assume) (if (i.= choice option) @right @wrong)]) options)) - _ (/.set-label @wrong) + _ (/.set_label @wrong) _ (..$Long::literal dummy) _ (/.goto @return) - _ (/.set-label @right) + _ (/.set_label @right) _ (..$Long::literal expected) - _ (/.set-label @return)] + _ (/.set_label @return)] ..$Long::wrap)) )) @@ -1533,24 +1533,24 @@ (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad [#let [$Exception (/type.class "java.lang.Exception" (list))] - @skipped /.new-label - @try /.new-label - @handler /.new-label - @return /.new-label + @skipped /.new_label + @try /.new_label + @handler /.new_label + @return /.new_label _ (/.try @try @handler @handler $Exception) - _ (/.set-label @try) + _ (/.set_label @try) _ (/.new $Exception) _ /.dup _ (..$String::literal exception) _ (/.invokespecial $Exception "<init>" (/type.method [(list ..$String) /type.void (list)])) _ /.athrow - _ (/.set-label @skipped) + _ (/.set_label @skipped) _ (..$Long::literal dummy) _ (/.goto @return) - _ (/.set-label @handler) + _ (/.set_label @handler) _ /.pop _ (..$Long::literal expected) - _ (/.set-label @return)] + _ (/.set_label @return)] ..$Long::wrap)))) (def: code @@ -1582,17 +1582,17 @@ (def: inheritance Test (do random.monad - [abstract-class ..class-name - interface-class (|> ..class-name - (random.filter (|>> (text\= abstract-class) not))) - concrete-class (|> ..class-name + [abstract_class ..class_name + interface_class (|> ..class_name + (random.filter (|>> (text\= abstract_class) not))) + concrete_class (|> ..class_name (random.filter (function (_ class) - (not (or (text\= abstract-class class) - (text\= interface-class class)))))) + (not (or (text\= abstract_class class) + (text\= interface_class class)))))) part0 ..$Long::random part1 ..$Long::random part2 ..$Long::random - fake-part2 ..$Long::random + fake_part2 ..$Long::random part3 ..$Long::random part4 ..$Long::random #let [expected ($_ i.+ @@ -1601,19 +1601,19 @@ (:coerce Int part2) (:coerce Int part3) (:coerce Int part4)) - $Concrete (/type.class concrete-class (list)) - $Abstract (/type.class abstract-class (list)) - $Interface (/type.class interface-class (list)) + $Concrete (/type.class concrete_class (list)) + $Abstract (/type.class abstract_class (list)) + $Interface (/type.class interface_class (list)) constructor::type (/type.method [(list) /type.void (list)]) method::type (/type.method [(list) /type.long (list)]) - inherited-method "inherited_method" - overriden-method "overriden_method" - abstract-method "abstract_method" - interface-method "interface_method" - virtual-method "virtual_method" - static-method "static_method" + inherited_method "inherited_method" + overriden_method "overriden_method" + abstract_method "abstract_method" + interface_method "interface_method" + virtual_method "virtual_method" + static_method "static_method" method (: (-> Text java/lang/Long (Resource Method)) (function (_ name value) @@ -1625,18 +1625,18 @@ [_ (..$Long::literal value)] /.lreturn))))) - interface-bytecode (|> (/class.class /version.v6_0 ($_ /modifier\compose /class.public /class.abstract /class.interface) - (/name.internal interface-class) + interface_bytecode (|> (/class.class /version.v6_0 ($_ /modifier\compose /class.public /class.abstract /class.interface) + (/name.internal interface_class) (/name.internal "java.lang.Object") (list) (list) (list (/method.method ($_ /modifier\compose /method.public /method.abstract) - interface-method method::type (list) #.None)) + interface_method method::type (list) #.None)) (row.row)) try.assume (format.run /class.writer)) - abstract-bytecode (|> (/class.class /version.v6_0 ($_ /modifier\compose /class.public /class.abstract) - (/name.internal abstract-class) + abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier\compose /class.public /class.abstract) + (/name.internal abstract_class) (/name.internal "java.lang.Object") (list) (list) @@ -1645,71 +1645,71 @@ constructor::type (list) (#.Some (do /.monad - [_ /.aload-0 + [_ /.aload_0 _ (/.invokespecial ..$Object "<init>" constructor::type)] /.return))) - (method inherited-method part0) - (method overriden-method fake-part2) + (method inherited_method part0) + (method overriden_method fake_part2) (/method.method ($_ /modifier\compose /method.public /method.abstract) - abstract-method method::type (list) #.None)) + abstract_method method::type (list) #.None)) (row.row)) try.assume (format.run /class.writer)) invoke (: (-> (Type Class) Text (Bytecode Any)) (function (_ class method) (do /.monad - [_ /.aload-0] + [_ /.aload_0] (/.invokevirtual class method method::type)))) - concrete-bytecode (|> (/class.class /version.v6_0 /class.public - (/name.internal concrete-class) - (/name.internal abstract-class) - (list (/name.internal interface-class)) + concrete_bytecode (|> (/class.class /version.v6_0 /class.public + (/name.internal concrete_class) + (/name.internal abstract_class) + (list (/name.internal interface_class)) (list) (list (/method.method /method.public "<init>" constructor::type (list) (#.Some (do /.monad - [_ /.aload-0 + [_ /.aload_0 _ (/.invokespecial $Abstract "<init>" constructor::type)] /.return))) - (method virtual-method part1) - (method overriden-method part2) - (method abstract-method part3) - (method interface-method part4) + (method virtual_method part1) + (method overriden_method part2) + (method abstract_method part3) + (method interface_method part4) (/method.method ($_ /modifier\compose /method.public /method.static) - static-method + static_method (/type.method [(list) ..$Long (list)]) (list) (#.Some (do /.monad [_ (/.new $Concrete) _ /.dup _ (/.invokespecial $Concrete "<init>" constructor::type) - _ /.astore-0 - _ (invoke $Abstract inherited-method) - _ (invoke $Concrete virtual-method) + _ /.astore_0 + _ (invoke $Abstract inherited_method) + _ (invoke $Concrete virtual_method) _ /.ladd - _ (invoke $Abstract overriden-method) + _ (invoke $Abstract overriden_method) _ /.ladd - _ /.aload-0 _ (/.invokeinterface $Interface interface-method method::type) + _ /.aload_0 _ (/.invokeinterface $Interface interface_method method::type) _ /.ladd - _ (invoke $Abstract abstract-method) + _ (invoke $Abstract abstract_method) _ /.ladd _ ..$Long::wrap] /.areturn)))) (row.row)) try.assume (format.run /class.writer)) - loader (/loader.memory (/loader.new-library []))]] + loader (/loader.memory (/loader.new_library []))]] (_.test "Class & interface inheritance" (case (do try.monad - [_ (/loader.define abstract-class abstract-bytecode loader) - _ (/loader.define interface-class interface-bytecode loader) - _ (/loader.define concrete-class concrete-bytecode loader) - class (io.run (/loader.load concrete-class loader)) - method (host.try (get-method static-method class)) + [_ (/loader.define abstract_class abstract_bytecode loader) + _ (/loader.define interface_class interface_bytecode loader) + _ (/loader.define concrete_class concrete_bytecode loader) + class (io.run (/loader.load concrete_class loader)) + method (host.try (get_method static_method class)) output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)] (wrap (:coerce Int output))) (#try.Success actual) @@ -1720,7 +1720,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of .._))) + (<| (_.context (%.name (name_of .._))) ($_ _.and (<| (_.context "instruction") ..instruction) diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux index 574bed8d6..7ad0e8ddc 100644 --- a/stdlib/source/test/lux/time/date.lux +++ b/stdlib/source/test/lux/time/date.lux @@ -27,7 +27,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and ($equivalence.spec /.equivalence ..date) ($order.spec /.order ..date) diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index ffe896cdc..a08b54659 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -25,7 +25,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and ($equivalence.spec /.equivalence ..day) ($order.spec /.order ..day) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index bd7756f06..89d9a4db7 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -21,11 +21,11 @@ (def: #export duration (Random Duration) - (\ random.monad map /.from-millis random.int)) + (\ random.monad map /.from_millis random.int)) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and ($equivalence.spec /.equivalence ..duration) ($order.spec /.order ..duration) @@ -35,7 +35,7 @@ (do random.monad [millis random.int] (_.test "Can convert from/to milliseconds." - (|> millis /.from-millis /.to-millis (i.= millis)))) + (|> millis /.from_millis /.to_millis (i.= millis)))) (do {! random.monad} [sample (|> duration (\ ! map (/.frame /.day))) frame duration @@ -43,9 +43,9 @@ #let [(^open "/\.") /.order]] ($_ _.and (_.test "Can scale a duration." - (|> sample (/.scale-up factor) (/.query sample) (i.= (.int factor)))) + (|> sample (/.scale_up factor) (/.query sample) (i.= (.int factor)))) (_.test "Scaling a duration by one does not change it." - (|> sample (/.scale-up 1) (/\= sample))) + (|> sample (/.scale_up 1) (/\= sample))) (_.test "Merging a duration with it's opposite yields an empty duration." (|> sample (/.merge (/.inverse sample)) (/\= /.empty))))) ))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index d24a4438d..cc2c0a742 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -28,11 +28,11 @@ (def: #export instant (Random Instant) - (\ random.monad map /.from-millis random.int)) + (\ random.monad map /.from_millis random.int)) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and ($equivalence.spec /.equivalence ..instant) ($order.spec /.order ..instant) @@ -42,7 +42,7 @@ (do random.monad [millis random.int] (_.test "Can convert from/to milliseconds." - (|> millis /.from-millis /.to-millis (i.= millis)))) + (|> millis /.from_millis /.to_millis (i.= millis)))) (do random.monad [sample instant span _duration.duration diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index 1ebd3810c..d7078fa65 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -30,7 +30,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and ($equivalence.spec /.equivalence ..month) ($order.spec /.order ..month) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 239e77434..c06b89478 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -53,7 +53,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and (do r.monad [sample ..random] @@ -75,14 +75,14 @@ (_.test "Can remove aliases from an already-named type." (\ /.equivalence = base - (/.un-alias aliased))) + (/.un_alias aliased))) (_.test "Can remove all names from a type." (and (not (\ /.equivalence = base - (/.un-name aliased))) + (/.un_name aliased))) (\ /.equivalence = - (/.un-name base) - (/.un-name aliased)))))) + (/.un_name base) + (/.un_name aliased)))))) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) members (|> ..random @@ -105,8 +105,8 @@ (and (list\= (list) members) (list\= (list <unit>) flat)))))] - ["variant" /.variant /.flatten-variant Nothing] - ["tuple" /.tuple /.flatten-tuple Any] + ["variant" /.variant /.flatten_variant Nothing] + ["tuple" /.tuple /.flatten_tuple Any] )) ))) (do {! r.monad} @@ -124,12 +124,12 @@ (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and (_.test "Can build and tear-down function types." - (let [[inputs output] (|> (/.function members extra) /.flatten-function)] + (let [[inputs output] (|> (/.function members extra) /.flatten_function)] (and (list\= members inputs) (/\= extra output)))) (_.test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] + (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] (n.= (list.size members) (list.size tparams)))) )) (do {! r.monad} @@ -146,19 +146,19 @@ (`` ($_ _.and (~~ (template [<desc> <ctor> <dtor>] [(_.test (format "Can build and tear-down " <desc> " types.") - (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)] - (and (n.= size flat-size) - (/\= extra flat-body))))] + (let [[flat_size flat_body] (|> extra (<ctor> size) <dtor>)] + (and (n.= size flat_size) + (/\= extra flat_body))))] - ["universally-quantified" /.univ-q /.flatten-univ-q] - ["existentially-quantified" /.ex-q /.flatten-ex-q] + ["universally-quantified" /.univ_q /.flatten_univ_q] + ["existentially-quantified" /.ex_q /.flatten_ex_q] )) ))) - (_.test (%.name (name-of /.:by-example)) + (_.test (%.name (name_of /.:by_example)) (let [example (: (Maybe Nat) #.None)] (/\= (.type (List Nat)) - (/.:by-example [a] + (/.:by_example [a] {(Maybe a) example} (List a))))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index dad107b5e..c41f610dc 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -29,30 +29,30 @@ (r.Random Name) (r.and ..short ..short)) -(def: (type' num-vars) +(def: (type' num_vars) (-> Nat (r.Random Type)) (r.rec (function (_ recur) (let [(^open "R\.") r.monad pairG (r.and recur recur) - quantifiedG (r.and (R\wrap (list)) (type' (inc num-vars))) - random-pair (r.either (r.either (R\map (|>> #.Sum) pairG) + quantifiedG (r.and (R\wrap (list)) (type' (inc num_vars))) + random_pair (r.either (r.either (R\map (|>> #.Sum) pairG) (R\map (|>> #.Product) pairG)) (r.either (R\map (|>> #.Function) pairG) (R\map (|>> #.Apply) pairG))) - random-id (let [random-id (r.either (R\map (|>> #.Var) r.nat) + random_id (let [random_id (r.either (R\map (|>> #.Var) r.nat) (R\map (|>> #.Ex) r.nat))] - (case num-vars - 0 random-id - _ (r.either (R\map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat) - random-id))) - random-quantified (r.either (R\map (|>> #.UnivQ) quantifiedG) + (case num_vars + 0 random_id + _ (r.either (R\map (|>> (n.% num_vars) (n.* 2) inc #.Parameter) r.nat) + random_id))) + random_quantified (r.either (R\map (|>> #.UnivQ) quantifiedG) (R\map (|>> #.ExQ) quantifiedG))] ($_ r.either (R\map (|>> #.Primitive) (r.and ..short (R\wrap (list)))) - random-pair - random-id - random-quantified + random_pair + random_id + random_quantified (R\map (|>> #.Named) (r.and ..name (type' 0))) ))))) @@ -60,54 +60,54 @@ (r.Random Type) (..type' 0)) -(def: (valid-type? type) +(def: (valid_type? type) (-> Type Bit) (case type (#.Primitive name params) - (list.every? valid-type? params) + (list.every? valid_type? params) (#.Ex id) #1 (^template [<tag>] [(<tag> left right) - (and (valid-type? left) (valid-type? right))]) + (and (valid_type? left) (valid_type? right))]) ([#.Sum] [#.Product] [#.Function]) (#.Named name type') - (valid-type? type') + (valid_type? type') _ #0)) -(def: (type-checks? input) +(def: (type_checks? input) (-> (/.Check []) Bit) - (case (/.run /.fresh-context input) + (case (/.run /.fresh_context input) (#.Right []) #1 (#.Left error) #0)) -(def: (build-ring num-connections) +(def: (build_ring num_connections) (-> Nat (/.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) (do {! /.monad} - [[head-id head-type] /.var - ids+types (monad.seq ! (list.repeat num-connections /.var)) - [tail-id tail-type] (monad.fold ! (function (_ [tail-id tail-type] [_head-id _head-type]) + [[head_id head_type] /.var + ids+types (monad.seq ! (list.repeat num_connections /.var)) + [tail_id tail_type] (monad.fold ! (function (_ [tail_id tail_type] [_head_id _head_type]) (do ! - [_ (/.check head-type tail-type)] - (wrap [tail-id tail-type]))) - [head-id head-type] + [_ (/.check head_type tail_type)] + (wrap [tail_id tail_type]))) + [head_id head_type] ids+types)] - (wrap [[head-id head-type] ids+types [tail-id tail-type]]))) + (wrap [[head_id head_type] ids+types [tail_id tail_type]]))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and (do r.monad - [sample (r.filter ..valid-type? ..type)] + [sample (r.filter ..valid_type? ..type)] ($_ _.and (_.test "Any is the super-type of everything." (/.checks? Any sample)) @@ -119,23 +119,23 @@ (and (/.checks? Nothing Nothing) (/.checks? Any Any))) (_.test "Existential types only match with themselves." - (and (type-checks? (do /.monad + (and (type_checks? (do /.monad [[_ exT] /.existential] (/.check exT exT))) - (not (type-checks? (do /.monad + (not (type_checks? (do /.monad [[_ exTL] /.existential [_ exTR] /.existential] (/.check exTL exTR)))))) (_.test "Names do not affect type-checking." - (and (type-checks? (do /.monad + (and (type_checks? (do /.monad [[_ exT] /.existential] (/.check (#.Named ["module" "name"] exT) exT))) - (type-checks? (do /.monad + (type_checks? (do /.monad [[_ exT] /.existential] (/.check exT (#.Named ["module" "name"] exT)))) - (type-checks? (do /.monad + (type_checks? (do /.monad [[_ exT] /.existential] (/.check (#.Named ["module" "name"] exT) (#.Named ["module" "name"] exT)))))) @@ -154,9 +154,9 @@ (/.checks? (type.tuple (list meta data)) (|> Ann (#.Apply meta) (#.Apply data)))))) (do r.monad - [#let [gen-short (r.ascii 10)] - nameL gen-short - nameR (|> gen-short (r.filter (|>> (text\= nameL) not))) + [#let [gen_short (r.ascii 10)] + nameL gen_short + nameR (|> gen_short (r.filter (|>> (text\= nameL) not))) paramL ..type paramR (r.filter (|>> (/.checks? paramL) not) ..type)] ($_ _.and @@ -172,86 +172,86 @@ )) ($_ _.and (_.test "Type-vars check against themselves." - (type-checks? (do /.monad + (type_checks? (do /.monad [[id var] /.var] (/.check var var)))) (_.test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (do /.monad + (and (type_checks? (do /.monad [[id var] /.var] (/.check var .Any))) - (type-checks? (do /.monad + (type_checks? (do /.monad [[id var] /.var] (/.check .Any var))))) (_.test "Cannot rebind already bound type-vars." - (not (type-checks? (do /.monad + (not (type_checks? (do /.monad [[id var] /.var _ (/.check var .Bit)] (/.check var .Nat))))) (_.test "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (do /.monad + (type_checks? (do /.monad [[id var] /.var _ (/.check var Any)] (/.check var .Bit)))) (_.test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (do /.monad + (type_checks? (do /.monad [[id var] /.var _ (/.check var Nothing)] (/.check .Bit var)))) ) (do {! r.monad} - [num-connections (|> r.nat (\ ! map (n.% 100))) + [num_connections (|> r.nat (\ ! map (n.% 100))) boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) - pick-pcg (r.and r.nat r.nat)] + pick_pcg (r.and r.nat r.nat)] ($_ _.and (_.test "Can create rings of variables." - (type-checks? (do /.monad - [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) + (type_checks? (do /.monad + [[[head_id head_type] ids+types [tail_id tail_type]] (build_ring num_connections) #let [ids (list\map product.left ids+types)] - headR (/.ring head-id) - tailR (/.ring tail-id)] + headR (/.ring head_id) + tailR (/.ring tail_id)] (/.assert "" - (let [same-rings? (\ set.equivalence = headR tailR) - expected-size? (n.= (inc num-connections) (set.size headR)) - same-vars? (|> (set.to-list headR) + (let [same_rings? (\ set.equivalence = headR tailR) + expected_size? (n.= (inc num_connections) (set.size headR)) + same_vars? (|> (set.to_list headR) (list.sort n.<) - (\ (list.equivalence n.equivalence) = (list.sort n.< (#.Cons head-id ids))))] - (and same-rings? - expected-size? - same-vars?)))))) + (\ (list.equivalence n.equivalence) = (list.sort n.< (#.Cons head_id ids))))] + (and same_rings? + expected_size? + same_vars?)))))) (_.test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do {! /.monad} - [[[head-id headT] ids+types tailT] (build-ring num-connections) + (type_checks? (do {! /.monad} + [[[head_id headT] ids+types tailT] (build_ring num_connections) #let [ids (list\map product.left ids+types)] _ (/.check headT boundT) - head-bound (/.read head-id) - tail-bound (monad.map ! /.read ids) - headR (/.ring head-id) + head_bound (/.read head_id) + tail_bound (monad.map ! /.read ids) + headR (/.ring head_id) tailR+ (monad.map ! /.ring ids)] - (let [rings-were-erased? (and (set.empty? headR) + (let [rings_were_erased? (and (set.empty? headR) (list.every? set.empty? tailR+)) - same-types? (list.every? (type\= boundT) (list& (maybe.default headT head-bound) - (list\map (function (_ [tail-id ?tailT]) - (maybe.default (#.Var tail-id) ?tailT)) - (list.zip/2 ids tail-bound))))] + same_types? (list.every? (type\= boundT) (list& (maybe.default headT head_bound) + (list\map (function (_ [tail_id ?tailT]) + (maybe.default (#.Var tail_id) ?tailT)) + (list.zip/2 ids tail_bound))))] (/.assert "" - (and rings-were-erased? - same-types?)))))) + (and rings_were_erased? + same_types?)))))) (_.test "Can merge multiple rings of variables." - (type-checks? (do /.monad - [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections) - [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections) - headRL-pre (/.ring head-idL) - headRR-pre (/.ring head-idR) + (type_checks? (do /.monad + [[[head_idL headTL] ids+typesL [tail_idL tailTL]] (build_ring num_connections) + [[head_idR headTR] ids+typesR [tail_idR tailTR]] (build_ring num_connections) + headRL_pre (/.ring head_idL) + headRR_pre (/.ring head_idR) _ (/.check headTL headTR) - headRL-post (/.ring head-idL) - headRR-post (/.ring head-idR)] + headRL_post (/.ring head_idL) + headRR_post (/.ring head_idR)] (/.assert "" - (let [same-rings? (\ set.equivalence = headRL-post headRR-post) - expected-size? (n.= (n.* 2 (inc num-connections)) - (set.size headRL-post)) - union? (\ set.equivalence = headRL-post (set.union headRL-pre headRR-pre))] - (and same-rings? - expected-size? + (let [same_rings? (\ set.equivalence = headRL_post headRR_post) + expected_size? (n.= (n.* 2 (inc num_connections)) + (set.size headRL_post)) + union? (\ set.equivalence = headRL_post (set.union headRL_pre headRR_pre))] + (and same_rings? + expected_size? union?)))))) )) ))) diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 960a8ab9d..4cb4e5093 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -14,7 +14,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (do r.monad [expected r.nat #let [value (:dynamic expected)]] diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 99e0c64ae..f78637b1b 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -20,7 +20,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (do {! random.monad} [#let [digit (\ ! map (n.% 10) random.nat)] left digit diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 298b95ad7..7f84dcd2b 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -16,39 +16,39 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) ($_ _.and (_.test "Can produce and consume keys in an ordered manner." (<| (n.= (n.+ 123 456)) io.run - /.run-sync + /.run_sync (do /.sync - [res|left (/.ordered-sync 123) - res|right (/.ordered-sync 456) - right (/.read-sync res|right) - left (/.read-sync res|left)] + [res|left (/.ordered_sync 123) + res|right (/.ordered_sync 456) + right (/.read_sync res|right) + left (/.read_sync res|left)] (wrap (n.+ left right))))) (_.test "Can exchange commutative keys." (<| (n.= (n.+ 123 456)) io.run - /.run-sync + /.run_sync (do /.sync - [res|left (/.commutative-sync 123) - res|right (/.commutative-sync 456) - _ (/.exchange-sync [1 0]) - left (/.read-sync res|left) - right (/.read-sync res|right)] + [res|left (/.commutative_sync 123) + res|right (/.commutative_sync 456) + _ (/.exchange_sync [1 0]) + left (/.read_sync res|left) + right (/.read_sync res|right)] (wrap (n.+ left right))))) (_.test "Can group and un-group keys." (<| (n.= (n.+ 123 456)) io.run - /.run-sync + /.run_sync (do /.sync - [res|left (/.commutative-sync 123) - res|right (/.commutative-sync 456) - _ (/.group-sync 2) - _ (/.un-group-sync 2) - right (/.read-sync res|right) - left (/.read-sync res|left)] + [res|left (/.commutative_sync 123) + res|right (/.commutative_sync 456) + _ (/.group_sync 2) + _ (/.un_group_sync 2) + right (/.read_sync res|right) + left (/.read_sync res|left)] (wrap (n.+ left right))))) ))) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index 56291563d..b7c7d3a50 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -17,22 +17,22 @@ (def: simulation (/.Simulation Bit) (structure - (def: (on-read dead?) + (def: (on_read dead?) (if dead? (exception.throw ..dead []) (#try.Success [dead? (char "a")]))) - (def: (on-read-line dead?) + (def: (on_read_line dead?) (if dead? (exception.throw ..dead []) (#try.Success [dead? "YOLO"]))) - (def: (on-write message dead?) + (def: (on_write message dead?) (if dead? (exception.throw ..dead []) (#try.Success dead?))) - (def: (on-close dead?) + (def: (on_close dead?) (if dead? (exception.throw ..dead []) (#try.Success true))))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 35706fa8a..173bd7586 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -30,37 +30,37 @@ [data ["_." binary]]]) -(def: truncate-millis +(def: truncate_millis (let [millis +1,000] (|>> (i./ millis) (i.* millis)))) -(def: (creation-and-deletion number) +(def: (creation_and_deletion number) (-> Nat Test) (r\wrap (do promise.monad [#let [path (format "temp_file_" (%.nat number))] result (promise.future (do (try.with io.monad) - [#let [check-existence! (: (IO (Try Bit)) + [#let [check_existence! (: (IO (Try Bit)) (try.lift io.monad (/.exists? io.monad /.default path)))] - pre! check-existence! - file (!.use (\ /.default create-file) path) - post! check-existence! + pre! check_existence! + file (!.use (\ /.default create_file) path) + post! check_existence! _ (!.use (\ file delete) []) - remains? check-existence!] + remains? check_existence!] (wrap (and (not pre!) post! (not remains?)))))] (_.assert "Can create/delete files." (try.default #0 result))))) -(def: (read-and-write number data) +(def: (read_and_write number data) (-> Nat Binary Test) (r\wrap (do promise.monad [#let [path (format "temp_file_" (%.nat number))] result (promise.future (do (try.with io.monad) - [file (!.use (\ /.default create-file) path) - _ (!.use (\ file over-write) data) + [file (!.use (\ /.default create_file) path) + _ (!.use (\ file over_write) data) content (!.use (\ file content) []) _ (!.use (\ file delete) [])] (wrap (\ binary.equivalence = data content))))] @@ -69,114 +69,114 @@ (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.context (%.name (name_of /._))) (do {! r.monad} - [file-size (|> r.nat (\ ! map (|>> (n.% 100) (n.max 10)))) - dataL (_binary.random file-size) - dataR (_binary.random file-size) - new-modified (|> r.int (\ ! map (|>> i.abs + [file_size (|> r.nat (\ ! map (|>> (n.% 100) (n.max 10)))) + dataL (_binary.random file_size) + dataR (_binary.random file_size) + new_modified (|> r.int (\ ! map (|>> i.abs (i.% +10,000,000,000,000) - truncate-millis - duration.from-millis + truncate_millis + duration.from_millis instant.absolute)))] ($_ _.and - ## (..creation-and-deletion 0) - ## (..read-and-write 1 dataL) + ## (..creation_and_deletion 0) + ## (..read_and_write 1 dataL) ## (wrap (do promise.monad ## [#let [path "temp_file_2"] ## result (promise.future ## (do (try.with io.monad) - ## [file (!.use (\ /.default create-file) path) - ## _ (!.use (\ file over-write) dataL) - ## read-size (!.use (\ file size) []) + ## [file (!.use (\ /.default create_file) path) + ## _ (!.use (\ file over_write) dataL) + ## read_size (!.use (\ file size) []) ## _ (!.use (\ file delete) [])] - ## (wrap (n.= file-size read-size))))] + ## (wrap (n.= file_size read_size))))] ## (_.assert "Can read file size." ## (try.default #0 result)))) ## (wrap (do promise.monad ## [#let [path "temp_file_3"] ## result (promise.future ## (do (try.with io.monad) - ## [file (!.use (\ /.default create-file) path) - ## _ (!.use (\ file over-write) dataL) + ## [file (!.use (\ /.default create_file) path) + ## _ (!.use (\ file over_write) dataL) ## _ (!.use (\ file append) dataR) ## content (!.use (\ file content) []) - ## read-size (!.use (\ file size) []) + ## read_size (!.use (\ file size) []) ## _ (!.use (\ file delete) [])] - ## (wrap (and (n.= (n.* 2 file-size) read-size) + ## (wrap (and (n.= (n.* 2 file_size) read_size) ## (\ binary.equivalence = ## dataL - ## (try.assume (binary.slice 0 (dec file-size) content))) + ## (try.assume (binary.slice 0 (dec file_size) content))) ## (\ binary.equivalence = ## dataR - ## (try.assume (binary.slice file-size (dec read-size) content)))))))] + ## (try.assume (binary.slice file_size (dec read_size) content)))))))] ## (_.assert "Can append to files." ## (try.default #0 result)))) ## (wrap (do promise.monad ## [#let [path "temp_dir_4"] ## result (promise.future ## (do (try.with io.monad) - ## [#let [check-existence! (: (IO (Try Bit)) + ## [#let [check_existence! (: (IO (Try Bit)) ## (try.lift io.monad (/.exists? io.monad /.default path)))] - ## pre! check-existence! - ## dir (!.use (\ /.default create-directory) path) - ## post! check-existence! + ## pre! check_existence! + ## dir (!.use (\ /.default create_directory) path) + ## post! check_existence! ## _ (!.use (\ dir discard) []) - ## remains? check-existence!] + ## remains? check_existence!] ## (wrap (and (not pre!) ## post! ## (not remains?)))))] ## (_.assert "Can create/delete directories." ## (try.default #0 result)))) ## (wrap (do promise.monad - ## [#let [file-path "temp_file_5" - ## dir-path "temp_dir_5"] + ## [#let [file_path "temp_file_5" + ## dir_path "temp_dir_5"] ## result (promise.future ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create-directory) dir-path) - ## file (!.use (\ /.default create-file) (format dir-path "/" file-path)) - ## _ (!.use (\ file over-write) dataL) - ## read-size (!.use (\ file size) []) + ## [dir (!.use (\ /.default create_directory) dir_path) + ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) + ## _ (!.use (\ file over_write) dataL) + ## read_size (!.use (\ file size) []) ## _ (!.use (\ file delete) []) ## _ (!.use (\ dir discard) [])] - ## (wrap (n.= file-size read-size))))] + ## (wrap (n.= file_size read_size))))] ## (_.assert "Can create files inside of directories." ## (try.default #0 result)))) ## (wrap (do promise.monad - ## [#let [file-path "temp_file_6" - ## dir-path "temp_dir_6" - ## inner-dir-path "inner_temp_dir_6"] + ## [#let [file_path "temp_file_6" + ## dir_path "temp_dir_6" + ## inner_dir_path "inner_temp_dir_6"] ## result (promise.future ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create-directory) dir-path) - ## pre-files (!.use (\ dir files) []) - ## pre-directories (!.use (\ dir directories) []) + ## [dir (!.use (\ /.default create_directory) dir_path) + ## pre_files (!.use (\ dir files) []) + ## pre_directories (!.use (\ dir directories) []) - ## file (!.use (\ /.default create-file) (format dir-path "/" file-path)) - ## inner-dir (!.use (\ /.default create-directory) (format dir-path "/" inner-dir-path)) - ## post-files (!.use (\ dir files) []) - ## post-directories (!.use (\ dir directories) []) + ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) + ## inner_dir (!.use (\ /.default create_directory) (format dir_path "/" inner_dir_path)) + ## post_files (!.use (\ dir files) []) + ## post_directories (!.use (\ dir directories) []) ## _ (!.use (\ file delete) []) - ## _ (!.use (\ inner-dir discard) []) + ## _ (!.use (\ inner_dir discard) []) ## _ (!.use (\ dir discard) [])] - ## (wrap (and (and (n.= 0 (list.size pre-files)) - ## (n.= 0 (list.size pre-directories))) - ## (and (n.= 1 (list.size post-files)) - ## (n.= 1 (list.size post-directories)))))))] + ## (wrap (and (and (n.= 0 (list.size pre_files)) + ## (n.= 0 (list.size pre_directories))) + ## (and (n.= 1 (list.size post_files)) + ## (n.= 1 (list.size post_directories)))))))] ## (_.assert "Can list files/directories inside a directory." ## (try.default #0 result)))) ## (wrap (do promise.monad ## [#let [path "temp_file_7"] ## result (promise.future ## (do (try.with io.monad) - ## [file (!.use (\ /.default create-file) path) - ## _ (!.use (\ file over-write) dataL) - ## _ (!.use (\ file modify) new-modified) - ## current-modified (!.use (\ file last-modified) []) + ## [file (!.use (\ /.default create_file) path) + ## _ (!.use (\ file over_write) dataL) + ## _ (!.use (\ file modify) new_modified) + ## current_modified (!.use (\ file last_modified) []) ## _ (!.use (\ file delete) [])] - ## (wrap (\ instant.equivalence = new-modified current-modified))))] + ## (wrap (\ instant.equivalence = new_modified current_modified))))] ## (_.assert "Can change the time of last modification." ## (try.default #0 result)))) ## (wrap (do promise.monad @@ -184,16 +184,16 @@ ## path1 (format "temp_file_8+1")] ## result (promise.future ## (do (try.with io.monad) - ## [#let [check-existence! (: (-> Path (IO (Try Bit))) + ## [#let [check_existence! (: (_> Path (IO (Try Bit))) ## (|>> (/.exists? io.monad /.default) ## (try.lift io.monad)))] - ## file0 (!.use (\ /.default create-file) path0) - ## _ (!.use (\ file0 over-write) dataL) - ## pre! (check-existence! path0) + ## file0 (!.use (\ /.default create_file) path0) + ## _ (!.use (\ file0 over_write) dataL) + ## pre! (check_existence! path0) ## file1 (: (IO (Try (File IO))) ## TODO: Remove : ## (!.use (\ file0 move) path1)) - ## post! (check-existence! path0) - ## confirmed? (check-existence! path1) + ## post! (check_existence! path0) + ## confirmed? (check_existence! path1) ## _ (!.use (\ file1 delete) [])] ## (wrap (and pre! ## (not post!) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index aa3a51e59..c0873b41a 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -74,16 +74,16 @@ (wrap (do promise.monad [?concern (\ watcher concern directory) ?stop (\ watcher stop directory)] - (_.cover' [/.not-being-watched] + (_.cover' [/.not_being_watched] (and (case ?concern (#try.Failure error) - (exception.match? /.not-being-watched error) + (exception.match? /.not_being_watched error) (#try.Success _) false) (case ?stop (#try.Failure error) - (exception.match? /.not-being-watched error) + (exception.match? /.not_being_watched error) (#try.Success _) false))))) @@ -101,23 +101,23 @@ [directory (random.ascii/alpha 5) #let [/ "/" [fs watcher] (/.mock /)] - expected-path (\ ! map (|>> (format directory /)) + expected_path (\ ! map (|>> (format directory /)) (random.ascii/alpha 5)) data (_binary.random 10)] (wrap (do {! promise.monad} [verdict (do (try.with !) - [_ (!.use (\ fs create-directory) [directory]) + [_ (!.use (\ fs create_directory) [directory]) _ (\ watcher start /.all directory) poll/0 (\ watcher poll []) - #let [no-events-prior-to-creation! + #let [no_events_prior_to_creation! (list.empty? poll/0)] - file (!.use (\ fs create-file) [expected-path]) + file (!.use (\ fs create_file) [expected_path]) poll/1 (\ watcher poll []) poll/1' (\ watcher poll []) - #let [after-creation! + #let [after_creation! (and (case poll/1 - (^ (list [actual-path concern])) - (and (text\= expected-path actual-path) + (^ (list [actual_path concern])) + (and (text\= expected_path actual_path) (and (/.creation? concern) (not (/.modification? concern)) (not (/.deletion? concern)))) @@ -125,14 +125,14 @@ _ false) (list.empty? poll/1'))] - _ (promise.delay 1 (#try.Success "Delay to make sure the over-write time-stamp always changes.")) - _ (!.use (\ file over-write) data) + _ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) + _ (!.use (\ file over_write) data) poll/2 (\ watcher poll []) poll/2' (\ watcher poll []) - #let [after-modification! + #let [after_modification! (and (case poll/2 - (^ (list [actual-path concern])) - (and (text\= expected-path actual-path) + (^ (list [actual_path concern])) + (and (text\= expected_path actual_path) (and (not (/.creation? concern)) (/.modification? concern) (not (/.deletion? concern)))) @@ -143,9 +143,9 @@ _ (!.use (\ file delete) []) poll/3 (\ watcher poll []) poll/3' (\ watcher poll []) - #let [after-deletion! + #let [after_deletion! (and (case poll/3 - (^ (list [actual-path concern])) + (^ (list [actual_path concern])) (and (not (/.creation? concern)) (not (/.modification? concern)) (/.deletion? concern)) @@ -153,10 +153,10 @@ _ false) (list.empty? poll/3'))]] - (wrap (and no-events-prior-to-creation! - after-creation! - after-modification! - after-deletion!)))] + (wrap (and no_events_prior_to_creation! + after_creation! + after_modification! + after_deletion!)))] (_.cover' [/.mock /.polling] (try.default false verdict))))) ))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index d3c7e24f8..1dbe5dcd5 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -32,65 +32,65 @@ (exception: dead) -(def: (simulation [environment working-directory command arguments]) +(def: (simulation [environment working_directory command arguments]) (-> [Environment Path /.Command (List /.Argument)] (/.Simulation Bit)) (structure - (def: (on-read dead?) + (def: (on_read dead?) (if dead? (exception.throw ..dead []) (do try.monad - [to-echo (try.from-maybe (list.head arguments))] - (wrap [dead? to-echo])))) + [to_echo (try.from_maybe (list.head arguments))] + (wrap [dead? to_echo])))) - (def: (on-error dead?) + (def: (on_error dead?) (if dead? (exception.throw ..dead []) (exception.return [dead? ""]))) - (def: (on-write message dead?) + (def: (on_write message dead?) (if dead? (exception.throw ..dead []) (#try.Success dead?))) - (def: (on-destroy dead?) + (def: (on_destroy dead?) (if dead? (exception.throw ..dead []) (#try.Success true))) - (def: (on-await dead?) + (def: (on_await dead?) (if dead? (exception.throw ..dead []) (#try.Success [true /.normal]))))) -(def: (io-shell command oops input destruction exit) +(def: (io_shell command oops input destruction exit) (-> /.Command Text Text Text /.Exit (/.Shell IO)) (structure (def: execute - ((debug.private /.can-execute) - (function (_ [environment working-directory command arguments]) + ((debug.private /.can_execute) + (function (_ [environment working_directory command arguments]) (io.io (#try.Success (: (/.Process IO) (structure (def: read - ((debug.private /.can-read) + ((debug.private /.can_read) (function (_ _) (io.io (#try.Success command))))) (def: error - ((debug.private /.can-read) + ((debug.private /.can_read) (function (_ _) (io.io (#try.Success oops))))) (def: write - ((debug.private /.can-write) + ((debug.private /.can_write) (function (_ message) (io.io (#try.Failure message))))) (def: destroy - ((debug.private /.can-destroy) + ((debug.private /.can_destroy) (function (_ _) (io.io (#try.Failure destruction))))) (def: await - ((debug.private /.can-wait) + ((debug.private /.can_wait) (function (_ _) (io.io (#try.Success exit)))))))))))))) @@ -109,7 +109,7 @@ input (random.ascii/alpha 5) destruction (random.ascii/alpha 5) exit random.int - #let [shell (/.async (..io-shell command oops input destruction exit))]] + #let [shell (/.async (..io_shell command oops input destruction exit))]] (wrap (do {! promise.monad} [verdict (do (try.with !) [process (!.use (\ shell execute) [environment.empty "~" command (list)]) @@ -137,6 +137,6 @@ wrote! destroyed! (i.= exit await))))] - (_.cover' [/.async /.Can-Write] + (_.cover' [/.async /.Can_Write] (try.default false verdict))))) ))) |