From 68d28495c9a2014d7b25ff028e955bf8f1ca8dee Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 10 Apr 2017 21:51:13 -0400 Subject: - Renamed lambda' and lambda'' to function' and function''. --- stdlib/source/lux.lux | 1226 ++++++++++++++++++++++++------------------------- 1 file changed, 613 insertions(+), 613 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0b92fb023..16077a0e3 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -677,7 +677,7 @@ (#AppT Meta Cursor)) AST) (_lux_lambda _ data - [_cursor data])) + [_cursor data])) #Nil) (_lux_def return @@ -688,8 +688,8 @@ (#ProdT Compiler (#BoundT +1)))))) (_lux_lambda _ val - (_lux_lambda _ state - (#Right state val)))) + (_lux_lambda _ state + (#Right state val)))) #Nil) (_lux_def fail @@ -700,8 +700,8 @@ (#ProdT Compiler (#BoundT +1)))))) (_lux_lambda _ msg - (_lux_lambda _ state - (#Left msg)))) + (_lux_lambda _ state + (#Left msg)))) #Nil) (_lux_def bool$ @@ -773,52 +773,52 @@ (_lux_def let'' (_lux_: Macro (_lux_lambda _ tokens - (_lux_case tokens - (#Cons lhs (#Cons rhs (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"]) - (#Cons rhs (#Cons lhs (#Cons body #Nil))))) - #Nil)) + (_lux_case tokens + (#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"]) + (#Cons rhs (#Cons lhs (#Cons body #Nil))))) + #Nil)) - _ - (fail "Wrong syntax for let''")))) + _ + (fail "Wrong syntax for let''")))) default-macro-meta) -(_lux_def lambda'' +(_lux_def function'' (_lux_: Macro (_lux_lambda _ tokens - (_lux_case tokens - (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)) - (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) - (#Cons (_meta (#SymbolS "" "")) - (#Cons arg - (#Cons (_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''")) - (#Cons (_meta (#TupleS args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))) - (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) - (#Cons (_meta (#SymbolS "" self)) - (#Cons arg - (#Cons (_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''")) - (#Cons (_meta (#TupleS args')) - (#Cons body #Nil)))))) - #Nil)))))) - #Nil)) - - _ - (fail "Wrong syntax for lambda''")))) + (_lux_case tokens + (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)) + (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) + (#Cons (_meta (#SymbolS "" "")) + (#Cons arg + (#Cons (_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "function''")) + (#Cons (_meta (#TupleS args')) + (#Cons body #Nil)))))) + #Nil)))))) + #Nil)) + + (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))) + (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) + (#Cons (_meta (#SymbolS "" self)) + (#Cons arg + (#Cons (_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "function''")) + (#Cons (_meta (#TupleS args')) + (#Cons body #Nil)))))) + #Nil)))))) + #Nil)) + + _ + (fail "Wrong syntax for function''")))) default-macro-meta) (_lux_def export?-meta @@ -850,84 +850,84 @@ (_lux_def with-export-meta (_lux_: (#LambdaT AST AST) - (lambda'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons export?-meta - (#Cons tail #Nil)))))) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons export?-meta + (#Cons tail #Nil)))))) #Nil) (_lux_def with-hidden-meta (_lux_: (#LambdaT AST AST) - (lambda'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons hidden?-meta - (#Cons tail #Nil)))))) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons hidden?-meta + (#Cons tail #Nil)))))) #Nil) (_lux_def with-macro-meta (_lux_: (#LambdaT AST AST) - (lambda'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons macro?-meta - (#Cons tail #Nil)))))) + (function'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons macro?-meta + (#Cons tail #Nil)))))) #Nil) (_lux_def def:'' (_lux_: Macro - (lambda'' [tokens] - (_lux_case tokens - (#Cons [[_ (#TagS ["" "export"])] - (#Cons [[_ (#FormS (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (with-export-meta meta) #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (with-export-meta meta) #Nil)])])]))) - #Nil])) - - (#Cons [[_ (#FormS (#Cons [name args]))] - (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons meta #Nil)])])]))) - #Nil])) - - (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons meta #Nil)])])]))) - #Nil])) + (function'' [tokens] + (_lux_case tokens + (#Cons [[_ (#TagS ["" "export"])] + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "function''"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (with-export-meta meta) #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (with-export-meta meta) #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "function''"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons meta #Nil)])])]))) + #Nil])) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons meta #Nil)])])]))) + #Nil])) - _ - (fail "Wrong syntax for def''")) - )) + _ + (fail "Wrong syntax for def''")) + )) default-macro-meta) (def:'' (macro:' tokens) @@ -1060,10 +1060,10 @@ [meta (#RecordS slots)] [meta (#RecordS (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST)) - (lambda'' [slot] - (_lux_case slot - [k v] - [(replace-syntax reps k) (replace-syntax reps v)]))) + (function'' [slot] + (_lux_case slot + [k v] + [(replace-syntax reps k) (replace-syntax reps v)]))) slots))] _ @@ -1079,9 +1079,9 @@ [_ (#RecordS pairs)] (record$ (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST)) - (lambda'' [pair] - (let'' [name val] pair - [name (update-bounds val)]))) + (function'' [pair] + (let'' [name val] pair + [name (update-bounds val)]))) pairs)) [_ (#FormS (#Cons [_ (#TagS "lux" "BoundT")] (#Cons [_ (#NatS idx)] #Nil)))] @@ -1105,7 +1105,7 @@ (next #Nil) (#Cons [_ (#SymbolS "" arg-name)] args') - (parse-quantified-args args' (lambda'' [names] (next (#Cons arg-name names)))) + (parse-quantified-args args' (function'' [names] (next (#Cons arg-name names)))) _ (fail "Expected symbol.") @@ -1136,7 +1136,7 @@ #Nil (#UnivQ #Nil (#LambdaT ($' List (#BoundT +1)) Int)) - (fold (lambda'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) + (fold (function'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) (macro:' #export (All tokens) (#Cons [["lux" "doc"] (#TextA "## Universal quantification. @@ -1157,31 +1157,31 @@ (_lux_case tokens (#Cons [_ (#TupleS args)] (#Cons body #Nil)) (parse-quantified-args args - (lambda'' [names] - (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) - (lambda'' [name' body'] - (form$ (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons (_lux_case [(Text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) + (function'' [names] + (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons (_lux_case [(Text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) _ (fail "Wrong syntax for All")) @@ -1208,31 +1208,31 @@ (_lux_case tokens (#Cons [_ (#TupleS args)] (#Cons body #Nil)) (parse-quantified-args args - (lambda'' [names] - (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) - (lambda'' [name' body'] - (form$ (#Cons (tag$ ["lux" "ExQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) - (update-bounds body')) #Nil)))))) - body - names) - (return (#Cons (_lux_case [(Text/= "" self-name) names] - [true _] - body' - - [_ #;Nil] - body' - - [false _] - (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] - [+2 (_lux_proc ["nat" "-"] - [(_lux_proc ["int" "to-nat"] - [(length names)]) - +1])]))] - #Nil) - body')) - #Nil))))) + (function'' [names] + (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["lux" "ExQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons (_lux_case [(Text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) _ (fail "Wrong syntax for Ex")) @@ -1241,7 +1241,7 @@ (def:'' (reverse list) #Nil (All [a] (#LambdaT ($' List a) ($' List a))) - (fold (lambda'' [head tail] (#Cons head tail)) + (fold (function'' [head tail] (#Cons head tail)) #Nil list)) @@ -1254,7 +1254,7 @@ (_lux_case (reverse tokens) (#Cons output inputs) (return (#Cons (fold (_lux_: (#LambdaT AST (#LambdaT AST AST)) - (lambda'' [i o] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil)))))) + (function'' [i o] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil)))))) output inputs) #Nil)) @@ -1266,10 +1266,10 @@ (#Cons [["lux" "doc"] (#TextA "## List-construction macro. (list 1 2 3)")] #;Nil) - (return (#Cons (fold (lambda'' [head tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) - #Nil)))) + (return (#Cons (fold (function'' [head tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) (tag$ ["lux" "Nil"]) (reverse xs)) #Nil))) @@ -1281,9 +1281,9 @@ #;Nil) (_lux_case (reverse xs) (#Cons last init) - (return (list (fold (lambda'' [head tail] - (form$ (list (tag$ ["lux" "Cons"]) - (tuple$ (list head tail))))) + (return (list (fold (function'' [head tail] + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) last init))) @@ -1302,7 +1302,7 @@ (return (list (tag$ ["lux" "UnitT"]))) (#Cons last prevs) - (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right))) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right))) last prevs))) )) @@ -1319,12 +1319,12 @@ (return (list (tag$ ["lux" "VoidT"]))) (#Cons last prevs) - (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right))) + (return (list (fold (function'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right))) last prevs))) )) -(macro:' (lambda' tokens) +(macro:' (function' tokens) (let'' [name tokens'] (_lux_case tokens (#Cons [[_ (#SymbolS ["" name])] tokens']) [name tokens'] @@ -1335,22 +1335,22 @@ (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])]) (_lux_case args #Nil - (fail "lambda' requires a non-empty arguments tuple.") + (fail "function' requires a non-empty arguments tuple.") (#Cons [harg targs]) (return (list (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" name]) harg - (fold (lambda'' [arg body'] - (form$ (list (symbol$ ["" "_lux_lambda"]) - (symbol$ ["" ""]) - arg - body'))) + (fold (function'' [arg body'] + (form$ (list (symbol$ ["" "_lux_lambda"]) + (symbol$ ["" ""]) + arg + body'))) body (reverse targs))))))) _ - (fail "Wrong syntax for lambda'")))) + (fail "Wrong syntax for function'")))) (macro:' (def:''' tokens) (_lux_case tokens @@ -1361,7 +1361,7 @@ name (form$ (list (symbol$ ["" "_lux_:"]) type - (form$ (list (symbol$ ["lux" "lambda'"]) + (form$ (list (symbol$ ["lux" "function'"]) name (tuple$ args) body)))) @@ -1381,7 +1381,7 @@ name (form$ (list (symbol$ ["" "_lux_:"]) type - (form$ (list (symbol$ ["lux" "lambda'"]) + (form$ (list (symbol$ ["lux" "function'"]) name (tuple$ args) body)))) @@ -1412,10 +1412,10 @@ (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])]) (return (list (fold (_lux_: (-> (& AST AST) AST AST) - (lambda' [binding body] - (_lux_case binding - [label value] - (form$ (list (symbol$ ["" "_lux_case"]) value label body))))) + (function' [binding body] + (_lux_case binding + [label value] + (form$ (list (symbol$ ["" "_lux_case"]) value label body))))) body (reverse (as-pairs bindings))))) @@ -1493,7 +1493,7 @@ (#Cons op tokens') (_lux_case tokens' (#Cons first nexts) - (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2))) + (return (list (fold (function' [a1 a2] (form$ (list op a1 a2))) first nexts))) @@ -1514,7 +1514,7 @@ (#Cons op tokens') (_lux_case (reverse tokens') (#Cons last prevs) - (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2))) + (return (list (fold (function' [a1 a2] (form$ (list op a1 a2))) last prevs))) @@ -1544,31 +1544,31 @@ #Nil ($' Monad Maybe) {#wrap - (lambda' [x] (#Some x)) + (function' [x] (#Some x)) #bind - (lambda' [f ma] - (_lux_case ma - #None #None - (#Some a) (f a)))}) + (function' [f ma] + (_lux_case ma + #None #None + (#Some a) (f a)))}) (def:''' Monad #Nil ($' Monad Lux) {#wrap - (lambda' [x] - (lambda' [state] - (#Right state x))) + (function' [x] + (function' [state] + (#Right state x))) #bind - (lambda' [f ma] - (lambda' [state] - (_lux_case (ma state) - (#Left msg) - (#Left msg) + (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 @@ -1576,16 +1576,16 @@ (let' [g!wrap (symbol$ ["" "wrap"]) g!bind (symbol$ ["" " bind "]) body' (fold (_lux_: (-> (& AST AST) AST AST) - (lambda' [binding body'] - (let' [[var value] binding] - (_lux_case var - [_ (#TagS "" "let")] - (form$ (list (symbol$ ["lux" "let'"]) value body')) - - _ - (form$ (list g!bind - (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body')) - value)))))) + (function' [binding body'] + (let' [[var value] binding] + (_lux_case var + [_ (#TagS "" "let")] + (form$ (list (symbol$ ["lux" "let'"]) value body')) + + _ + (form$ (list g!bind + (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body')) + value)))))) body (reverse (as-pairs bindings)))] (return (list (form$ (list (symbol$ ["" "_lux_case"]) @@ -1733,17 +1733,17 @@ [elems' (_lux_: ($' Lux ($' List AST)) (mapM Monad (_lux_: (-> AST ($' Lux AST)) - (lambda' [elem] - (_lux_case elem - [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))] - (wrap spliced) + (function' [elem] + (_lux_case elem + [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) - _ - (do Monad - [=elem (untemplate elem)] - (wrap (form$ (list (symbol$ ["" "_lux_:"]) - (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) - (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) + _ + (do Monad + [=elem (untemplate elem)] + (wrap (form$ (list (symbol$ ["" "_lux_:"]) + (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) + (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) elems))] (wrap (wrap-meta (form$ (list tag (form$ (list& (symbol$ ["lux" "$_"]) @@ -1831,12 +1831,12 @@ (do Monad [=fields (mapM Monad (_lux_: (-> (& AST AST) ($' Lux AST)) - (lambda' [kv] - (let' [[k v] kv] - (do Monad - [=k (untemplate replace? subst k) - =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) + (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" "RecordS"]) (untemplate-list =fields)))))) )) @@ -1925,16 +1925,16 @@ (_lux_case tokens (#Cons [init apps]) (return (list (fold (_lux_: (-> AST AST AST) - (lambda' [app acc] - (_lux_case app - [_ (#TupleS parts)] - (tuple$ (List/append parts (list acc))) + (function' [app acc] + (_lux_case app + [_ (#TupleS parts)] + (tuple$ (List/append parts (list acc))) - [_ (#FormS parts)] - (form$ (List/append parts (list acc))) + [_ (#FormS parts)] + (form$ (List/append parts (list acc))) - _ - (` ((~ app) (~ acc)))))) + _ + (` ((~ app) (~ acc)))))) init apps))) @@ -1952,16 +1952,16 @@ (_lux_case (reverse tokens) (#Cons [init apps]) (return (list (fold (_lux_: (-> AST AST AST) - (lambda' [app acc] - (_lux_case app - [_ (#TupleS parts)] - (tuple$ (List/append parts (list acc))) + (function' [app acc] + (_lux_case app + [_ (#TupleS parts)] + (tuple$ (List/append parts (list acc))) - [_ (#FormS parts)] - (form$ (List/append parts (list acc))) + [_ (#FormS parts)] + (form$ (List/append parts (list acc))) - _ - (` ((~ app) (~ acc)))))) + _ + (` ((~ app) (~ acc)))))) init apps))) @@ -1972,7 +1972,7 @@ (list [["lux" "doc"] (#TextA "Function composition.")]) (All [a b c] (-> (-> b c) (-> a b) (-> a c))) - (lambda' [x] (f (g x)))) + (function' [x] (f (g x)))) (def:''' (get-ident x) #Nil @@ -2034,9 +2034,9 @@ [meta (#RecordS members)] [meta (#RecordS (map (_lux_: (-> (& AST AST) (& AST AST)) - (lambda' [kv] - (let' [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) + (function' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) members))] _ @@ -2057,7 +2057,7 @@ #Nil (All [a] (-> (-> a Bool) ($' List a) Bool)) - (fold (lambda' [_2 _1] (if _1 (p _2) false)) true xs)) + (fold (function' [_2 _1] (if _1 (p _2) false)) true xs)) (macro:' #export (do-template tokens) (list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. @@ -2074,9 +2074,9 @@ (mapM Monad tuple->list data)] [(#Some bindings') (#Some data')] (let' [apply (_lux_: (-> RepEnv ($' List AST)) - (lambda' [env] (map (apply-template env) templates))) + (function' [env] (map (apply-template env) templates))) num-bindings (length bindings')] - (if (every? (lambda' [sample] (_lux_proc ["int" "="] [num-bindings sample])) + (if (every? (function' [sample] (_lux_proc ["int" "="] [num-bindings sample])) (map length data')) (|> data' (join-map (. apply (make-env bindings'))) @@ -2219,12 +2219,12 @@ _ (let' [loop (_lux_: (-> Nat Text Text) - (lambda' recur [input output] - (if (_lux_proc ["nat" "="] [input +0]) - (_lux_proc ["text" "append"] ["+" output]) - (recur (_lux_proc ["nat" "/"] [input +10]) - (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) - output])))))] + (function' recur [input output] + (if (_lux_proc ["nat" "="] [input +0]) + (_lux_proc ["text" "append"] ["+" output]) + (recur (_lux_proc ["nat" "/"] [input +10]) + (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10])) + output])))))] (loop value "")))) (def:''' (Int/abs value) @@ -2243,12 +2243,12 @@ "" "-")] ((_lux_: (-> Int Text Text) - (lambda' recur [input output] - (if (i.= 0 input) - (_lux_proc ["text" "append"] [sign output]) - (recur (i./ 10 input) - (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text) - output]))))) + (function' recur [input output] + (if (i.= 0 input) + (_lux_proc ["text" "append"] [sign output]) + (recur (i./ 10 input) + (_lux_proc ["text" "append"] [(|> input (i.% 10) (_lux_:! Nat) digit-to-text) + output]))))) (|> value (i./ 10) Int/abs) (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text))))) @@ -2340,14 +2340,14 @@ (do Monad [current-module current-module-name] (let' [[module name] ident] - (lambda' [state] - (_lux_case state - {#info info #source source #modules modules - #scopes scopes #type-vars types #host host - #seed seed #expected expected - #cursor cursor - #scope-type-vars scope-type-vars} - (#Right state (find-macro' modules current-module module name))))))) + (function' [state] + (_lux_case state + {#info info #source source #modules modules + #scopes scopes #type-vars 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 @@ -2451,16 +2451,16 @@ [_ (#RecordS pairs)] (do Monad [pairs' (mapM Monad - (lambda' [kv] - (let' [[key val] kv] - (do Monad - [val' (macro-expand-all val)] - (_lux_case val' - (#;Cons val'' #;Nil) - (return [key val'']) + (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 AST."))))) + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single AST."))))) pairs)] (wrap (list (record$ pairs')))) @@ -2479,7 +2479,7 @@ [_ (#FormS (#Cons type-fn args))] (fold (_lux_: (-> AST AST AST) - (lambda' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg))))) + (function' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg))))) (walk-type type-fn) (map walk-type args)) @@ -2547,13 +2547,13 @@ (do Monad [members (mapM Monad (: (-> [AST AST] (Lux [Text AST])) - (lambda' [pair] - (_lux_case pair - [[_ (#TagS "" member-name)] member-type] - (return [member-name member-type]) + (function' [pair] + (_lux_case pair + [[_ (#TagS "" member-name)] member-type] + (return [member-name member-type]) - _ - (fail "Wrong syntax for variant case.")))) + _ + (fail "Wrong syntax for variant case.")))) pairs)] (return [(` (& (~@ (map second members)))) (#Some (map first members))])) @@ -2573,19 +2573,19 @@ (do Monad [members (mapM Monad (: (-> AST (Lux [Text AST])) - (lambda' [case] - (_lux_case case - [_ (#TagS "" member-name)] - (return [member-name (` Unit)]) - - [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))] - (return [member-name member-type]) + (function' [case] + (_lux_case case + [_ (#TagS "" member-name)] + (return [member-name (` Unit)]) + + [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))] + (return [member-name member-type]) - [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))] - (return [member-name (` (& (~@ member-types)))]) + [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))] + (return [member-name (` (& (~@ member-types)))]) - _ - (fail "Wrong syntax for variant case.")))) + _ + (fail "Wrong syntax for variant case.")))) (list& case cases))] (return [(` (| (~@ (map second members)))) (#Some (map first members))])) @@ -2634,7 +2634,7 @@ (#Cons value actions) (let' [dummy (symbol$ ["" ""])] (return (list (fold (_lux_: (-> AST AST AST) - (lambda' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) + (function' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) value actions)))) @@ -2671,7 +2671,7 @@ body _ - (` (lambda' (~ name) [(~@ args)] (~ body)))) + (` (function' (~ name) [(~@ args)] (~ body)))) body'' (_lux_case ?type (#Some type) (` (: (~ type) (~ body'))) @@ -2741,7 +2741,7 @@ [_ (#RecordS kvs)] ($_ Text/append "{" (|> kvs - (map (lambda' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v))))) + (map (function' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v))))) (interpose " ") reverse (fold Text/append "")) "}") @@ -2849,7 +2849,7 @@ _ (let' [pairs (|> patterns - (map (lambda' [pattern] (list pattern body))) + (map (function' [pattern] (list pattern body))) (List/join))] (return (List/append pairs branches)))) _ @@ -2875,11 +2875,11 @@ (if (multiple? 2 (length bindings)) (|> bindings as-pairs reverse (fold (: (-> [AST AST] AST AST) - (lambda' [lr body'] - (let' [[l r] lr] - (if (symbol? l) - (` (;_lux_case (~ r) (~ l) (~ body'))) - (` (case (~ r) (~ l) (~ body'))))))) + (function' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` (;_lux_case (~ r) (~ l) (~ body'))) + (` (case (~ r) (~ l) (~ body'))))))) body) list return) @@ -2910,11 +2910,11 @@ (let [g!blank (symbol$ ["" ""]) g!name (symbol$ ident) body+ (fold (: (-> AST AST AST) - (lambda' [arg body'] - (if (symbol? arg) - (` (;_lux_lambda (~ g!blank) (~ arg) (~ body'))) - (` (;_lux_lambda (~ g!blank) (~ g!blank) - (case (~ g!blank) (~ arg) (~ body'))))))) + (function' [arg body'] + (if (symbol? arg) + (` (;_lux_lambda (~ g!blank) (~ arg) (~ body'))) + (` (;_lux_lambda (~ g!blank) (~ g!blank) + (case (~ g!blank) (~ arg) (~ body'))))))) body (reverse tail))] (return (list (if (symbol? head) @@ -2964,14 +2964,14 @@ [=xs (mapM Monad (: (-> [AST AST] (Lux AST)) (lambda [[k v]] - (case k - [_ (#TextS =k)] - (do Monad - [=v (process-def-meta-value v)] - (wrap (tuple$ (list (text$ =k) =v)))) - - _ - (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k)))))) + (case k + [_ (#TextS =k)] + (do Monad + [=v (process-def-meta-value v)] + (wrap (tuple$ (list (text$ =k) =v)))) + + _ + (fail (Text/append "Wrong syntax for DictA key: " (ast-to-text k)))))) kvs)] (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs))))) )) @@ -2984,15 +2984,15 @@ [=kvs (mapM Monad (: (-> [AST AST] (Lux AST)) (lambda [[k v]] - (case k - [_ (#TagS [pk nk])] - (do Monad - [=v (process-def-meta-value v)] - (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk))) - =v)))) + (case k + [_ (#TagS [pk nk])] + (do Monad + [=v (process-def-meta-value v)] + (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk))) + =v)))) - _ - (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast)))))) + _ + (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast)))))) kvs)] (wrap (untemplate-list =kvs))) @@ -3008,14 +3008,14 @@ _ (` (#;Cons [["lux" "func-args"] (#;ListA (list (~@ (map (lambda [arg] - (` (#;TextA (~ (text$ (ast-to-text arg)))))) + (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))] (~ meta))))) (def:' (with-type-args args) (-> (List AST) AST) (` {#;type-args (#;ListA (list (~@ (map (lambda [arg] - (` (#;TextA (~ (text$ (ast-to-text arg)))))) + (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))})) (def:' Export-Level @@ -3225,18 +3225,18 @@ (mapM Monad (: (-> AST (Lux [Text AST])) (lambda [token] - (case token - (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) - (wrap [name type]) + (case token + (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) + (wrap [name type]) - _ - (fail "Signatures require typed members!")))) + _ + (fail "Signatures require typed members!")))) (List/join sigs'))) #let [[_module _name] name+ def-name (symbol$ name) sig-type (record$ (map (: (-> [Text AST] [AST AST]) (lambda [[m-name m-type]] - [(tag$ ["" m-name]) m-type])) + [(tag$ ["" m-name]) m-type])) members)) sig-meta (meta-ast-merge (` {#;sig? true}) meta) @@ -3468,16 +3468,16 @@ (def: (find-module name) (-> Text (Lux Module)) (lambda [state] - (let [{#info info #source source #modules modules - #scopes scopes #type-vars types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] - (case (get name modules) - (#Some module) - (#Right state module) + (let [{#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case (get name modules) + (#Some module) + (#Right state module) - _ - (#Left ($_ Text/append "Unknown module: " name)))))) + _ + (#Left ($_ Text/append "Unknown module: " name)))))) (def: get-current-module (Lux Module) @@ -3531,16 +3531,16 @@ (def: get-expected-type (Lux Type) (lambda [state] - (let [{#info info #source source #modules modules - #scopes scopes #type-vars types #host host - #seed seed #expected expected #cursor cursor - #scope-type-vars scope-type-vars} state] - (case expected - (#Some type) - (#Right state type) + (let [{#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case expected + (#Some type) + (#Right state type) - #None - (#Left "Not expecting any type."))))) + #None + (#Left "Not expecting any type."))))) (macro: #export (struct tokens) {#;doc "Not meant to be used directly. Prefer \"struct:\"."} @@ -3561,17 +3561,17 @@ members (mapM Monad (: (-> AST (Lux [AST AST])) (lambda [token] - (case token - (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value meta))]) - (case (get tag-name tag-mappings) - (#Some tag) - (wrap [tag value]) + (case token + (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value meta))]) + (case (get tag-name tag-mappings) + (#Some tag) + (wrap [tag value]) - _ - (fail (Text/append "Unknown structure member: " tag-name))) + _ + (fail (Text/append "Unknown structure member: " tag-name))) - _ - (fail "Invalid structure member.")))) + _ + (fail "Invalid structure member.")))) (List/join tokens'))] (wrap (list (record$ members))))) @@ -3619,12 +3619,12 @@ (case (: (Maybe (List Text)) (mapM Monad (lambda [sa] - (case sa - [_ (#;SymbolS [_ arg-name])] - (#;Some arg-name) + (case sa + [_ (#;SymbolS [_ arg-name])] + (#;Some arg-name) - _ - #;None)) + _ + #;None)) sig-args)) (^ (#;Some params)) (#;Some (symbol$ ["" ($_ Text/append sig-name "<" (|> params (interpose ",") Text/join) ">")])) @@ -3725,9 +3725,9 @@ (case tags?? (#Some tags) (` {#;tags [(~@ (map (: (-> Text AST) - (lambda' [tag] - (form$ (list (tag$ ["lux" "TextA"]) - (text$ tag))))) + (function' [tag] + (form$ (list (tag$ ["lux" "TextA"]) + (text$ tag))))) tags))] #;type? true}) @@ -3790,12 +3790,12 @@ (mapM Monad (: (-> AST (Lux Text)) (lambda [def] - (case def - [_ (#SymbolS ["" name])] - (return name) + (case def + [_ (#SymbolS ["" name])] + (return name) - _ - (fail "only/exclude requires symbols.")))) + _ + (fail "only/exclude requires symbols.")))) defs)) (def: (parse-alias tokens) @@ -3886,29 +3886,29 @@ (if (|> parts (map (: (-> AST Bool) (lambda [part] - (case part - (^or [_ (#TextS _)] [_ (#SymbolS _)]) - true + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true - _ - false)))) + _ + false)))) (fold (lambda [r l] (and l r)) true)) (let [openings (fold (: (-> AST (List Openings) (List Openings)) (lambda [part openings] - (case part - [_ (#TextS prefix)] - (list& [prefix (list)] openings) - - [_ (#SymbolS struct-name)] - (case openings - #Nil - (list ["" (list struct-name)]) - - (#Cons [prefix structs] openings') - (#Cons [prefix (#Cons struct-name structs)] openings')) - - _ - openings))) + (case part + [_ (#TextS prefix)] + (list& [prefix (list)] openings) + + [_ (#SymbolS struct-name)] + (case openings + #Nil + (list ["" (list struct-name)]) + + (#Cons [prefix structs] openings') + (#Cons [prefix (#Cons struct-name structs)] openings')) + + _ + openings))) (: (List Openings) (list)) parts)] (return [openings tokens'])) @@ -3922,29 +3922,29 @@ (if (|> parts (map (: (-> AST Bool) (lambda [part] - (case part - (^or [_ (#TextS _)] [_ (#SymbolS _)]) - true + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true - _ - false)))) + _ + false)))) (fold (lambda [r l] (and l r)) true)) (let [openings (fold (: (-> AST (List Openings) (List Openings)) (lambda [part openings] - (case part - [_ (#TextS prefix)] - (list& [prefix (list)] openings) - - [_ (#SymbolS struct-name)] - (case openings - #Nil - (list ["" (list struct-name)]) - - (#Cons [prefix structs] openings') - (#Cons [prefix (#Cons struct-name structs)] openings')) - - _ - openings))) + (case part + [_ (#TextS prefix)] + (list& [prefix (list)] openings) + + [_ (#SymbolS struct-name)] + (case openings + #Nil + (list ["" (list struct-name)]) + + (#Cons [prefix structs] openings') + (#Cons [prefix (#Cons struct-name structs)] openings')) + + _ + openings))) (: (List Openings) (list)) parts)] (return [openings (list)])) @@ -3954,14 +3954,14 @@ (-> Text (List Importation) (List Importation)) (map (: (-> Importation Importation) (lambda [importation] - (let [{#import-name _name - #import-alias _alias - #import-refer {#refer-defs _referrals - #refer-open _openings}} importation] - {#import-name ($_ Text/append super-name "/" _name) - #import-alias _alias - #import-refer {#refer-defs _referrals - #refer-open _openings}}))))) + (let [{#import-name _name + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}} importation] + {#import-name ($_ Text/append super-name "/" _name) + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}}))))) (def: (replace-all pattern value template) (-> Text Text Text Text) @@ -3995,60 +3995,60 @@ [imports' (mapM Monad (: (-> AST (Lux (List Importation))) (lambda [token] - (case token - [_ (#SymbolS "" m-name)] - (do Monad - [m-name (clean-module m-name)] - (wrap (list [m-name #None {#refer-defs #All - #refer-open (list)}]))) - - (^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))]) - (do Monad - [m-name (clean-module m-name) - alias+extra (parse-alias extra) - #let [[alias extra] alias+extra] - referral+extra (parse-referrals extra) - #let [[referral extra] referral+extra] - openings+extra (parse-openings extra) - #let [[openings extra] openings+extra] - sub-imports (parse-imports extra) - #let [sub-imports (decorate-sub-importations m-name sub-imports)]] - (wrap (case [referral alias openings] - [#Nothing #None #Nil] sub-imports - _ (list& {#import-name m-name - #import-alias alias - #import-refer {#refer-defs referral - #refer-open openings}} - sub-imports)))) - - (^ [_ (#TupleS (list& [_ (#TextS alias)] [_ (#SymbolS "" m-name)] extra))]) - (do Monad - [m-name (clean-module m-name) - referral+extra (parse-short-referrals extra) - #let [[referral extra] referral+extra] - 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-refer {#refer-defs referral - #refer-open openings}}))) - - (^ [_ (#TupleS (list& [_ (#SymbolS "" m-name)] extra))]) - (do Monad - [m-name (clean-module m-name) - referral+extra (parse-short-referrals extra) - #let [[referral extra] referral+extra] - openings+extra (parse-short-openings extra) - #let [[openings extra] openings+extra]] - (wrap (list {#import-name m-name - #import-alias (#;Some m-name) - #import-refer {#refer-defs referral - #refer-open openings}}))) + (case token + [_ (#SymbolS "" m-name)] + (do Monad + [m-name (clean-module m-name)] + (wrap (list [m-name #None {#refer-defs #All + #refer-open (list)}]))) + + (^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + alias+extra (parse-alias extra) + #let [[alias extra] alias+extra] + referral+extra (parse-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-openings extra) + #let [[openings extra] openings+extra] + sub-imports (parse-imports extra) + #let [sub-imports (decorate-sub-importations m-name sub-imports)]] + (wrap (case [referral alias openings] + [#Nothing #None #Nil] sub-imports + _ (list& {#import-name m-name + #import-alias alias + #import-refer {#refer-defs referral + #refer-open openings}} + sub-imports)))) + + (^ [_ (#TupleS (list& [_ (#TextS alias)] [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + referral+extra (parse-short-referrals extra) + #let [[referral extra] referral+extra] + 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-refer {#refer-defs referral + #refer-open openings}}))) + + (^ [_ (#TupleS (list& [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + referral+extra (parse-short-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-short-openings extra) + #let [[openings extra] openings+extra]] + (wrap (list {#import-name m-name + #import-alias (#;Some m-name) + #import-refer {#refer-defs referral + #refer-open openings}}))) - _ - (do Monad - [current-module current-module-name] - (fail (Text/append "Wrong syntax for import @ " current-module)))))) + _ + (do Monad + [current-module current-module-name] + (fail (Text/append "Wrong syntax for import @ " current-module)))))) imports)] (wrap (List/join imports')))) @@ -4065,13 +4065,13 @@ (let [to-alias (map (: (-> [Text Def] (List Text)) (lambda [[name [def-type def-meta def-value]]] - (case [(get-meta ["lux" "export?"] def-meta) - (get-meta ["lux" "hidden?"] def-meta)] - [(#Some (#BoolA true)) #;None] - (list name) + (case [(get-meta ["lux" "export?"] def-meta) + (get-meta ["lux" "hidden?"] def-meta)] + [(#Some (#BoolA true)) #;None] + (list name) - _ - (list)))) + _ + (list)))) (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module] defs))] (#Right state (List/join to-alias))) @@ -4094,8 +4094,8 @@ (def: (is-member? cases name) (-> (List Text) Text Bool) (let [output (fold (lambda [case prev] - (or prev - (Text/= case name))) + (or prev + (Text/= case name))) false cases)] output)) @@ -4116,15 +4116,15 @@ #scope-type-vars scope-type-vars} (find (: (-> Scope (Maybe Type)) (lambda [env] - (case env - {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}} - (try-both (find (: (-> [Text Analysis] (Maybe Type)) - (lambda [[bname [[type _] _]]] - (if (Text/= name bname) - (#Some type) - #None)))) - locals - closure)))) + (case env + {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}} + (try-both (find (: (-> [Text Analysis] (Maybe Type)) + (lambda [[bname [[type _] _]]] + (if (Text/= name bname) + (#Some type) + #None)))) + locals + closure)))) scopes))) (def: (find-def-type name state) @@ -4171,25 +4171,25 @@ [#let [[module name] ident] current-module current-module-name] (lambda [state] - (if (Text/= "" module) - (case (find-in-env name state) - (#Some struct-type) - (#Right state struct-type) + (if (Text/= "" module) + (case (find-in-env name state) + (#Some struct-type) + (#Right state struct-type) - _ - (case (find-def-type [current-module name] state) - (#Some struct-type) - (#Right state struct-type) + _ + (case (find-def-type [current-module name] state) + (#Some struct-type) + (#Right state struct-type) - _ - (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) - (case (find-def-type ident state) - (#Some struct-type) - (#Right state struct-type) + _ + (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) + (case (find-def-type ident state) + (#Some struct-type) + (#Right state struct-type) - _ - (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) - ))) + _ + (#Left ($_ Text/append "Unknown var: " (Ident/encode ident))))) + ))) (def: (zip2 xs ys) (All [a b] (-> (List a) (List b) (List [a b]))) @@ -4281,26 +4281,26 @@ (do Monad [full-body ((: (-> Ident [(List Ident) (List Type)] AST (Lux AST)) (lambda recur [source [tags members] target] - (let [pattern (record$ (map (lambda [[t-module t-name]] - [(tag$ [t-module t-name]) - (symbol$ ["" (Text/append prefix t-name)])]) - tags))] - (do Monad - [enhanced-target (foldM Monad - (lambda [[[_ m-name] m-type] enhanced-target] - (do Monad - [m-structure (resolve-type-tags m-type)] - (case m-structure - (#;Some m-tags&members) - (recur ["" (Text/append prefix m-name)] - m-tags&members - enhanced-target) - - #;None - (wrap enhanced-target)))) - target - (zip2 tags members))] - (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target)))))))) + (let [pattern (record$ (map (lambda [[t-module t-name]] + [(tag$ [t-module t-name]) + (symbol$ ["" (Text/append prefix t-name)])]) + tags))] + (do Monad + [enhanced-target (foldM Monad + (lambda [[[_ m-name] m-type] enhanced-target] + (do Monad + [m-structure (resolve-type-tags m-type)] + (case m-structure + (#;Some m-tags&members) + (recur ["" (Text/append prefix m-name)] + m-tags&members + enhanced-target) + + #;None + (wrap enhanced-target)))) + target + (zip2 tags members))] + (wrap (` (;_lux_case (~ (symbol$ source)) (~ pattern) (~ enhanced-target)))))))) name tags&members body)] (wrap (list full-body))))) @@ -4337,8 +4337,8 @@ (^ (list& else branches')) (return (list (fold (: (-> [AST AST] AST AST) (lambda [branch else] - (let [[right left] branch] - (` (if (~ left) (~ right) (~ else)))))) + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) else (as-pairs branches')))) @@ -4381,9 +4381,9 @@ (#Some members) (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [AST AST]) (lambda [[[r-prefix r-name] [r-idx r-type]]] - [(tag$ [r-prefix r-name]) (if (n.= idx r-idx) - g!output - g!_)])) + [(tag$ [r-prefix r-name]) (if (n.= idx r-idx) + g!output + g!_)])) (zip2 tags (enumerate members))))] (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output)))))) @@ -4393,7 +4393,7 @@ (^ (list [_ (#TupleS slots)] record)) (return (list (fold (: (-> AST AST AST) (lambda [slot inner] - (` (;;get@ (~ slot) (~ inner))))) + (` (;;get@ (~ slot) (~ inner))))) record slots))) @@ -4488,13 +4488,13 @@ current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) (lambda [module-name all-defs referred-defs] - (mapM Monad - (: (-> Text (Lux Unit)) - (lambda [_def] - (if (is-member? all-defs _def) - (return []) - (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) - referred-defs)))]] + (mapM Monad + (: (-> Text (Lux Unit)) + (lambda [_def] + (if (is-member? all-defs _def) + (return []) + (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + referred-defs)))]] (case options #;Nil (wrap {#refer-defs referral @@ -4513,13 +4513,13 @@ [current-module current-module-name #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) (lambda [module-name all-defs referred-defs] - (mapM Monad - (: (-> Text (Lux Unit)) - (lambda [_def] - (if (is-member? all-defs _def) - (return []) - (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) - referred-defs)))] + (mapM Monad + (: (-> Text (Lux Unit)) + (lambda [_def] + (if (is-member? all-defs _def) + (return []) + (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + referred-defs)))] defs' (case r-defs #All (exported-defs module-name) @@ -4540,15 +4540,15 @@ (wrap (list))) #let [defs (map (: (-> Text AST) (lambda [def] - (` (;_lux_def (~ (symbol$ ["" def])) - (~ (symbol$ [module-name def])) - (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])] - #Nil))))) + (` (;_lux_def (~ (symbol$ ["" def])) + (~ (symbol$ [module-name def])) + (#Cons [["lux" "alias"] (#IdentA [(~ (text$ module-name)) (~ (text$ def))])] + #Nil))))) defs') openings (join-map (: (-> Openings (List AST)) (lambda [[prefix structs]] - (map (lambda [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) - structs))) + (map (lambda [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) + structs))) r-opens)]] (wrap (List/append defs openings)) )) @@ -4581,7 +4581,7 @@ #Nothing (list))) =opens (join-map (lambda [[prefix structs]] - (list& (text$ prefix) (map symbol$ structs))) + (list& (text$ prefix) (map symbol$ structs))) r-opens)] (` (;;refer (~ (text$ module-name)) (~@ =defs) @@ -4625,11 +4625,11 @@ imports (parse-imports _imports) #let [=imports (map (: (-> Importation AST) (lambda [[m-name m-alias =refer]] - (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) + (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) imports) =refers (map (: (-> Importation AST) (lambda [[m-name m-alias =refer]] - (refer-to-ast m-name =refer))) + (refer-to-ast m-name =refer))) imports)] =meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])] _meta))) @@ -4678,19 +4678,19 @@ [pattern' (mapM Monad (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) (lambda [[r-slot-name [r-idx r-type]]] - (do Monad - [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (do Monad + [g!slot (gensym "")] + (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) r-var])) + [(tag$ r-slot-name) r-var])) pattern')) output (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n.= idx r-idx) - value - r-var)])) + [(tag$ r-slot-name) (if (n.= idx r-idx) + value + r-var)])) pattern'))] (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) @@ -4711,13 +4711,13 @@ #let [pairs (zip2 slots bindings) update-expr (fold (: (-> [AST AST] AST AST) (lambda [[s b] v] - (` (;;set@ (~ s) (~ v) (~ b))))) + (` (;;set@ (~ s) (~ v) (~ b))))) value (reverse pairs)) [_ accesses'] (fold (: (-> [AST AST] [AST (List (List AST))] [AST (List (List AST))]) (lambda [[new-slot new-binding] [old-record accesses']] - [(` (get@ (~ new-slot) (~ new-binding))) - (#;Cons (list new-binding old-record) accesses')])) + [(` (get@ (~ new-slot) (~ new-binding))) + (#;Cons (list new-binding old-record) accesses')])) [record (: (List (List AST)) #;Nil)] pairs) accesses (List/join (reverse accesses'))]] @@ -4764,19 +4764,19 @@ [pattern' (mapM Monad (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) (lambda [[r-slot-name [r-idx r-type]]] - (do Monad - [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (do Monad + [g!slot (gensym "")] + (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) r-var])) + [(tag$ r-slot-name) r-var])) pattern')) output (record$ (map (: (-> [Ident Nat AST] [AST AST]) (lambda [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n.= idx r-idx) - (` ((~ fun) (~ r-var))) - r-var)])) + [(tag$ r-slot-name) (if (n.= idx r-idx) + (` ((~ fun) (~ r-var))) + r-var)])) pattern'))] (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) @@ -5017,8 +5017,8 @@ (^template [ ] [group-cursor ( parts)] (let [[group-cursor' parts-text] (fold (lambda [part [last-cursor text-accum]] - (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] - [part-cursor (Text/append text-accum part-text)])) + (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] + [part-cursor (Text/append text-accum part-text)])) [(delim-update-cursor group-cursor) ""] ( parts))] [(delim-update-cursor group-cursor') @@ -5149,7 +5149,7 @@ (return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types)) (~ (type-to-ast expected))) (lambda (~ (symbol$ ["" "recur"])) [(~@ vars)] - (~ body))) + (~ body))) (~@ inits)))))) (do Monad [aliases (mapM Monad @@ -5193,10 +5193,10 @@ (list& hslot tslots)) pattern (record$ (map (: (-> Ident [AST AST]) (lambda [[module name]] - (let [tag (tag$ [module name])] - (case (get name slot-pairings) - (#Some binding) [tag binding] - #None [tag g!_])))) + (let [tag (tag$ [module name])] + (case (get name slot-pairings) + (#Some binding) [tag binding] + #None [tag g!_])))) tags))]] (return (list& pattern body branches))) @@ -5228,15 +5228,15 @@ [=pairs (mapM Monad (: (-> [AST AST] (Maybe [AST AST])) (lambda [[slot value]] - (do Monad - [slot' (place-tokens label tokens slot) - value' (place-tokens label tokens value)] - (case [slot' value'] - (^ [(list =slot) (list =value)]) - (wrap [=slot =value]) + (do Monad + [slot' (place-tokens label tokens slot) + value' (place-tokens label tokens value)] + (case [slot' value'] + (^ [(list =slot) (list =value)]) + (wrap [=slot =value]) - _ - #None)))) + _ + #None)))) pairs)] (wrap (list (record$ =pairs)))) )) @@ -5349,9 +5349,9 @@ [=pairs (mapM Monad (: (-> [AST AST] (Lux [AST AST])) (lambda [[slot value]] - (do Monad - [=value (anti-quote value)] - (wrap [slot =value])))) + (do Monad + [=value (anti-quote value)] + (wrap [slot =value])))) pairs)] (wrap [meta (#RecordS =pairs)])) @@ -5414,12 +5414,12 @@ (def: (multi-level-case$ g!_ [[init-pattern levels] body]) (-> AST [MultiLevelCase AST] (List AST)) (let [inner-pattern-body (fold (lambda [[calculation pattern] success] - (` (case (~ calculation) - (~ pattern) - (~ success) + (` (case (~ calculation) + (~ pattern) + (~ success) - (~ g!_) - #;None))) + (~ g!_) + #;None))) (` (#;Some (~ body))) (: (List [AST AST]) (reverse levels)))] (list init-pattern inner-pattern-body))) @@ -5658,12 +5658,12 @@ (do Monad [args (mapM Monad (lambda [arg'] - (case arg' - [_ (#SymbolS ["" arg-name])] - (wrap arg-name) + (case arg' + [_ (#SymbolS ["" arg-name])] + (wrap arg-name) - _ - (fail "Couldn't parse an argument."))) + _ + (fail "Couldn't parse an argument."))) args')] (wrap [[name args] tokens'])) @@ -5720,7 +5720,7 @@ g!compiler (gensym "compiler") g!_ (gensym "_") #let [rep-env (map (lambda [arg] - [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) + [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) args)]] (wrap (list (` (macro: (~@ (gen-export-level ?export-level)) ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) -- cgit v1.2.3