From 693466dec80764358acea002f0ccfd5f0de17300 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 10 Apr 2017 22:53:51 -0400 Subject: - Renamed "lambda" to "function". --- stdlib/source/lux.lux | 724 +++++++++++++++++++++++++------------------------- 1 file changed, 362 insertions(+), 362 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 16077a0e3..4d5885393 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2888,14 +2888,14 @@ _ (fail "Wrong syntax for let"))) -(macro:' #export (lambda tokens) +(macro:' #export (function tokens) (list [["lux" "doc"] (#TextA "## Syntax for creating functions. ## Allows for giving the function itself a name, for the sake of recursion. (: (All [a b] (-> a b a)) - (lambda [x y] x)) + (function [x y] x)) (: (All [a b] (-> a b a)) - (lambda const [x y] x))")]) + (function const [x y] x))")]) (case (: (Maybe [Ident AST (List AST) AST]) (case tokens (^ (list [_ (#TupleS (#Cons head tail))] body)) @@ -2922,7 +2922,7 @@ (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) #None - (fail "Wrong syntax for lambda"))) + (fail "Wrong syntax for function"))) (def:' (process-def-meta-value ast) (-> AST (Lux AST)) @@ -2963,15 +2963,15 @@ (do Monad [=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)))))) + (function [[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)))))) kvs)] (wrap (form$ (list (tag$ ["lux" "DictA"]) (untemplate-list =xs))))) )) @@ -2983,16 +2983,16 @@ (do Monad [=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)))) + (function [[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)))) - _ - (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))) @@ -3007,15 +3007,15 @@ _ (` (#;Cons [["lux" "func-args"] - (#;ListA (list (~@ (map (lambda [arg] - (` (#;TextA (~ (text$ (ast-to-text arg)))))) + (#;ListA (list (~@ (map (function [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)))))) + (` {#;type-args (#;ListA (list (~@ (map (function [arg] + (` (#;TextA (~ (text$ (ast-to-text arg)))))) args))))})) (def:' Export-Level @@ -3095,7 +3095,7 @@ body _ - (` (lambda (~ name) [(~@ args)] (~ body)))) + (` (function (~ name) [(~@ args)] (~ body)))) body (case ?type (#Some type) (` (: (~ type) (~ body))) @@ -3224,19 +3224,19 @@ members (: (Lux (List [Text AST])) (mapM Monad (: (-> AST (Lux [Text AST])) - (lambda [token] - (case token - (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) - (wrap [name type]) + (function [token] + (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])) + (function [[m-name m-type]] + [(tag$ ["" m-name]) m-type])) members)) sig-meta (meta-ast-merge (` {#;sig? true}) meta) @@ -3467,17 +3467,17 @@ (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) + (function [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) - _ - (#Left ($_ Text/append "Unknown module: " name)))))) + _ + (#Left ($_ Text/append "Unknown module: " name)))))) (def: get-current-module (Lux Module) @@ -3530,17 +3530,17 @@ (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) - - #None - (#Left "Not expecting any type."))))) + (function [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) + + #None + (#Left "Not expecting any type."))))) (macro: #export (struct tokens) {#;doc "Not meant to be used directly. Prefer \"struct:\"."} @@ -3556,22 +3556,22 @@ _ (fail "No tags available for type."))) #let [tag-mappings (: (List [Text AST]) - (map (lambda [tag] [(second tag) (tag$ tag)]) + (map (function [tag] [(second tag) (tag$ tag)]) tags))] 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]) + (function [token] + (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))))) @@ -3618,13 +3618,13 @@ (^ [_ (#;FormS (list& [_ (#;SymbolS [_ sig-name])] sig-args))]) (case (: (Maybe (List Text)) (mapM Monad - (lambda [sa] - (case sa - [_ (#;SymbolS [_ arg-name])] - (#;Some arg-name) + (function [sa] + (case sa + [_ (#;SymbolS [_ arg-name])] + (#;Some arg-name) - _ - #;None)) + _ + #;None)) sig-args)) (^ (#;Some params)) (#;Some (symbol$ ["" ($_ Text/append sig-name "<" (|> params (interpose ",") Text/join) ">")])) @@ -3670,7 +3670,7 @@ (case (reverse tokens) (^ (list& last init)) (return (list (fold (: (-> AST AST AST) - (lambda [pre post] (`
))) + (function [pre post] (` ))) last init))) @@ -3789,13 +3789,13 @@ (-> (List AST) (Lux (List Text))) (mapM Monad (: (-> AST (Lux Text)) - (lambda [def] - (case def - [_ (#SymbolS ["" name])] - (return name) + (function [def] + (case def + [_ (#SymbolS ["" name])] + (return name) - _ - (fail "only/exclude requires symbols.")))) + _ + (fail "only/exclude requires symbols.")))) defs)) (def: (parse-alias tokens) @@ -3885,30 +3885,30 @@ (^ (list& [_ (#TagS "" "open")] [_ (#FormS parts)] tokens')) (if (|> parts (map (: (-> AST Bool) - (lambda [part] - (case part - (^or [_ (#TextS _)] [_ (#SymbolS _)]) - true - - _ - false)))) - (fold (lambda [r l] (and l r)) true)) + (function [part] + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true + + _ + false)))) + (fold (function [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))) + (function [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))) (: (List Openings) (list)) parts)] (return [openings tokens'])) @@ -3921,30 +3921,30 @@ (-> (List AST) (Lux [(List Openings) (List AST)])) (if (|> parts (map (: (-> AST Bool) - (lambda [part] - (case part - (^or [_ (#TextS _)] [_ (#SymbolS _)]) - true + (function [part] + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true - _ - false)))) - (fold (lambda [r l] (and l r)) true)) + _ + false)))) + (fold (function [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))) + (function [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))) (: (List Openings) (list)) parts)] (return [openings (list)])) @@ -3953,15 +3953,15 @@ (def: (decorate-sub-importations super-name) (-> 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}}))))) + (function [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}}))))) (def: (replace-all pattern value template) (-> Text Text Text Text) @@ -3994,61 +3994,61 @@ (do Monad [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}}))) + (function [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}}))) - _ - (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')))) @@ -4064,14 +4064,14 @@ (#Some =module) (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) + (function [[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) - _ - (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))) @@ -4093,9 +4093,9 @@ (def: (is-member? cases name) (-> (List Text) Text Bool) - (let [output (fold (lambda [case prev] - (or prev - (Text/= case name))) + (let [output (fold (function [case prev] + (or prev + (Text/= case name))) false cases)] output)) @@ -4115,16 +4115,16 @@ #seed seed #expected expected #cursor cursor #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)))) + (function [env] + (case env + {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}} + (try-both (find (: (-> [Text Analysis] (Maybe Type)) + (function [[bname [[type _] _]]] + (if (Text/= name bname) + (#Some type) + #None)))) + locals + closure)))) scopes))) (def: (find-def-type name state) @@ -4170,26 +4170,26 @@ (do Monad [#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) + (function [state] + (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]))) @@ -4280,27 +4280,27 @@ (#;Some tags&members) (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)))))))) + (function recur [source [tags members] target] + (let [pattern (record$ (map (function [[t-module t-name]] + [(tag$ [t-module t-name]) + (symbol$ ["" (Text/append prefix t-name)])]) + tags))] + (do Monad + [enhanced-target (foldM Monad + (function [[[_ 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))))) @@ -4336,9 +4336,9 @@ (case (reverse tokens) (^ (list& else branches')) (return (list (fold (: (-> [AST AST] AST AST) - (lambda [branch else] - (let [[right left] branch] - (` (if (~ left) (~ right) (~ else)))))) + (function [branch else] + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) else (as-pairs branches')))) @@ -4380,10 +4380,10 @@ (case (resolve-struct-type type) (#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!_)])) + (function [[[r-prefix r-name] [r-idx r-type]]] + [(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)))))) @@ -4392,15 +4392,15 @@ (^ (list [_ (#TupleS slots)] record)) (return (list (fold (: (-> AST AST AST) - (lambda [slot inner] - (` (;;get@ (~ slot) (~ inner))))) + (function [slot inner] + (` (;;get@ (~ slot) (~ inner))))) record slots))) (^ (list selector)) (do Monad [g!record (gensym "record")] - (wrap (list (` (lambda [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) + (wrap (list (` (function [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) _ (fail "Wrong syntax for get@"))) @@ -4415,7 +4415,7 @@ (do Monad [decls' (mapM Monad (: (-> [Ident Type] (Lux (List AST))) - (lambda [[sname stype]] (open-field prefix sname source+ stype))) + (function [[sname stype]] (open-field prefix sname source+ stype))) (zip2 tags members))] (return (List/join decls'))) @@ -4449,7 +4449,7 @@ (#Some [tags members]) (do Monad [decls' (mapM Monad (: (-> [Ident Type] (Lux (List AST))) - (lambda [[sname stype]] (open-field prefix sname source stype))) + (function [[sname stype]] (open-field prefix sname source stype))) (zip2 tags members))] (return (List/join decls'))) @@ -4463,13 +4463,13 @@ {#;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/append \"\")) ## => - (lambda [] + (function [] (fold Text/append \"\" (interpose \" \" (map Int/encode ))))"} (do Monad [g!arg (gensym "arg")] - (return (list (` (lambda [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) + (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) (def: (imported-by? import-name module-name) (-> Text Text (Lux Bool)) @@ -4487,14 +4487,14 @@ #let [[openings options] openings+options] 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)))]] + (function [module-name all-defs referred-defs] + (mapM Monad + (: (-> Text (Lux Unit)) + (function [_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 @@ -4512,14 +4512,14 @@ (do Monad [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)))] + (function [module-name all-defs referred-defs] + (mapM Monad + (: (-> Text (Lux Unit)) + (function [_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) @@ -4539,16 +4539,16 @@ #Nothing (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))))) + (function [def] + (` (;_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))) + (function [[prefix structs]] + (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) + structs))) r-opens)]] (wrap (List/append defs openings)) )) @@ -4580,8 +4580,8 @@ #Nothing (list))) - =opens (join-map (lambda [[prefix structs]] - (list& (text$ prefix) (map symbol$ structs))) + =opens (join-map (function [[prefix structs]] + (list& (text$ prefix) (map symbol$ structs))) r-opens)] (` (;;refer (~ (text$ module-name)) (~@ =defs) @@ -4624,12 +4624,12 @@ [(list) tokens]))] imports (parse-imports _imports) #let [=imports (map (: (-> Importation AST) - (lambda [[m-name m-alias =refer]] - (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) + (function [[m-name m-alias =refer]] + (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) imports) =refers (map (: (-> Importation AST) - (lambda [[m-name m-alias =refer]] - (refer-to-ast m-name =refer))) + (function [[m-name m-alias =refer]] + (refer-to-ast m-name =refer))) imports)] =meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])] _meta))) @@ -4677,20 +4677,20 @@ (do Monad [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])))) + (function [[r-slot-name [r-idx r-type]]] + (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])) + (function [[r-slot-name r-idx 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)])) + (function [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) (if (n.= idx r-idx) + value + r-var)])) pattern'))] (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) @@ -4706,18 +4706,18 @@ (do Monad [bindings (mapM Monad (: (-> AST (Lux AST)) - (lambda [_] (gensym "temp"))) + (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) update-expr (fold (: (-> [AST AST] AST AST) - (lambda [[s b] v] - (` (;;set@ (~ s) (~ v) (~ b))))) + (function [[s b] v] + (` (;;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')])) + (function [[new-slot 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'))]] @@ -4727,13 +4727,13 @@ (^ (list selector value)) (do Monad [g!record (gensym "record")] - (wrap (list (` (lambda [(~ 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 (` (lambda [(~ 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@"))) @@ -4763,20 +4763,20 @@ (do Monad [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])))) + (function [[r-slot-name [r-idx r-type]]] + (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])) + (function [[r-slot-name r-idx 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)])) + (function [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) (if (n.= idx r-idx) + (` ((~ fun) (~ r-var))) + r-var)])) pattern'))] (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) @@ -4799,13 +4799,13 @@ (^ (list selector fun)) (do Monad [g!record (gensym "record")] - (wrap (list (` (lambda [(~ 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 (` (lambda [(~ 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@"))) @@ -4856,7 +4856,7 @@ data' (mapM Monad tuple->list data)] (if (every? (i.= (length bindings')) (map length data')) (let [apply (: (-> RepEnv (List AST)) - (lambda [env] (map (apply-template env) templates)))] + (function [env] (map (apply-template env) templates)))] (|> data' (join-map (. apply (make-env bindings'))) wrap)) @@ -5016,9 +5016,9 @@ (^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 [[group-cursor' parts-text] (fold (function [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)])) [(delim-update-cursor group-cursor) ""] ( parts))] [(delim-update-cursor group-cursor') @@ -5041,7 +5041,7 @@ (#Doc-Comment comment) (|> comment (split-text "\n") - (map (lambda [line] ($_ Text/append "## " line "\n"))) + (map (function [line] ($_ Text/append "## " line "\n"))) Text/join) (#Doc-Example example) @@ -5148,13 +5148,13 @@ expected get-expected-type] (return (list (` ((;_lux_: (-> (~@ (map type-to-ast init-types)) (~ (type-to-ast expected))) - (lambda (~ (symbol$ ["" "recur"])) [(~@ vars)] - (~ body))) + (function (~ (symbol$ ["" "recur"])) [(~@ vars)] + (~ body))) (~@ inits)))))) (do Monad [aliases (mapM Monad (: (-> AST (Lux AST)) - (lambda [_] (gensym ""))) + (function [_] (gensym ""))) inits)] (return (list (` (let [(~@ (interleave aliases inits))] (;loop [(~@ (interleave vars aliases))] @@ -5189,14 +5189,14 @@ g!_ (gensym "_") #let [[idx tags exported? type] output slot-pairings (map (: (-> Ident [Text AST]) - (lambda [[module name]] [name (symbol$ ["" name])])) + (function [[module name]] [name (symbol$ ["" name])])) (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!_])))) + (function [[module name]] + (let [tag (tag$ [module name])] + (case (get name slot-pairings) + (#Some binding) [tag binding] + #None [tag g!_])))) tags))]] (return (list& pattern body branches))) @@ -5227,16 +5227,16 @@ (do Monad [=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]) + (function [[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)))) )) @@ -5348,10 +5348,10 @@ (do Monad [=pairs (mapM Monad (: (-> [AST AST] (Lux [AST AST])) - (lambda [[slot value]] - (do Monad - [=value (anti-quote value)] - (wrap [slot =value])))) + (function [[slot value]] + (do Monad + [=value (anti-quote value)] + (wrap [slot =value])))) pairs)] (wrap [meta (#RecordS =pairs)])) @@ -5413,13 +5413,13 @@ (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) + (let [inner-pattern-body (fold (function [[calculation pattern] success] + (` (case (~ calculation) + (~ pattern) + (~ success) - (~ g!_) - #;None))) + (~ g!_) + #;None))) (` (#;Some (~ body))) (: (List [AST AST]) (reverse levels)))] (list init-pattern inner-pattern-body))) @@ -5551,7 +5551,7 @@ (macro: #export (^@ tokens) {#;doc (doc "Allows you to simultaneously bind and de-structure a value." (def: (hash (^@ set [Hash _])) - (List/fold (lambda [elem acc] (n.+ (:: Hash hash elem) acc)) + (List/fold (function [elem acc] (n.+ (:: Hash hash elem) acc)) +0 (to-list set))))} (case tokens @@ -5657,13 +5657,13 @@ (^ (list& [_ (#FormS (list& [_ (#SymbolS ["" name])] args'))] tokens')) (do Monad [args (mapM Monad - (lambda [arg'] - (case arg' - [_ (#SymbolS ["" arg-name])] - (wrap arg-name) + (function [arg'] + (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'])) @@ -5719,8 +5719,8 @@ g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep-env (map (lambda [arg] - [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) + #let [rep-env (map (function [arg] + [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) args)]] (wrap (list (` (macro: (~@ (gen-export-level ?export-level)) ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) -- cgit v1.2.3