diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 3914 |
1 files changed, 1957 insertions, 1957 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 31e7fe01c..e61666570 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1,172 +1,172 @@ ## Basic types -(_lux_def dummy-cursor - (_lux_: (+4 (+0 "#Text" (+0)) (+4 (+0 "#Nat" (+0)) (+0 "#Nat" (+0)))) - ["" +0 +0]) - [["" +0 +0] - (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] - [["" +0 +0] (+0 true)]] - (+0)))]) +("lux def" dummy-cursor + ("lux check" (+4 (+0 "#Text" (+0)) (+4 (+0 "#Nat" (+0)) (+0 "#Nat" (+0)))) + ["" +0 +0]) + [["" +0 +0] + (+10 (+1 [[["" +0 +0] (+7 ["lux" "export?"])] + [["" +0 +0] (+0 true)]] + (+0)))]) ## (type: (List a) ## #Nil ## (#Cons a (List a))) -(_lux_def List - (+12 ["lux" "List"] - (+9 (+0) - (+3 ## "lux;Nil" - (+2) - ## "lux;Cons" - (+4 (+6 +1) - (+11 (+6 +1) (+6 +0)))))) - [dummy-cursor - (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (+1 [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (+1 [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (+1 [dummy-cursor (+5 "Nil")] (+1 [dummy-cursor (+5 "Cons")] (+0))))]] - (+1 [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (+1 [dummy-cursor (+5 "a")] (+0)))]] - (+1 [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "A potentially empty list of values.")]] - (+0)))))))]) - -(_lux_def Bool - (+12 ["lux" "Bool"] - (+0 "#Bool" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] +("lux def" List + (+12 ["lux" "List"] + (+9 (+0) + (+3 ## "lux;Nil" + (+2) + ## "lux;Cons" + (+4 (+6 +1) + (+11 (+6 +1) (+6 +0)))))) + [dummy-cursor + (+10 (+1 [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (+1 [[dummy-cursor (+7 ["lux" "export?"])] [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]] - #Nil))))]) - -(_lux_def Nat - (+12 ["lux" "Nat"] - (+0 "#Nat" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Natural numbers (unsigned integers). + (+1 [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (+1 [dummy-cursor (+5 "Nil")] (+1 [dummy-cursor (+5 "Cons")] (+0))))]] + (+1 [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (+1 [dummy-cursor (+5 "a")] (+0)))]] + (+1 [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "A potentially empty list of values.")]] + (+0)))))))]) + +("lux def" Bool + (+12 ["lux" "Bool"] + (+0 "#Bool" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill boolean values.")]] + #Nil))))]) + +("lux def" Nat + (+12 ["lux" "Nat"] + (+0 "#Nat" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Natural numbers (unsigned integers). They start at zero (+0) and extend in the positive direction.")]] - #Nil))))]) - -(_lux_def Int - (+12 ["lux" "Int"] - (+0 "#Int" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] - #Nil))))]) - -(_lux_def Frac - (+12 ["lux" "Frac"] - (+0 "#Frac" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] - #Nil))))]) - -(_lux_def Deg - (+12 ["lux" "Deg"] - (+0 "#Deg" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). + #Nil))))]) + +("lux def" Int + (+12 ["lux" "Int"] + (+0 "#Int" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] + #Nil))))]) + +("lux def" Frac + (+12 ["lux" "Frac"] + (+0 "#Frac" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + #Nil))))]) + +("lux def" Deg + (+12 ["lux" "Deg"] + (+0 "#Deg" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Fractional numbers that live in the interval [0,1). Useful for probability, and other domains that work within that interval.")]] - #Nil))))]) - -(_lux_def Text - (+12 ["lux" "Text"] - (+0 "#Text" #Nil)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]] - #Nil))))]) - -(_lux_def Void - (+12 ["lux" "Void"] - (+1)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")]] - #Nil))))]) - -(_lux_def Unit - (+12 ["lux" "Unit"] - (+2)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "An unusual type that only possesses a single value: []")]] - #Nil))))]) - -(_lux_def Ident - (+12 ["lux" "Ident"] - (+4 Text Text)) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "An identifier. + #Nil))))]) + +("lux def" Text + (+12 ["lux" "Text"] + (+0 "#Text" #Nil)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Your standard, run-of-the-mill string values.")]] + #Nil))))]) + +("lux def" Void + (+12 ["lux" "Void"] + (+1)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An unusual type that possesses no value, and thus cannot be instantiated.")]] + #Nil))))]) + +("lux def" Unit + (+12 ["lux" "Unit"] + (+2)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An unusual type that only possesses a single value: []")]] + #Nil))))]) + +("lux def" Ident + (+12 ["lux" "Ident"] + (+4 Text Text)) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "An identifier. It is used as part of Lux syntax to represent symbols and tags.")]] - #Nil))))]) + #Nil))))]) ## (type: (Maybe a) ## #None ## (#Some a)) -(_lux_def Maybe - (+12 ["lux" "Maybe"] - (+9 #Nil - (+3 ## "lux;None" - (+2) - ## "lux;Some" - (+6 +1)))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "None")] (#Cons [dummy-cursor (+5 "Some")] #Nil)))]] - (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "a")] #Nil))]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "A potentially missing value.")]] - #Nil))))))]) +("lux def" Maybe + (+12 ["lux" "Maybe"] + (+9 #Nil + (+3 ## "lux;None" + (+2) + ## "lux;Some" + (+6 +1)))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "None")] (#Cons [dummy-cursor (+5 "Some")] #Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "a")] #Nil))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "A potentially missing value.")]] + #Nil))))))]) ## (type: #rec Type ## (#Primitive Text (List Type)) @@ -183,144 +183,144 @@ ## (#Apply Type Type) ## (#Named Ident Type) ## ) -(_lux_def Type - (+12 ["lux" "Type"] - (_lux_case (+11 (+6 +1) (+6 +0)) - Type - (_lux_case (+11 Type List) - Type-List - (_lux_case (+4 Type Type) - Type-Pair - (+11 Void - (+9 #Nil - (+3 ## "lux;Primitive" - (+4 Text Type-List) - (+3 ## "lux;Void" - (+2) - (+3 ## "lux;Unit" - (+2) - (+3 ## "lux;Sum" - Type-Pair - (+3 ## "lux;Product" - Type-Pair - (+3 ## "lux;Function" - Type-Pair - (+3 ## "lux;Bound" - Nat - (+3 ## "lux;Var" - Nat - (+3 ## "lux;Ex" - Nat - (+3 ## "lux;UnivQ" - (+4 Type-List Type) - (+3 ## "lux;ExQ" - (+4 Type-List Type) - (+3 ## "lux;App" - Type-Pair - ## "lux;Named" - (+4 Ident Type))))))))))))))))))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Primitive")] - (#Cons [dummy-cursor (+5 "Void")] - (#Cons [dummy-cursor (+5 "Unit")] - (#Cons [dummy-cursor (+5 "Sum")] - (#Cons [dummy-cursor (+5 "Product")] - (#Cons [dummy-cursor (+5 "Function")] - (#Cons [dummy-cursor (+5 "Bound")] - (#Cons [dummy-cursor (+5 "Var")] - (#Cons [dummy-cursor (+5 "Ex")] - (#Cons [dummy-cursor (+5 "UnivQ")] - (#Cons [dummy-cursor (+5 "ExQ")] - (#Cons [dummy-cursor (+5 "Apply")] - (#Cons [dummy-cursor (+5 "Named")] - #Nil))))))))))))))]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "This type represents the data-structures that are used to specify types themselves.")]] - (#Cons [[dummy-cursor (+7 ["lux" "type-rec?"])] - [dummy-cursor (+0 true)]] - #Nil))))))]) +("lux def" Type + (+12 ["lux" "Type"] + ("lux case" (+11 (+6 +1) (+6 +0)) + Type + ("lux case" (+11 Type List) + Type-List + ("lux case" (+4 Type Type) + Type-Pair + (+11 Void + (+9 #Nil + (+3 ## "lux;Primitive" + (+4 Text Type-List) + (+3 ## "lux;Void" + (+2) + (+3 ## "lux;Unit" + (+2) + (+3 ## "lux;Sum" + Type-Pair + (+3 ## "lux;Product" + Type-Pair + (+3 ## "lux;Function" + Type-Pair + (+3 ## "lux;Bound" + Nat + (+3 ## "lux;Var" + Nat + (+3 ## "lux;Ex" + Nat + (+3 ## "lux;UnivQ" + (+4 Type-List Type) + (+3 ## "lux;ExQ" + (+4 Type-List Type) + (+3 ## "lux;App" + Type-Pair + ## "lux;Named" + (+4 Ident Type))))))))))))))))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Primitive")] + (#Cons [dummy-cursor (+5 "Void")] + (#Cons [dummy-cursor (+5 "Unit")] + (#Cons [dummy-cursor (+5 "Sum")] + (#Cons [dummy-cursor (+5 "Product")] + (#Cons [dummy-cursor (+5 "Function")] + (#Cons [dummy-cursor (+5 "Bound")] + (#Cons [dummy-cursor (+5 "Var")] + (#Cons [dummy-cursor (+5 "Ex")] + (#Cons [dummy-cursor (+5 "UnivQ")] + (#Cons [dummy-cursor (+5 "ExQ")] + (#Cons [dummy-cursor (+5 "Apply")] + (#Cons [dummy-cursor (+5 "Named")] + #Nil))))))))))))))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type-rec?"])] + [dummy-cursor (+0 true)]] + #Nil))))))]) ## (type: Top ## (Ex [a] a)) -(_lux_def Top - (#Named ["lux" "Top"] - (#ExQ #Nil (#Bound +1))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "The type of things whose type does not matter. +("lux def" Top + (#Named ["lux" "Top"] + (#ExQ #Nil (#Bound +1))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things whose type does not matter. It can be used to write functions or data-structures that can take, or return, anything.")]] - #Nil))))]) + #Nil))))]) ## (type: Bottom ## (All [a] a)) -(_lux_def Bottom - (#Named ["lux" "Bottom"] - (#UnivQ #Nil (#Bound +1))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "The type of things whose type is unknown or undefined. +("lux def" Bottom + (#Named ["lux" "Bottom"] + (#UnivQ #Nil (#Bound +1))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things whose type is unknown or undefined. Useful for expressions that cause errors or other \"extraordinary\" conditions.")]] - #Nil))))]) + #Nil))))]) ## (type: Cursor ## {#module Text ## #line Nat ## #column Nat}) -(_lux_def Cursor - (#Named ["lux" "Cursor"] - (#Product Text (#Product Nat Nat))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "module")] - (#Cons [dummy-cursor (+5 "line")] - (#Cons [dummy-cursor (+5 "column")] - #Nil))))]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] - (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - #Nil)))))]) +("lux def" Cursor + (#Named ["lux" "Cursor"] + (#Product Text (#Product Nat Nat))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "module")] + (#Cons [dummy-cursor (+5 "line")] + (#Cons [dummy-cursor (+5 "column")] + #Nil))))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "Cursors are for specifying the location of Code nodes in Lux files during compilation.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil)))))]) ## (type: (Ann m v) ## {#meta m ## #datum v}) -(_lux_def Ann - (#Named ["lux" "Ann"] - (#UnivQ #Nil - (#UnivQ #Nil - (#Product (#Bound +3) - (#Bound +1))))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "meta")] - (#Cons [dummy-cursor (+5 "datum")] - #Nil)))]] - (#Cons [[dummy-cursor (+7 ["lux" "doc"])] - [dummy-cursor (+5 "The type of things that can be annotated with meta-data of arbitrary types.")]] - (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #;Nil)))]] - (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - #Nil))))))]) +("lux def" Ann + (#Named ["lux" "Ann"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product (#Bound +3) + (#Bound +1))))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "meta")] + (#Cons [dummy-cursor (+5 "datum")] + #Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "doc"])] + [dummy-cursor (+5 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "m")] (#Cons [dummy-cursor (+5 "v")] #;Nil)))]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil))))))]) ## (type: (Code' w) ## (#Bool Bool) @@ -334,263 +334,263 @@ ## (#Form (List (w (Code' w)))) ## (#Tuple (List (w (Code' w)))) ## (#Record (List [(w (Code' w)) (w (Code' w))]))) -(_lux_def Code' - (#Named ["lux" "Code'"] - (_lux_case (#Apply (#Apply (#Bound +1) +("lux def" Code' + (#Named ["lux" "Code'"] + ("lux case" (#Apply (#Apply (#Bound +1) (#Bound +0)) (#Bound +1)) - Code - (_lux_case (#Apply Code List) - Code-List - (#UnivQ #Nil - (#Sum ## "lux;Bool" - Bool - (#Sum ## "lux;Nat" - Nat - (#Sum ## "lux;Int" - Int - (#Sum ## "lux;Deg" - Deg - (#Sum ## "lux;Frac" - Frac - (#Sum ## "lux;Text" - Text - (#Sum ## "lux;Symbol" - Ident - (#Sum ## "lux;Tag" - Ident - (#Sum ## "lux;Form" - Code-List - (#Sum ## "lux;Tuple" - Code-List - ## "lux;Record" - (#Apply (#Product Code Code) List) - )))))))))) - )))) - [dummy-cursor - (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")] - (#Cons [dummy-cursor (+5 "Nat")] - (#Cons [dummy-cursor (+5 "Int")] - (#Cons [dummy-cursor (+5 "Deg")] - (#Cons [dummy-cursor (+5 "Frac")] - (#Cons [dummy-cursor (+5 "Text")] - (#Cons [dummy-cursor (+5 "Symbol")] - (#Cons [dummy-cursor (+5 "Tag")] - (#Cons [dummy-cursor (+5 "Form")] - (#Cons [dummy-cursor (+5 "Tuple")] - (#Cons [dummy-cursor (+5 "Record")] - #Nil))))))))))))]] - (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]] - (#Cons [[dummy-cursor (+7 ["lux" "type?"])] - [dummy-cursor (+0 true)]] - (#Cons [[dummy-cursor (+7 ["lux" "export?"])] - [dummy-cursor (+0 true)]] - #Nil)))))]) + Code + ("lux case" (#Apply Code List) + Code-List + (#UnivQ #Nil + (#Sum ## "lux;Bool" + Bool + (#Sum ## "lux;Nat" + Nat + (#Sum ## "lux;Int" + Int + (#Sum ## "lux;Deg" + Deg + (#Sum ## "lux;Frac" + Frac + (#Sum ## "lux;Text" + Text + (#Sum ## "lux;Symbol" + Ident + (#Sum ## "lux;Tag" + Ident + (#Sum ## "lux;Form" + Code-List + (#Sum ## "lux;Tuple" + Code-List + ## "lux;Record" + (#Apply (#Product Code Code) List) + )))))))))) + )))) + [dummy-cursor + (+10 (#Cons [[dummy-cursor (+7 ["lux" "tags"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")] + (#Cons [dummy-cursor (+5 "Nat")] + (#Cons [dummy-cursor (+5 "Int")] + (#Cons [dummy-cursor (+5 "Deg")] + (#Cons [dummy-cursor (+5 "Frac")] + (#Cons [dummy-cursor (+5 "Text")] + (#Cons [dummy-cursor (+5 "Symbol")] + (#Cons [dummy-cursor (+5 "Tag")] + (#Cons [dummy-cursor (+5 "Form")] + (#Cons [dummy-cursor (+5 "Tuple")] + (#Cons [dummy-cursor (+5 "Record")] + #Nil))))))))))))]] + (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] + [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]] + (#Cons [[dummy-cursor (+7 ["lux" "type?"])] + [dummy-cursor (+0 true)]] + (#Cons [[dummy-cursor (+7 ["lux" "export?"])] + [dummy-cursor (+0 true)]] + #Nil)))))]) ## (type: Code ## (Ann Cursor (Code' (Ann Cursor)))) -(_lux_def Code - (#Named ["lux" "Code"] - (_lux_case (#Apply Cursor Ann) - w - (#Apply (#Apply w Code') w))) - [dummy-cursor - (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])] - [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]] - (#Cons [[dummy-cursor (#Tag ["lux" "type?"])] - [dummy-cursor (#Bool true)]] - (#Cons [[dummy-cursor (#Tag ["lux" "export?"])] - [dummy-cursor (#Bool true)]] - #Nil))))]) - -(_lux_def _ann - (_lux_: (#Function (#Apply (#Apply Cursor Ann) - Code') - Code) - (_lux_function _ data - [dummy-cursor data])) - [dummy-cursor (#Record #Nil)]) - -(_lux_def bool$ - (_lux_: (#Function Bool Code) - (_lux_function _ value (_ann (#Bool value)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def nat$ - (_lux_: (#Function Nat Code) - (_lux_function _ value (_ann (#Nat value)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def int$ - (_lux_: (#Function Int Code) - (_lux_function _ value (_ann (#Int value)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def deg$ - (_lux_: (#Function Deg Code) - (_lux_function _ value (_ann (#Deg value)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def frac$ - (_lux_: (#Function Frac Code) - (_lux_function _ value (_ann (#Frac value)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def text$ - (_lux_: (#Function Text Code) - (_lux_function _ text (_ann (#Text text)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def symbol$ - (_lux_: (#Function Ident Code) - (_lux_function _ ident (_ann (#Symbol ident)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def tag$ - (_lux_: (#Function Ident Code) - (_lux_function _ ident (_ann (#Tag ident)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def form$ - (_lux_: (#Function (#Apply Code List) Code) - (_lux_function _ tokens (_ann (#Form tokens)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def tuple$ - (_lux_: (#Function (#Apply Code List) Code) - (_lux_function _ tokens (_ann (#Tuple tokens)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def record$ - (_lux_: (#Function (#Apply (#Product Code Code) List) Code) - (_lux_function _ tokens (_ann (#Record tokens)))) - [dummy-cursor (#Record #Nil)]) - -(_lux_def default-def-meta-exported - (_lux_: (#Apply (#Product Code Code) List) - (#Cons [(tag$ ["lux" "type?"]) - (bool$ true)] - (#Cons [(tag$ ["lux" "export?"]) - (bool$ true)] - #Nil))) - (record$ #Nil)) - -(_lux_def default-def-meta-unexported - (_lux_: (#Apply (#Product Code Code) List) - (#Cons [(tag$ ["lux" "type?"]) - (bool$ true)] - #Nil)) - (record$ #Nil)) +("lux def" Code + (#Named ["lux" "Code"] + ("lux case" (#Apply Cursor Ann) + w + (#Apply (#Apply w Code') w))) + [dummy-cursor + (#Record (#Cons [[dummy-cursor (#Tag ["lux" "doc"])] + [dummy-cursor (#Text "The type of Code nodes for Lux syntax.")]] + (#Cons [[dummy-cursor (#Tag ["lux" "type?"])] + [dummy-cursor (#Bool true)]] + (#Cons [[dummy-cursor (#Tag ["lux" "export?"])] + [dummy-cursor (#Bool true)]] + #Nil))))]) + +("lux def" _ann + ("lux check" (#Function (#Apply (#Apply Cursor Ann) + Code') + Code) + ("lux function" _ data + [dummy-cursor data])) + [dummy-cursor (#Record #Nil)]) + +("lux def" bool$ + ("lux check" (#Function Bool Code) + ("lux function" _ value (_ann (#Bool value)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" nat$ + ("lux check" (#Function Nat Code) + ("lux function" _ value (_ann (#Nat value)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" int$ + ("lux check" (#Function Int Code) + ("lux function" _ value (_ann (#Int value)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" deg$ + ("lux check" (#Function Deg Code) + ("lux function" _ value (_ann (#Deg value)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" frac$ + ("lux check" (#Function Frac Code) + ("lux function" _ value (_ann (#Frac value)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" text$ + ("lux check" (#Function Text Code) + ("lux function" _ text (_ann (#Text text)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" symbol$ + ("lux check" (#Function Ident Code) + ("lux function" _ ident (_ann (#Symbol ident)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" tag$ + ("lux check" (#Function Ident Code) + ("lux function" _ ident (_ann (#Tag ident)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" form$ + ("lux check" (#Function (#Apply Code List) Code) + ("lux function" _ tokens (_ann (#Form tokens)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" tuple$ + ("lux check" (#Function (#Apply Code List) Code) + ("lux function" _ tokens (_ann (#Tuple tokens)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" record$ + ("lux check" (#Function (#Apply (#Product Code Code) List) Code) + ("lux function" _ tokens (_ann (#Record tokens)))) + [dummy-cursor (#Record #Nil)]) + +("lux def" default-def-meta-exported + ("lux check" (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "type?"]) + (bool$ true)] + (#Cons [(tag$ ["lux" "export?"]) + (bool$ true)] + #Nil))) + (record$ #Nil)) + +("lux def" default-def-meta-unexported + ("lux check" (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "type?"]) + (bool$ true)] + #Nil)) + (record$ #Nil)) ## (type: Def ## [Type Code Top]) -(_lux_def Def - (#Named ["lux" "Def"] - (#Product Type (#Product Code Top))) - (record$ (#Cons [(tag$ ["lux" "doc"]) - (text$ "Represents all the data associated with a definition: its type, its annotations, and its value.")] - default-def-meta-exported))) +("lux def" Def + (#Named ["lux" "Def"] + (#Product Type (#Product Code Top))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents all the data associated with a definition: its type, its annotations, and its value.")] + default-def-meta-exported))) ## (type: (Bindings k v) ## {#counter Nat ## #mappings (List [k v])}) -(_lux_def Bindings - (#Named ["lux" "Bindings"] - (#UnivQ #Nil - (#UnivQ #Nil - (#Product ## "lux;counter" - Nat - ## "lux;mappings" - (#Apply (#Product (#Bound +3) - (#Bound +1)) - List))))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "counter") (#Cons (text$ "mappings") #Nil)))] - (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #;Nil)))] - default-def-meta-exported)))) +("lux def" Bindings + (#Named ["lux" "Bindings"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product ## "lux;counter" + Nat + ## "lux;mappings" + (#Apply (#Product (#Bound +3) + (#Bound +1)) + List))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "counter") (#Cons (text$ "mappings") #Nil)))] + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #;Nil)))] + default-def-meta-exported)))) ## (type: #export Ref ## (#Local Nat) ## (#Captured Nat)) -(_lux_def Ref - (#Named ["lux" "Ref"] - (#Sum ## Local - Nat - ## Captured - Nat)) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "Local") (#Cons (text$ "Captured") #Nil)))] - default-def-meta-exported))) +("lux def" Ref + (#Named ["lux" "Ref"] + (#Sum ## Local + Nat + ## Captured + Nat)) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Local") (#Cons (text$ "Captured") #Nil)))] + default-def-meta-exported))) ## (type: Scope ## {#name (List Text) ## #inner Nat ## #locals (Bindings Text [Type Nat]) ## #captured (Bindings Text [Type Ref])}) -(_lux_def Scope - (#Named ["lux" "Scope"] - (#Product ## name - (#Apply Text List) - (#Product ## inner - Nat - (#Product ## locals - (#Apply (#Product Type Nat) (#Apply Text Bindings)) - ## captured - (#Apply (#Product Type Ref) (#Apply Text Bindings)))))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "name") (#Cons (text$ "inner") (#Cons (text$ "locals") (#Cons (text$ "captured") #Nil)))))] - default-def-meta-exported))) - -(_lux_def Code-List - (#Apply Code List) - (record$ default-def-meta-unexported)) +("lux def" Scope + (#Named ["lux" "Scope"] + (#Product ## name + (#Apply Text List) + (#Product ## inner + Nat + (#Product ## locals + (#Apply (#Product Type Nat) (#Apply Text Bindings)) + ## captured + (#Apply (#Product Type Ref) (#Apply Text Bindings)))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "name") (#Cons (text$ "inner") (#Cons (text$ "locals") (#Cons (text$ "captured") #Nil)))))] + default-def-meta-exported))) + +("lux def" Code-List + (#Apply Code List) + (record$ default-def-meta-unexported)) ## (type: (Either l r) ## (#Left l) ## (#Right r)) -(_lux_def Either - (#Named ["lux" "Either"] - (#UnivQ #Nil - (#UnivQ #Nil - (#Sum ## "lux;Left" - (#Bound +3) - ## "lux;Right" - (#Bound +1))))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))] - (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #;Nil)))] - (#Cons [(tag$ ["lux" "doc"]) - (text$ "A choice between two values of different types.")] - default-def-meta-exported))))) +("lux def" Either + (#Named ["lux" "Either"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Sum ## "lux;Left" + (#Bound +3) + ## "lux;Right" + (#Bound +1))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Left") (#Cons (text$ "Right") #Nil)))] + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #;Nil)))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "A choice between two values of different types.")] + default-def-meta-exported))))) ## (type: Source ## [Cursor Text]) -(_lux_def Source - (#Named ["lux" "Source"] - (#Product Cursor Text)) - (record$ default-def-meta-exported)) +("lux def" Source + (#Named ["lux" "Source"] + (#Product Cursor Text)) + (record$ default-def-meta-exported)) ## (type: Module-State ## #Active ## #Compiled ## #Cached) -(_lux_def Module-State - (#Named ["lux" "Module-State"] +("lux def" Module-State + (#Named ["lux" "Module-State"] + (#Sum + ## #Active + Unit (#Sum - ## #Active + ## #Compiled Unit - (#Sum - ## #Compiled - Unit - ## #Cached - Unit))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))] - default-def-meta-exported))) + ## #Cached + Unit))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Active") (#Cons (text$ "Compiled") (#Cons (text$ "Cached") #Nil))))] + default-def-meta-exported))) ## (type: Module ## {#module-hash Nat @@ -601,110 +601,110 @@ ## #types (List [Text [(List Ident) Bool Type]]) ## #module-anns Anns ## #module-state Module-State}) -(_lux_def Module - (#Named ["lux" "Module"] - (#Product ## "lux;module-hash" - Nat - (#Product ## "lux;module-aliases" - (#Apply (#Product Text Text) List) - (#Product ## "lux;defs" - (#Apply (#Product Text Def) List) - (#Product ## "lux;imports" - (#Apply Text List) - (#Product ## "lux;tags" +("lux def" Module + (#Named ["lux" "Module"] + (#Product ## "lux;module-hash" + Nat + (#Product ## "lux;module-aliases" + (#Apply (#Product Text Text) List) + (#Product ## "lux;defs" + (#Apply (#Product Text Def) List) + (#Product ## "lux;imports" + (#Apply Text List) + (#Product ## "lux;tags" + (#Apply (#Product Text + (#Product Nat + (#Product (#Apply Ident List) + (#Product Bool + Type)))) + List) + (#Product ## "lux;types" (#Apply (#Product Text - (#Product Nat - (#Product (#Apply Ident List) - (#Product Bool - Type)))) + (#Product (#Apply Ident List) + (#Product Bool + Type))) List) - (#Product ## "lux;types" - (#Apply (#Product Text - (#Product (#Apply Ident List) - (#Product Bool - Type))) - List) - (#Product ## "lux;module-annotations" - Code - Module-State)) - )))))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "module-hash") - (#Cons (text$ "module-aliases") - (#Cons (text$ "defs") - (#Cons (text$ "imports") - (#Cons (text$ "tags") - (#Cons (text$ "types") - (#Cons (text$ "module-annotations") - (#Cons (text$ "module-state") - #Nil)))))))))] - (#Cons [(tag$ ["lux" "doc"]) - (text$ "All the information contained within a Lux module.")] - default-def-meta-exported)))) + (#Product ## "lux;module-annotations" + Code + Module-State)) + )))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "module-hash") + (#Cons (text$ "module-aliases") + (#Cons (text$ "defs") + (#Cons (text$ "imports") + (#Cons (text$ "tags") + (#Cons (text$ "types") + (#Cons (text$ "module-annotations") + (#Cons (text$ "module-state") + #Nil)))))))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "All the information contained within a Lux module.")] + default-def-meta-exported)))) ## (type: Type-Context ## {#ex-counter Nat ## #var-counter Nat ## #var-bindings (List [Nat (Maybe Type)])}) -(_lux_def Type-Context - (#Named ["lux" "Type-Context"] - (#Product ## ex-counter +("lux def" Type-Context + (#Named ["lux" "Type-Context"] + (#Product ## ex-counter + Nat + (#Product ## var-counter Nat - (#Product ## var-counter - Nat - ## var-bindings - (#Apply (#Product Nat (#Apply Type Maybe)) - List)))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "ex-counter") - (#Cons (text$ "var-counter") - (#Cons (text$ "var-bindings") - #Nil))))] - default-def-meta-exported))) + ## var-bindings + (#Apply (#Product Nat (#Apply Type Maybe)) + List)))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "ex-counter") + (#Cons (text$ "var-counter") + (#Cons (text$ "var-bindings") + #Nil))))] + default-def-meta-exported))) ## (type: Mode ## #Build ## #Eval ## #REPL) -(_lux_def Mode - (#Named ["lux" "Mode"] - (#Sum ## Build +("lux def" Mode + (#Named ["lux" "Mode"] + (#Sum ## Build + #Unit + (#Sum ## Eval #Unit - (#Sum ## Eval - #Unit - ## REPL - #Unit))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "Build") - (#Cons (text$ "Eval") - (#Cons (text$ "REPL") - #Nil))))] - (#Cons [(tag$ ["lux" "doc"]) - (text$ "A sign that shows the conditions under which the compiler is running.")] - default-def-meta-exported)))) + ## REPL + #Unit))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "Build") + (#Cons (text$ "Eval") + (#Cons (text$ "REPL") + #Nil))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "A sign that shows the conditions under which the compiler is running.")] + default-def-meta-exported)))) ## (type: Info ## {#target Text ## #version Text ## #mode Mode}) -(_lux_def Info - (#Named ["lux" "Info"] +("lux def" Info + (#Named ["lux" "Info"] + (#Product + ## target + Text (#Product - ## target + ## version Text - (#Product - ## version - Text - ## mode - Mode))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "target") - (#Cons (text$ "version") - (#Cons (text$ "mode") - #Nil))))] - (#Cons [(tag$ ["lux" "doc"]) - (text$ "Information about the current version and type of compiler that is running.")] - default-def-meta-exported)))) + ## mode + Mode))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "target") + (#Cons (text$ "version") + (#Cons (text$ "mode") + #Nil))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "Information about the current version and type of compiler that is running.")] + default-def-meta-exported)))) ## (type: Compiler ## {#info Info @@ -717,325 +717,325 @@ ## #seed Nat ## #scope-type-vars (List Nat) ## #host Void}) -(_lux_def Compiler - (#Named ["lux" "Compiler"] - (#Product ## "lux;info" - Info - (#Product ## "lux;source" - Source - (#Product ## "lux;cursor" - Cursor - (#Product ## "lux;modules" - (#Apply (#Product Text Module) List) - (#Product ## "lux;scopes" - (#Apply Scope List) - (#Product ## "lux;type-context" - Type-Context - (#Product ## "lux;expected" - (#Apply Type Maybe) - (#Product ## "lux;seed" - Nat - (#Product ## scope-type-vars - (#Apply Nat List) - ## "lux;host" - Void)))))))))) - (record$ (#Cons [(tag$ ["lux" "tags"]) - (tuple$ (#Cons (text$ "info") - (#Cons (text$ "source") - (#Cons (text$ "cursor") - (#Cons (text$ "modules") - (#Cons (text$ "scopes") - (#Cons (text$ "type-context") - (#Cons (text$ "expected") - (#Cons (text$ "seed") - (#Cons (text$ "scope-type-vars") - (#Cons (text$ "host") - #Nil)))))))))))] - (#Cons [(tag$ ["lux" "doc"]) - (text$ "Represents the state of the Lux compiler during a run. +("lux def" Compiler + (#Named ["lux" "Compiler"] + (#Product ## "lux;info" + Info + (#Product ## "lux;source" + Source + (#Product ## "lux;cursor" + Cursor + (#Product ## "lux;modules" + (#Apply (#Product Text Module) List) + (#Product ## "lux;scopes" + (#Apply Scope List) + (#Product ## "lux;type-context" + Type-Context + (#Product ## "lux;expected" + (#Apply Type Maybe) + (#Product ## "lux;seed" + Nat + (#Product ## scope-type-vars + (#Apply Nat List) + ## "lux;host" + Void)))))))))) + (record$ (#Cons [(tag$ ["lux" "tags"]) + (tuple$ (#Cons (text$ "info") + (#Cons (text$ "source") + (#Cons (text$ "cursor") + (#Cons (text$ "modules") + (#Cons (text$ "scopes") + (#Cons (text$ "type-context") + (#Cons (text$ "expected") + (#Cons (text$ "seed") + (#Cons (text$ "scope-type-vars") + (#Cons (text$ "host") + #Nil)))))))))))] + (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents the state of the Lux compiler during a run. It is provided to macros during their invocation, so they can access compiler data. Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] - default-def-meta-exported)))) + default-def-meta-exported)))) ## (type: (Meta a) ## (-> Compiler (Either Text [Compiler a]))) -(_lux_def Meta - (#Named ["lux" "Meta"] - (#UnivQ #Nil - (#Function Compiler - (#Apply (#Product Compiler (#Bound +1)) - (#Apply Text Either))))) - (record$ (#Cons [(tag$ ["lux" "doc"]) - (text$ "Computations that can have access to the state of the compiler. +("lux def" Meta + (#Named ["lux" "Meta"] + (#UnivQ #Nil + (#Function Compiler + (#Apply (#Product Compiler (#Bound +1)) + (#Apply Text Either))))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Computations that can have access to the state of the compiler. These computations may fail, or modify the state of the compiler.")] - (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "a") #;Nil))] - default-def-meta-exported)))) + (#Cons [(tag$ ["lux" "type-args"]) + (tuple$ (#Cons (text$ "a") #;Nil))] + default-def-meta-exported)))) ## (type: Macro ## (-> (List Code) (Meta (List Code)))) -(_lux_def Macro - (#Named ["lux" "Macro"] - (#Function Code-List (#Apply Code-List Meta))) - (record$ (#Cons [(tag$ ["lux" "doc"]) - (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] - default-def-meta-exported))) +("lux def" Macro + (#Named ["lux" "Macro"] + (#Function Code-List (#Apply Code-List Meta))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] + default-def-meta-exported))) ## Base functions & macros -(_lux_def return - (_lux_: (#UnivQ #Nil - (#Function (#Bound +1) - (#Function Compiler - (#Apply (#Product Compiler - (#Bound +1)) - (#Apply Text Either))))) - (_lux_function _ val - (_lux_function _ state - (#Right state val)))) - (record$ #Nil)) - -(_lux_def fail - (_lux_: (#UnivQ #Nil - (#Function Text - (#Function Compiler - (#Apply (#Product Compiler - (#Bound +1)) - (#Apply Text Either))))) - (_lux_function _ msg - (_lux_function _ state - (#Left msg)))) - (record$ #Nil)) - -(_lux_def default-macro-meta - (_lux_: (#Apply (#Product Code Code) List) - (#Cons [(tag$ ["lux" "macro?"]) - (bool$ true)] - #Nil)) - (record$ #Nil)) - -(_lux_def let'' - (_lux_: Macro - (_lux_function _ tokens - (_lux_case tokens - (#Cons lhs (#Cons rhs (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"]) - (#Cons rhs (#Cons lhs (#Cons body #Nil))))) - #Nil)) - - _ - (fail "Wrong syntax for let''")))) - (record$ default-macro-meta)) - -(_lux_def function'' - (_lux_: Macro - (_lux_function _ tokens - (_lux_case tokens - (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) - (return (#Cons (_ann (#Form (#Cons (_ann (#Symbol "" "_lux_function")) - (#Cons (_ann (#Symbol "" "")) - (#Cons arg - (#Cons (_lux_case args' - #Nil - body - - _ - (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) - (#Cons (_ann (#Tuple args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))) - (return (#Cons (_ann (#Form (#Cons (_ann (#Symbol "" "_lux_function")) - (#Cons (_ann (#Symbol "" self)) - (#Cons arg - (#Cons (_lux_case args' - #Nil - body - - _ - (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) - (#Cons (_ann (#Tuple args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - _ - (fail "Wrong syntax for function''")))) - (record$ default-macro-meta)) - -(_lux_def cursor-code - (_lux_: Code - (tuple$ (#Cons (text$ "") (#Cons (nat$ +0) (#Cons (nat$ +0) #Nil))))) - (record$ #Nil)) - -(_lux_def meta-code - (_lux_: (#Function Ident (#Function Code Code)) - (_lux_function _ tag - (_lux_function _ value - (tuple$ (#Cons cursor-code - (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) - #Nil)))))) - (record$ #Nil)) - -(_lux_def flag-meta - (_lux_: (#Function Text Code) - (_lux_function _ tag - (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) - (#Cons [(meta-code ["lux" "Bool"] (bool$ true)) - #Nil])])))) - (record$ #Nil)) - -(_lux_def export?-meta - (_lux_: Code - (flag-meta "export?")) - (record$ #Nil)) - -(_lux_def hidden?-meta - (_lux_: Code - (flag-meta "hidden?")) - (record$ #Nil)) - -(_lux_def macro?-meta - (_lux_: Code - (flag-meta "macro?")) - (record$ #Nil)) - -(_lux_def with-export-meta - (_lux_: (#Function Code Code) - (function'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons export?-meta - (#Cons tail #Nil)))))) - (record$ #Nil)) - -(_lux_def with-hidden-meta - (_lux_: (#Function Code Code) - (function'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons hidden?-meta - (#Cons tail #Nil)))))) - (record$ #Nil)) - -(_lux_def with-macro-meta - (_lux_: (#Function Code Code) - (function'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons macro?-meta - (#Cons tail #Nil)))))) - (record$ #Nil)) - -(_lux_def def:'' - (_lux_: Macro - (function'' [tokens] - (_lux_case tokens - (#Cons [[_ (#Tag ["" "export"])] - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_def"])) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_:"])) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_def"])) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_def"])) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_:"])) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) - #Nil])) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_def"])) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) - #Nil])) - - _ - (fail "Wrong syntax for def''")) - )) - (record$ default-macro-meta)) - -(def:'' (macro:' tokens) - default-macro-meta - Macro - (_lux_case tokens - (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - ))) +("lux def" return + ("lux check" (#UnivQ #Nil + (#Function (#Bound +1) + (#Function Compiler + (#Apply (#Product Compiler + (#Bound +1)) + (#Apply Text Either))))) + ("lux function" _ val + ("lux function" _ state + (#Right state val)))) + (record$ #Nil)) + +("lux def" fail + ("lux check" (#UnivQ #Nil + (#Function Text + (#Function Compiler + (#Apply (#Product Compiler + (#Bound +1)) + (#Apply Text Either))))) + ("lux function" _ msg + ("lux function" _ state + (#Left msg)))) + (record$ #Nil)) + +("lux def" default-macro-meta + ("lux check" (#Apply (#Product Code Code) List) + (#Cons [(tag$ ["lux" "macro?"]) + (bool$ true)] + #Nil)) + (record$ #Nil)) + +("lux def" let'' + ("lux check" Macro + ("lux function" _ tokens + ("lux case" tokens + (#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (text$ "lux case") + (#Cons rhs (#Cons lhs (#Cons body #Nil))))) #Nil)) - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) + _ + (fail "Wrong syntax for let''")))) + (record$ default-macro-meta)) + +("lux def" function'' + ("lux check" Macro + ("lux function" _ tokens + ("lux case" tokens + (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) + (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) + (#Cons (_ann (#Symbol "" "")) + (#Cons arg + (#Cons ("lux case" args' + #Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))) + #Nil)))))) #Nil)) - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) - (#Cons (tag$ ["" "export"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta meta-data) - (#Cons (symbol$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) + (#Cons [_ (#Symbol "" self)] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))) + (return (#Cons (_ann (#Form (#Cons (_ann (#Text "lux function")) + (#Cons (_ann (#Symbol "" self)) + (#Cons arg + (#Cons ("lux case" args' + #Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Symbol "lux" "function''")) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))) + #Nil)))))) #Nil)) - + _ - (fail "Wrong syntax for macro:'"))) + (fail "Wrong syntax for function''")))) + (record$ default-macro-meta)) + +("lux def" cursor-code + ("lux check" Code + (tuple$ (#Cons (text$ "") (#Cons (nat$ +0) (#Cons (nat$ +0) #Nil))))) + (record$ #Nil)) + +("lux def" meta-code + ("lux check" (#Function Ident (#Function Code Code)) + ("lux function" _ tag + ("lux function" _ value + (tuple$ (#Cons cursor-code + (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) + #Nil)))))) + (record$ #Nil)) + +("lux def" flag-meta + ("lux check" (#Function Text Code) + ("lux function" _ tag + (tuple$ (#Cons [(meta-code ["lux" "Tag"] (tuple$ (#Cons (text$ "lux") (#Cons (text$ tag) #Nil)))) + (#Cons [(meta-code ["lux" "Bool"] (bool$ true)) + #Nil])])))) + (record$ #Nil)) + +("lux def" export?-meta + ("lux check" Code + (flag-meta "export?")) + (record$ #Nil)) + +("lux def" hidden?-meta + ("lux check" Code + (flag-meta "hidden?")) + (record$ #Nil)) + +("lux def" macro?-meta + ("lux check" Code + (flag-meta "macro?")) + (record$ #Nil)) + +("lux def" with-export-meta + ("lux check" (#Function Code Code) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons export?-meta + (#Cons tail #Nil)))))) + (record$ #Nil)) + +("lux def" with-hidden-meta + ("lux check" (#Function Code Code) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons hidden?-meta + (#Cons tail #Nil)))))) + (record$ #Nil)) + +("lux def" with-macro-meta + ("lux check" (#Function Code Code) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons macro?-meta + (#Cons tail #Nil)))))) + (record$ #Nil)) + +("lux def" def:'' + ("lux check" Macro + (function'' [tokens] + ("lux case" tokens + (#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) + (#Cons [name + (#Cons [(_ann (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [(_ann (#Form (#Cons [(_ann (#Symbol ["lux" "function''"])) + (#Cons [name + (#Cons [(_ann (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) + #Nil])) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) + (#Cons [name + (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))) + #Nil)])])]))) + #Nil])) + + _ + (fail "Wrong syntax for def''")) + )) + (record$ default-macro-meta)) + +(def:'' (macro:' tokens) + default-macro-meta + Macro + ("lux case" tokens + (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + ))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta meta-data) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + _ + (fail "Wrong syntax for macro:'"))) (macro:' #export (comment tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1046,19 +1046,19 @@ (return #Nil)) (macro:' ($' tokens) - (_lux_case tokens - (#Cons x #Nil) - (return tokens) - - (#Cons x (#Cons y xs)) - (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) - (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) - (#Cons y (#Cons x #Nil)))) - xs))) - #Nil)) + ("lux case" tokens + (#Cons x #Nil) + (return tokens) - _ - (fail "Wrong syntax for $'"))) + (#Cons x (#Cons y xs)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) + (#Cons (form$ (#Cons (tag$ ["lux" "Apply"]) + (#Cons y (#Cons x #Nil)))) + xs))) + #Nil)) + + _ + (fail "Wrong syntax for $'"))) (def:'' (map f xs) #;Nil @@ -1067,12 +1067,12 @@ (#Function (#Function (#Bound +3) (#Bound +1)) (#Function ($' List (#Bound +3)) ($' List (#Bound +1)))))) - (_lux_case xs - #Nil - #Nil + ("lux case" xs + #Nil + #Nil - (#Cons x xs') - (#Cons (f x) (map f xs')))) + (#Cons x xs') + (#Cons (f x) (map f xs')))) (def:'' RepEnv #;Nil @@ -1082,12 +1082,12 @@ (def:'' (make-env xs ys) #;Nil (#Function ($' List Text) (#Function ($' List Code) RepEnv)) - (_lux_case [xs ys] - [(#Cons x xs') (#Cons y ys')] - (#Cons [x y] (make-env xs' ys')) + ("lux case" [xs ys] + [(#Cons x xs') (#Cons y ys')] + (#Cons [x y] (make-env xs' ys')) - _ - #Nil)) + _ + #Nil)) (def:'' (text/= x y) #;Nil @@ -1097,70 +1097,70 @@ (def:'' (get-rep key env) #;Nil (#Function Text (#Function RepEnv ($' Maybe Code))) - (_lux_case env - #Nil - #None + ("lux case" env + #Nil + #None - (#Cons [k v] env') - (_lux_case (text/= k key) - true - (#Some v) + (#Cons [k v] env') + ("lux case" (text/= k key) + true + (#Some v) - false - (get-rep key env')))) + false + (get-rep key env')))) (def:'' (replace-syntax reps syntax) #;Nil (#Function RepEnv (#Function Code Code)) - (_lux_case syntax - [_ (#Symbol "" name)] - (_lux_case (get-rep name reps) - (#Some replacement) - replacement + ("lux case" syntax + [_ (#Symbol "" name)] + ("lux case" (get-rep name reps) + (#Some replacement) + replacement - #None - syntax) + #None + syntax) - [meta (#Form parts)] - [meta (#Form (map (replace-syntax reps) parts))] + [meta (#Form parts)] + [meta (#Form (map (replace-syntax reps) parts))] - [meta (#Tuple members)] - [meta (#Tuple (map (replace-syntax reps) members))] + [meta (#Tuple members)] + [meta (#Tuple (map (replace-syntax reps) members))] - [meta (#Record slots)] - [meta (#Record (map (_lux_: (#Function (#Product Code Code) (#Product Code Code)) - (function'' [slot] - (_lux_case slot - [k v] - [(replace-syntax reps k) (replace-syntax reps v)]))) - slots))] - - _ - syntax) + [meta (#Record slots)] + [meta (#Record (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [slot] + ("lux case" slot + [k v] + [(replace-syntax reps k) (replace-syntax reps v)]))) + slots))] + + _ + syntax) ) (def:'' (update-bounds code) #;Nil (#Function Code Code) - (_lux_case code - [_ (#Tuple members)] - (tuple$ (map update-bounds members)) + ("lux case" code + [_ (#Tuple members)] + (tuple$ (map update-bounds members)) - [_ (#Record pairs)] - (record$ (map (_lux_: (#Function (#Product Code Code) (#Product Code Code)) - (function'' [pair] - (let'' [name val] pair - [name (update-bounds val)]))) - pairs)) + [_ (#Record pairs)] + (record$ (map ("lux check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [pair] + (let'' [name val] pair + [name (update-bounds val)]))) + pairs)) - [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] - (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) + [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) - [_ (#Form members)] - (form$ (map update-bounds members)) + [_ (#Form members)] + (form$ (map update-bounds members)) - _ - code)) + _ + code)) (def:'' (parse-quantified-args args next) #;Nil @@ -1169,16 +1169,16 @@ (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) (#Apply ($' List Code) Meta) )) - (_lux_case args - #Nil - (next #Nil) + ("lux case" args + #Nil + (next #Nil) - (#Cons [_ (#Symbol "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + (#Cons [_ (#Symbol "" arg-name)] args') + (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) - _ - (fail "Expected symbol.") - )) + _ + (fail "Expected symbol.") + )) (def:'' (make-bound idx) #;Nil @@ -1194,12 +1194,12 @@ (#Function (#Bound +3) (#Function ($' List (#Bound +1)) (#Bound +3)))))) - (_lux_case xs - #Nil - init + ("lux case" xs + #Nil + init - (#Cons x xs') - (fold f (f x init) xs'))) + (#Cons x xs') + (fold f (f x init) xs'))) (def:'' (length list) #;Nil @@ -1218,43 +1218,43 @@ (| Unit [a (List a)]))")] #;Nil) - (let'' [self-name tokens] (_lux_case tokens - (#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] - - _ - ["" tokens]) - (_lux_case tokens - (#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (fold (_lux_: (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons (_lux_case [(text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) - - _ - (fail "Wrong syntax for All")) + (let'' [self-name tokens] ("lux case" tokens + (#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]) + ("lux case" tokens + (#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (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-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) + + _ + (fail "Wrong syntax for All")) )) (macro:' #export (Ex tokens) @@ -1270,43 +1270,43 @@ a (List (Self a))])")] #;Nil) - (let'' [self-name tokens] (_lux_case tokens - (#Cons [_ (#Symbol "" self-name)] tokens) - [self-name tokens] - - _ - ["" tokens]) - (_lux_case tokens - (#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse-quantified-args args - (function'' [names] - (let'' body' (fold (_lux_: (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "ExQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons (_lux_case [(text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) - - _ - (fail "Wrong syntax for Ex")) + (let'' [self-name tokens] ("lux case" tokens + (#Cons [_ (#Symbol "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]) + ("lux case" tokens + (#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse-quantified-args args + (function'' [names] + (let'' body' (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-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons ("lux case" [(text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")) )) (def:'' (reverse list) @@ -1323,16 +1323,16 @@ ## This is the type of a function that takes 2 Ints and returns an Int.")] #;Nil) - (_lux_case (reverse tokens) - (#Cons output inputs) - (return (#Cons (fold (_lux_: (#Function Code (#Function Code Code)) - (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) - output - inputs) - #Nil)) - - _ - (fail "Wrong syntax for ->"))) + ("lux case" (reverse tokens) + (#Cons output inputs) + (return (#Cons (fold ("lux check" (#Function Code (#Function Code Code)) + (function'' [i o] (form$ (#Cons (tag$ ["lux" "Function"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->"))) (macro:' #export (list xs) (#Cons [(tag$ ["lux" "doc"]) @@ -1353,16 +1353,16 @@ ## In other words, this macro prepends elements to another list. (list& 1 2 3 (list 4 5 6))")] #;Nil) - (_lux_case (reverse xs) - (#Cons last init) - (return (list (fold (function'' [head tail] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) - last - init))) + ("lux case" (reverse xs) + (#Cons last init) + (return (list (fold (function'' [head tail] + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) + last + init))) - _ - (fail "Wrong syntax for list&"))) + _ + (fail "Wrong syntax for list&"))) (macro:' #export (& tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1372,15 +1372,15 @@ ## The empty tuple, a.k.a. Unit. (&)")] #;Nil) - (_lux_case (reverse tokens) - #Nil - (return (list (tag$ ["lux" "Unit"]))) + ("lux case" (reverse tokens) + #Nil + (return (list (tag$ ["lux" "Unit"]))) - (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) - last - prevs))) - )) + (#Cons last prevs) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + last + prevs))) + )) (macro:' #export (| tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1390,144 +1390,144 @@ ## The empty tuple, a.k.a. Void. (|)")] #;Nil) - (_lux_case (reverse tokens) - #Nil - (return (list (tag$ ["lux" "Void"]))) + ("lux case" (reverse tokens) + #Nil + (return (list (tag$ ["lux" "Void"]))) - (#Cons last prevs) - (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) - last - prevs))) - )) + (#Cons last prevs) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) + last + prevs))) + )) (macro:' (function' tokens) - (let'' [name tokens'] (_lux_case tokens - (#Cons [[_ (#Symbol ["" name])] tokens']) - [name tokens'] + (let'' [name tokens'] ("lux case" tokens + (#Cons [[_ (#Symbol ["" name])] tokens']) + [name tokens'] - _ - ["" tokens]) - (_lux_case tokens' - (#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) - (_lux_case args - #Nil - (fail "function' requires a non-empty arguments tuple.") - - (#Cons [harg targs]) - (return (list (form$ (list (symbol$ ["" "_lux_function"]) - (symbol$ ["" name]) - harg - (fold (function'' [arg body'] - (form$ (list (symbol$ ["" "_lux_function"]) - (symbol$ ["" ""]) - arg - body'))) - body - (reverse targs))))))) + _ + ["" tokens]) + ("lux case" tokens' + (#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) + ("lux case" args + #Nil + (fail "function' requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list (form$ (list (text$ "lux function") + (symbol$ ["" name]) + harg + (fold (function'' [arg body'] + (form$ (list (text$ "lux function") + (symbol$ ["" ""]) + arg + body'))) + body + (reverse targs))))))) - _ - (fail "Wrong syntax for function'")))) + _ + (fail "Wrong syntax for function'")))) (macro:' (def:''' tokens) - (_lux_case tokens - (#Cons [[_ (#Tag ["" "export"])] - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (symbol$ ["" "_lux_def"]) - name - (form$ (list (symbol$ ["" "_lux_:"]) - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (list (form$ (list (symbol$ ["" "_lux_def"]) - name - (form$ (list (symbol$ ["" "_lux_:"]) - type - body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))))))) - - (#Cons [[_ (#Form (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (symbol$ ["" "_lux_def"]) - name - (form$ (list (symbol$ ["" "_lux_:"]) - type - (form$ (list (symbol$ ["lux" "function'"]) - name - (tuple$ args) - body)))) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (list (form$ (list (symbol$ ["" "_lux_def"]) - name - (form$ (list (symbol$ ["" "_lux_:"]) type body)) - (form$ (#Cons (symbol$ ["lux" "record$"]) - (#Cons meta - #Nil))))))) - - _ - (fail "Wrong syntax for def'''") - )) + ("lux case" tokens + (#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil))))))) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") + type + (form$ (list (symbol$ ["lux" "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux check") type body)) + (form$ (#Cons (symbol$ ["lux" "record$"]) + (#Cons meta + #Nil))))))) + + _ + (fail "Wrong syntax for def'''") + )) (def:''' (as-pairs xs) #;Nil (All [a] (-> ($' List a) ($' List (& a a)))) - (_lux_case xs - (#Cons x (#Cons y xs')) - (#Cons [x y] (as-pairs xs')) + ("lux case" xs + (#Cons x (#Cons y xs')) + (#Cons [x y] (as-pairs xs')) - _ - #Nil)) + _ + #Nil)) (macro:' (let' tokens) - (_lux_case tokens - (#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) - (return (list (fold (_lux_: (-> (& Code Code) Code - Code) - (function' [binding body] - (_lux_case binding - [label value] - (form$ (list (symbol$ ["" "_lux_case"]) value label body))))) - body - (reverse (as-pairs bindings))))) + ("lux case" tokens + (#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) + (return (list (fold ("lux check" (-> (& Code Code) Code + Code) + (function' [binding body] + ("lux case" binding + [label value] + (form$ (list (text$ "lux case") value label body))))) + body + (reverse (as-pairs bindings))))) - _ - (fail "Wrong syntax for let'"))) + _ + (fail "Wrong syntax for let'"))) (def:''' (any? p xs) #;Nil (All [a] (-> (-> a Bool) ($' List a) Bool)) - (_lux_case xs - #Nil - false + ("lux case" xs + #Nil + false - (#Cons x xs') - (_lux_case (p x) - true true - false (any? p xs')))) + (#Cons x xs') + ("lux case" (p x) + true true + false (any? p xs')))) (def:''' (spliced? token) #;Nil (-> Code Bool) - (_lux_case token - [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] - true + ("lux case" token + [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [_ #Nil])]))] + true - _ - false)) + _ + false)) (def:''' (wrap-meta content) #;Nil @@ -1538,44 +1538,44 @@ (def:''' (untemplate-list tokens) #;Nil (-> ($' List Code) Code) - (_lux_case tokens - #Nil - (_ann (#Tag ["lux" "Nil"])) + ("lux case" tokens + #Nil + (_ann (#Tag ["lux" "Nil"])) - (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens')))))) + (#Cons [token tokens']) + (_ann (#Form (list (_ann (#Tag ["lux" "Cons"])) token (untemplate-list tokens')))))) (def:''' (list/compose xs ys) #;Nil (All [a] (-> ($' List a) ($' List a) ($' List a))) - (_lux_case xs - (#Cons x xs') - (#Cons x (list/compose xs' ys)) + ("lux case" xs + (#Cons x xs') + (#Cons x (list/compose xs' ys)) - #Nil - ys)) + #Nil + ys)) (def:''' #export (splice-helper xs ys) (#Cons [(tag$ ["lux" "hidden?"]) (bool$ true)] #;Nil) (-> ($' List Code) ($' List Code) ($' List Code)) - (_lux_case xs - (#Cons x xs') - (#Cons x (splice-helper xs' ys)) + ("lux case" xs + (#Cons x xs') + (#Cons x (splice-helper xs' ys)) - #Nil - ys)) + #Nil + ys)) (def:''' (_$_joiner op a1 a2) #;Nil (-> Code Code Code Code) - (_lux_case op - [_ (#Form parts)] - (form$ (list/compose parts (list a1 a2))) + ("lux case" op + [_ (#Form parts)] + (form$ (list/compose parts (list a1 a2))) - _ - (form$ (list op a1 a2)))) + _ + (form$ (list op a1 a2)))) (macro:' #export (_$ tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1585,17 +1585,17 @@ ## => (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] #;Nil) - (_lux_case tokens - (#Cons op tokens') - (_lux_case tokens' - (#Cons first nexts) - (return (list (fold (_$_joiner op) first nexts))) + ("lux case" tokens + (#Cons op tokens') + ("lux case" tokens' + (#Cons first nexts) + (return (list (fold (_$_joiner op) first nexts))) - _ - (fail "Wrong syntax for _$")) - _ - (fail "Wrong syntax for _$"))) + (fail "Wrong syntax for _$")) + + _ + (fail "Wrong syntax for _$"))) (macro:' #export ($_ tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -1605,17 +1605,17 @@ ## => (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] #;Nil) - (_lux_case tokens - (#Cons op tokens') - (_lux_case (reverse tokens') - (#Cons last prevs) - (return (list (fold (_$_joiner op) last prevs))) + ("lux case" tokens + (#Cons op tokens') + ("lux case" (reverse tokens') + (#Cons last prevs) + (return (list (fold (_$_joiner op) last prevs))) - _ - (fail "Wrong syntax for $_")) - _ - (fail "Wrong syntax for $_"))) + (fail "Wrong syntax for $_")) + + _ + (fail "Wrong syntax for $_"))) ## (sig: (Monad m) ## (: (All [a] (-> a (m a))) @@ -1642,9 +1642,9 @@ #bind (function' [f ma] - (_lux_case ma - #None #None - (#Some a) (f a)))}) + ("lux case" ma + #None #None + (#Some a) (f a)))}) (def:''' Monad<Meta> #Nil @@ -1657,38 +1657,38 @@ #bind (function' [f ma] (function' [state] - (_lux_case (ma state) - (#Left msg) - (#Left msg) + ("lux case" (ma state) + (#Left msg) + (#Left msg) - (#Right state' a) - (f a state'))))}) + (#Right state' a) + (f a state'))))}) (macro:' (do tokens) - (_lux_case tokens - (#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (symbol$ ["" "wrap"]) - g!bind (symbol$ ["" " bind "]) - body' (fold (_lux_: (-> (& Code Code) Code Code) - (function' [binding body'] - (let' [[var value] binding] - (_lux_case var - [_ (#Tag "" "let")] - (form$ (list (symbol$ ["lux" "let'"]) value body')) - - _ - (form$ (list g!bind - (form$ (list (symbol$ ["" "_lux_function"]) (symbol$ ["" ""]) var body')) - value)))))) - body - (reverse (as-pairs bindings)))] - (return (list (form$ (list (symbol$ ["" "_lux_case"]) - monad - (record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) - body'))))) + ("lux case" tokens + (#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) + (let' [g!wrap (symbol$ ["" "wrap"]) + g!bind (symbol$ ["" " bind "]) + body' (fold ("lux check" (-> (& Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ("lux case" var + [_ (#Tag "" "let")] + (form$ (list (symbol$ ["lux" "let'"]) value body')) - _ - (fail "Wrong syntax for do"))) + _ + (form$ (list g!bind + (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) + value)))))) + body + (reverse (as-pairs bindings)))] + (return (list (form$ (list (text$ "lux case") + monad + (record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body'))))) + + _ + (fail "Wrong syntax for do"))) (def:''' (mapM m f xs) #Nil @@ -1700,16 +1700,16 @@ ($' List a) ($' m ($' List b)))) (let' [{#;wrap wrap #;bind _} m] - (_lux_case xs - #Nil - (wrap #Nil) - - (#Cons x xs') - (do m - [y (f x) - ys (mapM m f xs')] - (wrap (#Cons y ys))) - ))) + ("lux case" xs + #Nil + (wrap #Nil) + + (#Cons x xs') + (do m + [y (f x) + ys (mapM m f xs')] + (wrap (#Cons y ys))) + ))) (macro:' #export (if tokens) (list [(tag$ ["lux" "doc"]) @@ -1720,40 +1720,40 @@ \"Aw hell naw!\") => \"Oh, yeah!\"")]) - (_lux_case tokens - (#Cons test (#Cons then (#Cons else #Nil))) - (return (list (form$ (list (symbol$ ["" "_lux_case"]) test - (bool$ true) then - (bool$ false) else)))) + ("lux case" tokens + (#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (text$ "lux case") test + (bool$ true) then + (bool$ false) else)))) - _ - (fail "Wrong syntax for if"))) + _ + (fail "Wrong syntax for if"))) (def:''' (get k plist) #Nil (All [a] (-> Text ($' List (& Text a)) ($' Maybe a))) - (_lux_case plist - (#Cons [[k' v] plist']) - (if (text/= k k') - (#Some v) - (get k plist')) + ("lux case" plist + (#Cons [[k' v] plist']) + (if (text/= k k') + (#Some v) + (get k plist')) - #Nil - #None)) + #Nil + #None)) (def:''' (put k v dict) #Nil (All [a] (-> Text a ($' List (& Text a)) ($' List (& Text a)))) - (_lux_case dict - #Nil - (list [k v]) + ("lux case" dict + #Nil + (list [k v]) - (#Cons [[k' v'] dict']) - (if (text/= k k') - (#Cons [[k' v] dict']) - (#Cons [[k' v'] (put k v dict')])))) + (#Cons [[k' v'] dict']) + (if (text/= k k') + (#Cons [[k' v] dict']) + (#Cons [[k' v'] (put k v dict')])))) (def:''' #export (log! message) (list [(tag$ ["lux" "doc"]) @@ -1772,36 +1772,36 @@ #Nil (-> Ident Text) (let' [[module name] ident] - (_lux_case module - "" name - _ ($_ text/compose module ";" name)))) + ("lux case" module + "" name + _ ($_ text/compose module ";" name)))) (def:''' (get-meta tag def-meta) #Nil (-> Ident Code ($' Maybe Code)) (let' [[prefix name] tag] - (_lux_case def-meta - [_ (#Record def-meta)] - (_lux_case def-meta - (#Cons [key value] def-meta') - (_lux_case key - [_ (#Tag [prefix' name'])] - (_lux_case [(text/= prefix prefix') - (text/= name name')] - [true true] - (#Some value) + ("lux case" def-meta + [_ (#Record def-meta)] + ("lux case" def-meta + (#Cons [key value] def-meta') + ("lux case" key + [_ (#Tag [prefix' name'])] + ("lux case" [(text/= prefix prefix') + (text/= name name')] + [true true] + (#Some value) - _ - (get-meta tag (record$ def-meta'))) + _ + (get-meta tag (record$ def-meta'))) - _ - (get-meta tag (record$ def-meta'))) + _ + (get-meta tag (record$ def-meta'))) - #Nil - #None) + #Nil + #None) - _ - #None))) + _ + #None))) (def:''' (resolve-global-symbol ident state) #Nil @@ -1811,138 +1811,138 @@ #scopes scopes #type-context types #host host #seed seed #expected expected #cursor cursor #scope-type-vars scope-type-vars} state] - (_lux_case (get module modules) - (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) - (_lux_case (get name defs) - (#Some [def-type def-meta def-value]) - (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some [_ (#Symbol real-name)]) - (#Right [state real-name]) + ("lux case" (get module modules) + (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _}) + ("lux case" (get name defs) + (#Some [def-type def-meta def-value]) + ("lux case" (get-meta ["lux" "alias"] def-meta) + (#Some [_ (#Symbol real-name)]) + (#Right [state real-name]) - _ - (#Right [state ident])) + _ + (#Right [state ident])) - #None - (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))) - #None - (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))))) + (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))) + + #None + (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))))) (def:''' (splice replace? untemplate tag elems) #Nil (-> Bool (-> Code ($' Meta Code)) Code ($' List Code) ($' Meta Code)) - (_lux_case replace? + ("lux case" replace? + true + ("lux case" (any? spliced? elems) true - (_lux_case (any? spliced? elems) - true - (do Monad<Meta> - [elems' (_lux_: ($' Meta ($' List Code)) - (mapM Monad<Meta> - (_lux_: (-> Code ($' Meta Code)) - (function' [elem] - (_lux_case elem - [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap spliced) + (do Monad<Meta> + [elems' ("lux check" ($' Meta ($' List Code)) + (mapM Monad<Meta> + ("lux check" (-> Code ($' Meta Code)) + (function' [elem] + ("lux case" elem + [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) + + _ + (do Monad<Meta> + [=elem (untemplate elem)] + (wrap (form$ (list (text$ "lux check") + (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"]))))) + (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) + elems))] + (wrap (wrap-meta (form$ (list tag + (form$ (list& (symbol$ ["lux" "$_"]) + (symbol$ ["lux" "splice-helper"]) + elems'))))))) - _ - (do Monad<Meta> - [=elem (untemplate elem)] - (wrap (form$ (list (symbol$ ["" "_lux_:"]) - (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"]))))) - (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) - elems))] - (wrap (wrap-meta (form$ (list tag - (form$ (list& (symbol$ ["lux" "$_"]) - (symbol$ ["lux" "splice-helper"]) - elems'))))))) - - false - (do Monad<Meta> - [=elems (mapM Monad<Meta> untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) false (do Monad<Meta> [=elems (mapM Monad<Meta> untemplate elems)] - (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) + false + (do Monad<Meta> + [=elems (mapM Monad<Meta> untemplate elems)] + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) (def:''' (untemplate replace? subst token) #Nil (-> Bool Text Code ($' Meta Code)) - (_lux_case [replace? token] - [_ [_ (#Bool value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) - - [_ [_ (#Nat value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) + ("lux case" [replace? token] + [_ [_ (#Bool value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) - [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - - [_ [_ (#Deg value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) - - [_ [_ (#Frac value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) + [_ [_ (#Nat value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) - [_ [_ (#Text value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) + [_ [_ (#Int value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - [false [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + [_ [_ (#Deg value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) + + [_ [_ (#Frac value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) - [true [_ (#Tag [module name])]] - (let' [module' (_lux_case module - "" - subst + [_ [_ (#Text value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - _ - module)] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + [false [_ (#Tag [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - [true [_ (#Symbol [module name])]] - (do Monad<Meta> - [real-name (_lux_case module + [true [_ (#Tag [module name])]] + (let' [module' ("lux case" module "" - (if (text/= "" subst) - (wrap [module name]) - (resolve-global-symbol [subst name])) + subst _ - (wrap [module name])) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) - - [false [_ (#Symbol [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) - - [_ [_ (#Tuple elems)]] - (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems) - - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return unquoted) - - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate false subst keep-quoted) - - [_ [meta (#Form elems)]] - (do Monad<Meta> - [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) - #let [[_ form'] output]] - (return [meta form'])) - - [_ [_ (#Record fields)]] - (do Monad<Meta> - [=fields (mapM Monad<Meta> - (_lux_: (-> (& Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do Monad<Meta> - [=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)))))) - )) + module)] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + + [true [_ (#Symbol [module name])]] + (do Monad<Meta> + [real-name ("lux case" module + "" + (if (text/= "" subst) + (wrap [module name]) + (resolve-global-symbol [subst name])) + + _ + (wrap [module name])) + #let [[module name] real-name]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [false [_ (#Symbol [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + + [_ [_ (#Tuple elems)]] + (splice replace? (untemplate replace? subst) (tag$ ["lux" "Tuple"]) elems) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] + (return unquoted) + + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] + (untemplate false subst keep-quoted) + + [_ [meta (#Form elems)]] + (do Monad<Meta> + [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) + #let [[_ form'] output]] + (return [meta form'])) + + [_ [_ (#Record fields)]] + (do Monad<Meta> + [=fields (mapM Monad<Meta> + ("lux check" (-> (& Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do Monad<Meta> + [=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)))))) + )) (macro:' #export (primitive tokens) (list [(tag$ ["lux" "doc"]) @@ -1950,31 +1950,31 @@ (primitive java.lang.Object) (primitive java.util.List [java.lang.Long])")]) - (_lux_case tokens - (#Cons [_ (#Symbol "" class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + ("lux case" tokens + (#Cons [_ (#Symbol "" class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Symbol "" class-name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) - _ - (fail "Wrong syntax for primitive"))) + _ + (fail "Wrong syntax for primitive"))) (def:'' (current-module-name state) #Nil ($' Meta Text) - (_lux_case state - {#info info #source source #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} - (_lux_case (reverse scopes) - (#Cons {#name (#;Cons module-name #Nil) #inner _ #locals _ #captured _} _) - (#Right [state module-name]) + ("lux case" state + {#info info #source source #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + ("lux case" (reverse scopes) + (#Cons {#name (#;Cons module-name #Nil) #inner _ #locals _ #captured _} _) + (#Right [state module-name]) - _ - (#Left "Cannot get the module name without a module!") - ))) + _ + (#Left "Cannot get the module name without a module!") + ))) (macro:' #export (` tokens) (list [(tag$ ["lux" "doc"]) @@ -1983,15 +1983,15 @@ (` (def: (~ name) (function [(~@ args)] (~ body))))")]) - (_lux_case tokens - (#Cons template #Nil) - (do Monad<Meta> - [current-module current-module-name - =template (untemplate true current-module template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) + ("lux case" tokens + (#Cons template #Nil) + (do Monad<Meta> + [current-module current-module-name + =template (untemplate true current-module template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `"))) + _ + (fail "Wrong syntax for `"))) (macro:' #export (`' tokens) (list [(tag$ ["lux" "doc"]) @@ -1999,27 +1999,27 @@ (`' (def: (~ name) (function [(~@ args)] (~ body))))")]) - (_lux_case tokens - (#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate true "" template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) + ("lux case" tokens + (#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate true "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for `"))) + _ + (fail "Wrong syntax for `"))) (macro:' #export (' tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Quotation as a macro. (' \"YOLO\")")]) - (_lux_case tokens - (#Cons template #Nil) - (do Monad<Meta> - [=template (untemplate false "" template)] - (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) + ("lux case" tokens + (#Cons template #Nil) + (do Monad<Meta> + [=template (untemplate false "" template)] + (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) - _ - (fail "Wrong syntax for '"))) + _ + (fail "Wrong syntax for '"))) (macro:' #export (|> tokens) (list [(tag$ ["lux" "doc"]) @@ -2030,24 +2030,24 @@ (fold text/compose \"\" (interpose \" \" (map int/encode elems)))")]) - (_lux_case tokens - (#Cons [init apps]) - (return (list (fold (_lux_: (-> Code Code Code) - (function' [app acc] - (_lux_case app - [_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) + ("lux case" tokens + (#Cons [init apps]) + (return (list (fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + [_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) - _ - (` ((~ app) (~ acc)))))) - init - apps))) + _ + (` ((~ app) (~ acc)))))) + init + apps))) - _ - (fail "Wrong syntax for |>"))) + _ + (fail "Wrong syntax for |>"))) (macro:' #export (<| tokens) (list [(tag$ ["lux" "doc"]) @@ -2058,24 +2058,24 @@ (fold text/compose \"\" (interpose \" \" (map int/encode elems)))")]) - (_lux_case (reverse tokens) - (#Cons [init apps]) - (return (list (fold (_lux_: (-> Code Code Code) - (function' [app acc] - (_lux_case app - [_ (#Tuple parts)] - (tuple$ (list/compose parts (list acc))) + ("lux case" (reverse tokens) + (#Cons [init apps]) + (return (list (fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + [_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - [_ (#Form parts)] - (form$ (list/compose parts (list acc))) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) - _ - (` ((~ app) (~ acc)))))) - init - apps))) + _ + (` ((~ app) (~ acc)))))) + init + apps))) - _ - (fail "Wrong syntax for <|"))) + _ + (fail "Wrong syntax for <|"))) (def:''' #export (. f g) (list [(tag$ ["lux" "doc"]) @@ -2087,81 +2087,81 @@ (def:''' (get-ident x) #Nil (-> Code ($' Maybe Ident)) - (_lux_case x - [_ (#Symbol sname)] - (#Some sname) + ("lux case" x + [_ (#Symbol sname)] + (#Some sname) - _ - #None)) + _ + #None)) (def:''' (get-tag x) #Nil (-> Code ($' Maybe Ident)) - (_lux_case x - [_ (#Tag sname)] - (#Some sname) + ("lux case" x + [_ (#Tag sname)] + (#Some sname) - _ - #None)) + _ + #None)) (def:''' (get-name x) #Nil (-> Code ($' Maybe Text)) - (_lux_case x - [_ (#Symbol "" sname)] - (#Some sname) + ("lux case" x + [_ (#Symbol "" sname)] + (#Some sname) - _ - #None)) + _ + #None)) (def:''' (tuple->list tuple) #Nil (-> Code ($' Maybe ($' List Code))) - (_lux_case tuple - [_ (#Tuple members)] - (#Some members) + ("lux case" tuple + [_ (#Tuple members)] + (#Some members) - _ - #None)) + _ + #None)) (def:''' (apply-template env template) #Nil (-> RepEnv Code Code) - (_lux_case template - [_ (#Symbol "" sname)] - (_lux_case (get-rep sname env) - (#Some subst) - subst + ("lux case" template + [_ (#Symbol "" sname)] + ("lux case" (get-rep sname env) + (#Some subst) + subst - _ - template) + _ + template) - [meta (#Tuple elems)] - [meta (#Tuple (map (apply-template env) elems))] + [meta (#Tuple elems)] + [meta (#Tuple (map (apply-template env) elems))] - [meta (#Form elems)] - [meta (#Form (map (apply-template env) elems))] + [meta (#Form elems)] + [meta (#Form (map (apply-template env) elems))] - [meta (#Record members)] - [meta (#Record (map (_lux_: (-> (& Code Code) (& Code Code)) - (function' [kv] - (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) - members))] + [meta (#Record members)] + [meta (#Record (map ("lux check" (-> (& Code Code) (& Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members))] - _ - template)) + _ + template)) (def:''' (join-map f xs) #Nil (All [a b] (-> (-> a ($' List b)) ($' List a) ($' List b))) - (_lux_case xs - #Nil - #Nil + ("lux case" xs + #Nil + #Nil - (#Cons [x xs']) - (list/compose (f x) (join-map f xs')))) + (#Cons [x xs']) + (list/compose (f x) (join-map f xs')))) (def:''' (every? p xs) #Nil @@ -2179,26 +2179,26 @@ [i.inc 1] [i.dec -1])")]) - (_lux_case tokens - (#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) - (_lux_case [(mapM Monad<Maybe> get-name bindings) + ("lux case" tokens + (#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) + ("lux case" [(mapM Monad<Maybe> get-name bindings) (mapM Monad<Maybe> tuple->list data)] - [(#Some bindings') (#Some data')] - (let' [apply (_lux_: (-> RepEnv ($' List Code)) - (function' [env] (map (apply-template env) templates))) - num-bindings (length bindings')] - (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) - (map length data')) - (|> data' - (join-map (. apply (make-env bindings'))) - return) - (fail "Irregular arguments tuples for do-template."))) - - _ - (fail "Wrong syntax for do-template")) + [(#Some bindings') (#Some data')] + (let' [apply ("lux check" (-> RepEnv ($' List Code)) + (function' [env] (map (apply-template env) templates))) + num-bindings (length bindings')] + (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) + (map length data')) + (|> data' + (join-map (. apply (make-env bindings'))) + return) + (fail "Irregular arguments tuples for do-template."))) _ - (fail "Wrong syntax for do-template"))) + (fail "Wrong syntax for do-template")) + + _ + (fail "Wrong syntax for do-template"))) (do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] @@ -2314,29 +2314,29 @@ (def:''' (digit-to-text digit) #Nil (-> Nat Text) - (_lux_case digit - +0 "0" - +1 "1" +2 "2" +3 "3" - +4 "4" +5 "5" +6 "6" - +7 "7" +8 "8" +9 "9" - _ (_lux_proc ["io" "error"] ["undefined"]))) + ("lux case" digit + +0 "0" + +1 "1" +2 "2" +3 "3" + +4 "4" +5 "5" +6 "6" + +7 "7" +8 "8" +9 "9" + _ (_lux_proc ["io" "error"] ["undefined"]))) (def:''' (nat/encode value) #Nil (-> Nat Text) - (_lux_case value - +0 - "+0" - - _ - (let' [loop (_lux_: (-> Nat Text Text) - (function' recur [input output] - (if (_lux_proc ["nat" "="] [input +0]) - (_lux_proc ["text" "append"] ["+" output]) - (recur (_lux_proc ["nat" "/"] [input +10]) - (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) - output])))))] - (loop value "")))) + ("lux case" value + +0 + "+0" + + _ + (let' [loop ("lux check" (-> Nat Text Text) + (function' recur [input output] + (if (_lux_proc ["nat" "="] [input +0]) + (_lux_proc ["text" "append"] ["+" output]) + (recur (_lux_proc ["nat" "/"] [input +10]) + (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) + output])))))] + (loop value "")))) (def:''' (int/abs value) #Nil @@ -2353,15 +2353,15 @@ (let' [sign (if (i.> 0 value) "" "-")] - ((_lux_: (-> Int Text Text) - (function' recur [input output] - (if (i.= 0 input) - (_lux_proc ["text" "append"] [sign output]) - (recur (i./ 10 input) - (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text) - output]))))) + (("lux check" (-> Int Text Text) + (function' recur [input output] + (if (i.= 0 input) + (_lux_proc ["text" "append"] [sign output]) + (recur (i./ 10 input) + (_lux_proc ["text" "append"] [(|> input (i.% 10) ("lux coerce" Nat) digit-to-text) + output]))))) (|> value (i./ 10) int/abs) - (|> value (i.% 10) int/abs (_lux_:! Nat) digit-to-text))))) + (|> value (i.% 10) int/abs ("lux coerce" Nat) digit-to-text))))) (def:''' (frac/encode x) #Nil @@ -2390,41 +2390,41 @@ ($' Maybe Macro)) (do Monad<Maybe> [$module (get module modules) - gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} (_lux_: Module $module)] + gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] (get name bindings))] - (let' [[def-type def-meta def-value] (_lux_: Def gdef)] - (_lux_case (get-meta ["lux" "macro?"] def-meta) + (let' [[def-type def-meta def-value] ("lux check" Def gdef)] + ("lux case" (get-meta ["lux" "macro?"] def-meta) + (#Some [_ (#Bool true)]) + ("lux case" (get-meta ["lux" "export?"] def-meta) (#Some [_ (#Bool true)]) - (_lux_case (get-meta ["lux" "export?"] def-meta) - (#Some [_ (#Bool true)]) - (#Some (_lux_:! Macro def-value)) + (#Some ("lux coerce" Macro def-value)) - _ - (if (text/= module current-module) - (#Some (_lux_:! Macro def-value)) - #None)) - _ - (_lux_case (get-meta ["lux" "alias"] def-meta) - (#Some [_ (#Symbol [r-module r-name])]) - (find-macro' modules current-module r-module r-name) + (if (text/= module current-module) + (#Some ("lux coerce" Macro def-value)) + #None)) + + _ + ("lux case" (get-meta ["lux" "alias"] def-meta) + (#Some [_ (#Symbol [r-module r-name])]) + (find-macro' modules current-module r-module r-name) - _ - #None) - )) + _ + #None) + )) )) (def:''' (normalize ident) #Nil (-> Ident ($' Meta Ident)) - (_lux_case ident - ["" name] - (do Monad<Meta> - [module-name current-module-name] - (wrap [module-name name])) + ("lux case" ident + ["" name] + (do Monad<Meta> + [module-name current-module-name] + (wrap [module-name name])) - _ - (return ident))) + _ + (return ident))) (def:''' (find-macro ident) #Nil @@ -2433,13 +2433,13 @@ [current-module current-module-name] (let' [[module name] ident] (function' [state] - (_lux_case state - {#info info #source source #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))))))) + ("lux case" state + {#info info #source source #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right state (find-macro' modules current-module module name))))))) (def:''' (macro? ident) #Nil @@ -2447,9 +2447,9 @@ (do Monad<Meta> [ident (normalize ident) output (find-macro ident)] - (wrap (_lux_case output - (#Some _) true - #None false)))) + (wrap ("lux case" output + (#Some _) true + #None false)))) (def:''' (list/join xs) #Nil @@ -2461,169 +2461,169 @@ #Nil (All [a] (-> a ($' List a) ($' List a))) - (_lux_case xs - #Nil - xs + ("lux case" xs + #Nil + xs - (#Cons [x #Nil]) - xs + (#Cons [x #Nil]) + xs - (#Cons [x xs']) - (list& x sep (interpose sep xs')))) + (#Cons [x xs']) + (list& x sep (interpose sep xs')))) (def:''' (macro-expand-once token) #Nil (-> Code ($' Meta ($' List Code))) - (_lux_case token - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - (_lux_case ?macro - (#Some macro) - (macro args) - - #None - (return (list token)))) + ("lux case" token + [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + (#Some macro) + (macro args) + + #None + (return (list token)))) - _ - (return (list token)))) + _ + (return (list token)))) (def:''' (macro-expand token) #Nil (-> Code ($' Meta ($' List Code))) - (_lux_case token - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - (_lux_case ?macro - (#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (mapM Monad<Meta> macro-expand expansion)] - (wrap (list/join expansion'))) - - #None - (return (list token)))) + ("lux case" token + [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + (#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (mapM Monad<Meta> macro-expand expansion)] + (wrap (list/join expansion'))) + + #None + (return (list token)))) - _ - (return (list token)))) + _ + (return (list token)))) (def:''' (macro-expand-all syntax) #Nil (-> Code ($' Meta ($' List Code))) - (_lux_case syntax - [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Meta> - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - (_lux_case ?macro - (#Some macro) - (do Monad<Meta> - [expansion (macro args) - expansion' (mapM Monad<Meta> macro-expand-all expansion)] - (wrap (list/join expansion'))) - - #None - (do Monad<Meta> - [args' (mapM Monad<Meta> macro-expand-all args)] - (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) - - [_ (#Form members)] - (do Monad<Meta> - [members' (mapM Monad<Meta> macro-expand-all members)] - (wrap (list (form$ (list/join members'))))) - - [_ (#Tuple members)] - (do Monad<Meta> - [members' (mapM Monad<Meta> macro-expand-all members)] - (wrap (list (tuple$ (list/join members'))))) - - [_ (#Record pairs)] - (do Monad<Meta> - [pairs' (mapM Monad<Meta> - (function' [kv] - (let' [[key val] kv] - (do Monad<Meta> - [val' (macro-expand-all val)] - (_lux_case val' - (#;Cons val'' #;Nil) - (return [key val'']) + ("lux case" syntax + [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad<Meta> + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + (#Some macro) + (do Monad<Meta> + [expansion (macro args) + expansion' (mapM Monad<Meta> macro-expand-all expansion)] + (wrap (list/join expansion'))) + + #None + (do Monad<Meta> + [args' (mapM Monad<Meta> macro-expand-all args)] + (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) + + [_ (#Form members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] + (wrap (list (form$ (list/join members'))))) + + [_ (#Tuple members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] + (wrap (list (tuple$ (list/join members'))))) + + [_ (#Record pairs)] + (do Monad<Meta> + [pairs' (mapM Monad<Meta> + (function' [kv] + (let' [[key val] kv] + (do Monad<Meta> + [val' (macro-expand-all val)] + ("lux case" val' + (#;Cons val'' #;Nil) + (return [key val'']) - _ - (fail "The value-part of a KV-pair in a record must macro-expand to a single Code."))))) - pairs)] - (wrap (list (record$ pairs')))) + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single Code."))))) + pairs)] + (wrap (list (record$ pairs')))) - _ - (return (list syntax)))) + _ + (return (list syntax)))) (def:''' (walk-type type) #Nil (-> Code Code) - (_lux_case type - [_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (map walk-type parts)])) - - [_ (#Tuple members)] - (` (& (~@ (map walk-type members)))) - - [_ (#Form (#Cons type-fn args))] - (fold (_lux_: (-> Code Code Code) - (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (map walk-type args)) - - _ - type)) + ("lux case" type + [_ (#Form (#Cons [_ (#Tag tag)] parts))] + (form$ (#Cons [(tag$ tag) (map walk-type parts)])) + + [_ (#Tuple members)] + (` (& (~@ (map walk-type members)))) + + [_ (#Form (#Cons type-fn args))] + (fold ("lux check" (-> Code Code Code) + (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) + (walk-type type-fn) + (map walk-type args)) + + _ + type)) (macro:' #export (type tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Takes a type expression and returns it's representation as data-structure. (type (All [a] (Maybe (List a))))")]) - (_lux_case tokens - (#Cons type #Nil) - (do Monad<Meta> - [type+ (macro-expand-all type)] - (_lux_case type+ - (#Cons type' #Nil) - (wrap (list (walk-type type'))) - - _ - (fail "The expansion of the type-syntax had to yield a single element."))) + ("lux case" tokens + (#Cons type #Nil) + (do Monad<Meta> + [type+ (macro-expand-all type)] + ("lux case" type+ + (#Cons type' #Nil) + (wrap (list (walk-type type'))) + + _ + (fail "The expansion of the type-syntax had to yield a single element."))) - _ - (fail "Wrong syntax for type"))) + _ + (fail "Wrong syntax for type"))) (macro:' #export (: tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-annotation macro. (: (List Int) (list 1 2 3))")]) - (_lux_case tokens - (#Cons type (#Cons value #Nil)) - (return (list (` (;_lux_: (type (~ type)) (~ value))))) + ("lux case" tokens + (#Cons type (#Cons value #Nil)) + (return (list (` ("lux check" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :"))) + _ + (fail "Wrong syntax for :"))) (macro:' #export (:! tokens) (list [(tag$ ["lux" "doc"]) (text$ "## The type-coercion macro. (:! Dinosaur (list 1 2 3))")]) - (_lux_case tokens - (#Cons type (#Cons value #Nil)) - (return (list (` (;_lux_:! (type (~ type)) (~ value))))) + ("lux case" tokens + (#Cons type (#Cons value #Nil)) + (return (list (` ("lux coerce" (type (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :!"))) + _ + (fail "Wrong syntax for :!"))) (def:''' (empty? xs) #Nil (All [a] (-> ($' List a) Bool)) - (_lux_case xs - #Nil true - _ false)) + ("lux case" xs + #Nil true + _ false)) (do-template [<name> <type> <value>] [(def:''' (<name> xy) @@ -2637,72 +2637,72 @@ (def:''' (unfold-type-def type-codes) #Nil (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) - (_lux_case type-codes - (#Cons [_ (#Record pairs)] #;Nil) - (do Monad<Meta> - [members (mapM Monad<Meta> - (: (-> [Code Code] (Meta [Text Code])) - (function' [pair] - (_lux_case pair - [[_ (#Tag "" member-name)] member-type] - (return [member-name member-type]) - - _ - (fail "Wrong syntax for variant case.")))) - pairs)] - (return [(` (& (~@ (map second members)))) - (#Some (map first members))])) - - (#Cons type #Nil) - (_lux_case type - [_ (#Tag "" member-name)] - (return [(` #;Unit) (#;Some (list member-name))]) - - [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~@ member-types))) (#;Some (list member-name))]) + ("lux case" type-codes + (#Cons [_ (#Record pairs)] #;Nil) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> [Code Code] (Meta [Text Code])) + (function' [pair] + ("lux case" pair + [[_ (#Tag "" member-name)] member-type] + (return [member-name member-type]) - _ - (return [type #None])) + _ + (fail "Wrong syntax for variant case.")))) + pairs)] + (return [(` (& (~@ (map second members)))) + (#Some (map first members))])) - (#Cons case cases) - (do Monad<Meta> - [members (mapM Monad<Meta> - (: (-> Code (Meta [Text Code])) - (function' [case] - (_lux_case case - [_ (#Tag "" member-name)] - (return [member-name (` Unit)]) - - [_ (#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)))]) - - _ - (fail "Wrong syntax for variant case.")))) - (list& case cases))] - (return [(` (| (~@ (map second members)))) - (#Some (map first members))])) + (#Cons type #Nil) + ("lux case" type + [_ (#Tag "" member-name)] + (return [(` #;Unit) (#;Some (list member-name))]) + + [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] + (return [(` (& (~@ member-types))) (#;Some (list member-name))]) _ - (fail "Improper type-definition syntax"))) + (return [type #None])) + + (#Cons case cases) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> Code (Meta [Text Code])) + (function' [case] + ("lux case" case + [_ (#Tag "" member-name)] + (return [member-name (` Unit)]) + + [_ (#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)))]) + + _ + (fail "Wrong syntax for variant case.")))) + (list& case cases))] + (return [(` (| (~@ (map second members)))) + (#Some (map first members))])) + + _ + (fail "Improper type-definition syntax"))) (def:''' (gensym prefix state) #Nil (-> Text ($' Meta Code)) - (_lux_case state - {#info info #source source #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right {#info info #source source #modules modules - #scopes scopes #type-context types #host host - #seed (n.+ +1 seed) #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])))) + ("lux case" state + {#info info #source source #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right {#info info #source source #modules modules + #scopes scopes #type-context types #host host + #seed (n.+ +1 seed) #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])))) (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) @@ -2710,14 +2710,14 @@ ## A name has to be given to the whole type, to use it within its body. (Rec Self [Int (List Self)])")]) - (_lux_case tokens - (#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) - (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) - (update-bounds body))] - (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body'))))))) - - _ - (fail "Wrong syntax for Rec"))) + ("lux case" tokens + (#Cons [_ (#Symbol "" name)] (#Cons body #Nil)) + (let' [body' (replace-syntax (list [name (` (#Apply (~ (make-bound +1)) (~ (make-bound +0))))]) + (update-bounds body))] + (return (list (` (#Apply #;Void (#UnivQ #Nil (~ body'))))))) + + _ + (fail "Wrong syntax for Rec"))) (macro:' #export (exec tokens) (list [(tag$ ["lux" "doc"]) @@ -2727,62 +2727,62 @@ (log! \"#2\") (log! \"#3\") \"YOLO\")")]) - (_lux_case (reverse tokens) - (#Cons value actions) - (let' [dummy (symbol$ ["" ""])] - (return (list (fold (_lux_: (-> Code Code Code) - (function' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) - value - actions)))) + ("lux case" (reverse tokens) + (#Cons value actions) + (let' [dummy (symbol$ ["" ""])] + (return (list (fold ("lux check" (-> Code Code Code) + (function' [pre post] (` ("lux case" (~ pre) (~ dummy) (~ post))))) + value + actions)))) - _ - (fail "Wrong syntax for exec"))) + _ + (fail "Wrong syntax for exec"))) (macro:' (def:' tokens) - (let' [[export? tokens'] (_lux_case tokens - (#Cons [_ (#Tag ["" "export"])] tokens') - [true tokens'] + (let' [[export? tokens'] ("lux case" tokens + (#Cons [_ (#Tag ["" "export"])] tokens') + [true tokens'] - _ - [false tokens]) + _ + [false tokens]) parts (: (Maybe [Code (List Code) (Maybe Code) Code]) - (_lux_case tokens' - (#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) - (#Some name args (#Some type) body) - - (#Cons name (#Cons type (#Cons body #Nil))) - (#Some name #Nil (#Some type) body) - - (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (#Some name args #None body) - - (#Cons name (#Cons body #Nil)) - (#Some name #Nil #None body) + ("lux case" tokens' + (#Cons [_ (#Form (#Cons name args))] (#Cons type (#Cons body #Nil))) + (#Some name args (#Some type) body) + + (#Cons name (#Cons type (#Cons body #Nil))) + (#Some name #Nil (#Some type) body) + + (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (#Some name args #None body) + + (#Cons name (#Cons body #Nil)) + (#Some name #Nil #None body) - _ - #None))] - (_lux_case parts - (#Some name args ?type body) - (let' [body' (_lux_case args - #Nil - body + _ + #None))] + ("lux case" parts + (#Some name args ?type body) + (let' [body' ("lux case" args + #Nil + body - _ - (` (function' (~ name) [(~@ args)] (~ body)))) - body'' (_lux_case ?type - (#Some type) - (` (: (~ type) (~ body'))) - - #None - body')] - (return (list (` (;_lux_def (~ name) (~ body'') - [(~ cursor-code) - (#;Record (~ (if export? - (with-export-meta (tag$ ["lux" "Nil"])) - (tag$ ["lux" "Nil"]))))]))))) - - #None - (fail "Wrong syntax for def'")))) + _ + (` (function' (~ name) [(~@ args)] (~ body)))) + body'' ("lux case" ?type + (#Some type) + (` (: (~ type) (~ body'))) + + #None + body')] + (return (list (` ("lux def" (~ name) (~ body'') + [(~ cursor-code) + (#;Record (~ (if export? + (with-export-meta (tag$ ["lux" "Nil"])) + (tag$ ["lux" "Nil"]))))]))))) + + #None + (fail "Wrong syntax for def'")))) (def:' (rejoin-pair pair) (-> [Code Code] (List Code)) @@ -2791,89 +2791,89 @@ (def:' (code-to-text code) (-> Code Text) - (_lux_case code - [_ (#Bool value)] - (bool/encode value) + ("lux case" code + [_ (#Bool value)] + (bool/encode value) - [_ (#Nat value)] - (nat/encode value) + [_ (#Nat value)] + (nat/encode value) - [_ (#Int value)] - (int/encode value) + [_ (#Int value)] + (int/encode value) - [_ (#Deg value)] - (_lux_proc ["io" "error"] ["Undefined behavior."]) - - [_ (#Frac value)] - (frac/encode value) + [_ (#Deg value)] + (_lux_proc ["io" "error"] ["Undefined behavior."]) + + [_ (#Frac value)] + (frac/encode value) - [_ (#Text value)] - ($_ text/compose "\"" value "\"") - - [_ (#Symbol [prefix name])] - (if (text/= "" prefix) - name - ($_ text/compose prefix ";" name)) - - [_ (#Tag [prefix name])] - (if (text/= "" prefix) - ($_ text/compose "#" name) - ($_ text/compose "#" prefix ";" name)) - - [_ (#Form xs)] - ($_ text/compose "(" (|> xs - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")) ")") - - [_ (#Tuple xs)] - ($_ text/compose "[" (|> xs - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")) "]") - - [_ (#Record kvs)] - ($_ text/compose "{" (|> kvs - (map (function' [kv] (_lux_case kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v))))) - (interpose " ") - reverse - (fold text/compose "")) "}") - )) + [_ (#Text value)] + ($_ text/compose "\"" value "\"") + + [_ (#Symbol [prefix name])] + (if (text/= "" prefix) + name + ($_ text/compose prefix ";" name)) + + [_ (#Tag [prefix name])] + (if (text/= "" prefix) + ($_ text/compose "#" name) + ($_ text/compose "#" prefix ";" name)) + + [_ (#Form xs)] + ($_ text/compose "(" (|> xs + (map code-to-text) + (interpose " ") + reverse + (fold text/compose "")) ")") + + [_ (#Tuple xs)] + ($_ text/compose "[" (|> xs + (map code-to-text) + (interpose " ") + reverse + (fold text/compose "")) "]") + + [_ (#Record kvs)] + ($_ text/compose "{" (|> kvs + (map (function' [kv] ("lux case" kv [k v] ($_ text/compose (code-to-text k) " " (code-to-text v))))) + (interpose " ") + reverse + (fold text/compose "")) "}") + )) (def:' (expander branches) (-> (List Code) (Meta (List Code))) - (_lux_case branches - (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] - (#;Cons body - branches')) - (do Monad<Meta> - [??? (macro? macro-name)] - (if ??? - (do Monad<Meta> - [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) - body - sub-expansion))))) + ("lux case" branches + (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] + (#;Cons body + branches')) + (do Monad<Meta> + [??? (macro? macro-name)] + (if ??? + (do Monad<Meta> + [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] + (expander init-expansion)) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) + body + sub-expansion))))) - (#;Cons pattern (#;Cons body branches')) - (do Monad<Meta> - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (#;Cons pattern (#;Cons body branches')) + (do Monad<Meta> + [sub-expansion (expander branches')] + (wrap (list& pattern body sub-expansion))) - #;Nil - (do Monad<Meta> [] (wrap (list))) + #;Nil + (do Monad<Meta> [] (wrap (list))) - _ - (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches - (map code-to-text) - (interpose " ") - reverse - (fold text/compose "")))))) + _ + (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches + (map code-to-text) + (interpose " ") + reverse + (fold text/compose "")))))) (macro:' #export (case tokens) (list [(tag$ ["lux" "doc"]) @@ -2885,14 +2885,14 @@ _ #None)")]) - (_lux_case tokens - (#Cons value branches) - (do Monad<Meta> - [expansion (expander branches)] - (wrap (list (` (;_lux_case (~ value) (~@ expansion)))))) + ("lux case" tokens + (#Cons value branches) + (do Monad<Meta> + [expansion (expander branches)] + (wrap (list (` ("lux case" (~ value) (~@ expansion)))))) - _ - (fail "Wrong syntax for case"))) + _ + (fail "Wrong syntax for case"))) (macro:' #export (^ tokens) (list [(tag$ ["lux" "doc"]) @@ -2977,7 +2977,7 @@ (function' [lr body'] (let' [[l r] lr] (if (symbol? l) - (` (;_lux_case (~ r) (~ l) (~ body'))) + (` ("lux case" (~ r) (~ l) (~ body'))) (` (case (~ r) (~ l) (~ body'))))))) body) list @@ -3012,14 +3012,14 @@ body+ (fold (: (-> Code Code Code) (function' [arg body'] (if (symbol? arg) - (` (;_lux_function (~ g!blank) (~ arg) (~ body'))) - (` (;_lux_function (~ g!blank) (~ g!blank) - (case (~ g!blank) (~ arg) (~ body'))))))) + (` ("lux function" (~ g!blank) (~ arg) (~ body'))) + (` ("lux function" (~ g!blank) (~ g!blank) + (case (~ g!blank) (~ arg) (~ body'))))))) body (reverse tail))] (return (list (if (symbol? head) - (` (;_lux_function (~ g!name) (~ head) (~ body+))) - (` (;_lux_function (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) + (` ("lux function" (~ g!name) (~ head) (~ body+))) + (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) #None (fail "Wrong syntax for function"))) @@ -3179,25 +3179,25 @@ #None body) =meta (process-def-meta meta)] - (return (list (` (;_lux_def (~ name) - (~ body) - [(~ cursor-code) - (#;Record (~ (with-func-args args - (case export? - #;None - =meta - - (#;Some (#;Left [])) - (with-export-meta =meta) - - (#;Some (#;Right [])) - (|> =meta - with-export-meta - with-hidden-meta) - ))))]))))) + (return (list (` ("lux def" (~ name) + (~ body) + [(~ cursor-code) + (#;Record (~ (with-func-args args + (case export? + #;None + =meta + + (#;Some (#;Left [])) + (with-export-meta =meta) + + (#;Some (#;Right [])) + (|> =meta + with-export-meta + with-hidden-meta) + ))))]))))) #None - (fail "Wrong syntax for def")))) + (fail "Wrong syntax for def:")))) (def: (meta-code-add addition meta) (-> [Code Code] Code Code) @@ -3305,7 +3305,7 @@ (: (-> Code (Meta [Text Code])) (function [token] (case token - (^ [_ (#Form (list [_ (#Symbol _ "_lux_:")] type [_ (#Symbol ["" name])]))]) + (^ [_ (#Form (list [_ (#Text "lux check")] type [_ (#Symbol ["" name])]))]) (wrap [name type]) _ @@ -3650,7 +3650,7 @@ (: (-> Code (Meta [Code Code])) (function [token] (case token - (^ [_ (#Form (list [_ (#Symbol _ "_lux_def")] [_ (#Symbol "" tag-name)] value meta))]) + (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Symbol "" tag-name)] value meta))]) (case (get tag-name tag-mappings) (#Some tag) (wrap [tag value]) @@ -4391,7 +4391,7 @@ (wrap enhanced-target)))) target (zip2 tags members))] - (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target)))))))) + (wrap (` ("lux case" (~ (symbol$ source)) (~ pattern) (~ enhanced-target)))))))) name tags&members body)] (wrap (list full-body))))) @@ -4476,7 +4476,7 @@ g!output g!_)])) (zip2 tags (enumerate members))))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output)))))) + (return (list (` ("lux case" (~ record) (~ pattern) (~ g!output)))))) _ (fail "get@ can only use records."))) @@ -4511,8 +4511,8 @@ (return (list/join decls'))) _ - (return (list (` (;_lux_def (~ (symbol$ ["" (text/compose prefix name)])) (~ source+) - [(~ cursor-code) (#;Record #Nil)]))))))) + (return (list (` ("lux def" (~ (symbol$ ["" (text/compose prefix name)])) (~ source+) + [(~ cursor-code) (#;Record #Nil)]))))))) (macro: #export (open tokens) {#;doc "## Opens a structure and generates a definition for each of its members (including nested members). @@ -4643,12 +4643,12 @@ (wrap (list))) #let [defs (map (: (-> Text Code) (function [def] - (` (;_lux_def (~ (symbol$ ["" def])) - (~ (symbol$ [module-name def])) - [(~ cursor-code) - (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])] - [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]] - #Nil))])))) + (` ("lux def" (~ (symbol$ ["" def])) + (~ (symbol$ [module-name def])) + [(~ cursor-code) + (#;Record (#Cons [[(~ cursor-code) (#;Tag ["lux" "alias"])] + [(~ cursor-code) (#;Symbol [(~ (text$ module-name)) (~ (text$ def))])]] + #Nil))])))) defs') openings (join-map (: (-> Openings (List Code)) (function [[prefix structs]] @@ -4798,7 +4798,7 @@ value r-var)])) pattern'))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + (return (list (` ("lux case" (~ record) (~ pattern) (~ output))))))) _ (fail "set@ can only use records."))) @@ -4884,7 +4884,7 @@ (` ((~ fun) (~ r-var))) r-var)])) pattern'))] - (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + (return (list (` ("lux case" (~ record) (~ pattern) (~ output))))))) _ (fail "update@ can only use records."))) @@ -5253,10 +5253,10 @@ #None (fail "Wrong syntax for loop"))) init-types (mapM Monad<Meta> find-type inits') expected get-expected-type] - (return (list (` ((;_lux_: (-> (~@ (map type-to-code init-types)) - (~ (type-to-code expected))) - (function (~ (symbol$ ["" "recur"])) [(~@ vars)] - (~ body))) + (return (list (` (("lux check" (-> (~@ (map type-to-code init-types)) + (~ (type-to-code expected))) + (function (~ (symbol$ ["" "recur"])) [(~@ vars)] + (~ body))) (~@ inits)))))) (do Monad<Meta> [aliases (mapM Monad<Meta> @@ -5557,18 +5557,18 @@ expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp - (` (;_lux_case (;_lux_: (#;Apply (~ (type-to-code expected)) Maybe) - (case (~ g!temp) - (~@ (multi-level-case$ g!temp [mlc body])) - - (~ g!temp) - #;None)) - (#;Some (~ g!temp)) - (~ g!temp) - - #;None - (case (~ g!temp) - (~@ next-branches)))))] + (` ("lux case" ("lux check" (#;Apply (~ (type-to-code expected)) Maybe) + (case (~ g!temp) + (~@ (multi-level-case$ g!temp [mlc body])) + + (~ g!temp) + #;None)) + (#;Some (~ g!temp)) + (~ g!temp) + + #;None + (case (~ g!temp) + (~@ next-branches)))))] (wrap output))) _ @@ -5694,7 +5694,7 @@ (^ (list expr)) (do Monad<Meta> [type get-expected-type] - (wrap (list (` (;_lux_:! (~ (type-to-code type)) (~ expr)))))) + (wrap (list (` ("lux coerce" (~ (type-to-code type)) (~ expr)))))) _ (fail "Wrong syntax for :!!"))) @@ -5899,7 +5899,7 @@ (wrap (list pick)) #;None - (wrap (list))) + (fail ($_ text/compose "No code for target platform: " target))) (^ (list [_ (#Record options)] default)) (wrap (list (;;default default (pick-for-target target options)))) |