From 8c5cca122817bc63f4f84cc8351ced3cb67e5eea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 04:51:04 -0400 Subject: - Changed the identifier separator, from the semi-colon (;) to the period/dot (.). --- stdlib/source/lux.lux | 4256 +++++++++++++++++++++++++------------------------ 1 file changed, 2132 insertions(+), 2124 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0087a8d89..c1d94e53b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -13,9 +13,9 @@ ("lux def" List (+12 ["lux" "List"] (+9 (+0) - (+3 ## "lux;Nil" + (+3 ## "lux.Nil" (+2) - ## "lux;Cons" + ## "lux.Cons" (+4 (+6 +1) (+11 (+6 +1) (+6 +0)))))) [dummy-cursor @@ -151,9 +151,9 @@ ("lux def" Maybe (+12 ["lux" "Maybe"] (+9 #Nil - (+3 ## "lux;None" + (+3 ## "lux.None" (+2) - ## "lux;Some" + ## "lux.Some" (+6 +1)))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -193,31 +193,31 @@ {Type-Pair (+11 Void (+9 #Nil - (+3 ## "lux;Primitive" + (+3 ## "lux.Primitive" (+4 Text Type-List) - (+3 ## "lux;Void" + (+3 ## "lux.Void" (+2) - (+3 ## "lux;Unit" + (+3 ## "lux.Unit" (+2) - (+3 ## "lux;Sum" + (+3 ## "lux.Sum" Type-Pair - (+3 ## "lux;Product" + (+3 ## "lux.Product" Type-Pair - (+3 ## "lux;Function" + (+3 ## "lux.Function" Type-Pair - (+3 ## "lux;Bound" + (+3 ## "lux.Bound" Nat - (+3 ## "lux;Var" + (+3 ## "lux.Var" Nat - (+3 ## "lux;Ex" + (+3 ## "lux.Ex" Nat - (+3 ## "lux;UnivQ" + (+3 ## "lux.UnivQ" (+4 Type-List Type) - (+3 ## "lux;ExQ" + (+3 ## "lux.ExQ" (+4 Type-List Type) - (+3 ## "lux;App" + (+3 ## "lux.Apply" Type-Pair - ## "lux;Named" + ## "lux.Named" (+4 Ident Type)))))))))))))))})})})) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] @@ -315,7 +315,7 @@ (#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)))]] + [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?"])] @@ -343,27 +343,27 @@ ("lux case" ("lux check type" (#Apply Code List)) {Code-List (#UnivQ #Nil - (#Sum ## "lux;Bool" + (#Sum ## "lux.Bool" Bool - (#Sum ## "lux;Nat" + (#Sum ## "lux.Nat" Nat - (#Sum ## "lux;Int" + (#Sum ## "lux.Int" Int - (#Sum ## "lux;Deg" + (#Sum ## "lux.Deg" Deg - (#Sum ## "lux;Frac" + (#Sum ## "lux.Frac" Frac - (#Sum ## "lux;Text" + (#Sum ## "lux.Text" Text - (#Sum ## "lux;Symbol" + (#Sum ## "lux.Symbol" Ident - (#Sum ## "lux;Tag" + (#Sum ## "lux.Tag" Ident - (#Sum ## "lux;Form" + (#Sum ## "lux.Form" Code-List - (#Sum ## "lux;Tuple" + (#Sum ## "lux.Tuple" Code-List - ## "lux;Record" + ## "lux.Record" (#Apply (#Product Code Code) List) )))))))))) )})})) @@ -382,7 +382,7 @@ (#Cons [dummy-cursor (+5 "Record")] #Nil))))))))))))]] (#Cons [[dummy-cursor (+7 ["lux" "type-args"])] - [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "w")] #;Nil))]] + [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?"])] @@ -500,16 +500,16 @@ (#Named ["lux" "Bindings"] (#UnivQ #Nil (#UnivQ #Nil - (#Product ## "lux;counter" + (#Product ## "lux.counter" Nat - ## "lux;mappings" + ## "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)))] + (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #Nil)))] default-def-meta-exported)))) ## (type: #export Ref @@ -555,14 +555,14 @@ (#Named ["lux" "Either"] (#UnivQ #Nil (#UnivQ #Nil - (#Sum ## "lux;Left" + (#Sum ## "lux.Left" (#Bound +3) - ## "lux;Right" + ## "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)))] + (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))))) @@ -603,28 +603,28 @@ ## #module-state Module-State}) ("lux def" Module (#Named ["lux" "Module"] - (#Product ## "lux;module-hash" + (#Product ## "lux.module-hash" Nat - (#Product ## "lux;module-aliases" + (#Product ## "lux.module-aliases" (#Apply (#Product Text Text) List) - (#Product ## "lux;defs" + (#Product ## "lux.defs" (#Apply (#Product Text Def) List) - (#Product ## "lux;imports" + (#Product ## "lux.imports" (#Apply Text List) - (#Product ## "lux;tags" + (#Product ## "lux.tags" (#Apply (#Product Text (#Product Nat (#Product (#Apply Ident List) (#Product Bool Type)))) List) - (#Product ## "lux;types" + (#Product ## "lux.types" (#Apply (#Product Text (#Product (#Apply Ident List) (#Product Bool Type))) List) - (#Product ## "lux;module-annotations" + (#Product ## "lux.module-annotations" Code Module-State)) )))))) @@ -720,27 +720,27 @@ ## #host Void}) ("lux def" Compiler (#Named ["lux" "Compiler"] - (#Product ## "lux;info" + (#Product ## "lux.info" Info - (#Product ## "lux;source" + (#Product ## "lux.source" Source - (#Product ## "lux;cursor" + (#Product ## "lux.cursor" Cursor - (#Product ## "lux;current-module" + (#Product ## "lux.current-module" (#Apply Text Maybe) - (#Product ## "lux;modules" + (#Product ## "lux.modules" (#Apply (#Product Text Module) List) - (#Product ## "lux;scopes" + (#Product ## "lux.scopes" (#Apply Scope List) - (#Product ## "lux;type-context" + (#Product ## "lux.type-context" Type-Context - (#Product ## "lux;expected" + (#Product ## "lux.expected" (#Apply Type Maybe) - (#Product ## "lux;seed" + (#Product ## "lux.seed" Nat (#Product ## scope-type-vars (#Apply Nat List) - ## "lux;host" + ## "lux.host" Void))))))))))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "info") @@ -776,7 +776,7 @@ These computations may fail, or modify the state of the compiler.")] (#Cons [(tag$ ["lux" "type-args"]) - (tuple$ (#Cons (text$ "a") #;Nil))] + (tuple$ (#Cons (text$ "a") #Nil))] default-def-meta-exported)))) ## (type: Macro @@ -826,7 +826,7 @@ ("lux case" tokens {(#Cons lhs (#Cons rhs (#Cons body #Nil))) (return (#Cons (form$ (#Cons (text$ "lux case") - (#Cons rhs (#Cons (record$ (#;Cons [lhs body] #Nil)) #Nil)))) + (#Cons rhs (#Cons (record$ (#Cons [lhs body] #Nil)) #Nil)))) #Nil)) _ @@ -1003,612 +1003,612 @@ (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)) + 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:'")})) + _ + (fail "Wrong syntax for macro:'")})) (macro:' #export (comment tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Throws away any code given to it. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Throws away any code given to it. ## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor. (comment 1 2 3 4)")] - #;Nil) - (return #Nil)) + #Nil) + (return #Nil)) (macro:' ($' tokens) - ("lux case" tokens - {(#Cons x #Nil) - (return 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)) + (#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 $'")})) + _ + (fail "Wrong syntax for $'")})) (def:'' (map f xs) - #;Nil - (#UnivQ #Nil - (#UnivQ #Nil - (#Function (#Function (#Bound +3) (#Bound +1)) - (#Function ($' List (#Bound +3)) - ($' List (#Bound +1)))))) - ("lux case" xs - {#Nil - #Nil + #Nil + (#UnivQ #Nil + (#UnivQ #Nil + (#Function (#Function (#Bound +3) (#Bound +1)) + (#Function ($' List (#Bound +3)) + ($' List (#Bound +1)))))) + ("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 - Type - ($' List (#Product Text Code))) + #Nil + Type + ($' List (#Product Text Code))) (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')) + #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')) - _ - #Nil})) + _ + #Nil})) (def:'' (text/= x y) - #;Nil - (#Function Text (#Function Text Bool)) - ("lux text =" x y)) + #Nil + (#Function Text (#Function Text Bool)) + ("lux text =" x y)) (def:'' (get-rep key env) - #;Nil - (#Function Text (#Function RepEnv ($' Maybe Code))) - ("lux case" env - {#Nil - #None + #Nil + (#Function Text (#Function RepEnv ($' Maybe Code))) + ("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 + #Nil + (#Function RepEnv (#Function Code Code)) + ("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 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}) - ) + [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)) + #Nil + (#Function Code Code) + ("lux case" code + {[_ (#Tuple members)] + (tuple$ (map update-bounds members)) - [_ (#Record pairs)] - (record$ (map ("lux check" (#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 nat +" +2 idx)) #Nil))) + [_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))] + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux 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 - ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) - (#Function ($' List Code) - (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) - (#Apply ($' List Code) Meta) - )) - ("lux case" args - {#Nil - (next #Nil) - - (#Cons [_ (#Symbol "" arg-name)] args') - (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + #Nil + ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) + (#Function ($' List Code) + (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) + (#Apply ($' List Code) Meta) + )) + ("lux case" args + {#Nil + (next #Nil) - _ - (fail "Expected symbol.")} - )) + (#Cons [_ (#Symbol "" arg-name)] args') + (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) + + _ + (fail "Expected symbol.")} + )) (def:'' (make-bound idx) - #;Nil - (#Function Nat Code) - (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) + #Nil + (#Function Nat Code) + (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ idx) #Nil)))) (def:'' (list/fold f init xs) - #;Nil - ## (All [a b] (-> (-> b a a) a (List b) a)) - (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) - (#Function (#Bound +3) - (#Bound +3))) - (#Function (#Bound +3) - (#Function ($' List (#Bound +1)) - (#Bound +3)))))) - ("lux case" xs - {#Nil - init + #Nil + ## (All [a b] (-> (-> b a a) a (List b) a)) + (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Bound +1) + (#Function (#Bound +3) + (#Bound +3))) + (#Function (#Bound +3) + (#Function ($' List (#Bound +1)) + (#Bound +3)))))) + ("lux case" xs + {#Nil + init - (#Cons x xs') - (list/fold f (f x init) xs')})) + (#Cons x xs') + (list/fold f (f x init) xs')})) (def:'' (list/size list) - #;Nil - (#UnivQ #Nil - (#Function ($' List (#Bound +1)) Nat)) - (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list)) + #Nil + (#UnivQ #Nil + (#Function ($' List (#Bound +1)) Nat)) + (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list)) (macro:' #export (All tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Universal quantification. - (All [a] - (-> a a)) - - ## A name can be provided, to specify a recursive type. - (All List [a] - (| 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' (list/fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-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 nat *" - +2 ("lux nat -" - (list/size names) - +1)))] - #Nil) - body')}) - #Nil))))) - - _ - (fail "Wrong syntax for All")}) - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Universal quantification. + (All [a] + (-> a a)) + + ## A name can be provided, to specify a recursive type. + (All List [a] + (| 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' (list/fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-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 nat *" + +2 ("lux nat -" + (list/size names) + +1)))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for All")}) + )) (macro:' #export (Ex tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Existential quantification. - (Ex [a] - [(Codec Text a) - a]) - - ## A name can be provided, to specify a recursive type. - (Ex Self [a] - [(Codec Text a) - 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' (list/fold ("lux check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["lux" "ExQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-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 nat *" - +2 ("lux nat -" - (list/size names) - +1)))] - #Nil) - body')}) - #Nil))))) - - _ - (fail "Wrong syntax for Ex")}) - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Existential quantification. + (Ex [a] + [(Codec Text a) + a]) + + ## A name can be provided, to specify a recursive type. + (Ex Self [a] + [(Codec Text a) + 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' (list/fold ("lux check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "ExQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-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 nat *" + +2 ("lux nat -" + (list/size names) + +1)))] + #Nil) + body')}) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")}) + )) (def:'' (list/reverse list) - #;Nil - (All [a] (#Function ($' List a) ($' List a))) - (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) - (function'' [head tail] (#Cons head tail))) - #Nil - list)) + #Nil + (All [a] (#Function ($' List a) ($' List a))) + (list/fold ("lux check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (function'' [head tail] (#Cons head tail))) + #Nil + list)) (macro:' #export (-> tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Function types: + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Function types: (-> Int Int Int) ## This is the type of a function that takes 2 Ints and returns an Int.")] - #;Nil) - ("lux case" (list/reverse tokens) - {(#Cons output inputs) - (return (#Cons (list/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 ->")})) + #Nil) + ("lux case" (list/reverse tokens) + {(#Cons output inputs) + (return (#Cons (list/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"]) - (text$ "## List-construction macro. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro. (list 1 2 3)")] - #;Nil) - (return (#Cons (list/fold (function'' [head tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) - #Nil)))) - (tag$ ["lux" "Nil"]) - (list/reverse xs)) - #Nil))) + #Nil) + (return (#Cons (list/fold (function'' [head tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) + (tag$ ["lux" "Nil"]) + (list/reverse xs)) + #Nil))) (macro:' #export (list& xs) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## List-construction macro, with the last element being a tail-list. + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## List-construction macro, with the last element being a tail-list. ## In other words, this macro prepends elements to another list. (list& 1 2 3 (list 4 5 6))")] - #;Nil) - ("lux case" (list/reverse xs) - {(#Cons last init) - (return (list (list/fold (function'' [head tail] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) - last - init))) + #Nil) + ("lux case" (list/reverse xs) + {(#Cons last init) + (return (list (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"]) - (text$ "## Tuple types: - (& Text Int Bool) - - ## The empty tuple, a.k.a. Unit. - (&)")] - #;Nil) - ("lux case" (list/reverse tokens) - {#Nil - (return (list (tag$ ["lux" "Unit"]))) - - (#Cons last prevs) - (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) - last - prevs)))} - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Tuple types: + (& Text Int Bool) + + ## The empty tuple, a.k.a. Unit. + (&)")] + #Nil) + ("lux case" (list/reverse tokens) + {#Nil + (return (list (tag$ ["lux" "Unit"]))) + + (#Cons last prevs) + (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Product"]) left right))) + last + prevs)))} + )) (macro:' #export (| tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Variant types: - (| Text Int Bool) - - ## The empty tuple, a.k.a. Void. - (|)")] - #;Nil) - ("lux case" (list/reverse tokens) - {#Nil - (return (list (tag$ ["lux" "Void"]))) - - (#Cons last prevs) - (return (list (list/fold (function'' [left right] (form$ (list (tag$ ["lux" "Sum"]) left right))) - last - prevs)))} - )) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Variant types: + (| Text Int Bool) + + ## The empty tuple, a.k.a. Void. + (|)")] + #Nil) + ("lux case" (list/reverse tokens) + {#Nil + (return (list (tag$ ["lux" "Void"]))) + + (#Cons last prevs) + (return (list (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 (text$ "lux function") - (symbol$ ["" name]) - harg - (list/fold (function'' [arg body'] - (form$ (list (text$ "lux function") - (symbol$ ["" ""]) - arg - body'))) - body - (list/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 + (list/fold (function'' [arg body'] + (form$ (list (text$ "lux function") + (symbol$ ["" ""]) + arg + body'))) + body + (list/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 (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))))))) + ("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'''")} - )) + _ + (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')) + #Nil + (All [a] (-> ($' List a) ($' List (& a a)))) + ("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 (list/fold ("lux check" (-> (& Code Code) Code - Code) - (function' [binding body] - ("lux case" binding - {[label value] - (form$ (list (text$ "lux case") value (record$ (list [label body]))))}))) - body - (list/reverse (as-pairs bindings))))) + ("lux case" tokens + {(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) + (return (list (list/fold ("lux check" (-> (& Code Code) Code + Code) + (function' [binding body] + ("lux case" binding + {[label value] + (form$ (list (text$ "lux case") value (record$ (list [label body]))))}))) + body + (list/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 - - (#Cons x xs') - ("lux case" (p x) - {true true - false (any? p xs')})})) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + ("lux case" xs + {#Nil + false + + (#Cons x xs') + ("lux case" (p x) + {true true + false (any? p xs')})})) (def:''' (wrap-meta content) - #;Nil - (-> Code Code) - (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) - content))) + #Nil + (-> Code Code) + (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) + content))) (def:''' (untemplate-list tokens) - #;Nil - (-> ($' List Code) Code) - ("lux case" tokens - {#Nil - (_ann (#Tag ["lux" "Nil"])) + #Nil + (-> ($' List Code) Code) + ("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)) + #Nil + (All [a] (-> ($' List a) ($' List a) ($' List a))) + ("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)) + (#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)) - #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))) + #Nil + (-> Code Code Code Code) + ("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"]) - (text$ "## Left-association for the application of binary functions over variadic arguments. - (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] - #;Nil) - ("lux case" tokens - {(#Cons op tokens') - ("lux case" tokens' - {(#Cons first nexts) - (return (list (list/fold (_$_joiner op) first nexts))) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Left-association for the application of binary functions over variadic arguments. + (_$ text/compose \"Hello, \" name \".\\nHow are you?\") - _ - (fail "Wrong syntax for _$")}) - - _ - (fail "Wrong syntax for _$")})) + ## => + (text/compose (text/compose \"Hello, \" name) \".\\nHow are you?\")")] + #Nil) + ("lux case" tokens + {(#Cons op tokens') + ("lux case" tokens' + {(#Cons first nexts) + (return (list (list/fold (_$_joiner op) first nexts))) + + _ + (fail "Wrong syntax for _$")}) + + _ + (fail "Wrong syntax for _$")})) (macro:' #export ($_ tokens) - (#Cons [(tag$ ["lux" "doc"]) - (text$ "## Right-association for the application of binary functions over variadic arguments. - ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - - ## => - (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] - #;Nil) - ("lux case" tokens - {(#Cons op tokens') - ("lux case" (list/reverse tokens') - {(#Cons last prevs) - (return (list (list/fold (_$_joiner op) last prevs))) + (#Cons [(tag$ ["lux" "doc"]) + (text$ "## Right-association for the application of binary functions over variadic arguments. + ($_ text/compose \"Hello, \" name \".\\nHow are you?\") - _ - (fail "Wrong syntax for $_")}) - - _ - (fail "Wrong syntax for $_")})) + ## => + (text/compose \"Hello, \" (text/compose name \".\\nHow are you?\"))")] + #Nil) + ("lux case" tokens + {(#Cons op tokens') + ("lux case" (list/reverse tokens') + {(#Cons last prevs) + (return (list (list/fold (_$_joiner op) last prevs))) + + _ + (fail "Wrong syntax for $_")}) + + _ + (fail "Wrong syntax for $_")})) ## (sig: (Monad m) ## (: (All [a] (-> a (m a))) @@ -1616,639 +1616,644 @@ ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) (def:''' Monad - (list& [(tag$ ["lux" "tags"]) - (tuple$ (list (text$ "wrap") (text$ "bind")))] - default-def-meta-unexported) - Type - (#Named ["lux" "Monad"] - (All [m] - (& (All [a] (-> a ($' m a))) - (All [a b] (-> (-> a ($' m b)) - ($' m a) - ($' m b))))))) + (list& [(tag$ ["lux" "tags"]) + (tuple$ (list (text$ "wrap") (text$ "bind")))] + default-def-meta-unexported) + Type + (#Named ["lux" "Monad"] + (All [m] + (& (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b))))))) (def:''' Monad - #Nil - ($' Monad Maybe) - {#wrap - (function' [x] (#Some x)) - - #bind - (function' [f ma] - ("lux case" ma - {#None #None - (#Some a) (f a)}))}) + #Nil + ($' Monad Maybe) + {#wrap + (function' [x] (#Some x)) + + #bind + (function' [f ma] + ("lux case" ma + {#None #None + (#Some a) (f a)}))}) (def:''' Monad - #Nil - ($' Monad Meta) - {#wrap - (function' [x] - (function' [state] - (#Right state x))) - - #bind - (function' [f ma] - (function' [state] - ("lux case" (ma state) - {(#Left msg) - (#Left msg) + #Nil + ($' Monad Meta) + {#wrap + (function' [x] + (function' [state] + (#Right state x))) + + #bind + (function' [f ma] + (function' [state] + ("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' (list/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')) - - _ - (form$ (list g!bind - (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) - value))})))) - body - (list/reverse (as-pairs bindings)))] - (return (list (form$ (list (text$ "lux case") - monad - (record$ (list [(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' (list/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')) + + _ + (form$ (list g!bind + (form$ (list (text$ "lux function") (symbol$ ["" ""]) var body')) + value))})))) + body + (list/reverse (as-pairs bindings)))] + (return (list (form$ (list (text$ "lux case") + monad + (record$ (list [(record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body']))))))) - _ - (fail "Wrong syntax for do")})) + _ + (fail "Wrong syntax for do")})) (def:''' (monad/map m f xs) - #Nil - ## (All [m a b] - ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) - (All [m a b] - (-> ($' Monad m) - (-> a ($' m b)) - ($' 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 (monad/map m f xs')] - (wrap (#Cons y ys))) - }))) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) + (All [m a b] + (-> ($' Monad m) + (-> a ($' m b)) + ($' 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 (monad/map m f xs')] + (wrap (#Cons y ys))) + }))) (def:''' (monad/fold m f y xs) - #Nil - ## (All [m a b] - ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) - (All [m a b] - (-> ($' Monad m) - (-> a b ($' m b)) - b - ($' List a) - ($' m b))) - (let' [{#;wrap wrap #;bind _} m] - ("lux case" xs - {#Nil - (wrap y) - - (#Cons x xs') - (do m - [y' (f x y)] - (monad/fold m f y' xs')) - }))) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) + (All [m a b] + (-> ($' Monad m) + (-> a b ($' m b)) + b + ($' List a) + ($' m b))) + (let' [{#wrap wrap #bind _} m] + ("lux case" xs + {#Nil + (wrap y) + + (#Cons x xs') + (do m + [y' (f x y)] + (monad/fold m f y' xs')) + }))) (macro:' #export (if tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "Picks which expression to evaluate based on a boolean test value. + (list [(tag$ ["lux" "doc"]) + (text$ "Picks which expression to evaluate based on a boolean test value. - (if true - \"Oh, yeah!\" - \"Aw hell naw!\") + (if true + \"Oh, yeah!\" + \"Aw hell naw!\") - => \"Oh, yeah!\"")]) - ("lux case" tokens - {(#Cons test (#Cons then (#Cons else #Nil))) - (return (list (form$ (list (text$ "lux case") test - (record$ (list [(bool$ true) then] - [(bool$ false) else])))))) + => \"Oh, yeah!\"")]) + ("lux case" tokens + {(#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (text$ "lux case") test + (record$ (list [(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')) - - #Nil - #None})) + #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')) + + #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]) - - (#Cons [[k' v'] dict']) - (if (text/= k k') - (#Cons [[k' v] dict']) - (#Cons [[k' v'] (put k v dict')]))})) + #Nil + (All [a] + (-> Text a ($' List (& Text a)) ($' List (& Text a)))) + ("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')]))})) (def:''' #export (log! message) - (list [(tag$ ["lux" "doc"]) - (text$ "Logs message to standard output. + (list [(tag$ ["lux" "doc"]) + (text$ "Logs message to standard output. - Useful for debugging.")]) - (-> Text Unit) - ("lux io log" message)) + Useful for debugging.")]) + (-> Text Unit) + ("lux io log" message)) (def:''' (text/compose x y) - #Nil - (-> Text Text Text) - ("lux text concat" x y)) + #Nil + (-> Text Text Text) + ("lux text concat" x y)) (def:''' (ident/encode ident) - #Nil - (-> Ident Text) - (let' [[module name] ident] - ("lux case" module - {"" name - _ ($_ text/compose module ";" name)}))) + #Nil + (-> Ident Text) + (let' [[module name] ident] + ("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) + #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) - _ - (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 - (-> Ident ($' Meta Ident)) - (let' [[module name] ident - {#info info #source source #current-module _ #modules modules - #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]) + #Nil + (-> Ident ($' Meta Ident)) + (let' [[module name] ident + {#info info #source source #current-module _ #modules modules + #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]) - _ - (#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)))}))) + #None + (#Left ($_ text/compose "Unknown definition: " (ident/encode ident)))}) + + #None + (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) (def:''' (splice replace? untemplate elems) - #Nil - (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) - ("lux case" replace? - {true - ("lux case" (list/reverse elems) - {#Nil - (return (tag$ ["lux" "Nil"])) - - (#Cons lastI inits) - (do Monad - [lastO ("lux case" lastI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap spliced) + #Nil + (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) + ("lux case" replace? + {true + ("lux case" (list/reverse elems) + {#Nil + (return (tag$ ["lux" "Nil"])) + + (#Cons lastI inits) + (do Monad + [lastO ("lux case" lastI + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) - _ - (do Monad - [lastO (untemplate lastI)] - (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})] - (monad/fold Monad - (function' [leftI rightO] - ("lux case" leftI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) - spliced - rightO))) + _ + (do Monad + [lastO (untemplate lastI)] + (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list lastO (tag$ ["lux" "Nil"])))))))})] + (monad/fold Monad + (function' [leftI rightO] + ("lux case" leftI + {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) + spliced + rightO))) - _ - (do Monad - [leftO (untemplate leftI)] - (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))})) - lastO - inits))}) - false - (do Monad - [=elems (monad/map Monad untemplate elems)] - (wrap (untemplate-list =elems)))})) + _ + (do Monad + [leftO (untemplate leftI)] + (wrap (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list leftO rightO))))))})) + lastO + inits))}) + false + (do Monad + [=elems (monad/map Monad untemplate elems)] + (wrap (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))))) - - [_ [_ (#Int value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) + #Nil + (-> Bool Text Code ($' Meta Code)) + ("lux case" [replace? token] + {[_ [_ (#Bool value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ 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))))) - - [_ [_ (#Text value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - - [false [_ (#Tag [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - - [true [_ (#Tag [module name])]] - (let' [module' ("lux case" module - {"" - subst + [_ [_ (#Nat value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Nat"]) (nat$ value))))) - _ - module})] - (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - - [true [_ (#Symbol [module name])]] - (do Monad - [real-name ("lux case" module - {"" - (if (text/= "" subst) - (wrap [module name]) - (resolve-global-symbol [subst name])) + [_ [_ (#Int value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - _ - (wrap [module name])}) - #let [[module name] real-name]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (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))))) - [false [_ (#Symbol [module name])]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) + [_ [_ (#Text value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return unquoted) + [false [_ (#Tag [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] - (untemplate false subst keep-quoted) + [true [_ (#Tag [module name])]] + (let' [module' ("lux case" module + {"" + subst - [_ [meta (#Form elems)]] - (do Monad - [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] - (wrap [meta output'])) + _ + module})] + (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) - [_ [meta (#Tuple elems)]] - (do Monad - [output (splice replace? (untemplate replace? subst) elems) - #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] - (wrap [meta output'])) + [true [_ (#Symbol [module name])]] + (do Monad + [real-name ("lux case" module + {"" + (if (text/= "" subst) + (wrap [module name]) + (resolve-global-symbol [subst name])) - [_ [_ (#Record fields)]] - (do Monad - [=fields (monad/map Monad - ("lux check" (-> (& Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do Monad - [=k (untemplate replace? subst k) - =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) - fields)] - (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} - )) + _ + (wrap [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))))))) + + [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 + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] + (wrap [meta output'])) + + [_ [meta (#Tuple elems)]] + (do Monad + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] + (wrap [meta output'])) + + [_ [_ (#Record fields)]] + (do Monad + [=fields (monad/map Monad + ("lux check" (-> (& Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do Monad + [=k (untemplate replace? subst k) + =v (untemplate replace? subst v)] + (wrap (tuple$ (list =k =v))))))) + fields)] + (wrap (wrap-meta (form$ (list (tag$ ["lux" "Record"]) (untemplate-list =fields))))))} + )) (macro:' #export (primitive tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Macro to treat define new primitive types. - (primitive \"java.lang.Object\") + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro to treat define new primitive types. + (primitive \"java.lang.Object\") - (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")]) - ("lux case" tokens - {(#Cons [_ (#Text class-name)] #Nil) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + (primitive \"java.util.List\" [(primitive \"java.lang.Long\")])")]) + ("lux case" tokens + {(#Cons [_ (#Text class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) - (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) + (#Cons [_ (#Text class-name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "Primitive"]) (text$ class-name) (untemplate-list params))))) - _ - (fail "Wrong syntax for primitive")})) + _ + (fail "Wrong syntax for primitive")})) (def:'' (current-module-name state) - #Nil - ($' Meta Text) - ("lux case" state - {{#info info #source source #current-module current-module #modules modules - #scopes scopes #type-context types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} - ("lux case" current-module - {(#;Some module-name) - (#Right [state module-name]) + #Nil + ($' Meta Text) + ("lux case" state + {{#info info #source source #current-module current-module #modules modules + #scopes scopes #type-context types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + ("lux case" current-module + {(#Some module-name) + (#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"]) - (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. - (` (def: (~ name) - (function [(~@ args)] - (~ body))))")]) - ("lux case" tokens - {(#Cons template #Nil) - (do Monad - [current-module current-module-name - =template (untemplate true current-module template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. + (` (def: (~ name) + (function [(~@ args)] + (~ body))))")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad + [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"]) - (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. - (`' (def: (~ name) - (function [(~@ args)] - (~ body))))")]) - ("lux case" tokens - {(#Cons template #Nil) - (do Monad - [=template (untemplate true "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (`' (def: (~ name) + (function [(~@ args)] + (~ body))))")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad + [=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 - [=template (untemplate false "" template)] - (wrap (list (form$ (list (text$ "lux check") (symbol$ ["lux" "Code"]) =template))))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Quotation as a macro. + (' \"YOLO\")")]) + ("lux case" tokens + {(#Cons template #Nil) + (do Monad + [=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"]) - (text$ "## Piping macro. - (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) - - ## => - (fold text/compose \"\" - (interpose \" \" - (map int/encode elems)))")]) - ("lux case" tokens - {(#Cons [init apps]) - (return (list (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))) - - _ - (` ((~ app) (~ acc)))}))) - init - apps))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Piping macro. + (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) + ("lux case" tokens + {(#Cons [init apps]) + (return (list (list/fold ("lux check" (-> Code Code Code) + (function' [app acc] + ("lux case" app + {[_ (#Tuple parts)] + (tuple$ (list/compose parts (list acc))) - _ - (fail "Wrong syntax for |>")})) + [_ (#Form parts)] + (form$ (list/compose parts (list acc))) + + _ + (` ((~ app) (~ acc)))}))) + init + apps))) + + _ + (fail "Wrong syntax for |>")})) (macro:' #export (<| tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Reverse piping macro. - (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) - - ## => - (fold text/compose \"\" - (interpose \" \" - (map int/encode elems)))")]) - ("lux case" (list/reverse tokens) - {(#Cons [init apps]) - (return (list (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))) - - _ - (` ((~ app) (~ acc)))}))) - init - apps))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Reverse piping macro. + (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) + + ## => + (fold text/compose \"\" + (interpose \" \" + (map int/encode elems)))")]) + ("lux case" (list/reverse tokens) + {(#Cons [init apps]) + (return (list (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))) + + _ + (` ((~ app) (~ acc)))}))) + init + apps))) - _ - (fail "Wrong syntax for <|")})) + _ + (fail "Wrong syntax for <|")})) (def:''' (compose f g) - (list [(tag$ ["lux" "doc"]) - (text$ "Function composition.")]) - (All [a b c] - (-> (-> b c) (-> a b) (-> a c))) - (function' [x] (f (g x)))) + (list [(tag$ ["lux" "doc"]) + (text$ "Function composition.")]) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) (def:''' (get-ident x) - #Nil - (-> Code ($' Maybe Ident)) - ("lux case" x - {[_ (#Symbol sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Ident)) + ("lux case" x + {[_ (#Symbol sname)] + (#Some sname) - _ - #None})) + _ + #None})) (def:''' (get-tag x) - #Nil - (-> Code ($' Maybe Ident)) - ("lux case" x - {[_ (#Tag sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Ident)) + ("lux case" x + {[_ (#Tag sname)] + (#Some sname) - _ - #None})) + _ + #None})) (def:''' (get-name x) - #Nil - (-> Code ($' Maybe Text)) - ("lux case" x - {[_ (#Symbol "" sname)] - (#Some sname) + #Nil + (-> Code ($' Maybe Text)) + ("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) + #Nil + (-> Code ($' Maybe ($' List Code))) + ("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 + #Nil + (-> RepEnv Code Code) + ("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 check" (-> (& 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 + #Nil + (All [a b] + (-> (-> a ($' List b)) ($' List a) ($' List b))) + ("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 - (All [a] - (-> (-> a Bool) ($' List a) Bool)) - (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + (list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) (macro:' #export (do-template tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. - (do-template [ ] - [(def: #export - (-> Int Int) - (i/+ ))] - - [i/inc 1] - [i/dec -1])")]) - ("lux case" tokens - {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) - ("lux case" [(monad/map Monad get-name bindings) - (monad/map Monad tuple->list data)] - {[(#Some bindings') (#Some data')] - (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (map (apply-template env) templates))) - num-bindings (list/size bindings')] - (if (every? (function' [sample] ("lux nat =" num-bindings sample)) - (map list/size data')) - (|> data' - (join-map (compose apply (make-env bindings'))) - return) - (fail "Irregular arguments tuples for do-template."))) + (list [(tag$ ["lux" "doc"]) + (text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. + (do-template [ ] + [(def: #export + (-> Int Int) + (i/+ ))] + + [i/inc 1] + [i/dec -1])")]) + ("lux case" tokens + {(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) + ("lux case" [(monad/map Monad get-name bindings) + (monad/map Monad tuple->list data)] + {[(#Some bindings') (#Some data')] + (let' [apply ("lux check" (-> RepEnv ($' List Code)) + (function' [env] (map (apply-template env) templates))) + num-bindings (list/size bindings')] + (if (every? (function' [sample] ("lux nat =" num-bindings sample)) + (map list/size data')) + (|> data' + (join-map (compose 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")})) + _ + (fail "Wrong syntax for do-template")})) (do-template [ <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export ( test subject) - (list [(tag$ ["lux" "doc"]) (text$ )]) - (-> Bool) - ( subject test)) + (list [(tag$ ["lux" "doc"]) + (text$ )]) + (-> Bool) + ( subject test)) (def:''' #export ( test subject) - (list [(tag$ ["lux" "doc"]) (text$ <<-doc>)]) - (-> Bool) - ( subject test)) + (list [(tag$ ["lux" "doc"]) + (text$ <<-doc>)]) + (-> Bool) + ( subject test)) (def:''' #export ( test subject) - (list [(tag$ ["lux" "doc"]) (text$ <<=-doc>)]) - (-> Bool) - (if ( subject test) - true - ( subject test))) + (list [(tag$ ["lux" "doc"]) + (text$ <<=-doc>)]) + (-> Bool) + (if ( subject test) + true + ( subject test))) (def:''' #export ( test subject) - (list [(tag$ ["lux" "doc"]) (text$ <>-doc>)]) - (-> Bool) - ( test subject)) + (list [(tag$ ["lux" "doc"]) + (text$ <>-doc>)]) + (-> Bool) + ( test subject)) (def:''' #export ( test subject) - (list [(tag$ ["lux" "doc"]) (text$ <>=-doc>)]) - (-> Bool) - (if ( test subject) - true - ( subject test)))] + (list [(tag$ ["lux" "doc"]) + (text$ <>=-doc>)]) + (-> Bool) + (if ( test subject) + true + ( subject test)))] [ Nat "lux nat =" "lux nat <" n/= n/< n/<= n/> n/>= "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."] @@ -2265,9 +2270,10 @@ (do-template [ ] [(def:''' #export ( param subject) - (list [(tag$ ["lux" "doc"]) (text$ )]) - (-> ) - ( subject param))] + (list [(tag$ ["lux" "doc"]) + (text$ )]) + (-> ) + ( subject param))] [ Nat n/+ "lux nat +" "Nat(ural) addition."] [ Nat n/- "lux nat -" "Nat(ural) substraction."] @@ -2296,9 +2302,10 @@ (do-template [ ] [(def:''' #export ( param subject) - (list [(tag$ ["lux" "doc"]) (text$ )]) - (-> Nat ) - ( subject param))] + (list [(tag$ ["lux" "doc"]) + (text$ )]) + (-> Nat ) + ( subject param))] [ Deg d/scale "lux deg scale" "Deg(ree) scale."] [ Deg d/reciprocal "lux deg reciprocal" "Deg(ree) reciprocal."] @@ -2306,11 +2313,12 @@ (do-template [ ] [(def:''' #export ( left right) - (list [(tag$ ["lux" "doc"]) (text$ )]) - (-> ) - (if ( right left) - left - right))] + (list [(tag$ ["lux" "doc"]) + (text$ )]) + (-> ) + (if ( right left) + left + right))] [n/min Nat n/< "Nat(ural) minimum."] [n/max Nat n/> "Nat(ural) maximum."] @@ -2326,903 +2334,903 @@ ) (def:''' (bool/encode x) - #Nil - (-> Bool Text) - (if x "true" "false")) + #Nil + (-> Bool Text) + (if x "true" "false")) (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 io error" "undefined")})) + #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 io error" "undefined")})) (def:''' (nat/encode value) - #Nil - (-> Nat Text) - ("lux case" value - {+0 - "+0" + #Nil + (-> Nat Text) + ("lux case" value + {+0 + "+0" - _ - (let' [loop ("lux check" (-> Nat Text Text) - (function' recur [input output] - (if (n/= +0 input) - (text/compose "+" output) - (recur (n// +10 input) - (text/compose (|> input (n/% +10) digit-to-text) - output)))))] - (loop value ""))})) + _ + (let' [loop ("lux check" (-> Nat Text Text) + (function' recur [input output] + (if (n/= +0 input) + (text/compose "+" output) + (recur (n// +10 input) + (text/compose (|> input (n/% +10) digit-to-text) + output)))))] + (loop value ""))})) (def:''' (int/abs value) - #Nil - (-> Int Int) - (if (i/< 0 value) - (i/* -1 value) - value)) + #Nil + (-> Int Int) + (if (i/< 0 value) + (i/* -1 value) + value)) (def:''' (int/encode value) - #Nil - (-> Int Text) - (if (i/= 0 value) - "0" - (let' [sign (if (i/> 0 value) - "" - "-")] - (("lux check" (-> Int Text Text) - (function' recur [input output] - (if (i/= 0 input) - (text/compose sign output) - (recur (i// 10 input) - (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text) - output))))) - (|> value (i// 10) int/abs) - (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text))))) + #Nil + (-> Int Text) + (if (i/= 0 value) + "0" + (let' [sign (if (i/> 0 value) + "" + "-")] + (("lux check" (-> Int Text Text) + (function' recur [input output] + (if (i/= 0 input) + (text/compose sign output) + (recur (i// 10 input) + (text/compose (|> input (i/% 10) ("lux coerce" Nat) digit-to-text) + output))))) + (|> value (i// 10) int/abs) + (|> value (i/% 10) int/abs ("lux coerce" Nat) digit-to-text))))) (def:''' (frac/encode x) - #Nil - (-> Frac Text) - ("lux frac encode" x)) + #Nil + (-> Frac Text) + ("lux frac encode" x)) (def:''' (multiple? div n) - #Nil - (-> Nat Nat Bool) - (|> n (n/% div) (n/= +0))) + #Nil + (-> Nat Nat Bool) + (|> n (n/% div) (n/= +0))) (def:''' #export (not x) - (list [(tag$ ["lux" "doc"]) - (text$ "## Boolean negation. + (list [(tag$ ["lux" "doc"]) + (text$ "## Boolean negation. - (not true) => false + (not true) => false - (not false) => true")]) - (-> Bool Bool) - (if x false true)) + (not false) => true")]) + (-> Bool Bool) + (if x false true)) (def:''' (find-macro' modules current-module module name) - #Nil - (-> ($' List (& Text Module)) - Text Text Text - ($' Maybe Macro)) - (do Monad - [$module (get module modules) - 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 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)]) - (#Some ("lux coerce" Macro def-value)) + #Nil + (-> ($' List (& Text Module)) + Text Text Text + ($' Maybe Macro)) + (do Monad + [$module (get module modules) + 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 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)]) + (#Some ("lux coerce" Macro def-value)) - _ - (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) + _ + (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 - [module-name current-module-name] - (wrap [module-name name])) + #Nil + (-> Ident ($' Meta Ident)) + ("lux case" ident + {["" name] + (do Monad + [module-name current-module-name] + (wrap [module-name name])) - _ - (return ident)})) + _ + (return ident)})) (def:''' (find-macro ident) - #Nil - (-> Ident ($' Meta ($' Maybe Macro))) - (do Monad - [current-module current-module-name] - (let' [[module name] ident] - (function' [state] - ("lux case" state - {{#info info #source source #current-module _ #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))}))))) + #Nil + (-> Ident ($' Meta ($' Maybe Macro))) + (do Monad + [current-module current-module-name] + (let' [[module name] ident] + (function' [state] + ("lux case" state + {{#info info #source source #current-module _ #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 - (-> Ident ($' Meta Bool)) - (do Monad - [ident (normalize ident) - output (find-macro ident)] - (wrap ("lux case" output - {(#Some _) true - #None false})))) + #Nil + (-> Ident ($' Meta Bool)) + (do Monad + [ident (normalize ident) + output (find-macro ident)] + (wrap ("lux case" output + {(#Some _) true + #None false})))) (def:''' (list/join xs) - #Nil - (All [a] - (-> ($' List ($' List a)) ($' List a))) - (list/fold list/compose #Nil (list/reverse xs))) + #Nil + (All [a] + (-> ($' List ($' List a)) ($' List a))) + (list/fold list/compose #Nil (list/reverse xs))) (def:''' (interpose sep xs) - #Nil - (All [a] - (-> a ($' List a) ($' List a))) - ("lux case" xs - {#Nil - xs + #Nil + (All [a] + (-> a ($' List a) ($' List a))) + ("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 - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (macro args) - - #None - (return (list token))})) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" token + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad + [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 - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (do Monad - [expansion (macro args) - expansion' (monad/map Monad macro-expand expansion)] - (wrap (list/join expansion'))) - - #None - (return (list token))})) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" token + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad + [expansion (macro args) + expansion' (monad/map Monad 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 - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - ("lux case" ?macro - {(#Some macro) - (do Monad - [expansion (macro args) - expansion' (monad/map Monad macro-expand-all expansion)] - (wrap (list/join expansion'))) - - #None - (do Monad - [args' (monad/map Monad macro-expand-all args)] - (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))})) - - [_ (#Form members)] - (do Monad - [members' (monad/map Monad macro-expand-all members)] - (wrap (list (form$ (list/join members'))))) + #Nil + (-> Code ($' Meta ($' List Code))) + ("lux case" syntax + {[_ (#Form (#Cons [_ (#Symbol macro-name)] args))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + ("lux case" ?macro + {(#Some macro) + (do Monad + [expansion (macro args) + expansion' (monad/map Monad macro-expand-all expansion)] + (wrap (list/join expansion'))) + + #None + (do Monad + [args' (monad/map Monad macro-expand-all args)] + (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args'))))))})) + + [_ (#Form members)] + (do Monad + [members' (monad/map Monad macro-expand-all members)] + (wrap (list (form$ (list/join members'))))) + + [_ (#Tuple members)] + (do Monad + [members' (monad/map Monad macro-expand-all members)] + (wrap (list (tuple$ (list/join members'))))) + + [_ (#Record pairs)] + (do Monad + [pairs' (monad/map Monad + (function' [kv] + (let' [[key val] kv] + (do Monad + [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')))) - [_ (#Tuple members)] - (do Monad - [members' (monad/map Monad macro-expand-all members)] - (wrap (list (tuple$ (list/join members'))))) - - [_ (#Record pairs)] - (do Monad - [pairs' (monad/map Monad - (function' [kv] - (let' [[key val] kv] - (do Monad - [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')))) - - _ - (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))] - (list/fold ("lux check" (-> Code Code Code) - (function' [arg type-fn] (` (#;Apply (~ arg) (~ type-fn))))) - (walk-type type-fn) - (map walk-type args)) - - _ - 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))] + (list/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 - [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.")})) + (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 + [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 check" (type (~ type)) (~ value))))) + (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 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 coerce" (type (~ type)) (~ value))))) + (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 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})) + #Nil + (All [a] (-> ($' List a) Bool)) + ("lux case" xs + {#Nil true + _ false})) (do-template [ ] [(def:''' ( xy) - #Nil - (All [a b] (-> (& a b) )) - (let' [[x y] xy] ))] + #Nil + (All [a b] (-> (& a b) )) + (let' [[x y] xy] ))] [first a x] [second b y]) (def:''' (unfold-type-def type-codes) - #Nil - (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) - ("lux case" type-codes - {(#Cons [_ (#Record pairs)] #;Nil) - (do Monad - [members (monad/map Monad - (: (-> [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))]) - - _ - (return [type #None])}) - - (#Cons case cases) - (do Monad - [members (monad/map Monad - (: (-> 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)))]) + #Nil + (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) + ("lux case" type-codes + {(#Cons [_ (#Record pairs)] #Nil) + (do Monad + [members (monad/map Monad + (: (-> [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))]) - _ - (fail "Wrong syntax for variant case.")}))) - (list& case cases))] - (return [(` (| (~@ (map second members)))) - (#Some (map first members))])) + _ + (return [type #None])}) + + (#Cons case cases) + (do Monad + [members (monad/map Monad + (: (-> 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")})) + _ + (fail "Improper type-definition syntax")})) (def:''' (gensym prefix state) - #Nil - (-> Text ($' Meta Code)) - ("lux case" state - {{#info info #source source #current-module _ #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 #current-module _ #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))]))})) + #Nil + (-> Text ($' Meta Code)) + ("lux case" state + {{#info info #source source #current-module _ #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 #current-module _ #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"]) - (text$ "## Parameter-less recursive types. - ## 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")})) + (list [(tag$ ["lux" "doc"]) + (text$ "## Parameter-less recursive types. + ## 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")})) (macro:' #export (exec tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Sequential execution of expressions (great for side-effects). - (exec - (log! \"#1\") - (log! \"#2\") - (log! \"#3\") - \"YOLO\")")]) - ("lux case" (list/reverse tokens) - {(#Cons value actions) - (let' [dummy (symbol$ ["" ""])] - (return (list (list/fold ("lux check" (-> Code Code Code) - (function' [pre post] (` ("lux case" (~ pre) {(~ dummy) (~ post)})))) - value - actions)))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Sequential execution of expressions (great for side-effects). + (exec + (log! \"#1\") + (log! \"#2\") + (log! \"#3\") + \"YOLO\")")]) + ("lux case" (list/reverse tokens) + {(#Cons value actions) + (let' [dummy (symbol$ ["" ""])] + (return (list (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'] - - _ - [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) + (let' [[export? tokens'] ("lux case" tokens + {(#Cons [_ (#Tag ["" "export"])] tokens') + [true 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) - _ - #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)) - (let' [[left right] pair] - (list left right))) + (-> [Code Code] (List Code)) + (let' [[left right] pair] + (list left right))) (def:' (code-to-text code) - (-> Code Text) - ("lux case" code - {[_ (#Bool value)] - (bool/encode value) - - [_ (#Nat value)] - (nat/encode value) - - [_ (#Int value)] - (int/encode value) - - [_ (#Deg value)] - ("lux 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 " ") - list/reverse - (list/fold text/compose "")) ")") - - [_ (#Tuple xs)] - ($_ text/compose "[" (|> xs - (map code-to-text) - (interpose " ") - list/reverse - (list/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 " ") - list/reverse - (list/fold text/compose "")) "}")} - )) + (-> Code Text) + ("lux case" code + {[_ (#Bool value)] + (bool/encode value) + + [_ (#Nat value)] + (nat/encode value) + + [_ (#Int value)] + (int/encode value) + + [_ (#Deg value)] + ("lux 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 " ") + list/reverse + (list/fold text/compose "")) ")") + + [_ (#Tuple xs)] + ($_ text/compose "[" (|> xs + (map code-to-text) + (interpose " ") + list/reverse + (list/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 " ") + list/reverse + (list/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 - [??? (macro? macro-name)] - (if ??? - (do Monad - [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] - (expander init-expansion)) - (do Monad - [sub-expansion (expander branches')] - (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) - body - sub-expansion))))) + (-> (List Code) (Meta (List Code))) + ("lux case" branches + {(#Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] + (#Cons body + branches')) + (do Monad + [??? (macro? macro-name)] + (if ??? + (do Monad + [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] + (expander init-expansion)) + (do Monad + [sub-expansion (expander branches')] + (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) + body + sub-expansion))))) - (#;Cons pattern (#;Cons body branches')) - (do Monad - [sub-expansion (expander branches')] - (wrap (list& pattern body sub-expansion))) + (#Cons pattern (#Cons body branches')) + (do Monad + [sub-expansion (expander branches')] + (wrap (list& pattern body sub-expansion))) - #;Nil - (do Monad [] (wrap (list))) + #Nil + (do Monad [] (wrap (list))) - _ - (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches - (map code-to-text) - (interpose " ") - list/reverse - (list/fold text/compose ""))))})) + _ + (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches + (map code-to-text) + (interpose " ") + list/reverse + (list/fold text/compose ""))))})) (macro:' #export (case tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## The pattern-matching macro. - ## Allows the usage of macros within the patterns to provide custom syntax. - (case (: (List Int) (list 1 2 3)) - (#Cons x (#Cons y (#Cons z #Nil))) - (#Some ($_ i/* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## The pattern-matching macro. + ## Allows the usage of macros within the patterns to provide custom syntax. + (case (: (List Int) (list 1 2 3)) + (#Cons x (#Cons y (#Cons z #Nil))) + (#Some ($_ i/* x y z)) - _ - #None)")]) - ("lux case" tokens - {(#Cons value branches) - (do Monad - [expansion (expander branches)] - (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion)))))))) + _ + #None)")]) + ("lux case" tokens + {(#Cons value branches) + (do Monad + [expansion (expander branches)] + (wrap (list (` ("lux case" (~ value) (~ (record$ (as-pairs expansion)))))))) - _ - (fail "Wrong syntax for case")})) + _ + (fail "Wrong syntax for case")})) (macro:' #export (^ tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Macro-expanding patterns. - ## It's a special macro meant to be used with 'case'. - (case (: (List Int) (list 1 2 3)) - (^ (list x y z)) - (#Some ($_ i/* x y z)) + (list [(tag$ ["lux" "doc"]) + (text$ "## Macro-expanding patterns. + ## It's a special macro meant to be used with 'case'. + (case (: (List Int) (list 1 2 3)) + (^ (list x y z)) + (#Some ($_ i/* x y z)) - _ - #None)")]) - (case tokens - (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) - (do Monad - [pattern+ (macro-expand-all pattern)] - (case pattern+ - (#Cons pattern' #Nil) - (wrap (list& pattern' body branches)) - - _ - (fail "^ can only expand to 1 pattern."))) - - _ - (fail "Wrong syntax for ^ macro"))) + _ + #None)")]) + (case tokens + (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) + (do Monad + [pattern+ (macro-expand-all pattern)] + (case pattern+ + (#Cons pattern' #Nil) + (wrap (list& pattern' body branches)) + + _ + (fail "^ can only expand to 1 pattern."))) + + _ + (fail "Wrong syntax for ^ macro"))) (macro:' #export (^or tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Or-patterns. - ## It's a special macro meant to be used with 'case'. - (type: Weekday - #Monday - #Tuesday - #Wednesday - #Thursday - #Friday - #Saturday - #Sunday) - - (def: (weekend? day) - (-> Weekday Bool) - (case day - (^or #Saturday #Sunday) - true - - _ - false))")]) - (case tokens - (^ (list& [_ (#Form patterns)] body branches)) - (case patterns - #Nil - (fail "^or cannot have 0 patterns") + (list [(tag$ ["lux" "doc"]) + (text$ "## Or-patterns. + ## It's a special macro meant to be used with 'case'. + (type: Weekday + #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday + #Sunday) + + (def: (weekend? day) + (-> Weekday Bool) + (case day + (^or #Saturday #Sunday) + true + + _ + false))")]) + (case tokens + (^ (list& [_ (#Form patterns)] body branches)) + (case patterns + #Nil + (fail "^or cannot have 0 patterns") - _ - (let' [pairs (|> patterns - (map (function' [pattern] (list pattern body))) - (list/join))] - (return (list/compose pairs branches)))) - _ - (fail "Wrong syntax for ^or"))) + _ + (let' [pairs (|> patterns + (map (function' [pattern] (list pattern body))) + (list/join))] + (return (list/compose pairs branches)))) + _ + (fail "Wrong syntax for ^or"))) (def:' (symbol? code) - (-> Code Bool) - (case code - [_ (#Symbol _)] - true + (-> Code Bool) + (case code + [_ (#Symbol _)] + true - _ - false)) + _ + false)) (macro:' #export (let tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Creates local bindings. - ## Can (optionally) use pattern-matching macros when binding. - (let [x (foo bar) - y (baz quux)] - (op x y))")]) - (case tokens - (^ (list [_ (#Tuple bindings)] body)) - (if (multiple? +2 (list/size bindings)) - (|> bindings as-pairs list/reverse - (list/fold (: (-> [Code Code] Code Code) - (function' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` ("lux case" (~ r) {(~ l) (~ body')})) - (` (case (~ r) (~ l) (~ body'))))))) - body) - list - return) - (fail "let requires an even number of parts")) + (list [(tag$ ["lux" "doc"]) + (text$ "## Creates local bindings. + ## Can (optionally) use pattern-matching macros when binding. + (let [x (foo bar) + y (baz quux)] + (op x y))")]) + (case tokens + (^ (list [_ (#Tuple bindings)] body)) + (if (multiple? +2 (list/size bindings)) + (|> bindings as-pairs list/reverse + (list/fold (: (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` ("lux case" (~ r) {(~ l) (~ body')})) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + return) + (fail "let requires an even number of parts")) - _ - (fail "Wrong syntax for let"))) + _ + (fail "Wrong syntax for let"))) (macro:' #export (function tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Syntax for creating functions. - ## Allows for giving the function itself a name, for the sake of recursion. - (: (All [a b] (-> a b a)) - (function [x y] x)) - - (: (All [a b] (-> a b a)) - (function const [x y] x))")]) - (case (: (Maybe [Ident Code (List Code) Code]) - (case tokens - (^ (list [_ (#Tuple (#Cons head tail))] body)) - (#Some ["" ""] head tail body) - - (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body)) - (#Some ["" name] head tail body) - - _ - #None)) - (#Some ident head tail body) - (let [g!blank (symbol$ ["" ""]) - g!name (symbol$ ident) - body+ (list/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'))))))) - body - (list/reverse tail))] - (return (list (if (symbol? head) - (` ("lux function" (~ g!name) (~ head) (~ body+))) - (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) - - #None - (fail "Wrong syntax for function"))) + (list [(tag$ ["lux" "doc"]) + (text$ "## Syntax for creating functions. + ## Allows for giving the function itself a name, for the sake of recursion. + (: (All [a b] (-> a b a)) + (function [x y] x)) + + (: (All [a b] (-> a b a)) + (function const [x y] x))")]) + (case (: (Maybe [Ident Code (List Code) Code]) + (case tokens + (^ (list [_ (#Tuple (#Cons head tail))] body)) + (#Some ["" ""] head tail body) + + (^ (list [_ (#Symbol ["" name])] [_ (#Tuple (#Cons head tail))] body)) + (#Some ["" name] head tail body) + + _ + #None)) + (#Some ident head tail body) + (let [g!blank (symbol$ ["" ""]) + g!name (symbol$ ident) + body+ (list/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'))))))) + body + (list/reverse tail))] + (return (list (if (symbol? head) + (` ("lux function" (~ g!name) (~ head) (~ body+))) + (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) + + #None + (fail "Wrong syntax for function"))) (def:' (process-def-meta-value code) - (-> Code Code) - (case code - [_ (#Bool value)] - (meta-code ["lux" "Bool"] (bool$ value)) - - [_ (#Nat value)] - (meta-code ["lux" "Nat"] (nat$ value)) - - [_ (#Int value)] - (meta-code ["lux" "Int"] (int$ value)) - - [_ (#Deg value)] - (meta-code ["lux" "Deg"] (deg$ value)) - - [_ (#Frac value)] - (meta-code ["lux" "Frac"] (frac$ value)) - - [_ (#Text value)] - (meta-code ["lux" "Text"] (text$ value)) - - [_ (#Tag [prefix name])] - (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) - - (^or [_ (#Form _)] [_ (#Symbol _)]) - code - - [_ (#Tuple xs)] - (|> xs - (map process-def-meta-value) - untemplate-list - (meta-code ["lux" "Tuple"])) - - [_ (#Record kvs)] - (|> kvs - (map (: (-> [Code Code] Code) - (function [[k v]] - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))])))) - untemplate-list - (meta-code ["lux" "Record"])) - )) + (-> Code Code) + (case code + [_ (#Bool value)] + (meta-code ["lux" "Bool"] (bool$ value)) + + [_ (#Nat value)] + (meta-code ["lux" "Nat"] (nat$ value)) + + [_ (#Int value)] + (meta-code ["lux" "Int"] (int$ value)) + + [_ (#Deg value)] + (meta-code ["lux" "Deg"] (deg$ value)) + + [_ (#Frac value)] + (meta-code ["lux" "Frac"] (frac$ value)) + + [_ (#Text value)] + (meta-code ["lux" "Text"] (text$ value)) + + [_ (#Tag [prefix name])] + (meta-code ["lux" "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) + + (^or [_ (#Form _)] [_ (#Symbol _)]) + code + + [_ (#Tuple xs)] + (|> xs + (map process-def-meta-value) + untemplate-list + (meta-code ["lux" "Tuple"])) + + [_ (#Record kvs)] + (|> kvs + (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))])))) + untemplate-list + (meta-code ["lux" "Record"])) + )) (def:' (process-def-meta kvs) - (-> (List [Code Code]) Code) - (untemplate-list (map (: (-> [Code Code] Code) - (function [[k v]] - (` [(~ (process-def-meta-value k)) - (~ (process-def-meta-value v))]))) - kvs))) + (-> (List [Code Code]) Code) + (untemplate-list (map (: (-> [Code Code] Code) + (function [[k v]] + (` [(~ (process-def-meta-value k)) + (~ (process-def-meta-value v))]))) + kvs))) (def:' (with-func-args args meta) - (-> (List Code) Code Code) - (case args - #;Nil - meta - - _ - (` (#;Cons [[(~ cursor-code) (#;Tag ["lux" "func-args"])] - [(~ cursor-code) (#;Tuple (;list (~@ (map (function [arg] - (` [(~ cursor-code) (#;Text (~ (text$ (code-to-text arg))))])) - args))))]] - (~ meta))))) + (-> (List Code) Code Code) + (case args + #Nil + meta + + _ + (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])] + [(~ cursor-code) (#.Tuple (.list (~@ (map (function [arg] + (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))])) + args))))]] + (~ meta))))) (def:' (with-type-args args) - (-> (List Code) Code) - (` {#;type-args [(~@ (map (function [arg] (text$ (code-to-text arg))) - args))]})) + (-> (List Code) Code) + (` {#.type-args [(~@ (map (function [arg] (text$ (code-to-text arg))) + args))]})) (def:' Export-Level - Type - ($' Either - Unit ## Exported - Unit ## Hidden - )) + Type + ($' Either + Unit ## Exported + Unit ## Hidden + )) (def:' (export-level^ tokens) - (-> (List Code) [(Maybe Export-Level) (List Code)]) - (case tokens - (#Cons [_ (#Tag [_ "export"])] tokens') - [(#;Some (#;Left [])) tokens'] + (-> (List Code) [(Maybe Export-Level) (List Code)]) + (case tokens + (#Cons [_ (#Tag [_ "export"])] tokens') + [(#Some (#Left [])) tokens'] - (#Cons [_ (#Tag [_ "hidden"])] tokens') - [(#;Some (#;Right [])) tokens'] + (#Cons [_ (#Tag [_ "hidden"])] tokens') + [(#Some (#Right [])) tokens'] - _ - [#;None tokens])) + _ + [#None tokens])) (def:' (export-level ?el) - (-> (Maybe Export-Level) (List Code)) - (case ?el - #;None - (list) + (-> (Maybe Export-Level) (List Code)) + (case ?el + #None + (list) - (#;Some (#;Left [])) - (list (' #export)) + (#Some (#Left [])) + (list (' #export)) - (#;Some (#;Right [])) - (list (' #hidden)))) + (#Some (#Right [])) + (list (' #hidden)))) (macro:' #export (def: tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "## Defines global constants/functions. - (def: (rejoin-pair pair) - (-> [Code Code] (List Code)) - (let [[left right] pair] - (list left right))) - - (def: branching-exponent - Int - 5)")]) - (let [[export? tokens'] (export-level^ tokens) - parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) - (case tokens' - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) - (#Some [name args (#Some type) body meta-kvs]) - - (^ (list name [_ (#Record meta-kvs)] type body)) - (#Some [name #Nil (#Some type) body meta-kvs]) + (list [(tag$ ["lux" "doc"]) + (text$ "## Defines global constants/functions. + (def: (rejoin-pair pair) + (-> [Code Code] (List Code)) + (let [[left right] pair] + (list left right))) + + (def: branching-exponent + Int + 5)")]) + (let [[export? tokens'] (export-level^ tokens) + parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) + (case tokens' + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] type body)) + (#Some [name args (#Some type) body meta-kvs]) + + (^ (list name [_ (#Record meta-kvs)] type body)) + (#Some [name #Nil (#Some type) body meta-kvs]) - (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) - (#Some [name args #None body meta-kvs]) + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta-kvs)] body)) + (#Some [name args #None body meta-kvs]) - (^ (list name [_ (#Record meta-kvs)] body)) - (#Some [name #Nil #None body meta-kvs]) - - (^ (list [_ (#Form (#Cons name args))] type body)) - (#Some [name args (#Some type) body #Nil]) - - (^ (list name type body)) - (#Some [name #Nil (#Some type) body #Nil]) - - (^ (list [_ (#Form (#Cons name args))] body)) - (#Some [name args #None body #Nil]) - - (^ (list name body)) - (#Some [name #Nil #None body #Nil]) + (^ (list name [_ (#Record meta-kvs)] body)) + (#Some [name #Nil #None body meta-kvs]) + + (^ (list [_ (#Form (#Cons name args))] type body)) + (#Some [name args (#Some type) body #Nil]) + + (^ (list name type body)) + (#Some [name #Nil (#Some type) body #Nil]) + + (^ (list [_ (#Form (#Cons name args))] body)) + (#Some [name args #None body #Nil]) + + (^ (list name body)) + (#Some [name #Nil #None body #Nil]) - _ - #None))] - (case parts - (#Some name args ?type body meta) - (let [body (case args - #Nil - body + _ + #None))] + (case parts + (#Some name args ?type body meta) + (let [body (case args + #Nil + body - _ - (` (function (~ name) [(~@ args)] (~ body)))) - body (case ?type - (#Some type) - (` (: (~ type) (~ body))) - - #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) - ))))]))))) - - #None - (fail "Wrong syntax for def:")))) + _ + (` (function (~ name) [(~@ args)] (~ body)))) + body (case ?type + (#Some type) + (` (: (~ type) (~ body))) + + #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) + ))))]))))) + + #None + (fail "Wrong syntax for def:")))) (def: (meta-code-add addition meta) (-> [Code Code] Code Code) (case [addition meta] - [[name value] [cursor (#;Record pairs)]] - [cursor (#;Record (#;Cons [name value] pairs))] + [[name value] [cursor (#Record pairs)]] + [cursor (#Record (#Cons [name value] pairs))] _ meta)) @@ -3230,62 +3238,62 @@ (def: (meta-code-merge addition base) (-> Code Code Code) (case addition - [cursor (#;Record pairs)] + [cursor (#Record pairs)] (list/fold meta-code-add base pairs) _ base)) (macro:' #export (macro: tokens) - (list [(tag$ ["lux" "doc"]) - (text$ "Macro-definition macro. + (list [(tag$ ["lux" "doc"]) + (text$ "Macro-definition macro. + + (macro: #export (ident-for tokens) + (case tokens + (^template [] + (^ (list [_ ( [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + ([#Symbol] [#Tag]) + + _ + (fail \"Wrong syntax for ident-for\")))")]) + (let [[exported? tokens] (export-level^ tokens) + name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) + (case tokens + (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] body)) + (#Some [name args (` {}) body]) + + (^ (list [_ (#Symbol name)] body)) + (#Some [name #Nil (` {}) body]) - (macro: #export (ident-for tokens) - (case tokens - (^template [] - (^ (list [_ ( [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#;Symbol] [#;Tag]) + (^ (list [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] body)) + (#Some [name args [meta-rec-cursor (#Record meta-rec-parts)] body]) + + (^ (list [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] body)) + (#Some [name #Nil [meta-rec-cursor (#Record meta-rec-parts)] body]) - _ - (fail \"Wrong syntax for ident-for\")))")]) - (let [[exported? tokens] (export-level^ tokens) - name+args+meta+body?? (: (Maybe [Ident (List Code) Code Code]) - (case tokens - (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] body)) - (#Some [name args (` {}) body]) - - (^ (list [_ (#;Symbol name)] body)) - (#Some [name #Nil (` {}) body]) - - (^ (list [_ (#;Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] body)) - (#Some [name args [meta-rec-cursor (#;Record meta-rec-parts)] body]) - - (^ (list [_ (#;Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] body)) - (#Some [name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] body]) - - _ - #None))] - (case name+args+meta+body?? - (#Some [name args meta body]) - (let [name (symbol$ name) - def-sig (case args - #;Nil name - _ (` ((~ name) (~@ args))))] - (return (list (` (;;def: (~@ (export-level exported?)) - (~ def-sig) - (~ (meta-code-merge (` {#;macro? true}) - meta)) - - ;;Macro - (~ body)))))) - + _ + #None))] + (case name+args+meta+body?? + (#Some [name args meta body]) + (let [name (symbol$ name) + def-sig (case args + #Nil name + _ (` ((~ name) (~@ args))))] + (return (list (` (..def: (~@ (export-level exported?)) + (~ def-sig) + (~ (meta-code-merge (` {#.macro? true}) + meta)) + + ..Macro + (~ body)))))) + - #None - (fail "Wrong syntax for macro:")))) + #None + (fail "Wrong syntax for macro:")))) (macro: #export (sig: tokens) - {#;doc "## Definition of signatures ala ML. + {#.doc "## Definition of signatures ala ML. (sig: #export (Ord a) (: (Eq a) eq) @@ -3300,11 +3308,11 @@ (let [[exported? tokens'] (export-level^ tokens) ?parts (: (Maybe [Ident (List Code) Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#;Record meta-rec-parts)] sigs)) - (#Some name args [meta-rec-cursor (#;Record meta-rec-parts)] sigs) + (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) + (#Some name args [meta-rec-cursor (#Record meta-rec-parts)] sigs) - (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#;Record meta-rec-parts)] sigs)) - (#Some name #Nil [meta-rec-cursor (#;Record meta-rec-parts)] sigs) + (^ (list& [_ (#Symbol name)] [meta-rec-cursor (#Record meta-rec-parts)] sigs)) + (#Some name #Nil [meta-rec-cursor (#Record meta-rec-parts)] sigs) (^ (list& [_ (#Form (list& [_ (#Symbol name)] args))] sigs)) (#Some name args (` {}) sigs) @@ -3336,15 +3344,15 @@ (function [[m-name m-type]] [(tag$ ["" m-name]) m-type])) members)) - sig-meta (meta-code-merge (` {#;sig? true}) + sig-meta (meta-code-merge (` {#.sig? true}) meta) usage (case args - #;Nil + #Nil def-name _ (` ((~ def-name) (~@ args))))]] - (return (list (` (;;type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) #None (fail "Wrong syntax for sig:")))) @@ -3366,7 +3374,7 @@ (do-template [
] [(macro: #export ( tokens) - {#;doc } + {#.doc } (case (list/reverse tokens) (^ (list& last init)) (return (list (list/fold (: (-> Code Code Code) @@ -3387,20 +3395,20 @@ (def: (last-index-of' part part-size since text) (-> Text Nat Nat Text (Maybe Nat)) (case ("lux text index" text part (n/+ part-size since)) - #;None - (#;Some since) + #None + (#Some since) - (#;Some since') + (#Some since') (last-index-of' part part-size since' text))) (def: (last-index-of part text) (-> Text Text (Maybe Nat)) (case ("lux text index" text part +0) - (#;Some since) + (#Some since) (last-index-of' part ("lux text size" part) since text) - #;None - #;None)) + #None + #None)) (def: (clip1 from text) (-> Nat Text (Maybe Text)) @@ -3411,38 +3419,38 @@ ("lux text clip" text from to)) (def: #export (error! message) - {#;doc "## Causes an error, with the given error message. + {#.doc "## Causes an error, with the given error message. (error! \"OH NO!\")"} (-> Text Bottom) ("lux io error" message)) (macro: (default tokens state) - {#;doc "## Allows you to provide a default value that will be used - ## if a (Maybe x) value turns out to be #;None. - (default 20 (#;Some 10)) => 10 + {#.doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #.None. + (default 20 (#.Some 10)) => 10 - (default 20 #;None) => 20"} + (default 20 #.None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])]) + (let [g!temp (: Code [dummy-cursor (#Symbol ["" ""])]) code (` (case (~ maybe) - (#;Some (~ g!temp)) + (#.Some (~ g!temp)) (~ g!temp) - #;None + #.None (~ else)))] - (#;Right [state (list code)])) + (#Right [state (list code)])) _ - (#;Left "Wrong syntax for default"))) + (#Left "Wrong syntax for default"))) (def: (text/split splitter input) (-> Text Text (List Text)) (case (index-of splitter input) - #;None + #None (list input) - (#;Some idx) + (#Some idx) (list& (default (error! "UNDEFINED") (clip2 +0 idx input)) (text/split splitter @@ -3538,17 +3546,17 @@ _ (list type)))] - [flatten-variant #;Sum] - [flatten-tuple #;Product] - [flatten-lambda #;Function] + [flatten-variant #Sum] + [flatten-tuple #Product] + [flatten-lambda #Function] ) (def: (flatten-app type) (-> Type [Type (List Type)]) (case type - (#;Apply head func') + (#Apply head func') (let [[func tail] (flatten-app func')] - [func (#;Cons head tail)]) + [func (#Cons head tail)]) _ [type (list)])) @@ -3657,7 +3665,7 @@ (#Left "Not expecting any type."))))) (macro: #export (struct tokens) - {#;doc "Not meant to be used directly. Prefer \"struct:\"."} + {#.doc "Not meant to be used directly. Prefer \"struct:\"."} (do Monad [tokens' (monad/map Monad macro-expand tokens) struct-type get-expected-type @@ -3694,27 +3702,27 @@ (|> parts list/reverse (list/fold text/compose ""))) (macro: #export (struct: tokens) - {#;doc "## Definition of structures ala ML. + {#.doc "## Definition of structures ala ML. (struct: #export Ord (Ord Int) (def: eq Eq) (def: (< test subject) - (lux;< test subject)) + (lux.< test subject)) (def: (<= test subject) - (or (lux;< test subject) - (lux;= test subject))) - (def: (lux;> test subject) - (lux;> test subject)) - (def: (lux;>= test subject) - (or (lux;> test subject) - (lux;= test subject))))"} + (or (lux.< test subject) + (lux.= test subject))) + (def: (lux.> test subject) + (lux.> test subject)) + (def: (lux.>= test subject) + (or (lux.> test subject) + (lux.= test subject))))"} (let [[exported? tokens'] (export-level^ tokens) ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) (case tokens' - (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#;Record meta-rec-parts)] type defs)) - (#Some name args type [meta-rec-cursor (#;Record meta-rec-parts)] defs) + (^ (list& [_ (#Form (list& name args))] [meta-rec-cursor (#Record meta-rec-parts)] type defs)) + (#Some name args type [meta-rec-cursor (#Record meta-rec-parts)] defs) - (^ (list& name [meta-rec-cursor (#;Record meta-rec-parts)] type defs)) - (#Some name #Nil type [meta-rec-cursor (#;Record meta-rec-parts)] defs) + (^ (list& name [meta-rec-cursor (#Record meta-rec-parts)] type defs)) + (#Some name #Nil type [meta-rec-cursor (#Record meta-rec-parts)] defs) (^ (list& [_ (#Form (list& name args))] type defs)) (#Some name args type (` {}) defs) @@ -3727,59 +3735,59 @@ (case ?parts (#Some [name args type meta defs]) (case (case name - [_ (#;Symbol ["" "_"])] + [_ (#Symbol ["" "_"])] (case type - (^ [_ (#;Form (list& [_ (#;Symbol [_ sig-name])] sig-args))]) + (^ [_ (#Form (list& [_ (#Symbol [_ sig-name])] sig-args))]) (case (: (Maybe (List Text)) (monad/map Monad (function [sa] (case sa - [_ (#;Symbol [_ arg-name])] - (#;Some arg-name) + [_ (#Symbol [_ arg-name])] + (#Some arg-name) _ - #;None)) + #None)) sig-args)) - (^ (#;Some params)) - (#;Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")])) + (^ (#Some params)) + (#Some (symbol$ ["" ($_ text/compose sig-name "<" (|> params (interpose ",") text/join) ">")])) _ - #;None) + #None) _ - #;None) + #None) _ - (#;Some name) + (#Some name) ) - (#;Some name) + (#Some name) (let [usage (case args #Nil name _ (` ((~ name) (~@ args))))] - (return (list (` (;;def: (~@ (export-level exported?)) (~ usage) - (~ (meta-code-merge (` {#;struct? true}) + (return (list (` (..def: (~@ (export-level exported?)) (~ usage) + (~ (meta-code-merge (` {#.struct? true}) meta)) (~ type) (struct (~@ defs))))))) - #;None + #None (fail "Cannot infer name, so struct must have a name other than \"_\"!")) #None (fail "Wrong syntax for struct:")))) (def: #export (id x) - {#;doc "Identity function. + {#.doc "Identity function. Does nothing to it's argument and just returns it."} (All [a] (-> a a)) x) (macro: #export (type: tokens) - {#;doc "## The type-definition macro. + {#.doc "## The type-definition macro. (type: (List a) #Nil (#Cons a (List a)))"} @@ -3792,20 +3800,20 @@ [false tokens']) parts (: (Maybe [Text (List Code) Code (List Code)]) (case tokens' - (^ (list [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) - (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) + (^ (list [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) + (#Some [name #Nil [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])]) - (^ (list& [_ (#Symbol "" name)] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) - (#Some [name #Nil [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) + (^ (list& [_ (#Symbol "" name)] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (#Some [name #Nil [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)]) (^ (list& [_ (#Symbol "" name)] type-codes)) (#Some [name #Nil (` {}) type-codes]) - (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] [type-cursor (#;Record type-parts)])) - (#Some [name args [meta-cursor (#;Record meta-parts)] (list [type-cursor (#;Record type-parts)])]) + (^ (list [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] [type-cursor (#Record type-parts)])) + (#Some [name args [meta-cursor (#Record meta-parts)] (list [type-cursor (#Record type-parts)])]) - (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#;Record meta-parts)] type-code1 type-codes)) - (#Some [name args [meta-cursor (#;Record meta-parts)] (#;Cons type-code1 type-codes)]) + (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] [meta-cursor (#Record meta-parts)] type-code1 type-codes)) + (#Some [name args [meta-cursor (#Record meta-parts)] (#Cons type-code1 type-codes)]) (^ (list& [_ (#Form (#Cons [_ (#Symbol "" name)] args))] type-codes)) (#Some [name args (` {}) type-codes]) @@ -3822,19 +3830,19 @@ type-meta (: Code (case tags?? (#Some tags) - (` {#;tags [(~@ (map text$ tags))] - #;type? true}) + (` {#.tags [(~@ (map text$ tags))] + #.type? true}) _ - (` {#;type? true}))) + (` {#.type? true}))) type' (: (Maybe Code) (if rec? (if (empty? args) (let [g!param (symbol$ ["" ""]) prime-name (symbol$ ["" name]) - type+ (replace-syntax (list [name (` ((~ prime-name) #;Void))]) type)] + type+ (replace-syntax (list [name (` ((~ prime-name) #.Void))]) type)] (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) - #;Void)))) + #.Void)))) #None) (case args #Nil @@ -3844,13 +3852,13 @@ (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))] (case type' (#Some type'') - (return (list (` (;;def: (~@ (export-level exported?)) (~ type-name) + (return (list (` (..def: (~@ (export-level exported?)) (~ type-name) (~ ($_ meta-code-merge (with-type-args args) - (if rec? (' {#;type-rec? true}) (' {})) + (if rec? (' {#.type-rec? true}) (' {})) type-meta meta)) Type - (#;Named [(~ (text$ module-name)) + (#.Named [(~ (text$ module-name)) (~ (text$ name))] (type (~ type''))))))) @@ -4064,10 +4072,10 @@ (def: (count-ups ups input) (-> Nat Text Nat) (case ("lux text index" input "/" ups) - #;None + #None ups - (#;Some found) + (#Some found) (if (n/= ups found) (count-ups (n/+ +1 ups) input) ups))) @@ -4075,10 +4083,10 @@ (def: (list/drop amount a+) (All [a] (-> Nat (List a) (List a))) (case [amount a+] - (^or [+0 _] [_ #;Nil]) + (^or [+0 _] [_ #Nil]) a+ - [_ (#;Cons _ a+')] + [_ (#Cons _ a+')] (list/drop (n/- +1 amount) a+'))) (def: (clean-module relative-root module) @@ -4146,7 +4154,7 @@ openings+extra (parse-short-openings extra) #let [[openings extra] openings+extra]] (wrap (list {#import-name m-name - #import-alias (#;Some (replace-all ";" m-name alias)) + #import-alias (#Some (replace-all "." m-name alias)) #import-refer {#refer-defs referral #refer-open openings}}))) @@ -4158,7 +4166,7 @@ openings+extra (parse-short-openings extra) #let [[openings extra] openings+extra]] (wrap (list {#import-name m-name - #import-alias (#;Some raw-m-name) + #import-alias (#Some raw-m-name) #import-refer {#refer-defs referral #refer-open openings}}))) @@ -4184,7 +4192,7 @@ (function [[name [def-type def-meta def-value]]] (case [(get-meta ["lux" "export?"] def-meta) (get-meta ["lux" "hidden?"] def-meta)] - [(#Some [_ (#Bool true)]) #;None] + [(#Some [_ (#Bool true)]) #None] (list name) _ @@ -4200,12 +4208,12 @@ (def: (filter p xs) (All [a] (-> (-> a Bool) (List a) (List a))) (case xs - #;Nil + #Nil (list) - (#;Cons x xs') + (#Cons x xs') (if (p x) - (#;Cons x (filter p xs')) + (#Cons x (filter p xs')) (filter p xs')))) (def: (is-member? cases name) @@ -4221,8 +4229,8 @@ (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) - #;None (f x2) - (#;Some y) (#;Some y))) + #None (f x2) + (#Some y) (#Some y))) (def: (find-in-env name state) (-> Text Compiler (Maybe Type)) @@ -4288,10 +4296,10 @@ (def: (find-type-var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings - #;Nil - #;Nil + #Nil + #Nil - (#;Cons [var bound] bindings') + (#Cons [var bound] bindings') (if (n/= idx var) bound (find-type-var idx bindings')))) @@ -4328,10 +4336,10 @@ #scope-type-vars _} compiler {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] (case (find-type-var type-id var-bindings) - #;None + #None temp - (#;Some actualT) + (#Some actualT) (#Right [compiler actualT]))) _ @@ -4357,7 +4365,7 @@ (case type (#Primitive name params) (case params - #;Nil + #Nil name _ @@ -4401,7 +4409,7 @@ ")")) (#Named [prefix name] _) - ($_ text/compose prefix ";" name) + ($_ text/compose prefix "." name) )) (macro: #hidden (^open' tokens) @@ -4411,10 +4419,10 @@ [init-type (find-type name) struct-evidence (resolve-type-tags init-type)] (case struct-evidence - #;None + #None (fail (text/compose "Can only \"open\" structs: " (type/show init-type))) - (#;Some tags&members) + (#Some tags&members) (do Monad [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code)) (function recur [source [tags members] target] @@ -4428,12 +4436,12 @@ (do Monad [m-structure (resolve-type-tags m-type)] (case m-structure - (#;Some m-tags&members) + (#Some m-tags&members) (recur ["" (text/compose prefix m-name)] m-tags&members enhanced-target) - #;None + #None (wrap enhanced-target)))) target (zip2 tags members))] @@ -4445,7 +4453,7 @@ (fail "Wrong syntax for ^open"))) (macro: #export (^open tokens) - {#;doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. + {#.doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. ## Can optionally take a \"prefix\" text for the generated local bindings. (def: #export (range (^open) from to) (All [a] (-> (Enum a) a a (List a))) @@ -4457,13 +4465,13 @@ (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) (^ (list& [_ (#Form (list))] body branches)) - (return (list& (` (;;^open "")) body branches)) + (return (list& (` (..^open "")) body branches)) _ (fail "Wrong syntax for ^open"))) (macro: #export (cond tokens) - {#;doc "## Branching structures with multiple test conditions. + {#.doc "## Branching structures with multiple test conditions. (cond (n/even? num) \"even\" (n/odd? num) \"odd\" ## else-branch @@ -4496,7 +4504,7 @@ (enumerate' +0 xs)) (macro: #export (get@ tokens) - {#;doc "## Accesses the value of a record at a given tag. + {#.doc "## Accesses the value of a record at a given tag. (get@ #field my-record) ## Can also work with multiple levels of nesting: @@ -4530,14 +4538,14 @@ (^ (list [_ (#Tuple slots)] record)) (return (list (list/fold (: (-> Code Code Code) (function [slot inner] - (` (;;get@ (~ slot) (~ inner))))) + (` (..get@ (~ slot) (~ inner))))) record slots))) (^ (list selector)) (do Monad [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record))))))) _ (fail "Wrong syntax for get@"))) @@ -4558,10 +4566,10 @@ _ (return (list (` ("lux def" (~ (symbol$ ["" (text/compose prefix name)])) (~ source+) - [(~ cursor-code) (#;Record #Nil)]))))))) + [(~ cursor-code) (#.Record #Nil)]))))))) (macro: #export (open tokens) - {#;doc "## Opens a structure and generates a definition for each of its members (including nested members). + {#.doc "## Opens a structure and generates a definition for each of its members (including nested members). ## For example: (open Number \"i:\") ## Will generate: @@ -4597,7 +4605,7 @@ (fail "Wrong syntax for open"))) (macro: #export (|>> tokens) - {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. + {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. (|>> (map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (function [] @@ -4609,7 +4617,7 @@ (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) (macro: #export (<<| tokens) - {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. + {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. (<<| (fold text/compose \"\") (interpose \" \") (map int/encode)) ## => (function [] @@ -4645,7 +4653,7 @@ (fail ($_ text/compose _def " is not defined in module " module-name " @ " current-module))))) referred-defs)))]] (case options - #;Nil + #Nil (wrap {#refer-defs referral #refer-open openings}) @@ -4692,8 +4700,8 @@ (` ("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))])]] + (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])] + [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]] #Nil))])))) defs') openings (join-map (: (-> Openings (List Code)) @@ -4734,17 +4742,17 @@ =opens (join-map (function [[prefix structs]] (list& (text$ prefix) (map symbol$ structs))) r-opens)] - (` (;;refer (~ (text$ module-name)) + (` (..refer (~ (text$ module-name)) (~@ =defs) (~' #open) ((~@ =opens)))))) (macro: #export (module: tokens) - {#;doc "Module-definition macro. + {#.doc "Module-definition macro. Can take optional annotations and allows the specification of modules to import. ## Examples - (;module: {#;doc \"Some documentation...\"} + (.module: {#.doc \"Some documentation...\"} lux (lux (control (monad #as M #refer #all)) (data (text #open (\"text/\" Monoid)) @@ -4755,7 +4763,7 @@ (macro code)) (// (type #open (\"\" Eq)))) - (;module: {#;doc \"Some documentation...\"} + (.module: {#.doc \"Some documentation...\"} lux (lux (control [\"M\" monad #*]) (data [text \"text/\" Monoid] @@ -4783,14 +4791,14 @@ (function [[m-name m-alias =refer]] (refer-to-code m-name =refer))) imports) - =meta (process-def-meta (list& [(` #;imports) (` [(~@ =imports)])] + =meta (process-def-meta (list& [(` #.imports) (` [(~@ =imports)])] _meta)) =module (` ("lux module" [(~ cursor-code) - (#;Record (~ =meta))]))]] - (wrap (#;Cons =module =refers)))) + (#.Record (~ =meta))]))]] + (wrap (#Cons =module =refers)))) (macro: #export (:: tokens) - {#;doc "## Allows accessing the value of a structure's member. + {#.doc "## Allows accessing the value of a structure's member. (:: Codec encode) ## Also allows using that value as a function. @@ -4806,7 +4814,7 @@ (fail "Wrong syntax for ::"))) (macro: #export (set@ tokens) - {#;doc "## Sets the value of a record at a given tag. + {#.doc "## Sets the value of a record at a given tag. (set@ #name \"Lux\" lang) ## Can also work with multiple levels of nesting: @@ -4852,7 +4860,7 @@ (^ (list [_ (#Tuple slots)] value record)) (case slots - #;Nil + #Nil (fail "Wrong syntax for set@") _ @@ -4864,14 +4872,14 @@ #let [pairs (zip2 slots bindings) update-expr (list/fold (: (-> [Code Code] Code Code) (function [[s b] v] - (` (;;set@ (~ s) (~ v) (~ b))))) + (` (..set@ (~ s) (~ v) (~ b))))) value (list/reverse pairs)) [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function [[new-slot new-binding] [old-record accesses']] [(` (get@ (~ new-slot) (~ new-binding))) - (#;Cons (list new-binding old-record) accesses')])) - [record (: (List (List Code)) #;Nil)] + (#Cons (list new-binding old-record) accesses')])) + [record (: (List (List Code)) #Nil)] pairs) accesses (list/join (list/reverse accesses'))]] (wrap (list (` (let [(~@ accesses)] @@ -4880,19 +4888,19 @@ (^ (list selector value)) (do Monad [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do Monad [g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function [(~ g!value) (~ g!record)] (;;set@ (~ selector) (~ g!value) (~ g!record))))))) + (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (fail "Wrong syntax for set@"))) (macro: #export (update@ tokens) - {#;doc "## Modifies the value of a record at a given tag, based on some function. + {#.doc "## Modifies the value of a record at a given tag, based on some function. (update@ #age i/inc person) ## Can also work with multiple levels of nesting: @@ -4938,7 +4946,7 @@ (^ (list [_ (#Tuple slots)] fun record)) (case slots - #;Nil + #Nil (fail "Wrong syntax for update@") _ @@ -4952,49 +4960,49 @@ (^ (list selector fun)) (do Monad [g!record (gensym "record")] - (wrap (list (` (function [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do Monad [g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function [(~ g!fun) (~ g!record)] (;;update@ (~ selector) (~ g!fun) (~ g!record))))))) + (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (fail "Wrong syntax for update@"))) (macro: #export (^template tokens) - {#;doc "## It's similar to do-template, but meant to be used during pattern-matching. + {#.doc "## It's similar to do-template, but meant to be used during pattern-matching. (def: (beta-reduce env type) (-> (List Type) Type Type) (case type - (#;Primitive name params) - (#;Primitive name (list/map (beta-reduce env) params)) + (#.Primitive name params) + (#.Primitive name (list/map (beta-reduce env) params)) (^template [] ( left right) ( (beta-reduce env left) (beta-reduce env right))) - ([#;Sum] [#;Product]) + ([#.Sum] [#.Product]) (^template [] ( left right) ( (beta-reduce env left) (beta-reduce env right))) - ([#;Function] - [#;Apply]) + ([#.Function] + [#.Apply]) (^template [] ( old-env def) (case old-env - #;Nil + #.Nil ( env def) _ type)) - ([#;UnivQ] - [#;ExQ]) + ([#.UnivQ] + [#.ExQ]) - (#;Bound idx) - (default type (list;nth idx env)) + (#.Bound idx) + (default type (list.nth idx env)) _ type @@ -5013,7 +5021,7 @@ (|> data' (join-map (compose apply (make-env bindings'))) wrap)) - #;None))) + #None))) (#Some output) (return (list/compose output branches)) @@ -5066,7 +5074,7 @@ (def: (identify-doc-fragment code) (-> Code Doc-Fragment) (case code - [_ (#;Text comment)] + [_ (#Text comment)] (#Doc-Comment comment) _ @@ -5088,7 +5096,7 @@ (do-template [ ] [(def: #export ( value) - {#;doc } + {#.doc } (-> ) ( value))] @@ -5116,8 +5124,8 @@ (def: (repeat n x) (All [a] (-> Int a (List a))) (if (i/> 0 n) - (#;Cons x (repeat (i/+ -1 n) x)) - #;Nil)) + (#Cons x (repeat (i/+ -1 n) x)) + #Nil)) (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) (-> Nat Cursor Cursor Text) @@ -5200,7 +5208,7 @@ (text/compose text "\n\n")))) (macro: #export (doc tokens) - {#;doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. + {#.doc "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given. ## For Example: (doc \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop. @@ -5211,7 +5219,7 @@ (recur (i/inc count) (f x)) x)))"} (return (list (` [(~ cursor-code) - (#;Text (~ (|> tokens + (#.Text (~ (|> tokens (map (|>> identify-doc-fragment doc-fragment->Text)) text/join text$)))])))) @@ -5275,7 +5283,7 @@ )) (macro: #export (loop tokens) - {#;doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." + {#.doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." "Can be used in monadic code to create monadic loops." (loop [count 0 x init] @@ -5306,14 +5314,14 @@ (function [_] (gensym ""))) inits)] (return (list (` (let [(~@ (interleave aliases inits))] - (;loop [(~@ (interleave vars aliases))] + (.loop [(~@ (interleave vars aliases))] (~ body))))))))) _ (fail "Wrong syntax for loop"))) (macro: #export (^slots tokens) - {#;doc (doc "Allows you to extract record members as local variables with the same names." + {#.doc (doc "Allows you to extract record members as local variables with the same names." "For example:" (let [(^slots [#foo #bar #baz]) quux] (f foo bar baz)))} @@ -5391,7 +5399,7 @@ )) (macro: #export (with-expansions tokens) - {#;doc (doc "Controlled macro-expansion." + {#.doc (doc "Controlled macro-expansion." "Bind an arbitraty number of Codes resulting from macro-expansion to local bindings." "Wherever a binding appears, the bound Codes will be spliced in there." (test: "Code operations & structures" @@ -5401,18 +5409,18 @@ (compare (:: Code/encode show )) (compare true (:: Eq = ))] - [(bool true) "true" [_ (#;Bool true)]] - [(bool false) "false" [_ (#;Bool false)]] - [(int 123) "123" [_ (#;Int 123)]] - [(frac 123.0) "123.0" [_ (#;Frac 123.0)]] - [(text "\n") "\"\\n\"" [_ (#;Text "\n")]] - [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]] - [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]] - [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;Form (list [_ (#;Bool true)] [_ (#;Int 123)]))])] - [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;Tuple (list [_ (#;Bool true)] [_ (#;Int 123)]))])] - [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;Record (list [[_ (#;Bool true)] [_ (#;Int 123)]]))])] - [(local-tag "lol") "#lol" [_ (#;Tag ["" "lol"])]] - [(local-symbol "lol") "lol" [_ (#;Symbol ["" "lol"])]] + [(bool true) "true" [_ (#.Bool true)]] + [(bool false) "false" [_ (#.Bool false)]] + [(int 123) "123" [_ (#.Int 123)]] + [(frac 123.0) "123.0" [_ (#.Frac 123.0)]] + [(text "\n") "\"\\n\"" [_ (#.Text "\n")]] + [(tag ["yolo" "lol"]) "#yolo.lol" [_ (#.Tag ["yolo" "lol"])]] + [(symbol ["yolo" "lol"]) "yolo.lol" [_ (#.Symbol ["yolo" "lol"])]] + [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#.Form (list [_ (#.Bool true)] [_ (#.Int 123)]))])] + [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#.Tuple (list [_ (#.Bool true)] [_ (#.Int 123)]))])] + [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#.Record (list [[_ (#.Bool true)] [_ (#.Int 123)]]))])] + [(local-tag "lol") "#lol" [_ (#.Tag ["" "lol"])]] + [(local-symbol "lol") "lol" [_ (#.Symbol ["" "lol"])]] )] (test-all ))))} (case tokens @@ -5421,7 +5429,7 @@ (^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings')) (do Monad [expansion (macro-expand-once macro-expr)] - (case (place-tokens var-name expansion (` (;with-expansions + (case (place-tokens var-name expansion (` (.with-expansions [(~@ bindings')] (~@ bodies)))) (#Some output) @@ -5509,12 +5517,12 @@ )) (macro: #export (^~ tokens) - {#;doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns." + {#.doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns." "The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)." (def: (empty?' node) (All [K V] (-> (Node K V) Bool)) (case node - (^~ (#Base ;;clean-bitmap _)) + (^~ (#Base ..clean-bitmap _)) true _ @@ -5542,7 +5550,7 @@ (def: (case-level^ level) (-> Code (Meta [Code Code])) (case level - (^ [_ (#;Tuple (list expr binding))]) + (^ [_ (#Tuple (list expr binding))]) (return [expr binding]) _ @@ -5552,10 +5560,10 @@ (def: (multi-level-case^ levels) (-> (List Code) (Meta Multi-Level-Case)) (case levels - #;Nil + #Nil (fail "Multi-level patterns cannot be empty.") - (#;Cons init extras) + (#Cons init extras) (do Monad [extras' (monad/map Monad case-level^ extras)] (wrap [init extras'])))) @@ -5568,47 +5576,47 @@ (~ success) (~ g!_) - #;None))) - (` (#;Some (~ body))) + #.None))) + (` (#.Some (~ body))) (: (List [Code Code]) (list/reverse levels)))] (list init-pattern inner-pattern-body))) (macro: #export (^multi tokens) - {#;doc (doc "Multi-level pattern matching." + {#.doc (doc "Multi-level pattern matching." "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#;Some [chunk uri']) [(text/= static chunk) true]) + (^multi (#.Some [chunk uri']) [(text/= static chunk) true]) (match-uri endpoint? parts' uri') _ - (#;Left (format "Static part " (%t static) " does not match URI: " uri))) + (#.Left (format "Static part " (%t static) " does not match URI: " uri))) "Short-cuts can be taken when using boolean tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#;Some [chunk uri']) (text/= static chunk)) + (^multi (#.Some [chunk uri']) (text/= static chunk)) (match-uri endpoint? parts' uri') _ - (#;Left (format "Static part " (%t static) " does not match URI: " uri))))} + (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens - (^ (list& [_meta (#;Form levels)] body next-branches)) + (^ (list& [_meta (#Form levels)] body next-branches)) (do Monad [mlc (multi-level-case^ levels) expected get-expected-type g!temp (gensym "temp")] (let [output (list g!temp - (` ("lux case" ("lux check" (#;Apply (~ (type-to-code expected)) Maybe) + (` ("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)) + #.None)) + {(#Some (~ g!temp)) (~ g!temp) - #;None + #None (case (~ g!temp) (~@ next-branches))})))] (wrap output))) @@ -5617,15 +5625,15 @@ (fail "Wrong syntax for ^multi"))) (macro: #export (ident-for tokens) - {#;doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." - (ident-for #;doc) + {#.doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." + (ident-for #.doc) "=>" ["lux" "doc"])} (case tokens (^template [] (^ (list [_ ( [prefix name])])) (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) - ([#;Symbol] [#;Tag]) + ([#Symbol] [#Tag]) _ (fail "Wrong syntax for ident-for"))) @@ -5655,16 +5663,16 @@ (def: (list-at idx xs) (All [a] (-> Nat (List a) (Maybe a))) (case xs - #;Nil - #;None + #Nil + #None - (#;Cons x xs') + (#Cons x xs') (if (n/= +0 idx) - (#;Some x) + (#Some x) (list-at (n/dec idx) xs')))) (macro: #export ($ tokens) - {#;doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." + {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, +0 corresponds to the 'a' variable." (def: #export (from-list list) (All [a] (-> (List a) (Sequence a))) @@ -5677,17 +5685,17 @@ (do Monad [stvs get-scope-type-vars] (case (list-at idx (list/reverse stvs)) - (#;Some var-id) + (#Some var-id) (wrap (list (` (#Ex (~ (nat$ var-id)))))) - #;None + #None (fail (text/compose "Indexed-type does not exist: " (nat/encode idx))))) _ (fail "Wrong syntax for $"))) (def: #export (is reference sample) - {#;doc (doc "Tests whether the 2 values are identical (not just \"equal\")." + {#.doc (doc "Tests whether the 2 values are identical (not just \"equal\")." "This one should succeed:" (let [value 5] (is value value)) @@ -5698,13 +5706,13 @@ ("lux is" reference sample)) (macro: #export (^@ tokens) - {#;doc (doc "Allows you to simultaneously bind and de-structure a value." + {#.doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash _])) (list/fold (function [elem acc] (n/+ (:: Hash hash elem) acc)) +0 (to-list set))))} (case tokens - (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] pattern))] body branches)) + (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches)) (let [g!whole (symbol$ ["" name])] (return (list& g!whole (` (case (~ g!whole) (~ pattern) (~ body))) @@ -5714,12 +5722,12 @@ (fail "Wrong syntax for ^@"))) (macro: #export (^|> tokens) - {#;doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." + {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." (case input (^|> value [n/inc (n/% +10) (n/max +1)]) (foo value)))} (case tokens - (^ (list& [_meta (#;Form (list [_ (#;Symbol ["" name])] [_ (#;Tuple steps)]))] body branches)) + (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches)) (let [g!name (symbol$ ["" name])] (return (list& g!name (` (let [(~ g!name) (|> (~ g!name) (~@ steps))] @@ -5730,7 +5738,7 @@ (fail "Wrong syntax for ^|>"))) (macro: #export (:!! tokens) - {#;doc (doc "Coerces the given expression to the type of whatever is expected." + {#.doc (doc "Coerces the given expression to the type of whatever is expected." (: Dinosaur (:!! (list 1 2 3))))} (case tokens (^ (list expr)) @@ -5742,27 +5750,27 @@ (fail "Wrong syntax for :!!"))) (macro: #export (undefined tokens) - {#;doc (doc "Meant to be used as a stand-in for functions with undefined implementations." + {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." "Undefined expressions will type-check against everything, so they make good dummy implementations." "However, if an undefined expression is ever evaluated, it will raise a runtime error." (def: (square x) (-> Int Int) (undefined)))} (case tokens - #;Nil + #Nil (return (list (` (error! "Undefined behavior.")))) _ (fail "Wrong syntax for undefined"))) (macro: #export (type-of tokens) - {#;doc (doc "Generates the type corresponding to a given definition or variable." + {#.doc (doc "Generates the type corresponding to a given definition or variable." (let [my-num (: Int 123)] (type-of my-num)) "==" Int)} (case tokens - (^ (list [_ (#;Symbol var-name)])) + (^ (list [_ (#Symbol var-name)])) (do Monad [var-type (find-type var-name)] (wrap (list (type-to-code var-type)))) @@ -5778,25 +5786,25 @@ (-> (List Code) (Meta [(Maybe Export-Level') (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "export"])] tokens')) - (return [(#;Some #Export) tokens']) + (return [(#Some #Export) tokens']) (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (return [(#;Some #Hidden) tokens']) + (return [(#Some #Hidden) tokens']) _ - (return [#;None tokens]) + (return [#None tokens]) )) (def: (gen-export-level ?export-level) (-> (Maybe Export-Level') (List Code)) (case ?export-level - #;None + #None (list) - (#;Some #Export) + (#Some #Export) (list (' #export)) - (#;Some #Hidden) + (#Some #Hidden) (list (' #hidden)) )) @@ -5851,7 +5859,7 @@ )) (macro: #export (template: tokens) - {#;doc (doc "Define macros in the style of do-template and ^template." + {#.doc (doc "Define macros in the style of do-template and ^template." "For simple macros that do not need any fancy features." (template: (square x) (i/* x x)))} @@ -5876,16 +5884,16 @@ (~ anns) (case (~ g!tokens) (^ (list (~@ (map (|>> [""] symbol$) args)))) - (#;Right [(~ g!compiler) + (#.Right [(~ g!compiler) (list (` (~ (replace-syntax rep-env input-template))))]) (~ g!_) - (#;Left (~ (text$ (text/compose "Wrong syntax for " name)))) + (#.Left (~ (text$ (text/compose "Wrong syntax for " name)))) ))))) )) (macro: #export (as-is tokens compiler) - (#;Right [compiler tokens])) + (#Right [compiler tokens])) (macro: #export (char tokens compiler) (case tokens @@ -5894,10 +5902,10 @@ (|> ("lux text char" input +0) (default (undefined)) nat$ list - [compiler] #;Right) + [compiler] #Right) _ - (#;Left "Wrong syntax for char"))) + (#Left "Wrong syntax for char"))) (def: #export (when test f) (All [a] (-> Bool (-> a a) (-> a a))) @@ -5907,25 +5915,25 @@ value))) (type: #export (Array a) - {#;doc "Mutable arrays."} - (#;Primitive "#Array" (#;Cons a #;Nil))) + {#.doc "Mutable arrays."} + (#.Primitive "#Array" (#.Cons a #.Nil))) (def: target (Meta Text) (function [compiler] - (#;Right [compiler (get@ [#info #target] compiler)]))) + (#Right [compiler (get@ [#info #target] compiler)]))) (def: (pick-for-target target options) (-> Text (List [Code Code]) (Maybe Code)) (case options - #;Nil - #;None + #Nil + #None - (#;Cons [key value] options') + (#Cons [key value] options') (case key (^multi [_ (#Text platform)] (text/= target platform)) - (#;Some value) + (#Some value) _ (pick-for-target target options')) @@ -5937,14 +5945,14 @@ (case tokens (^ (list [_ (#Record options)])) (case (pick-for-target target options) - (#;Some pick) + (#Some pick) (wrap (list pick)) - #;None + #None (fail ($_ text/compose "No code for target platform: " target))) (^ (list [_ (#Record options)] default)) - (wrap (list (;;default default (pick-for-target target options)))) + (wrap (list (..default default (pick-for-target target options)))) _ (fail "Wrong syntax for 'for'")))) @@ -6017,7 +6025,7 @@ last (#Cons [init inits']) - (` (#;Cons (~ init) (~ (untemplate-list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplate-list& last inits')))))) (def: (untemplate-pattern pattern) (-> Code (Meta Code)) @@ -6046,7 +6054,7 @@ (wrap (` [(~ =key) (~ =value)])))) fields) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (#;Record (~ (untemplate-list =fields)))]))) + (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))]))) [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))] (return unquoted) @@ -6057,8 +6065,8 @@ (^template [] [_ ( elems)] (case (list/reverse elems) - (#;Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - inits) + (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + inits) (do Monad [=inits (monad/map Monad untemplate-pattern (list/reverse inits)) g!meta (gensym "g!meta")] @@ -6069,12 +6077,12 @@ [=elems (monad/map Monad untemplate-pattern elems) g!meta (gensym "g!meta")] (wrap (` [(~ g!meta) ( (~ (untemplate-list =elems)))]))))) - ([#;Tuple] [#;Form]) + ([#Tuple] [#Form]) )) (macro: #export (^code tokens) (case tokens - (^ (list& [_meta (#;Form (list template))] body branches)) + (^ (list& [_meta (#Form (list template))] body branches)) (do Monad [pattern (untemplate-pattern template)] (wrap (list& pattern body branches))) -- cgit v1.2.3