diff options
| author | Eduardo Julian | 2017-12-01 23:40:15 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2017-12-01 23:40:15 -0400 |
| commit | 414c0a1a1f53322d8f4c11230ded98c5b83b6310 (patch) | |
| tree | 5ac65a4b63731c1c457fd079a26735f1af27846b /stdlib | |
| parent | 0ea9403e482b7f01df9e634ae2533b20ef56a9ab (diff) | |
- Changed some of the syntax for macro templating.
- "gensym" now produces Ident instead of Code.
Diffstat (limited to '')
31 files changed, 739 insertions, 731 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 4ec6e1ea1..e7326f34b 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1064,7 +1064,7 @@ _ (fail "Wrong syntax for $'")})) -(def:'' (map f xs) +(def:'' (list/map f xs) #Nil (#UnivQ #Nil (#UnivQ #Nil @@ -1076,7 +1076,7 @@ #Nil (#Cons x xs') - (#Cons (f x) (map f xs'))})) + (#Cons (f x) (list/map f xs'))})) (def:'' RepEnv #Nil @@ -1126,18 +1126,18 @@ syntax}) [meta (#Form parts)] - [meta (#Form (map (replace-syntax reps) parts))] + [meta (#Form (list/map (replace-syntax reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (map (replace-syntax reps) members))] + [meta (#Tuple (list/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))] + [meta (#Record (list/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}) @@ -1148,20 +1148,20 @@ (#Function Code Code) ("lux case" code {[_ (#Tuple members)] - (tuple$ (map update-bounds members)) + (tuple$ (list/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$ (list/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 members)] - (form$ (map update-bounds members)) + (form$ (list/map update-bounds members)) _ code})) @@ -1854,7 +1854,7 @@ (#Cons lastI inits) (do Monad<Meta> [lastO ("lux case" lastI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] (wrap spliced) _ @@ -1864,7 +1864,7 @@ (monad/fold Monad<Meta> (function' [leftI rightO] ("lux case" leftI - {[_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) spliced rightO))) @@ -1933,6 +1933,9 @@ [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] (return unquoted) + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident)))) + [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] (untemplate false subst keep-quoted) @@ -1996,10 +1999,10 @@ (macro:' #export (` tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (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)] + (function [(~+ args)] (~ body))))")]) ("lux case" tokens {(#Cons template #Nil) @@ -2013,9 +2016,9 @@ (macro:' #export (`' tokens) (list [(tag$ ["lux" "doc"]) - (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (text$ "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms. (`' (def: (~ name) - (function [(~@ args)] + (function [(~+ args)] (~ body))))")]) ("lux case" tokens {(#Cons template #Nil) @@ -2042,12 +2045,12 @@ (macro:' #export (|> tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Piping macro. - (|> elems (map int/encode) (interpose \" \") (fold text/compose \"\")) + (|> elems (list/map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (fold text/compose \"\" (interpose \" \" - (map int/encode elems)))")]) + (list/map int/encode elems)))")]) ("lux case" tokens {(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) @@ -2070,12 +2073,12 @@ (macro:' #export (<| tokens) (list [(tag$ ["lux" "doc"]) (text$ "## Reverse piping macro. - (<| (fold text/compose \"\") (interpose \" \") (map int/encode) elems) + (<| (fold text/compose \"\") (interpose \" \") (list/map int/encode) elems) ## => (fold text/compose \"\" (interpose \" \" - (map int/encode elems)))")]) + (list/map int/encode elems)))")]) ("lux case" (list/reverse tokens) {(#Cons [init apps]) (return (list (list/fold ("lux check" (-> Code Code Code) @@ -2155,17 +2158,17 @@ template}) [meta (#Tuple elems)] - [meta (#Tuple (map (apply-template env) elems))] + [meta (#Tuple (list/map (apply-template env) elems))] [meta (#Form elems)] - [meta (#Form (map (apply-template env) elems))] + [meta (#Form (list/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 (list/map ("lux check" (-> (& Code Code) (& Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members))] _ template})) @@ -2203,10 +2206,10 @@ (monad/map Monad<Maybe> tuple->list data)] {[(#Some bindings') (#Some data')] (let' [apply ("lux check" (-> RepEnv ($' List Code)) - (function' [env] (map (apply-template env) templates))) + (function' [env] (list/map (apply-template env) templates))) num-bindings (list/size bindings')] (if (every? (function' [sample] ("lux nat =" num-bindings sample)) - (map list/size data')) + (list/map list/size data')) (|> data' (join-map (compose apply (make-env bindings'))) return) @@ -2591,16 +2594,16 @@ (-> Code Code) ("lux case" type {[_ (#Form (#Cons [_ (#Tag tag)] parts))] - (form$ (#Cons [(tag$ tag) (map walk-type parts)])) + (form$ (#Cons [(tag$ tag) (list/map walk-type parts)])) [_ (#Tuple members)] - (` (& (~@ (map walk-type members)))) + (` (& (~+ (list/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)) + (list/map walk-type args)) _ type})) @@ -2677,8 +2680,8 @@ _ (fail "Wrong syntax for variant case.")}))) pairs)] - (return [(` (& (~@ (map second members)))) - (#Some (map first members))])) + (return [(` (& (~+ (list/map second members)))) + (#Some (list/map first members))])) (#Cons type #Nil) ("lux case" type @@ -2686,7 +2689,7 @@ (return [(` #.Unit) (#Some (list member-name))]) [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [(` (& (~@ member-types))) (#Some (list member-name))]) + (return [(` (& (~+ member-types))) (#Some (list member-name))]) _ (return [type #None])}) @@ -2704,20 +2707,20 @@ (return [member-name member-type]) [_ (#Form (#Cons [_ (#Tag "" member-name)] member-types))] - (return [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))])) + (return [(` (| (~+ (list/map second members)))) + (#Some (list/map first members))])) _ (fail "Improper type-definition syntax")})) (def:''' (gensym prefix state) #Nil - (-> Text ($' Meta Code)) + (-> Text ($' Meta Ident)) ("lux case" state {{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host @@ -2729,7 +2732,7 @@ #seed (n/+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars} - (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) + ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])})) (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) @@ -2795,7 +2798,7 @@ body _ - (` (function' (~ name) [(~@ args)] (~ body)))}) + (` (function' (~ name) [(~+ args)] (~ body)))}) body'' ("lux case" ?type {(#Some type) (` (: (~ type) (~ body'))) @@ -2849,21 +2852,21 @@ [_ (#Form xs)] ($_ text/compose "(" (|> xs - (map code-to-text) + (list/map code-to-text) (interpose " ") list/reverse (list/fold text/compose "")) ")") [_ (#Tuple xs)] ($_ text/compose "[" (|> xs - (map code-to-text) + (list/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))}))) + (list/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 "")) "}")} @@ -2897,7 +2900,7 @@ _ (fail ($_ text/compose "\"lux.case\" expects an even number of tokens: " (|> branches - (map code-to-text) + (list/map code-to-text) (interpose " ") list/reverse (list/fold text/compose ""))))})) @@ -2974,7 +2977,7 @@ _ (let' [pairs (|> patterns - (map (function' [pattern] (list pattern body))) + (list/map (function' [pattern] (list pattern body))) (list/join))] (return (list/compose pairs branches)))) _ @@ -3033,20 +3036,19 @@ _ #None)) - (#Some ident head tail body) - (let [g!blank (symbol$ ["" ""]) - g!name (symbol$ ident) + (#Some g!name head tail body) + (let [g!blank ["" ""] 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'))))))) + (` ("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+)))))))) + (` ("lux function" (~@ g!name) (~ head) (~ body+))) + (` ("lux function" (~@ g!name) (~@ g!blank) (case (~@ g!blank) (~ head) (~ body+)))))))) #None (fail "Wrong syntax for function"))) @@ -3080,27 +3082,27 @@ [_ (#Tuple xs)] (|> xs - (map process-def-meta-value) + (list/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))])))) + (list/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))) + (untemplate-list (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) @@ -3110,15 +3112,15 @@ _ (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])] - [(~ cursor-code) (#.Tuple (.list (~@ (map (function [arg] - (` [(~ cursor-code) (#.Text (~ (text$ (code-to-text arg))))])) - args))))]] + [(~ cursor-code) (#.Tuple (.list (~+ (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))]})) + (` {#.type-args [(~+ (list/map (function [arg] (text$ (code-to-text arg))) + args))]})) (def:' Export-Level Type @@ -3198,7 +3200,7 @@ body _ - (` (function (~ name) [(~@ args)] (~ body)))) + (` (function (~ name) [(~+ args)] (~ body)))) body (case ?type (#Some type) (` (: (~ type) (~ body))) @@ -3279,8 +3281,8 @@ (let [name (symbol$ name) def-sig (case args #Nil name - _ (` ((~ name) (~@ args))))] - (return (list (` (..def: (~@ (export-level exported?)) + _ (` ((~ name) (~+ args))))] + (return (list (` (..def: (~+ (export-level exported?)) (~ def-sig) (~ (meta-code-merge (` {#.macro? true}) meta)) @@ -3340,10 +3342,10 @@ (list/join sigs'))) #let [[_module _name] name+ def-name (symbol$ name) - sig-type (record$ (map (: (-> [Text Code] [Code Code]) - (function [[m-name m-type]] - [(tag$ ["" m-name]) m-type])) - members)) + sig-type (record$ (list/map (: (-> [Text Code] [Code Code]) + (function [[m-name m-type]] + [(tag$ ["" m-name]) m-type])) + members)) sig-meta (meta-code-merge (` {#.sig? true}) meta) usage (case args @@ -3351,8 +3353,8 @@ def-name _ - (` ((~ def-name) (~@ args))))]] - (return (list (` (..type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + (` ((~ def-name) (~+ args))))]] + (return (list (` (..type: (~+ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) #None (fail "Wrong syntax for sig:")))) @@ -3678,8 +3680,8 @@ _ (fail "No tags available for type."))) #let [tag-mappings (: (List [Text Code]) - (map (function [tag] [(second tag) (tag$ tag)]) - tags))] + (list/map (function [tag] [(second tag) (tag$ tag)]) + tags))] members (monad/map Monad<Meta> (: (-> Code (Meta [Code Code])) (function [token] @@ -3766,12 +3768,12 @@ name _ - (` ((~ name) (~@ args))))] - (return (list (` (..def: (~@ (export-level exported?)) (~ usage) + (` ((~ name) (~+ args))))] + (return (list (` (..def: (~+ (export-level exported?)) (~ usage) (~ (meta-code-merge (` {#.struct? true}) meta)) (~ type) - (struct (~@ defs))))))) + (struct (~+ defs))))))) #None (fail "Cannot infer name, so struct must have a name other than \"_\"!")) @@ -3830,7 +3832,7 @@ type-meta (: Code (case tags?? (#Some tags) - (` {#.tags [(~@ (map text$ tags))] + (` {#.tags [(~+ (list/map text$ tags))] #.type? true}) _ @@ -3849,10 +3851,10 @@ (#Some type) _ - (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))] + (#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}) (' {})) type-meta @@ -3986,14 +3988,14 @@ (case tokens (^ (list& [_ (#Tag "" "open")] [_ (#Form parts)] tokens')) (if (|> parts - (map (: (-> Code Bool) - (function [part] - (case part - (^or [_ (#Text _)] [_ (#Symbol _)]) - true + (list/map (: (-> Code Bool) + (function [part] + (case part + (^or [_ (#Text _)] [_ (#Symbol _)]) + true - _ - false)))) + _ + false)))) (list/fold (function [r l] (and l r)) true)) (let [openings (list/fold (: (-> Code (List Openings) (List Openings)) (function [part openings] @@ -4022,14 +4024,14 @@ (def: (parse-short-openings parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (if (|> parts - (map (: (-> Code Bool) - (function [part] - (case part - (^or [_ (#Text _)] [_ (#Symbol _)]) - true + (list/map (: (-> Code Bool) + (function [part] + (case part + (^or [_ (#Text _)] [_ (#Symbol _)]) + true - _ - false)))) + _ + false)))) (list/fold (function [r l] (and l r)) true)) (let [openings (list/fold (: (-> Code (List Openings) (List Openings)) (function [part openings] @@ -4054,16 +4056,16 @@ (def: (decorate-sub-importations super-name) (-> Text (List Importation) (List Importation)) - (map (: (-> Importation Importation) - (function [importation] - (let [{#import-name _name - #import-alias _alias - #import-refer {#refer-defs _referrals - #refer-open _openings}} importation] - {#import-name ($_ text/compose super-name "/" _name) - #import-alias _alias - #import-refer {#refer-defs _referrals - #refer-open _openings}}))))) + (list/map (: (-> Importation Importation) + (function [importation] + (let [{#import-name _name + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}} importation] + {#import-name ($_ text/compose super-name "/" _name) + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}}))))) (def: (replace-all pattern value template) (-> Text Text Text Text) @@ -4187,18 +4189,18 @@ modules)] (case (get module modules) (#Some =module) - (let [to-alias (map (: (-> [Text Def] - (List Text)) - (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] - (list name) + (let [to-alias (list/map (: (-> [Text Def] + (List Text)) + (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] + (list name) - _ - (list)))) - (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] - defs))] + _ + (list)))) + (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] + defs))] (#Right state (list/join to-alias))) #None @@ -4369,7 +4371,7 @@ name _ - ($_ text/compose "(" name " " (|> params (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")) + ($_ text/compose "(" name " " (|> params (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")) #Void "Void" @@ -4378,13 +4380,13 @@ "Unit" (#Sum _) - ($_ text/compose "(| " (|> (flatten-variant type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") + ($_ text/compose "(| " (|> (flatten-variant type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") (#Product _) - ($_ text/compose "[" (|> (flatten-tuple type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]") + ($_ text/compose "[" (|> (flatten-tuple type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) "]") (#Function _) - ($_ text/compose "(-> " (|> (flatten-lambda type) (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") + ($_ text/compose "(-> " (|> (flatten-lambda type) (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")") (#Bound id) (nat/encode id) @@ -4405,7 +4407,7 @@ (let [[func args] (flatten-app type)] ($_ text/compose "(" (type/show func) " " - (|> args (map type/show) (interpose " ") list/reverse (list/fold text/compose "")) + (|> args (list/map type/show) (interpose " ") list/reverse (list/fold text/compose "")) ")")) (#Named [prefix name] _) @@ -4426,10 +4428,10 @@ (do Monad<Meta> [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Meta Code)) (function recur [source [tags members] target] - (let [pattern (record$ (map (function [[t-module t-name]] - [(tag$ [t-module t-name]) - (symbol$ ["" (text/compose prefix t-name)])]) - tags))] + (let [pattern (record$ (list/map (function [[t-module t-name]] + [(tag$ [t-module t-name]) + (symbol$ ["" (text/compose prefix t-name)])]) + tags))] (do Monad<Meta> [enhanced-target (monad/fold Monad<Meta> (function [[[_ m-name] m-type] enhanced-target] @@ -4462,7 +4464,7 @@ (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches)) (do Monad<Meta> [g!temp (gensym "temp")] - (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) + (return (list& (symbol$ g!temp) (` (^open' (~@ g!temp) (~ (text$ prefix)) (~ body))) branches))) (^ (list& [_ (#Form (list))] body branches)) (return (list& (` (..^open "")) body branches)) @@ -4524,13 +4526,14 @@ g!output (gensym "")] (case (resolve-struct-type type) (#Some members) - (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [Code Code]) - (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)}))))) + (let [pattern (record$ (list/map (: (-> [Ident [Nat Type]] [Code Code]) + (function [[[r-prefix r-name] [r-idx r-type]]] + [(tag$ [r-prefix r-name]) + (symbol$ (if (n/= idx r-idx) + g!output + g!_))])) + (zip2 tags (enumerate members))))] + (return (list (` ("lux case" (~ record) {(~ pattern) (~@ g!output)}))))) _ (fail "get@ can only use records."))) @@ -4545,7 +4548,7 @@ (^ (list selector)) (do Monad<Meta> [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@"))) @@ -4606,27 +4609,27 @@ (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. - (|>> (map int/encode) (interpose \" \") (fold text/compose \"\")) + (|>> (list/map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (function [<arg>] (fold text/compose \"\" (interpose \" \" - (map int/encode <arg>))))"} + (list/map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] - (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) + (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. - (<<| (fold text/compose \"\") (interpose \" \") (map int/encode)) + (<<| (fold text/compose \"\") (interpose \" \") (list/map int/encode)) ## => (function [<arg>] (fold text/compose \"\" (interpose \" \" - (map int/encode <arg>))))"} + (list/map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] - (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg)))))))) + (return (list (` (function [(~@ g!arg)] (<| (~+ tokens) (~@ g!arg)))))))) (def: (imported-by? import-name module-name) (-> Text Text (Meta Bool)) @@ -4660,7 +4663,7 @@ _ (fail ($_ text/compose "Wrong syntax for refer @ " current-module "\n" (|> options - (map code-to-text) + (list/map code-to-text) (interpose " ") (list/fold text/compose ""))))))) @@ -4695,19 +4698,19 @@ #Nothing (wrap (list))) - #let [defs (map (: (-> Text Code) - (function [def] - (` ("lux def" (~ (symbol$ ["" def])) - (~ (symbol$ [module-name def])) - [(~ cursor-code) - (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])] - [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]] - #Nil))])))) - defs') + #let [defs (list/map (: (-> Text Code) + (function [def] + (` ("lux def" (~ (symbol$ ["" def])) + (~ (symbol$ [module-name def])) + [(~ cursor-code) + (#.Record (#Cons [[(~ cursor-code) (#.Tag ["lux" "alias"])] + [(~ cursor-code) (#.Symbol [(~ (text$ module-name)) (~ (text$ def))])]] + #Nil))])))) + defs') openings (join-map (: (-> Openings (List Code)) (function [[prefix structs]] - (map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) - structs))) + (list/map (function [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) + structs))) r-opens)]] (wrap (list/compose defs openings)) )) @@ -4730,21 +4733,21 @@ (list (' #refer) (' #all)) (#Only defs) - (list (' #refer) (`' (#only (~@ (map (|>> [""] symbol$) - defs))))) + (list (' #refer) (`' (#only (~+ (list/map (|>> [""] symbol$) + defs))))) (#Exclude defs) - (list (' #refer) (`' (#exclude (~@ (map (|>> [""] symbol$) - defs))))) + (list (' #refer) (`' (#exclude (~+ (list/map (|>> [""] symbol$) + defs))))) #Nothing (list))) =opens (join-map (function [[prefix structs]] - (list& (text$ prefix) (map symbol$ structs))) + (list& (text$ prefix) (list/map symbol$ structs))) r-opens)] (` (..refer (~ (text$ module-name)) - (~@ =defs) - (~' #open) ((~@ =opens)))))) + (~+ =defs) + (~' #open) ((~+ =opens)))))) (macro: #export (module: tokens) {#.doc "Module-definition macro. @@ -4783,15 +4786,15 @@ [(list) tokens]))] current-module current-module-name imports (parse-imports current-module _imports) - #let [=imports (map (: (-> Importation Code) - (function [[m-name m-alias =refer]] - (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) - imports) - =refers (map (: (-> Importation Code) - (function [[m-name m-alias =refer]] - (refer-to-code m-name =refer))) - imports) - =meta (process-def-meta (list& [(` #.imports) (` [(~@ =imports)])] + #let [=imports (list/map (: (-> Importation Code) + (function [[m-name m-alias =refer]] + (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) + imports) + =refers (list/map (: (-> Importation Code) + (function [[m-name m-alias =refer]] + (refer-to-code m-name =refer))) + imports) + =meta (process-def-meta (list& [(` #.imports) (` [(~+ =imports)])] _meta)) =module (` ("lux module" [(~ cursor-code) (#.Record (~ =meta))]))]] @@ -4808,7 +4811,7 @@ (return (list (` (let [(^open) (~ struct)] (~ (symbol$ member)))))) (^ (list& struct [_ (#Symbol member)] args)) - (return (list (` ((let [(^open) (~ struct)] (~ (symbol$ member))) (~@ args))))) + (return (list (` ((let [(^open) (~ struct)] (~ (symbol$ member))) (~+ args))))) _ (fail "Wrong syntax for ::"))) @@ -4841,18 +4844,20 @@ (function [[r-slot-name [r-idx r-type]]] (do Monad<Meta> [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r-slot-name r-idx (symbol$ g!slot)])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code]) - (function [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) r-var])) - pattern')) - output (record$ (map (: (-> [Ident Nat Code] [Code Code]) - (function [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n/= idx r-idx) - value - r-var)])) - pattern'))] + (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (function [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) + r-var])) + pattern')) + output (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (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)})))))) _ @@ -4866,35 +4871,36 @@ _ (do Monad<Meta> [bindings (monad/map Monad<Meta> - (: (-> Code (Meta Code)) + (: (-> Code (Meta Ident)) (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) - update-expr (list/fold (: (-> [Code Code] Code Code) + update-expr (list/fold (: (-> [Code Ident] 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))]) + [_ accesses'] (list/fold (: (-> [Code Ident] [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')])) + (let [new-binding (symbol$ new-binding)] + [(` (get@ (~ new-slot) (~ new-binding))) + (#Cons (list new-binding old-record) accesses')]))) [record (: (List (List Code)) #Nil)] pairs) accesses (list/join (list/reverse accesses'))]] - (wrap (list (` (let [(~@ accesses)] + (wrap (list (` (let [(~+ accesses)] (~ update-expr))))))) (^ (list selector value)) (do Monad<Meta> [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<Meta> [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@"))) @@ -4927,18 +4933,20 @@ (function [[r-slot-name [r-idx r-type]]] (do Monad<Meta> [g!slot (gensym "")] - (return [r-slot-name r-idx g!slot])))) + (return [r-slot-name r-idx (symbol$ g!slot)])))) (zip2 tags (enumerate members)))] - (let [pattern (record$ (map (: (-> [Ident Nat Code] [Code Code]) - (function [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) r-var])) - pattern')) - output (record$ (map (: (-> [Ident Nat Code] [Code Code]) - (function [[r-slot-name r-idx r-var]] - [(tag$ r-slot-name) (if (n/= idx r-idx) - (` ((~ fun) (~ r-var))) - r-var)])) - pattern'))] + (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (function [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) + r-var])) + pattern')) + output (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) + (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)})))))) _ @@ -4953,20 +4961,20 @@ (do Monad<Meta> [g!record (gensym "record") g!temp (gensym "temp")] - (wrap (list (` (let [(~ g!record) (~ record) - (~ g!temp) (get@ [(~@ slots)] (~ g!record))] - (set@ [(~@ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) + (wrap (list (` (let [(~@ g!record) (~ record) + (~@ g!temp) (get@ [(~+ slots)] (~@ g!record))] + (set@ [(~+ slots)] ((~ fun) (~@ g!temp)) (~@ g!record)))))))) (^ (list selector fun)) (do Monad<Meta> [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<Meta> [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@"))) @@ -5015,9 +5023,9 @@ (do Monad<Maybe> [bindings' (monad/map Monad<Maybe> get-name bindings) data' (monad/map Monad<Maybe> tuple->list data)] - (if (every? (n/= (list/size bindings')) (map list/size data')) + (if (every? (n/= (list/size bindings')) (list/map list/size data')) (let [apply (: (-> RepEnv (List Code)) - (function [env] (map (apply-template env) templates)))] + (function [env] (list/map (apply-template env) templates)))] (|> data' (join-map (compose apply (make-env bindings'))) wrap)) @@ -5057,14 +5065,14 @@ (^template [<tag>] [[_ _ column] (<tag> parts)] - (list/fold n/min column (map find-baseline-column parts))) + (list/fold n/min column (list/map find-baseline-column parts))) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list/fold n/min column - (list/compose (map (|>> first find-baseline-column) pairs) - (map (|>> second find-baseline-column) pairs))) + (list/compose (list/map (|>> first find-baseline-column) pairs) + (list/map (|>> second find-baseline-column) pairs))) )) (type: Doc-Fragment @@ -5149,7 +5157,7 @@ (def: rejoin-all-pairs (-> (List [Code Code]) (List Code)) - (|>> (map rejoin-pair) list/join)) + (|>> (list/map rejoin-pair) list/join)) (def: (doc-example->Text prev-cursor baseline example) (-> Cursor Nat Code [Cursor Text]) @@ -5198,7 +5206,7 @@ (#Doc-Comment comment) (|> comment (text/split "\n") - (map (function [line] ($_ text/compose "## " line "\n"))) + (list/map (function [line] ($_ text/compose "## " line "\n"))) text/join) (#Doc-Example example) @@ -5220,7 +5228,7 @@ x)))"} (return (list (` [(~ cursor-code) (#.Text (~ (|> tokens - (map (|>> identify-doc-fragment doc-fragment->Text)) + (list/map (|>> identify-doc-fragment doc-fragment->Text)) text/join text$)))])))) @@ -5242,7 +5250,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#Primitive (~ (text$ name)) (~ (untemplate-list (map type-to-code params))))) + (` (#Primitive (~ (text$ name)) (~ (untemplate-list (list/map type-to-code params))))) #Void (` #Void) @@ -5268,11 +5276,11 @@ (` (#Ex (~ (nat$ id)))) (#UnivQ env type) - (let [env' (untemplate-list (map type-to-code env))] + (let [env' (untemplate-list (list/map type-to-code env))] (` (#UnivQ (~ env') (~ (type-to-code type))))) (#ExQ env type) - (let [env' (untemplate-list (map type-to-code env))] + (let [env' (untemplate-list (list/map type-to-code env))] (` (#ExQ (~ env') (~ (type-to-code type))))) (#Apply arg fun) @@ -5293,8 +5301,8 @@ (case tokens (^ (list [_ (#Tuple bindings)] body)) (let [pairs (as-pairs bindings) - vars (map first pairs) - inits (map second pairs)] + vars (list/map first pairs) + inits (list/map second pairs)] (if (every? symbol? inits) (do Monad<Meta> [inits' (: (Meta (List Ident)) @@ -5303,18 +5311,19 @@ #None (fail "Wrong syntax for loop"))) init-types (monad/map Monad<Meta> find-type inits') expected get-expected-type] - (return (list (` (("lux check" (-> (~@ (map type-to-code init-types)) + (return (list (` (("lux check" (-> (~+ (list/map type-to-code init-types)) (~ (type-to-code expected))) - (function (~ (symbol$ ["" "recur"])) [(~@ vars)] + (function (~ (symbol$ ["" "recur"])) [(~+ vars)] (~ body))) - (~@ inits)))))) + (~+ inits)))))) (do Monad<Meta> [aliases (monad/map Monad<Meta> - (: (-> Code (Meta Code)) + (: (-> Code (Meta Ident)) (function [_] (gensym ""))) - inits)] - (return (list (` (let [(~@ (interleave aliases inits))] - (.loop [(~@ (interleave vars aliases))] + inits) + #let [aliases (list/map symbol$ aliases)]] + (return (list (` (let [(~+ (interleave aliases inits))] + (.loop [(~+ (interleave vars aliases))] (~ body))))))))) _ @@ -5345,16 +5354,16 @@ output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output - slot-pairings (map (: (-> Ident [Text Code]) - (function [[module name]] [name (symbol$ ["" name])])) - (list& hslot tslots)) - pattern (record$ (map (: (-> Ident [Code Code]) - (function [[module name]] - (let [tag (tag$ [module name])] - (case (get name slot-pairings) - (#Some binding) [tag binding] - #None [tag g!_])))) - tags))]] + slot-pairings (list/map (: (-> Ident [Text Code]) + (function [[module name]] [name (symbol$ ["" name])])) + (list& hslot tslots)) + pattern (record$ (list/map (: (-> Ident [Code Code]) + (function [[module name]] + (let [tag (tag$ [module name])] + (case (get name slot-pairings) + (#Some binding) [tag binding] + #None [tag (symbol$ g!_)])))) + tags))]] (return (list& pattern body branches))) _ @@ -5430,8 +5439,8 @@ (do Monad<Meta> [expansion (macro-expand-once macro-expr)] (case (place-tokens var-name expansion (` (.with-expansions - [(~@ bindings')] - (~@ bodies)))) + [(~+ bindings')] + (~+ bodies)))) (#Some output) (wrap output) @@ -5569,13 +5578,13 @@ (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> Code [Multi-Level-Case Code] (List Code)) + (-> Ident [Multi-Level-Case Code] (List Code)) (let [inner-pattern-body (list/fold (function [[calculation pattern] success] (` (case (~ calculation) (~ pattern) (~ success) - (~ g!_) + (~@ g!_) #.None))) (` (#.Some (~ body))) (: (List [Code Code]) (list/reverse levels)))] @@ -5606,19 +5615,19 @@ [mlc (multi-level-case^ levels) expected get-expected-type g!temp (gensym "temp")] - (let [output (list g!temp + (let [output (list (symbol$ g!temp) (` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) - (case (~ g!temp) - (~@ (multi-level-case$ g!temp [mlc body])) + (case (~@ g!temp) + (~+ (multi-level-case$ g!temp [mlc body])) - (~ g!temp) + (~@ g!temp) #.None)) - {(#Some (~ g!temp)) - (~ g!temp) + {(#Some (~@ g!temp)) + (~@ g!temp) #None - (case (~ g!temp) - (~@ next-branches))})))] + (case (~@ g!temp) + (~+ next-branches))})))] (wrap output))) _ @@ -5713,9 +5722,9 @@ (to-list set))))} (case tokens (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches)) - (let [g!whole (symbol$ ["" name])] - (return (list& g!whole - (` (case (~ g!whole) (~ pattern) (~ body))) + (let [g!whole ["" name]] + (return (list& (symbol$ g!whole) + (` (case (~@ g!whole) (~ pattern) (~ body))) branches))) _ @@ -5728,9 +5737,9 @@ (foo value)))} (case tokens (^ (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))] + (let [g!name ["" name]] + (return (list& (symbol$ g!name) + (` (let [(~@ g!name) (|> (~@ g!name) (~+ steps))] (~ body))) branches))) @@ -5876,18 +5885,18 @@ g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") - #let [rep-env (map (function [arg] - [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) - args)]] - (wrap (list (` (macro: (~@ (gen-export-level ?export-level)) - ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) + #let [rep-env (list/map (function [arg] + [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) + args)]] + (wrap (list (` (macro: (~+ (gen-export-level ?export-level)) + ((~ (symbol$ ["" name])) (~@ g!tokens) (~@ g!compiler)) (~ anns) - (case (~ g!tokens) - (^ (list (~@ (map (|>> [""] symbol$) args)))) - (#.Right [(~ g!compiler) + (case (~@ g!tokens) + (^ (list (~+ (list/map (|>> [""] symbol$) args)))) + (#.Right [(~@ g!compiler) (list (` (~ (replace-syntax rep-env input-template))))]) - (~ g!_) + (~@ g!_) (#.Left (~ (text$ (text/compose "Wrong syntax for " name)))) ))))) )) @@ -5972,14 +5981,14 @@ (^ [ann (#Form (list [_ (#Symbol ["" "~~"])] expansion))]) (do Monad<Meta> [g!expansion (gensym "g!expansion")] - (wrap [(list [g!expansion expansion]) g!expansion])) + (wrap [(list [(symbol$ g!expansion) expansion]) (symbol$ g!expansion)])) (^template [<tag>] [ann (<tag> parts)] (do Monad<Meta> [=parts (monad/map Monad<Meta> label-code parts)] - (wrap [(list/fold list/compose (list) (map left =parts)) - [ann (<tag> (map right =parts))]]))) + (wrap [(list/fold list/compose (list) (list/map left =parts)) + [ann (<tag> (list/map right =parts))]]))) ([#Form] [#Tuple]) [ann (#Record kvs)] @@ -5993,8 +6002,8 @@ [val-labels val-labelled] =val]] (wrap [(list/compose key-labels val-labels) [key-labelled val-labelled]]))) kvs)] - (wrap [(list/fold list/compose (list) (map left =kvs)) - [ann (#Record (map right =kvs))]])) + (wrap [(list/fold list/compose (list) (list/map left =kvs)) + [ann (#Record (list/map right =kvs))]])) _ (return [(list) code]))) @@ -6005,8 +6014,8 @@ (do Monad<Meta> [=raw (label-code raw) #let [[labels labelled] =raw]] - (wrap (list (` (with-expansions [(~@ (|> labels - (map (function [[label expansion]] (list label expansion))) + (wrap (list (` (with-expansions [(~+ (|> labels + (list/map (function [[label expansion]] (list label expansion))) list/join))] (~ labelled)))))) @@ -6034,7 +6043,7 @@ [_ (<tag> value)] (do Monad<Meta> [g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))) + (wrap (` [(~@ g!meta) (<tag> (~ (<gen> value)))])))) ([#Bool "Bool" bool$] [#Nat "Nat" nat$] [#Int "Int" int$] @@ -6054,29 +6063,29 @@ (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) - [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] - (fail "Cannot use (~@) inside of ^code unless it is the last element in a form or a tuple.") + [_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] + (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") (^template [<tag>] [_ (<tag> elems)] (case (list/reverse elems) - (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] + (#Cons [_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] inits) (do Monad<Meta> [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits)) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) + (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) _ (do Monad<Meta> [=elems (monad/map Monad<Meta> untemplate-pattern elems) g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) + (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) ([#Tuple] [#Form]) )) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 328d717ce..5aa8217e2 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -129,23 +129,23 @@ (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] - (wrap (list (` ("lux program" (~ g!args) + (wrap (list (` ("lux program" (~@ g!args) (case ((: (..CLI (io.IO Unit)) (do .._Monad<CLI>_ - [(~@ (|> args + [(~+ (|> args (list/map (function [[binding parser]] (list binding parser))) list/join)) - (~ g!_) ..end] + (~@ g!_) ..end] ((~' wrap) (do io.Monad<IO> [] (~ body))))) - (~ g!args)) - (#E.Success [(~ g!_) (~ g!output)]) - (~ g!output) + (~@ g!args)) + (#E.Success [(~@ g!_) (~@ g!output)]) + (~@ g!output) - (#E.Error (~ g!message)) - (error! (~ g!message)) + (#E.Error (~@ g!message)) + (error! (~@ g!message)) ))) ))) )) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index a079d2d28..9f3403aad 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -221,7 +221,7 @@ output (message state self) #let [_ (log! "AFTER")]] (wrap output)))))} - (with-gensyms [g!message g!self g!state g!init g!error g!return g!output] + (with-gensyms [g!init] (do @ [module macro.current-module-name #let [g!type (code.local-symbol (state-name _name)) @@ -229,16 +229,16 @@ g!actor (code.local-symbol _name) g!new (code.local-symbol (new-name _name)) g!vars (list/map code.local-symbol _vars)]] - (wrap (list (` (type: (~@ (csw.export export)) ((~ g!type) (~@ g!vars)) + (wrap (list (` (type: (~+ (csw.export export)) ((~ g!type) (~+ g!vars)) (~ state-type))) - (` (type: (~@ (csw.export export)) ((~ g!actor) (~@ g!vars)) + (` (type: (~+ (csw.export export)) ((~ g!actor) (~+ g!vars)) (~ (|> annotations (with-actor [module _name]) csw.annotations)) - (..Actor ((~ g!type) (~@ g!vars))))) - (` (def: (~@ (csw.export export)) (~ g!behavior) - (All [(~@ g!vars)] - (..Behavior ((~ g!type) (~@ g!vars)))) + (..Actor ((~ g!type) (~+ g!vars))))) + (` (def: (~+ (csw.export export)) (~ g!behavior) + (All [(~+ g!vars)] + (..Behavior ((~ g!type) (~+ g!vars)))) {#..handle (~ (case ?handle #.None (` ..default-handle) @@ -260,10 +260,10 @@ (do P.Monad<Promise> [] (~ bodyC))))))})) - (` (def: (~@ (csw.export export)) ((~ g!new) (~ g!init)) - (All [(~@ g!vars)] - (-> ((~ g!type) (~@ g!vars)) (io.IO ((~ g!actor) (~@ g!vars))))) - (..spawn (~ g!behavior) (~ g!init)))))) + (` (def: (~+ (csw.export export)) ((~ g!new) (~@ g!init)) + (All [(~+ g!vars)] + (-> ((~ g!type) (~+ g!vars)) (io.IO ((~ g!actor) (~+ g!vars))))) + (..spawn (~ g!behavior) (~@ g!init)))))) ))) (type: Signature @@ -313,7 +313,7 @@ #let [g!type (code.symbol (product.both id state-name actor-name)) g!message (code.local-symbol (get@ #name signature)) g!actor-vars (list/map code.local-symbol actor-vars) - g!actor (` ((~ (code.symbol actor-name)) (~@ g!actor-vars))) + actorC (` ((~ (code.symbol actor-name)) (~+ g!actor-vars))) g!all-vars (|> (get@ #vars signature) (list/map code.local-symbol) (list/compose g!actor-vars)) g!inputsC (|> (get@ #inputs signature) (list/map (|>> product.left code.local-symbol))) g!inputsT (|> (get@ #inputs signature) (list/map product.right)) @@ -335,32 +335,32 @@ (code.replace g!var g!ref outputT)) (get@ #output signature) ref-replacements)]] - (wrap (list (` (def: (~@ (csw.export export)) ((~ g!message) (~@ g!inputsC) (~ g!self)) + (wrap (list (` (def: (~+ (csw.export export)) ((~ g!message) (~+ g!inputsC) (~ g!self)) (~ (|> annotations (with-message actor-name) csw.annotations)) - (All [(~@ g!all-vars)] (-> (~@ g!inputsT) (~ g!actor) (T.Task (~ (get@ #output signature))))) - (let [(~ g!task) (T.task (~ g!outputT))] + (All [(~+ g!all-vars)] (-> (~+ g!inputsT) (~ actorC) (T.Task (~ (get@ #output signature))))) + (let [(~@ g!task) (T.task (~ g!outputT))] (io.run (do io.Monad<IO> - [(~ g!sent?) (..send (function [(~ g!state) (~ g!self)] - (do P.Monad<Promise> - [(~ g!return) (: (T.Task [((~ g!type) (~@ g!actor-refs)) - (~ g!outputT)]) - (do T.Monad<Task> - [] - (~ body)))] - (case (~ g!return) - (#.Right [(~ g!state) (~ g!return)]) - (exec (io.run (P.resolve (#.Right (~ g!return)) (~ g!task))) - (T.return (~ g!state))) - - (#.Left (~ g!error)) - (exec (io.run (P.resolve (#.Left (~ g!error)) (~ g!task))) - (T.fail (~ g!error)))) - )) - (~ g!self))] - (if (~ g!sent?) - ((~' wrap) (~ g!task)) + [(~@ g!sent?) (..send (function [(~ g!state) (~ g!self)] + (do P.Monad<Promise> + [(~@ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs)) + (~ g!outputT)]) + (do T.Monad<Task> + [] + (~ body)))] + (case (~@ g!return) + (#.Right [(~ g!state) (~@ g!return)]) + (exec (io.run (P.resolve (#.Right (~@ g!return)) (~@ g!task))) + (T.return (~ g!state))) + + (#.Left (~@ g!error)) + (exec (io.run (P.resolve (#.Left (~@ g!error)) (~@ g!task))) + (T.fail (~@ g!error)))) + )) + (~ g!self))] + (if (~@ g!sent?) + ((~' wrap) (~@ g!task)) ((~' wrap) (T.throw ..Dead "")))))))) )) ))) diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux index 1ba795b24..388415c44 100644 --- a/stdlib/source/lux/concurrency/space.lux +++ b/stdlib/source/lux/concurrency/space.lux @@ -133,16 +133,16 @@ (do @ [actor-name (A.resolve-actor actor-name) #let [stateT (` ((~ (code.symbol (product.both id A.state-name actor-name))) - (~@ actor-params))) + (~+ actor-params))) g!actionL (code.local-symbol (get@ #action-name declaration)) g!senderL (code.local-symbol (get@ #sender-name declaration)) g!spaceL (code.local-symbol (get@ #space-name declaration)) g!receiverL (code.local-symbol (get@ #receiver-name declaration)) g!event (get@ #event declaration) g!state (get@ #state declaration)]] - (wrap (list (` (def: (~@ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL)) + (wrap (list (` (def: (~+ (csw.export export)) ((~ g!actionL) [(~ g!event) (~ g!senderL) (~ g!spaceL)] (~ g!receiverL)) (~ (csw.annotations annotations)) - (All [(~@ (L/map code.local-symbol t-vars))] + (All [(~+ (L/map code.local-symbol t-vars))] (..Action (~ eventT) (~ stateT))) (T.from-promise (_future diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 104dcf593..da2e11710 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -7,8 +7,8 @@ [monad]) (data [text] text/format - [maybe "m/" Monad<Maybe>] - (coll [list "L/" Fold<List> Functor<List>])) + [maybe "maybe/" Monad<Maybe>] + (coll [list "list/" Fold<List> Functor<List>])) [macro #+ with-gensyms Monad<Meta>] (macro [code] ["s" syntax #+ syntax:] @@ -43,10 +43,10 @@ (def: (stack-fold tops bottom) (-> (List Code) Code Code) - (L/fold (function [top bottom] - (` [(~ bottom) (~ top)])) - bottom - tops)) + (list/fold (function [top bottom] + (` [(~ bottom) (~ top)])) + bottom + tops)) (def: (singleton expander) (-> (Meta (List Code)) (Meta Code)) @@ -58,18 +58,18 @@ _ (macro.fail (format "Cannot expand to more than a single AST/Code node:\n" - (|> expansion (L/map %code) (text.join-with " "))))))) + (|> expansion (list/map %code) (text.join-with " "))))))) (syntax: #export (=> [aliases aliases^] [inputs stack^] [outputs stack^]) (let [de-alias (function [aliased] - (L/fold (function [[from to] pre] - (code.replace (code.local-symbol from) to pre)) - aliased - aliases))] - (case [(|> inputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`)))) - (|> outputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))] + (list/fold (function [[from to] pre] + (code.replace (code.local-symbol from) to pre)) + aliased + aliases))] + (case [(|> inputs (get@ #bottom) (maybe/map (|>> code.nat (~) #.Bound (`)))) + (|> outputs (get@ #bottom) (maybe/map (|>> code.nat (~) #.Bound (`))))] [(#.Some bottomI) (#.Some bottomO)] (monad.do @ [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) bottomI))) @@ -80,9 +80,9 @@ [?bottomI ?bottomO] (with-gensyms [g!stack] (monad.do @ - [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) - outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] - (wrap (list (` (All [(~ g!stack)] + [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default (code.symbol g!stack) ?bottomI)))) + outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default (code.symbol g!stack) ?bottomO))))] + (wrap (list (` (All [(~@ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) @@ -104,33 +104,34 @@ (` (..push (~ command))) [_ (#.Tuple block)] - (` (..push (|>> (~@ (L/map prepare block))))) + (` (..push (|>> (~+ (list/map prepare block))))) _ command)) (syntax: #export (||> [commands (p.some s.any)]) - (wrap (list (` (|> ..begin! (~@ (L/map prepare commands)) ..end!))))) + (wrap (list (` (|> ..begin! (~+ (list/map prepare commands)) ..end!))))) (syntax: #export (word: [export csr.export] [name s.local-symbol] [annotations (p.default cs.empty-annotations csr.annotations)] type [commands (p.some s.any)]) - (wrap (list (` (def: (~@ (csw.export export)) (~ (code.local-symbol name)) + (wrap (list (` (def: (~+ (csw.export export)) (~ (code.local-symbol name)) (~ (csw.annotations annotations)) (~ type) - (|>> (~@ (L/map prepare commands)))))))) + (|>> (~+ (list/map prepare commands)))))))) (syntax: #export (apply [arity (|> s.nat (p.filter (.n/> +0)))]) (with-gensyms [g!func g!stack g!output] (monad.do @ - [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))] - (wrap (list (` (: (All [(~@ g!inputs) (~ g!output)] - (-> (-> (~@ g!inputs) (~ g!output)) - (=> [(~@ g!inputs)] [(~ g!output)]))) - (function [(~ g!func)] - (function [(~ (stack-fold g!inputs g!stack))] - [(~ g!stack) ((~ g!func) (~@ g!inputs))]))))))))) + [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @)) + #let [g!inputs (list/map code.symbol g!inputs)]] + (wrap (list (` (: (All [(~+ g!inputs) (~@ g!output)] + (-> (-> (~+ g!inputs) (~@ g!output)) + (=> [(~+ g!inputs)] [(~@ g!output)]))) + (function [(~@ g!func)] + (function [(~ (stack-fold g!inputs (code.symbol g!stack)))] + [(~@ g!stack) ((~@ g!func) (~+ g!inputs))]))))))))) ## [Primitives] (def: #export apply1 (apply +1)) diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index db0202e40..1f50fe547 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -57,9 +57,9 @@ (syntax: #export (pending expr) {#.doc (doc "Turns any expression into a function that is pending a continuation." - (pending (some-computation some-input)))} + (pending (some-function some-input)))} (with-gensyms [g!k] - (wrap (list (` (.function [(~ g!k)] ((~ g!k) (~ expr)))))))) + (wrap (list (` (.function [(~@ g!k)] ((~@ g!k) (~ expr)))))))) (def: #export (portal init) (All [i o z] diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux index ac0ae5432..71d476517 100644 --- a/stdlib/source/lux/control/contract.lux +++ b/stdlib/source/lux/control/contract.lux @@ -31,7 +31,7 @@ (i/+ 2 2)))} (do @ [g!output (macro.gensym "")] - (wrap (list (` (let [(~ g!output) (~ expr)] + (wrap (list (` (let [(~@ g!output) (~ expr)] (exec (assert! (~ (code.text (format "Post-condition failed: " (%code test)))) - ((~ test) (~ g!output))) - (~ g!output)))))))) + ((~ test) (~@ g!output))) + (~@ g!output)))))))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index d14158590..dcac4fc6d 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -74,6 +74,6 @@ [current-module macro.current-module-name #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") g!message (code.symbol ["" "message"])]] - (wrap (list (` (def: (~@ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message)) + (wrap (list (` (def: (~+ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message)) Exception (_text/compose_ (~ (code.text descriptor)) (~ g!message)))))))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index f8208fee6..09b41b530 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -21,7 +21,7 @@ (new> 0 i/inc)))} (case (list.reverse tokens) (^ (list& _ r-body)) - (wrap (list (` (|> (~@ (list.reverse r-body)))))) + (wrap (list (` (|> (~+ (list.reverse r-body)))))) _ (undefined))) @@ -45,17 +45,17 @@ [(new> -1)])))} (with-gensyms [g!temp] (wrap (list (` (with-expansions - [(~ g!temp) (~ prev)] - (cond (~@ (do Monad<List> + [(~@ g!temp) (~ prev)] + (cond (~+ (do Monad<List> [[test then] branches] - (list (` (|> (~ g!temp) (~@ test))) - (` (|> (~ g!temp) (~@ then)))))) + (list (` (|> (~@ g!temp) (~+ test))) + (` (|> (~@ g!temp) (~+ then)))))) (~ (case ?else (#.Some else) - (` (|> (~ g!temp) (~@ else))) + (` (|> (~@ g!temp) (~+ else))) _ - g!temp))))))))) + (code.symbol g!temp)))))))))) (syntax: #export (loop> [test body^] [then body^] prev) {#.doc (doc "Loops for pipes." @@ -64,10 +64,10 @@ (loop> [(i/< 10)] [i/inc])))} (with-gensyms [g!temp] - (wrap (list (` (loop [(~ g!temp) (~ prev)] - (if (|> (~ g!temp) (~@ test)) - ((~' recur) (|> (~ g!temp) (~@ then))) - (~ g!temp)))))))) + (wrap (list (` (loop [(~@ g!temp) (~ prev)] + (if (|> (~@ g!temp) (~+ test)) + ((~' recur) (|> (~@ g!temp) (~+ then))) + (~@ g!temp)))))))) (syntax: #export (do> monad [steps (p.some body^)] prev) {#.doc (doc "Monadic pipes." @@ -82,11 +82,11 @@ (^ (list& last-step prev-steps)) (let [step-bindings (do Monad<List> [step (list.reverse prev-steps)] - (list g!temp (` (|> (~ g!temp) (~@ step)))))] + (list (code.symbol g!temp) (` (|> (~@ g!temp) (~+ step)))))] (wrap (list (` (do (~ monad) - [(~ g!temp) (~ prev) - (~@ step-bindings)] - (|> (~ g!temp) (~@ last-step))))))) + [(~@ g!temp) (~ prev) + (~+ step-bindings)] + (|> (~@ g!temp) (~+ last-step))))))) _ (wrap (list prev))))) @@ -97,11 +97,10 @@ (|> 5 (exec> [int-to-nat %n log!]) (i/* 10)))} - (do @ - [g!temp (macro.gensym "")] - (wrap (list (` (let [(~ g!temp) (~ prev)] - (exec (|> (~ g!temp) (~@ body)) - (~ g!temp)))))))) + (with-gensyms [g!temp] + (wrap (list (` (let [(~@ g!temp) (~ prev)] + (exec (|> (~@ g!temp) (~+ body)) + (~@ g!temp)))))))) (syntax: #export (tuple> [paths (p.many body^)] prev) {#.doc (doc "Parallel branching for pipes." @@ -111,10 +110,9 @@ [i/dec (i// 2)] [Int/encode])) "Will become: [50 2 \"5\"]")} - (do @ - [g!temp (macro.gensym "")] - (wrap (list (` (let [(~ g!temp) (~ prev)] - [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body)))) + (with-gensyms [g!temp] + (wrap (list (` (let [(~@ g!temp) (~ prev)] + [(~+ (L/map (function [body] (` (|> (~@ g!temp) (~+ body)))) paths))])))))) (syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev) @@ -133,5 +131,5 @@ 9 "nine" _ "???")))} (wrap (list (` (case (~ prev) - (~@ (L/join (L/map (function [[pattern body]] (list pattern body)) + (~+ (L/join (L/map (function [[pattern body]] (list pattern body)) branches)))))))) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 27f4e8bad..9709db465 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -359,27 +359,27 @@ (let [(^open) Functor<List> indices (n/range +0 (n/dec num-lists)) type-vars (: (List Code) (map (|>> nat/encode symbol$) indices)) - zip-type (` (All [(~@ type-vars)] - (-> (~@ (map (: (-> Code Code) (function [var] (` (List (~ var))))) + zip-type (` (All [(~+ type-vars)] + (-> (~+ (map (: (-> Code Code) (function [var] (` (List (~ var))))) type-vars)) - (List [(~@ type-vars)])))) + (List [(~+ type-vars)])))) vars+lists (|> indices (map n/inc) (map (function [idx] (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) + pattern (` [(~+ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") list-vars (map product.right vars+lists) code (` (: (~ zip-type) - (function (~ g!step) [(~@ list-vars)] - (case [(~@ list-vars)] + (function (~ g!step) [(~+ list-vars)] + (case [(~+ list-vars)] (~ pattern) - (#.Cons [(~@ (map product.left vars+lists))] - ((~ g!step) (~@ list-vars))) + (#.Cons [(~+ (map product.left vars+lists))] + ((~ g!step) (~+ list-vars))) (~ g!blank) #.Nil))))] @@ -405,9 +405,9 @@ g!return-type (symbol$ "\treturn-type\t") g!func (symbol$ "\tfunc\t") type-vars (: (List Code) (map (|>> nat/encode symbol$) indices)) - zip-type (` (All [(~@ type-vars) (~ g!return-type)] - (-> (-> (~@ type-vars) (~ g!return-type)) - (~@ (map (: (-> Code Code) (function [var] (` (List (~ var))))) + zip-type (` (All [(~+ type-vars) (~ g!return-type)] + (-> (-> (~+ type-vars) (~ g!return-type)) + (~+ (map (: (-> Code Code) (function [var] (` (List (~ var))))) type-vars)) (List (~ g!return-type))))) vars+lists (|> indices @@ -416,17 +416,17 @@ (let [base (nat/encode idx)] [(symbol$ base) (symbol$ ("lux text concat" base "'"))])))) - pattern (` [(~@ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) + pattern (` [(~+ (map (function [[v vs]] (` (#.Cons (~ v) (~ vs)))) vars+lists))]) g!step (symbol$ "\tstep\t") g!blank (symbol$ "\t_\t") list-vars (map product.right vars+lists) code (` (: (~ zip-type) - (function (~ g!step) [(~ g!func) (~@ list-vars)] - (case [(~@ list-vars)] + (function (~ g!step) [(~ g!func) (~+ list-vars)] + (case [(~+ list-vars)] (~ pattern) - (#.Cons ((~ g!func) (~@ (map product.left vars+lists))) - ((~ g!step) (~ g!func) (~@ list-vars))) + (#.Cons ((~ g!func) (~+ (map product.left vars+lists))) + ((~ g!step) (~ g!func) (~+ list-vars))) (~ g!blank) #.Nil))))] diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index e5d2717fc..bc9787adf 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -369,7 +369,7 @@ (syntax: #export (sequence [elems (p.some s.any)]) {#.doc (doc "Sequence literals." (sequence 10 20 30 40))} - (wrap (list (` (from-list (list (~@ elems))))))) + (wrap (list (` (from-list (list (~+ elems))))))) ## [Structures] (struct: #export (Eq<Node> Eq<a>) (All [a] (-> (Eq a) (Eq (Node a)))) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index 0cfa549bb..d4ab696fd 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -6,7 +6,8 @@ [cont #+ pending Cont] ["p" parser]) [macro #+ with-gensyms] - (macro ["s" syntax #+ syntax: Syntax]) + (macro [code] + ["s" syntax #+ syntax: Syntax]) (data (coll [list "List/" Monad<List>]) bool))) @@ -134,10 +135,10 @@ "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] (func x y z)))} - (with-gensyms [g!s] - (let [body+ (` (let [(~@ (List/join (List/map (function [pattern] - (list (` [(~ pattern) (~ g!s)]) - (` (cont.run (~ g!s))))) + (with-gensyms [g!stream] + (let [body+ (` (let [(~+ (List/join (List/map (function [pattern] + (list (` [(~ pattern) (~@ g!stream)]) + (` (cont.run (~@ g!stream))))) patterns)))] (~ body)))] - (wrap (list& g!s body+ branches))))) + (wrap (list& (code.symbol g!stream) body+ branches))))) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index 077f68191..76f4f1894 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -51,7 +51,7 @@ 40 {}}]))} (wrap (list (` (~ (loop [[value children] root] (` {#value (~ value) - #children (list (~@ (L/map recur children)))}))))))) + #children (list (~+ (L/map recur children)))}))))))) ## [Structs] (struct: #export (Eq<Tree> Eq<a>) (All [a] (-> (Eq a) (Eq (Tree a)))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 37d6f954f..2e9a1ec8a 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -75,7 +75,7 @@ (wrap (list (` (: JSON #Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) + (wrap (list (` (: JSON (#Array (sequence (~+ (list/map wrapper members)))))))) [_ (#.Record pairs)] (do Monad<Meta> @@ -88,7 +88,7 @@ _ (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~@ pairs'))))))))) + (wrap (list (` (: JSON (#Object (dict.from-list text.Hash<Text> (list (~+ pairs'))))))))) _ (wrap (list token)) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 27c60afa9..54be54080 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -5,7 +5,7 @@ [applicative #+ Applicative] [monad #+ Monad do]) (concurrency [atom]) - [macro] + [macro #+ with-gensyms] (macro ["s" syntax #+ syntax:]) (type abstract))) @@ -30,9 +30,8 @@ ((@repr l-value) []))) (syntax: #export (freeze expr) - (do @ - [g!_ (macro.gensym "_")] - (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) + (with-gensyms [g!_] + (wrap (list (` (freeze' (function [(~@ g!_)] (~ expr)))))))) (struct: #export _ (Functor Lazy) (def: (map f fa) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index e1c93bc5f..f70a109f8 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -26,7 +26,7 @@ (syntax: #export (format [fragments (p.many s.any)]) {#.doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} - (wrap (list (` ($_ _compose_ (~@ fragments)))))) + (wrap (list (` ($_ _compose_ (~+ fragments)))))) ## [Formatters] (type: #export (Formatter a) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 1f1a0a3c0..bee56b728 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -10,7 +10,7 @@ ["e" error] [maybe] (coll [list "list/" Fold<List> Monad<List>])) - [macro #- run] + [macro #+ with-gensyms] (macro [code] ["s" syntax #+ syntax:]))) @@ -103,8 +103,8 @@ re-range^ re-options^))] (wrap (case negate? - (#.Some _) (` (l.not ($_ p.either (~@ parts)))) - #.None (` ($_ p.either (~@ parts))))))) + (#.Some _) (` (l.not ($_ p.either (~+ parts)))) + #.None (` ($_ p.either (~+ parts))))))) (def: re-user-class^ (l.Lexer Code) @@ -308,8 +308,8 @@ +0) (` (do p.Monad<Parser> [(~ (' #let)) [(~ g!total) ""] - (~@ (|> steps list.reverse list/join))] - ((~ (' wrap)) [(~ g!total) (~@ (list.reverse names))])))]) + (~+ (|> steps list.reverse list/join))] + ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))]) )) (def: #hidden (unflatten^ lexer) @@ -367,7 +367,7 @@ (if (list.empty? tail) (wrap head) (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) - (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (list/map prep-alternative tail))))])))) + (` ($_ (~ g!op) (~ (prep-alternative head)) (~+ (list/map prep-alternative tail))))])))) (def: (re-scoped^ current-module) (-> Text (l.Lexer [Re-Group Code])) @@ -484,11 +484,10 @@ _ do-something-else))} - (do @ - [g!temp (macro.gensym "temp")] - (wrap (list& (` (^multi (~ g!temp) - [(l.run (~ g!temp) (regex (~ (code.text pattern)))) - (#e.Success (~ (maybe.default g!temp + (with-gensyms [g!temp] + (wrap (list& (` (^multi (~@ g!temp) + [(l.run (~@ g!temp) (regex (~ (code.text pattern)))) + (#e.Success (~ (maybe.default (code.symbol g!temp) bindings)))])) body branches)))) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 5e52cc283..fafaa81c7 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -77,8 +77,8 @@ (case shape (#.Left [function args ?type]) (wrap (list (` (:! (~ (default (' ..Object) ?type)) - ("js call" (~ function) (~@ args)))))) + ("js call" (~ function) (~+ args)))))) (#.Right [object field args ?type]) (wrap (list (` (:! (~ (default (' ..Object) ?type)) - ("js object-call" (~ object) (~ (code.text field)) (~@ args)))))))) + ("js object-call" (~ object) (~ (code.text field)) (~+ args)))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index a53ec1a5f..29937c041 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -290,7 +290,7 @@ [[name params] _ _] (let [name (sanitize name) =params (list/map (class->type' mode type-params in-array?) params)] - (` (primitive (~ (code.text name)) [(~@ =params)]))))) + (` (primitive (~ (code.text name)) [(~+ =params)]))))) (def: (class->type' mode type-params in-array? class) (-> Primitive-Mode (List TypeParam) Bool GenericType Code) @@ -341,7 +341,7 @@ (class->type #ManualPrM class-params bound1)))) class-params)] (` (primitive (~ (code.text (sanitize class-name))) - [(~@ =params)])))) + [(~+ =params)])))) (def: empty-imports Class-Imports @@ -579,7 +579,7 @@ (s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) - (~@ args)))))) + (~+ args)))))) (def: (make-static-method-parser params class-name method-name arg-decls) (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) @@ -589,7 +589,7 @@ (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) - (~@ args)))))) + (~+ args)))))) (do-template [<name> <jvm-op>] [(def: (<name> params class-name method-name arg-decls) @@ -600,7 +600,7 @@ (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) - (~' _jvm_this) (~@ args))))))] + (~' _jvm_this) (~+ args))))))] [make-special-method-parser "jvm invokespecial"] [make-virtual-method-parser "jvm invokevirtual"] @@ -1206,7 +1206,7 @@ #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list))) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text.join-with "," arg-decls')))) - (~' _jvm_this) (~@ args)))))))] + (~' _jvm_this) (~+ args)))))))] (with-parens (spaced (list "override" (class-decl$ class-decl) @@ -1259,9 +1259,9 @@ (generic-type$ return-type)))) )) -(def: (complete-call$ obj [method args]) - (-> Code Partial-Call Code) - (` ((~ method) (~ args) (~ obj)))) +(def: (complete-call$ g!obj [method args]) + (-> Ident Partial-Call Code) + (` ((~ method) (~ args) (~@ g!obj)))) ## [Syntax] (def: object-super-class @@ -1402,10 +1402,10 @@ "=>" (#.Some "YOLO"))} (with-gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm null?" (~ g!temp)) + (wrap (list (` (let [(~@ g!temp) (~ expr)] + (if ("jvm null?" (~@ g!temp)) #.None - (#.Some (~ g!temp))))))))) + (#.Some (~@ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1418,8 +1418,8 @@ "YOLO")} (with-gensyms [g!value] (wrap (list (` ("lux case" (~ expr) - {(#.Some (~ g!value)) - (~ g!value) + {(#.Some (~@ g!value)) + (~@ g!value) #.None ("jvm null")})))))) @@ -1430,7 +1430,7 @@ "If it fails, you get (#.Left error+stack-traces-as-text)." (try (risky-computation input)))} (with-gensyms [g!_] - (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr)))))))) + (wrap (list (`' ("lux try" (.function [(~@ g!_)] (~ expr)))))))) (syntax: #export (instance? [#let [imports (class-imports *compiler*)]] [class (generic-type^ imports (list))] @@ -1446,8 +1446,8 @@ (do @ [g!obj (macro.gensym "obj")] (wrap (list (` (: (-> (primitive "java.lang.Object") Bool) - (function [(~ g!obj)] - ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) + (function [(~@ g!obj)] + ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~@ g!obj)))))))) )) (syntax: #export (synchronized lock body) @@ -1464,9 +1464,9 @@ (ClassName::method1 [arg0 arg1 arg2]) (ClassName::method2 [arg3 arg4 arg5])))} (with-gensyms [g!obj] - (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~@ (list/map (complete-call$ g!obj) methods)) - (~ g!obj)))))))) + (wrap (list (` (let [(~@ g!obj) (~ obj)] + (exec (~+ (list/map (complete-call$ g!obj) methods)) + (~@ g!obj)))))))) (def: (class-import$ long-name? [full-name params]) (-> Bool ClassDecl Code) @@ -1478,9 +1478,9 @@ {#.type? true #..jvm-class (~ (code.text full-name))} Type - (All [(~@ params')] + (All [(~+ params')] (primitive (~ (code.text (sanitize full-name))) - [(~@ params')])))))) + [(~+ params')])))))) (def: (member-type-vars class-tvars member) (-> (List TypeParam) ImportMemberDecl (List TypeParam)) @@ -1509,9 +1509,10 @@ (: (-> [Bool GenericType] (Meta [Code Code])) (function [[maybe? _]] (with-gensyms [arg-name] - (wrap [arg-name (if maybe? - (` (!!! (~ arg-name))) - arg-name)])))) + (let [arg-name (code.symbol arg-name)] + (wrap [arg-name (if maybe? + (` (!!! (~ arg-name))) + arg-name)]))))) import-member-args) #let [arg-classes (: (List Text) (list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars))) @@ -1550,11 +1551,11 @@ [(` (Maybe (~ return-type))) (` (??? (~ return-term)))] [return-type - (let [g!temp (code.symbol ["" "Ω"])] - (` (let [(~ g!temp) (~ return-term)] + (let [g!temp ["" "Ω"]] + (` (let [(~@ g!temp) (~ return-term)] (if (not (null? (:! (primitive "java.lang.Object") - (~ g!temp)))) - (~ g!temp) + (~@ g!temp)))) + (~@ g!temp) (error! "Cannot produce null references from method calls.")))))]) _ @@ -1634,7 +1635,7 @@ body #AutoPrM - (` (let [(~@ (|> inputs + (` (let [(~+ (|> inputs (list/map auto-conv) list/join))] (~ body))))) @@ -1653,19 +1654,19 @@ "float" (` (f2d (~ output))) _ output))) -(def: (with-mode-field-set mode class input) - (-> Primitive-Mode GenericType Code Code) +(def: (with-mode-field-set mode class g!input) + (-> Primitive-Mode GenericType Ident Code) (case mode #ManualPrM - input + (code.symbol g!input) #AutoPrM (case (simple-class$ (list) class) - "byte" (` (l2b (~ input))) - "short" (` (l2s (~ input))) - "int" (` (l2i (~ input))) - "float" (` (d2f (~ input))) - _ input))) + "byte" (` (l2b (~@ g!input))) + "short" (` (l2s (~@ g!input))) + "int" (` (l2i (~@ g!input))) + "float" (` (d2f (~@ g!input))) + _ (code.symbol g!input)))) (def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix) (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code))) @@ -1686,7 +1687,7 @@ (let [=class-tvars (|> class-tvars (list.filter free-type-param?) (list/map type-param->type-arg))] - (` (All [(~@ =class-tvars)] (primitive (~ (code.text full-name)) [(~@ =class-tvars)])))))) + (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) getter-interop (: (-> Text Code) (function [name] (let [getter-name (code.symbol ["" (format method-prefix member-separator name)])] @@ -1701,15 +1702,15 @@ #let [def-name (code.symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) def-params (list (code.tuple arg-function-inputs)) jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))) - (~@ arg-method-inputs))) + (~+ arg-method-inputs))) (with-mode-inputs (get@ #import-member-mode commons) (list.zip2 arg-classes arg-function-inputs))) [return-type jvm-interop] (|> [return-type jvm-interop] (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` (def: ((~ def-name) (~@ def-params)) - (All [(~@ all-params)] (-> [(~@ arg-types)] (~ return-type))) + (wrap (list (` (def: ((~ def-name) (~+ def-params)) + (All [(~+ all-params)] (-> [(~+ arg-types)] (~ return-type))) (~ jvm-interop)))))) (#MethodDecl [commons method]) @@ -1730,19 +1731,19 @@ (case kind #Class ["invokevirtual" - (list g!obj) + (list (code.symbol g!obj)) (list (class-decl-type$ class))] #Interface ["invokeinterface" - (list g!obj) + (list (code.symbol g!obj)) (list (class-decl-type$ class))] ))) def-params (#.Cons (code.tuple arg-function-inputs) obj-ast) - def-param-types (#.Cons (` [(~@ arg-types)]) class-ast) + def-param-types (#.Cons (` [(~+ arg-types)]) class-ast) jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes)))) - (~@ obj-ast) (~@ arg-method-inputs))) + (~+ obj-ast) (~+ arg-method-inputs))) (with-mode-output (get@ #import-member-mode commons) (get@ #import-method-return method)) (with-mode-inputs (get@ #import-member-mode commons) @@ -1751,16 +1752,16 @@ (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` (def: ((~ def-name) (~@ def-params)) - (All [(~@ all-params)] (-> (~@ def-param-types) (~ return-type))) + (wrap (list (` (def: ((~ def-name) (~+ def-params)) + (All [(~+ all-params)] (-> (~+ def-param-types) (~ return-type))) (~ jvm-interop))))))) (#FieldAccessDecl fad) (do Monad<Meta> [#let [(^open) fad base-gtype (class->type import-field-mode type-params import-field-type) - g!class (class-decl-type$ class) - g!type (if import-field-maybe? + classC (class-decl-type$ class) + typeC (if import-field-maybe? (` (Maybe (~ base-gtype))) base-gtype) tvar-asts (: (List Code) @@ -1772,19 +1773,19 @@ getter-interop (with-gensyms [g!obj] (let [getter-call (if import-field-static? getter-name - (` ((~ getter-name) (~ g!obj)))) + (` ((~ getter-name) (~@ g!obj)))) getter-type (if import-field-setter? - (` (IO (~ g!type))) - g!type) + (` (IO (~ typeC))) + typeC) getter-type (if import-field-static? getter-type - (` (-> (~ g!class) (~ getter-type)))) - getter-type (` (All [(~@ tvar-asts)] (~ getter-type))) + (` (-> (~ classC) (~ getter-type)))) + getter-type (` (All [(~+ tvar-asts)] (~ getter-type))) getter-body (if import-field-static? (with-mode-field-get import-field-mode import-field-type (` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) (with-mode-field-get import-field-mode import-field-type - (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) + (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~@ g!obj))))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1797,11 +1798,11 @@ setter-interop (if import-field-setter? (with-gensyms [g!obj g!value] (let [setter-call (if import-field-static? - (` ((~ setter-name) (~ g!value))) - (` ((~ setter-name) (~ g!value) (~ g!obj)))) + (` ((~ setter-name) (~@ g!value))) + (` ((~ setter-name) (~@ g!value) (~@ g!obj)))) setter-type (if import-field-static? - (` (All [(~@ tvar-asts)] (-> (~ g!type) (IO Unit)))) - (` (All [(~@ tvar-asts)] (-> (~ g!type) (~ g!class) (IO Unit))))) + (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit)))) + (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit))))) setter-value (with-mode-field-set import-field-mode import-field-type g!value) setter-value (if import-field-maybe? (` (!!! (~ setter-value))) @@ -1980,8 +1981,8 @@ _ (with-gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array-read (~ idx) (~ g!array))))))))) + (wrap (list (` (let [(~@ g!array) (~ array)] + (..array-read (~ idx) (~@ g!array))))))))) (syntax: #export (array-write idx value array) {#.doc (doc "Stores an element into an array." @@ -2009,8 +2010,8 @@ _ (with-gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array-write (~ idx) (~ value) (~ g!array))))))))) + (wrap (list (` (let [(~@ g!array) (~ array)] + (..array-write (~ idx) (~ value) (~@ g!array))))))))) (def: simple-bindings^ (Syntax (List [Text Code])) @@ -2033,10 +2034,10 @@ (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.symbol ["" (product.left res)])))))) bindings)] (wrap (list (` (do Monad<IO> - [(~@ inits) - (~ g!output) (~ body) - (~' #let) [(~ g!_) (exec (~@ (list.reverse closes)) [])]] - ((~' wrap) (~ g!output))))))))) + [(~+ inits) + (~@ g!output) (~ body) + (~' #let) [(~@ g!_) (exec (~+ (list.reverse closes)) [])]] + ((~' wrap) (~@ g!output))))))))) (syntax: #export (class-for [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))]) diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux index ab680cb6c..43febdb8c 100644 --- a/stdlib/source/lux/lang/type.lux +++ b/stdlib/source/lux/lang/type.lux @@ -169,7 +169,7 @@ (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (list (~@ (list/map to-ast params))))) + (list (~+ (list/map to-ast params))))) (^template [<tag>] <tag> @@ -189,7 +189,7 @@ (^template [<tag> <macro> <flattener>] (<tag> left right) - (` (<macro> (~@ (list/map to-ast (<flattener> type)))))) + (` (<macro> (~+ (list/map to-ast (<flattener> type)))))) ([#.Sum | flatten-variant] [#.Product & flatten-tuple]) @@ -198,7 +198,7 @@ (^template [<tag>] (<tag> env body) - (` (<tag> (list (~@ (list/map to-ast env))) + (` (<tag> (list (~+ (list/map to-ast env))) (~ (to-ast body))))) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 0b28598c8..384a723c9 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -361,10 +361,10 @@ {#.doc "Generates a unique identifier as an Code node (ready to be used in code templates). A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} - (-> Text (Meta Code)) + (-> Text (Meta Ident)) (function [compiler] (#e.Success [(update@ #.seed n/inc compiler) - (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))])]))) + ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))]]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) @@ -379,11 +379,11 @@ {#.doc (doc "Creates new symbols and offers them to the body expression." (syntax: #export (synchronized lock body) (with-gensyms [g!lock g!body g!_] - (wrap (list (` (let [(~ g!lock) (~ lock) - (~ g!_) ("jvm monitorenter" (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) ("jvm monitorexit" (~ g!lock))] - (~ g!body))))) + (wrap (list (` (let [(~@ g!lock) (~ lock) + (~@ g!_) ("jvm monitorenter" (~ g!lock)) + (~@ g!body) (~ body) + (~@ g!_) ("jvm monitorexit" (~ g!lock))] + (~@ g!body))))) )))} (case tokens (^ (list [_ (#.Tuple symbols)] body)) @@ -393,7 +393,7 @@ (function [name] (list (code.symbol ["" name]) (` (gensym (~ (code.text name))))))) symbol-names))]] (wrap (list (` (do Monad<Meta> - [(~@ symbol-defs)] + [(~+ symbol-defs)] (~ body)))))) _ diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 05a609e1b..118723709 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -200,7 +200,7 @@ (let [partialI (|> current-arg (n/* +2) (n/+ funcI)) partial-varI (n/inc partialI) partial-varL (label partial-varI) - partialC (` ((~ funcL) (~@ (|> (list.n/range +0 (n/dec num-args)) + partialC (` ((~ funcL) (~+ (|> (list.n/range +0 (n/dec num-args)) (list/map (|>> (n/* +2) n/inc (n/+ funcI) label)) list.reverse))))] (recur (n/inc current-arg) @@ -336,7 +336,7 @@ (|> allT (monad.map @ (function.const bound)) (local allT)))] - (wrap (` ((~@ allC)))))) + (wrap (` ((~+ allC)))))) (def: #export log (All [a] (Poly a)) @@ -352,21 +352,21 @@ [name s.local-symbol] body) (with-gensyms [g!type g!output] - (let [g!name (code.symbol ["" name])] - (wrap (.list (` (syntax: (~@ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol]) + (let [g!name ["" name]] + (wrap (.list (` (syntax: (~+ (csw.export export)) ((~@ g!name) [(~@ g!type) s.symbol]) (do macro.Monad<Meta> - [(~ g!type) (macro.find-type-def (~ g!type))] + [(~@ g!type) (macro.find-type-def (~@ g!type))] (case (|> (~ body) - (.function [(~ g!name)]) + (.function [(~@ g!name)]) p.rec (do p.Monad<Parser> []) - (..run (~ g!type)) + (..run (~@ g!type)) (: (.Either .Text .Code))) - (#.Left (~ g!output)) - (macro.fail (~ g!output)) + (#.Left (~@ g!output)) + (macro.fail (~@ g!output)) - (#.Right (~ g!output)) - ((~' wrap) (.list (~ g!output)))))))))))) + (#.Right (~@ g!output)) + ((~' wrap) (.list (~@ g!output)))))))))))) (def: (common-poly-name? poly-func) (-> Text Bool) @@ -400,8 +400,8 @@ custom-impl #.None - (` ((~ (code.symbol poly-func)) (~@ (list/map code.symbol poly-args)))))]] - (wrap (.list (` (def: (~@ (csw.export export)) + (` ((~ (code.symbol poly-func)) (~+ (list/map code.symbol poly-args)))))]] + (wrap (.list (` (def: (~+ (csw.export export)) (~ (code.symbol ["" name])) {#.struct? true} (~ impl))))))) @@ -412,7 +412,7 @@ (case type (#.Primitive name params) (` (#.Primitive (~ (code.text name)) - (list (~@ (list/map (to-ast env) params))))) + (list (~+ (list/map (to-ast env) params))))) (^template [<tag>] <tag> @@ -444,7 +444,7 @@ (^template [<tag> <macro> <flattener>] (<tag> left right) - (` (<macro> (~@ (list/map (to-ast env) (<flattener> type)))))) + (` (<macro> (~+ (list/map (to-ast env) (<flattener> type)))))) ([#.Sum | type.flatten-variant] [#.Product & type.flatten-tuple]) @@ -453,7 +453,7 @@ (^template [<tag>] (<tag> scope body) - (` (<tag> (list (~@ (list/map (to-ast env) scope))) + (` (<tag> (list (~+ (list/map (to-ast env) scope))) (~ (to-ast env body))))) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index 46feab967..3550df0c0 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -100,7 +100,7 @@ (wrap (` (: (~ (@Eq inputT)) (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] - (~@ (list/join (list/map (function [[tag g!eq]] + (~+ (list/join (list/map (function [[tag g!eq]] (list (` [((~ (code.nat tag)) (~ g!left)) ((~ (code.nat tag)) (~ g!right))]) (` ((~ g!eq) (~ g!left) (~ g!right))))) @@ -114,8 +114,8 @@ g!lefts (list/map (|>> nat/encode (text/compose "left") code.local-symbol) indices) g!rights (list/map (|>> nat/encode (text/compose "right") code.local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) - (function [[(~@ g!lefts)] [(~@ g!rights)]] - (and (~@ (|> (list.zip3 g!eqs g!lefts g!rights) + (function [[(~+ g!lefts)] [(~+ g!rights)]] + (and (~+ (|> (list.zip3 g!eqs g!lefts g!rights) (list/map (function [[g!eq g!left g!right]] (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion @@ -128,16 +128,16 @@ ## Type applications (do @ [[funcC argsC] (poly.apply (p.seq Eq<?> (p.many Eq<?>)))] - (wrap (` ((~ funcC) (~@ argsC))))) + (wrap (` ((~ funcC) (~+ argsC))))) ## Bound type-vars poly.bound ## Polymorphism (do @ [[funcC varsC bodyC] (poly.polymorphic Eq<?>)] - (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) eq.Eq (`)) varsC)) - (eq.Eq ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) - (function (~ funcC) [(~@ varsC)] + (wrap (` (: (All [(~+ varsC)] + (-> (~+ (list/map (|>> (~) eq.Eq (`)) varsC)) + (eq.Eq ((~ (poly.to-ast *env* inputT)) (~+ varsC))))) + (function (~ funcC) [(~+ varsC)] (~ bodyC)))))) poly.recursive-call ## If all else fails... diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index fbd8dcd03..79740c32c 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -30,8 +30,8 @@ (if (n/= +1 num-vars) (` (functor.Functor (~ (poly.to-ast *env* unwrappedT)))) (let [paramsC (|> num-vars n/dec list.indices (L/map (|>> %n code.local-symbol)))] - (` (All [(~@ paramsC)] - (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~@ paramsC))))))))) + (` (All [(~+ paramsC)] + (functor.Functor ((~ (poly.to-ast *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (: (-> Code (poly.Poly Code)) (function Arg<?> [valueC] ($_ p.either @@ -45,7 +45,7 @@ [_ (wrap []) membersC (poly.variant (p.many (Arg<?> valueC)))] (wrap (` (case (~ valueC) - (~@ (L/join (L/map (function [[tag memberC]] + (~+ (L/join (L/map (function [[tag memberC]] (list (` ((~ (code.nat tag)) (~ valueC))) (` ((~ (code.nat tag)) (~ memberC))))) (list.enumerate membersC)))))))) @@ -63,8 +63,8 @@ (L/compose pairsCC (list [slotC memberC]))))) (wrap pairsCC)))))] (wrap (` (case (~ valueC) - [(~@ (L/map product.left pairsCC))] - [(~@ (L/map product.right pairsCC))])))) + [(~+ (L/map product.left pairsCC))] + [(~+ (L/map product.right pairsCC))])))) ## Functions (do @ [_ (wrap []) @@ -74,8 +74,8 @@ #let [inC+ (|> (list.size inT+) n/dec (list.n/range +0) (L/map (|>> %n (format "\u0000inC") code.local-symbol)))]] - (wrap (` (function [(~@ inC+)] - (let [(~ outL) ((~ valueC) (~@ inC+))] + (wrap (` (function [(~+ inC+)] + (let [(~ outL) ((~ valueC) (~+ inC+))] (~ outC)))))) ## Recursion (do p.Monad<Parser> diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 3a5148377..a81ca1bb4 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -150,7 +150,7 @@ (wrap (` (: (~ (@JSON//encode inputT)) (function [(~ g!input)] (case (~ g!input) - (~@ (list/join (list/map (function [[tag g!encode]] + (~+ (list/join (list/map (function [[tag g!encode]] (list (` ((~ (code.nat tag)) (~ g!input))) (` (//.json [(~ (code.frac (..tag tag))) ((~ g!encode) (~ g!input))])))) @@ -161,8 +161,8 @@ (list.n/range +0) (list/map (|>> nat/encode code.local-symbol)))]] (wrap (` (: (~ (@JSON//encode inputT)) - (function [[(~@ g!members)]] - (//.json [(~@ (list/map (function [[g!member g!encode]] + (function [[(~+ g!members)]] + (//.json [(~+ (list/map (function [[g!member g!encode]] (` ((~ g!encode) (~ g!member)))) (list.zip2 g!members g!encoders)))])))))) ## Type recursion @@ -175,16 +175,16 @@ ## Type applications (do @ [partsC (poly.apply (p.many Codec<JSON,?>//encode))] - (wrap (` ((~@ partsC))))) + (wrap (` ((~+ partsC))))) ## Polymorphism (do @ [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//encode)] - (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (function [varC] (` (-> (~ varC) //.JSON))) + (wrap (` (: (All [(~+ varsC)] + (-> (~+ (list/map (function [varC] (` (-> (~ varC) //.JSON))) varsC)) - (-> ((~ (poly.to-ast *env* inputT)) (~@ varsC)) + (-> ((~ (poly.to-ast *env* inputT)) (~+ varsC)) //.JSON))) - (function (~ funcC) [(~@ varsC)] + (function (~ funcC) [(~+ varsC)] (~ bodyC)))))) poly.bound poly.recursive-call @@ -252,7 +252,7 @@ [members (poly.variant (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) ($_ p.alt - (~@ (list/map (function [[tag memberC]] + (~+ (list/map (function [[tag memberC]] (` (|> (~ memberC) (p.after (//.number! (~ (code.frac (..tag tag))))) //.array))) @@ -260,7 +260,7 @@ (do @ [g!decoders (poly.tuple (p.many Codec<JSON,?>//decode))] (wrap (` (: (~ (@JSON//decode inputT)) - (//.array ($_ p.seq (~@ g!decoders))))))) + (//.array ($_ p.seq (~+ g!decoders))))))) ## Type recursion (do @ [[selfC bodyC] (poly.recursive Codec<JSON,?>//decode)] @@ -271,14 +271,14 @@ ## Type applications (do @ [[funcC argsC] (poly.apply (p.seq Codec<JSON,?>//decode (p.many Codec<JSON,?>//decode)))] - (wrap (` ((~ funcC) (~@ argsC))))) + (wrap (` ((~ funcC) (~+ argsC))))) ## Polymorphism (do @ [[funcC varsC bodyC] (poly.polymorphic Codec<JSON,?>//decode)] - (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>> (~) //.Reader (`)) varsC)) - (//.Reader ((~ (poly.to-ast *env* inputT)) (~@ varsC))))) - (function (~ funcC) [(~@ varsC)] + (wrap (` (: (All [(~+ varsC)] + (-> (~+ (list/map (|>> (~) //.Reader (`)) varsC)) + (//.Reader ((~ (poly.to-ast *env* inputT)) (~+ varsC))))) + (function (~ funcC) [(~+ varsC)] (~ bodyC)))))) poly.bound poly.recursive-call @@ -308,5 +308,5 @@ (with-gensyms [g!inputs] (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) (Codec<JSON,?>//encode (~ inputT))) - (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) + (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) (Codec<JSON,?>//decode (~ inputT)))) ))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index b18e0763f..48fd00a7c 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -200,7 +200,7 @@ (def: #hidden _Monad<Parser>_ p.Monad<Parser>) (macro: #export (syntax: tokens) - {#.doc (doc "A more advanced way to define macros than macro:." + {#.doc (doc "A more advanced way to define macros than \"macro:\"." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Monad<Meta>, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." @@ -256,7 +256,7 @@ _ (macro.fail "Syntax pattern expects tuples or symbols.")))) args) - #let [g!state (code.symbol ["" "*compiler*"]) + #let [g!state ["" "*compiler*"] error-msg (code.text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? (#.Some #.Left) @@ -267,20 +267,20 @@ _ (list)))]] - (wrap (list (` (macro: (~@ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) + (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~@ g!tokens) (~@ g!state)) (~ meta) - ("lux case" (..run (~ g!tokens) + ("lux case" (..run (~@ g!tokens) (: (Syntax (Meta (List Code))) (do .._Monad<Parser>_ - [(~@ (join-pairs vars+parsers))] + [(~+ (join-pairs vars+parsers))] ((~' wrap) (do macro.Monad<Meta> [] (~ body)))))) - {(#E.Success (~ g!body)) - ((~ g!body) (~ g!state)) + {(#E.Success (~@ g!body)) + ((~@ g!body) (~@ g!state)) - (#E.Error (~ g!msg)) - (#E.Error (text/join-with ": " (list (~ error-msg) (~ g!msg))))}))))))) + (#E.Error (~@ g!msg)) + (#E.Error (text/join-with ": " (list (~ error-msg) (~@ g!msg))))}))))))) _ (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 66bec5d9b..7c24e22d5 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -187,15 +187,15 @@ (|> x (+ y) (- y) (= x))))))) )} (with-gensyms [g!context g!test g!error] - (wrap (list (` (def: #export (~ g!context) + (wrap (list (` (def: #export (~@ g!context) {#..test (.._code/text_ (~ description))} (IO Test) (io (case ("lux try" [(io (do ..Monad<Random> [] (~ test)))]) - (#.Right (~ g!test)) - (~ g!test) + (#.Right (~@ g!test)) + (~@ g!test) - (#.Left (~ g!error)) - (..fail (~ g!error)))))))))) + (#.Left (~@ g!error)) + (..fail (~@ g!error)))))))))) (def: (exported-tests module-name) (-> Text (Meta (List [Text Text Text]))) @@ -234,24 +234,24 @@ groups (list.split-all promise.concurrency-level tests+)]] (wrap (list (` (: (IO Unit) (io (exec (do Monad<Promise> - [(~' #let) [(~ g!total-successes) +0 - (~ g!total-failures) +0] - (~@ (list/join (list/map (function [group] - (list (` [(~ g!successes) (~ g!failures)]) (` (run' (list (~@ group)))) - (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) - (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))]))) + [(~' #let) [(~@ g!total-successes) +0 + (~@ g!total-failures) +0] + (~+ (list/join (list/map (function [group] + (list (` [(~@ g!successes) (~@ g!failures)]) (` (run' (list (~+ group)))) + (' #let) (` [(~@ g!total-successes) (n/+ (~@ g!successes) (~@ g!total-successes)) + (~@ g!total-failures) (n/+ (~@ g!failures) (~@ g!total-failures))]))) groups)))] (exec (log! ($_ _composeT_ "Test-suite finished." "\n" - (_%i_ (nat-to-int (~ g!total-successes))) + (_%i_ (nat-to-int (~@ g!total-successes))) " out of " - (_%i_ (nat-to-int (n/+ (~ g!total-failures) - (~ g!total-successes)))) + (_%i_ (nat-to-int (n/+ (~@ g!total-failures) + (~@ g!total-successes)))) " tests passed." "\n" - (_%i_ (nat-to-int (~ g!total-failures))) " tests failed.")) - (promise.future (if (n/> +0 (~ g!total-failures)) + (_%i_ (nat-to-int (~@ g!total-failures))) " tests failed.")) + (promise.future (if (n/> +0 (~@ g!total-failures)) ..die ..exit)))) []))))))))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 8d20c25c5..81f879f7b 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -63,8 +63,8 @@ (do macro.Monad<Meta> [this-module (macro.find-module this-module-name) #let [type-varsC (list/map code.local-symbol type-vars) - abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~@ type-varsC))) + abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC))) + representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~+ type-varsC))) this-module (|> this-module (update@ #.defs (put down-cast (: Def [Macro macro-anns @@ -72,7 +72,7 @@ (function [tokens] (case tokens (^ (list value)) - (wrap (list (` ((: (All [(~@ type-varsC)] + (wrap (list (` ((: (All [(~+ type-varsC)] (-> (~ representation-declaration) (~ abstract-declaration))) (|>> :!!)) (~ value))))) @@ -85,7 +85,7 @@ (function [tokens] (case tokens (^ (list value)) - (wrap (list (` ((: (All [(~@ type-varsC)] + (wrap (list (` ((: (All [(~+ type-varsC)] (-> (~ abstract-declaration) (~ representation-declaration))) (|>> :!!)) (~ value))))) @@ -154,13 +154,13 @@ [primitives (p.some s.any)]) (let [hidden-name (representation-name name) type-varsC (list/map code.local-symbol type-vars) - abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code.local-symbol hidden-name)) (~@ type-varsC)))] - (wrap (list& (` (type: (~@ (csw.export export)) (~ abstract-declaration) + abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC))) + representation-declaration (` ((~ (code.local-symbol hidden-name)) (~+ type-varsC)))] + (wrap (list& (` (type: (~+ (csw.export export)) (~ abstract-declaration) (~ (csw.annotations annotations)) - (primitive (~ (code.text hidden-name)) [(~@ type-varsC)]))) - (` (type: (~@ (csw.export export)) (~ representation-declaration) + (primitive (~ (code.text hidden-name)) [(~+ type-varsC)]))) + (` (type: (~+ (csw.export export)) (~ representation-declaration) (~ representation-type))) - (` (install-casts (~ (code.local-symbol name)) [(~@ type-varsC)])) + (` (install-casts (~ (code.local-symbol name)) [(~+ type-varsC)])) (list/compose primitives (list (` (un-install-casts)))))))) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 39acf31ba..4d9fc797c 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -302,7 +302,7 @@ (code.symbol constructor) _ - (` ((~ (code.symbol constructor)) (~@ (list/map instance$ dependencies)))))) + (` ((~ (code.symbol constructor)) (~+ (list/map instance$ dependencies)))))) (syntax: #export (::: [member s.symbol] [args (p.alt (p.seq (p.some s.symbol) s.end!) @@ -344,7 +344,7 @@ (#.Cons chosen #.Nil) (wrap (list (` (:: (~ (instance$ chosen)) (~ (code.local-symbol (product.right member))) - (~@ (list/map code.symbol args)))))) + (~+ (list/map code.symbol args)))))) _ (macro.fail (format "Too many options available: " @@ -355,9 +355,9 @@ (#.Right [args _]) (do @ - [labels (monad.seq @ (list.repeat (list.size args) - (macro.gensym ""))) - #let [retry (` (let [(~@ (|> (list.zip2 labels args) (list/map join-pair) list/join))] - (..::: (~ (code.symbol member)) (~@ labels))))]] + [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @)) + #let [labels (list/map code.symbol labels) + retry (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))] + (..::: (~ (code.symbol member)) (~+ labels))))]] (wrap (list retry))) )) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index ba4b06384..03c3fb8a7 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -1,15 +1,15 @@ (.module: lux - (lux (control ["M" monad #+ do Monad] + (lux (control [monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) (data [text] text/format [product] [maybe] - [ident #+ "Ident/" Eq<Ident>] - (coll [list "L/" Functor<List> Fold<List> Monoid<List>] + [ident #+ "ident/" Eq<Ident>] + (coll [list "list/" Functor<List> Fold<List> Monoid<List>] [set #+ Set])) - [macro #+ Monad<Meta> "Macro/" Monad<Meta>] + [macro #+ Monad<Meta> "macro/" Monad<Meta>] (macro [code] ["s" syntax #+ syntax:] (syntax ["cs" common] @@ -66,7 +66,7 @@ (|> (list.size ancestors) n/dec (list.n/range +0) - (L/map (|>> %n (format "ancestor") code.local-symbol))))) + (list/map (|>> %n (format "ancestor") code.local-symbol))))) ## [Methods] (type: Method @@ -85,33 +85,33 @@ s.any))) (def: (declarationM g!self (^open)) - (-> Code Method Code) - (let [g!type-vars (L/map code.local-symbol type-vars) + (-> Ident Method Code) + (let [g!type-vars (list/map code.local-symbol type-vars) g!method (code.local-symbol name)] - (` (: (All [(~@ g!type-vars)] - (-> (~@ inputs) (~ g!self) (~ output))) + (` (: (All [(~+ g!type-vars)] + (-> (~+ inputs) (~@ g!self) (~ output))) (~ g!method))))) (def: (definition export [interface parameters] g!self-object g!ext g!states (^open)) - (-> (Maybe cs.Export) Declaration Code Code (List Code) Method Code) + (-> (Maybe cs.Export) Declaration Code Ident (List Code) Method Code) (let [g!method (code.local-symbol name) - g!parameters (L/map code.local-symbol parameters) - g!type-vars (L/map code.local-symbol type-vars) + g!parameters (list/map code.local-symbol parameters) + g!type-vars (list/map code.local-symbol type-vars) g!_temp (code.symbol ["" "_temp"]) g!_object (code.symbol ["" "_object"]) g!_behavior (code.symbol ["" "_behavior"]) g!_state (code.symbol ["" "_state"]) g!_extension (code.symbol ["" "_extension"]) - g!_args (L/map (|>> product.left nat-to-int %i (format "_") code.local-symbol) - (list.enumerate inputs)) - g!destructuring (L/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)])) - (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) - (maybe.default g!states (list.tail g!states)))] - (` (def: (~@ (csw.export export)) ((~ g!method) (~@ g!_args) (~ g!_object)) - (All [(~@ g!parameters) (~ g!ext) (~@ g!states) (~@ g!type-vars)] - (-> (~@ inputs) (~ g!self-object) (~ output))) + g!_args (list/map (|>> product.left nat-to-int %i (format "_") code.local-symbol) + (list.enumerate inputs)) + g!destructuring (list/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)])) + (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) + (maybe.default g!states (list.tail g!states)))] + (` (def: (~+ (csw.export export)) ((~ g!method) (~+ g!_args) (~ g!_object)) + (All [(~+ g!parameters) (~@ g!ext) (~+ g!states) (~+ g!type-vars)] + (-> (~+ inputs) (~ g!self-object) (~ output))) (let [(~ g!destructuring) (~ g!_object)] - (:: (~ g!_behavior) (~ g!method) (~@ g!_args) (~ g!_object))))))) + (:: (~ g!_behavior) (~ g!method) (~+ g!_args) (~ g!_object))))))) ## [Inheritance] (type: Reference @@ -121,7 +121,7 @@ (def: (no-parent? parent) (-> Ident Bool) - (Ident/= no-parent parent)) + (ident/= no-parent parent)) (def: (with-interface parent interface) (-> Ident Ident cs.Annotations cs.Annotations) @@ -147,7 +147,7 @@ (case [(macro.get-tag-ann (ident-for <name-tag>) annotations) (macro.get-tag-ann (ident-for <parent-tag>) annotations)] [(#.Some real-name) (#.Some parent)] - (if (Ident/= no-parent parent) + (if (ident/= no-parent parent) (wrap [real-name (list)]) (do @ [[_ ancestors] (<name> parent)] @@ -170,7 +170,7 @@ (#.Function inputT outputT) (let [[stateT+ objectT] (type.flatten-function currentT)] - (Macro/wrap [depth stateT+])) + (macro/wrap [depth stateT+])) _ (macro.fail (format "Cannot extract inheritance from type: " (type.to-text newT)))))) @@ -184,11 +184,11 @@ size (|> (n/dec size) (list.n/range +0) - (L/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`))) + (list/map (|>> (n/* +2) n/inc code.nat (~) #.Bound (`))) (list.zip2 (list.reverse mappings)) - (L/fold (function [[mappingC boundC] genericC] - (code.replace boundC mappingC genericC)) - typeC)))) + (list/fold (function [[mappingC boundC] genericC] + (code.replace boundC mappingC genericC)) + typeC)))) (def: referenceS (s.Syntax Reference) @@ -211,12 +211,12 @@ ## Utils (def: (nest ancestors bottom) (-> (List Code) Code Code) - (L/fold (function [[level _] g!bottom] - (let [g!_behavior' (code.local-symbol (format "_behavior" (%n level))) - g!_state' (code.local-symbol (format "_state" (%n level)))] - (` [(~ g!_behavior') (~ g!_state') (~ g!bottom)]))) - bottom - (list.enumerate ancestors))) + (list/fold (function [[level _] g!bottom] + (let [g!_behavior' (code.local-symbol (format "_behavior" (%n level))) + g!_state' (code.local-symbol (format "_state" (%n level)))] + (` [(~ g!_behavior') (~ g!_state') (~ g!bottom)]))) + bottom + (list.enumerate ancestors))) ## Names (do-template [<name> <category>] @@ -242,7 +242,7 @@ ) (def: (getterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) Code) (let [g!get (code.local-symbol (getN interface)) g!interface (code.local-symbol interface) @@ -251,17 +251,17 @@ g!_state (' _state) g!_extension (' _extension) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))] - (` (def: (~@ (csw.export export)) ((~ g!get) (~ g!_object)) - (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] - (-> (~ g!object) (~ g!child))) + (` (def: (~+ (csw.export export)) ((~ g!get) (~ g!_object)) + (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] + (-> (~ g!object) (~@ g!child))) (let [(~ g!tear-down) (~ g!_object)] (~ g!_state)))))) (def: (setterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) Code) (let [g!set (code.local-symbol (setN interface)) g!interface (code.local-symbol interface) @@ -271,20 +271,20 @@ g!_extension (' _extension) g!_input (' _input) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) (~ g!_input) (~ g!_extension)]))] - (` (def: (~@ (csw.export export)) + (` (def: (~+ (csw.export export)) ((~ g!set) (~ g!_input) (~ g!_object)) - (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] - (-> (~ g!child) (~ g!object) (~ g!object))) + (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] + (-> (~@ g!child) (~ g!object) (~ g!object))) (let [(~ g!tear-down) (~ g!_object)] (~ g!build-up)))))) (def: (updaterN export interface g!parameters g!ext g!child ancestors) - (-> (Maybe cs.Export) Text (List Code) Code Code (List Ident) + (-> (Maybe cs.Export) Text (List Code) Ident Ident (List Ident) Code) (let [g!update (code.local-symbol (updateN interface)) g!interface (code.local-symbol interface) @@ -294,15 +294,15 @@ g!_extension (' _extension) g!_change (' _change) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) ((~ g!_change) (~ g!_state)) (~ g!_extension)]))] - (` (def: (~@ (csw.export export)) + (` (def: (~+ (csw.export export)) ((~ g!update) (~ g!_change) (~ g!_object)) - (All [(~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)] - (-> (-> (~ g!child) (~ g!child)) + (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] + (-> (-> (~@ g!child) (~@ g!child)) (-> (~ g!object) (~ g!object)))) (let [(~ g!tear-down) (~ g!_object)] (~ g!build-up)))))) @@ -313,34 +313,34 @@ (case type (#.Primitive name params) (do Monad<Meta> - [paramsC+ (M.map @ type-to-code params)] + [paramsC+ (monad.map @ type-to-code params)] (wrap (` (.primitive (~ (code.symbol ["" name])) - (~@ paramsC+))))) + (~+ paramsC+))))) #.Void - (Macro/wrap (` (.|))) + (macro/wrap (` (.|))) #.Unit - (Macro/wrap (` (.&))) + (macro/wrap (` (.&))) (^template [<tag> <macro> <flatten>] (<tag> _) (do Monad<Meta> - [partsC+ (M.map @ type-to-code (<flatten> type))] - (wrap (` (<macro> (~@ partsC+)))))) + [partsC+ (monad.map @ type-to-code (<flatten> type))] + (wrap (` (<macro> (~+ partsC+)))))) ([#.Sum .| type.flatten-variant] [#.Product .& type.flatten-tuple]) (#.Function input output) (do Monad<Meta> [#let [[insT+ outT] (type.flatten-function type)] - insC+ (M.map @ type-to-code insT+) + insC+ (monad.map @ type-to-code insT+) outC (type-to-code outT)] - (wrap (` (.-> (~@ insC+) (~ outC))))) + (wrap (` (.-> (~+ insC+) (~ outC))))) (^template [<tag>] (<tag> idx) - (Macro/wrap (` (<tag> (~ (code.nat idx)))))) + (macro/wrap (` (<tag> (~ (code.nat idx)))))) ([#.Bound] [#.Var] [#.Ex]) @@ -349,11 +349,11 @@ (do Monad<Meta> [#let [[funcT argsT+] (type.flatten-application type)] funcC (type-to-code funcT) - argsC+ (M.map @ type-to-code argsT+)] - (wrap (` ((~ funcC) (~@ argsC+))))) + argsC+ (monad.map @ type-to-code argsT+)] + (wrap (` ((~ funcC) (~+ argsC+))))) (#.Named name unnamedT) - (Macro/wrap (code.symbol name)) + (macro/wrap (code.symbol name)) _ (macro.fail (format "Cannot convert type to code: " (type.to-text type))))) @@ -378,34 +378,34 @@ (wrap [parent (list& parent ancestors) mappings])))) #let [g!signature (code.local-symbol (signatureN interface)) g!interface (code.local-symbol interface) - g!parameters (L/map code.local-symbol parameters) + g!parameters (list/map code.local-symbol parameters) g!self-ref (if (list.empty? g!parameters) (list g!interface) (list)) g!interface-def (if (no-parent? parent) - (let [g!recur (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~ g!child)))] - (` (Ex (~@ g!self-ref) [(~ g!ext) (~ g!child)] - [((~ g!signature) (~@ g!parameters) (~ g!recur)) - (~ g!child) - (~ g!ext)]))) + (let [g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~@ g!child)))] + (` (Ex (~+ g!self-ref) [(~@ g!ext) (~@ g!child)] + [((~ g!signature) (~+ g!parameters) (~ g!recur)) + (~@ g!child) + (~@ g!ext)]))) (let [g!parent (code.symbol parent) g!ancestors (ancestor-inputs ancestors) - g!recur (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child)))] - (` (Ex (~@ g!self-ref) [(~ g!ext) (~@ g!ancestors) (~ g!child)] - ((~ g!parent) (~@ mappings) - [((~ g!signature) (~@ g!parameters) (~ g!recur)) - (~ g!child) - (~ g!ext)] - (~@ g!ancestors))))))]] - (wrap (list& (` (sig: (~@ (csw.export export)) - ((~ g!signature) (~@ g!parameters) (~ g!self-class)) - (~@ (let [de-alias (code.replace (code.local-symbol alias) g!self-class)] - (L/map (|>> (update@ #inputs (L/map de-alias)) - (update@ #output de-alias) - (declarationM g!self-class)) - methods))))) + g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))] + (` (Ex (~+ g!self-ref) [(~@ g!ext) (~+ g!ancestors) (~@ g!child)] + ((~ g!parent) (~+ mappings) + [((~ g!signature) (~+ g!parameters) (~ g!recur)) + (~@ g!child) + (~@ g!ext)] + (~+ g!ancestors))))))]] + (wrap (list& (` (sig: (~+ (csw.export export)) + ((~ g!signature) (~+ g!parameters) (~@ g!self-class)) + (~+ (let [de-alias (code.replace (code.local-symbol alias) (code.symbol g!self-class))] + (list/map (|>> (update@ #inputs (list/map de-alias)) + (update@ #output de-alias) + (declarationM g!self-class)) + methods))))) - (` (type: (~@ (csw.export export)) ((~ g!interface) (~@ g!parameters)) + (` (type: (~+ (csw.export export)) ((~ g!interface) (~+ g!parameters)) (~ (|> annotations (with-interface parent [module interface]) csw.annotations)) @@ -416,13 +416,13 @@ (updaterN export interface g!parameters g!ext g!child ancestors) (let [g!ancestors (ancestor-inputs ancestors) - g!states (L/compose g!ancestors (list g!child)) - g!self-object (` ((~ g!interface) (~@ g!parameters) (~ g!ext) (~@ g!ancestors) (~ g!child))) + g!states (list/compose g!ancestors (list (code.symbol g!child))) + g!self-object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) de-alias (code.replace (code.symbol ["" alias]) g!self-object)] - (L/map (|>> (update@ #inputs (L/map de-alias)) - (update@ #output de-alias) - (definition export decl g!self-object g!ext g!states)) - methods)))) + (list/map (|>> (update@ #inputs (list/map de-alias)) + (update@ #output de-alias) + (definition export decl g!self-object g!ext g!states)) + methods)))) ))) (syntax: #export (class: [export csr.export] @@ -451,9 +451,9 @@ (do @ [newT (macro.find-def-type (product.both id newN parent)) [depth rawT+] (extract newT) - codeT+ (M.map @ type-to-code rawT+)] - (wrap (L/map (specialize parent-mappings) codeT+))))) - #let [g!parameters (L/map code.local-symbol parameters) + codeT+ (monad.map @ type-to-code rawT+)] + (wrap (list/map (specialize parent-mappings) codeT+))))) + #let [g!parameters (list/map code.local-symbol parameters) g!state (code.local-symbol (stateN instance)) g!struct (code.local-symbol (structN instance)) @@ -464,51 +464,51 @@ g!parent-structs (if (no-parent? parent) (list) - (L/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))] - g!parent-inits (M.map @ (function [_] (macro.gensym "parent-init")) - g!parent-structs) - #let [g!full-init (L/fold (function [[parent-struct parent-state] child] - (` [(~ parent-struct) (~ parent-state) (~ child)])) - (` [(~ g!struct) (~ g!init) []]) - (list.zip2 g!parent-structs g!parent-inits)) + (list/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))] + g!parent-inits (monad.map @ (function [_] (:: @ map code.symbol (macro.gensym "parent-init"))) + g!parent-structs) + #let [g!full-init (list/fold (function [[parent-struct parent-state] child] + (` [(~ parent-struct) (~ parent-state) (~ child)])) + (` [(~ g!struct) (~@ g!init) []]) + (list.zip2 g!parent-structs g!parent-inits)) g!new (code.local-symbol (newN instance)) - g!recur (` ((~ g!class) (~@ g!parameters) (~ g!extension))) + g!recur (` ((~ g!class) (~+ g!parameters) (~@ g!extension))) g!rec (if (list.empty? g!parameters) (list (' #rec)) (list))]] - (wrap (list (` (type: (~@ (csw.export export)) - ((~ g!state) (~@ g!parameters)) + (wrap (list (` (type: (~+ (csw.export export)) + ((~ g!state) (~+ g!parameters)) (~ state-type))) - (` (type: (~@ (csw.export export)) (~@ g!rec) ((~ g!class) (~@ g!parameters)) + (` (type: (~+ (csw.export export)) (~+ g!rec) ((~ g!class) (~+ g!parameters)) (~ (|> annotations (with-class interface parent [module instance]) csw.annotations)) - (Ex [(~ g!extension)] + (Ex [(~@ g!extension)] (~ (if (no-parent? parent) - (` ((~ g!interface) (~@ interface-mappings) - (~ g!extension) - ((~ g!state) (~@ g!parameters)))) + (` ((~ g!interface) (~+ interface-mappings) + (~@ g!extension) + ((~ g!state) (~+ g!parameters)))) (let [g!parent (code.symbol parent)] - (` ((~ g!parent) (~@ parent-mappings) - [((~ g!signature) (~@ interface-mappings) (~ g!recur)) - ((~ g!state) (~@ g!parameters)) - (~ g!extension)])))))))) - - (` (struct: (~@ (csw.export export)) (~ g!struct) - (All [(~@ g!parameters) (~ g!extension)] - ((~ g!signature) (~@ interface-mappings) - ((~ g!interface) (~@ interface-mappings) - (~ g!extension) - (~@ g!inheritance) - ((~ g!state) (~@ g!parameters))))) - (~@ impls))) - - (` (def: (~@ (csw.export export)) ((~ g!new) (~@ g!parent-inits) (~ g!init)) - (All [(~@ g!parameters)] - (-> (~@ g!inheritance) - ((~ g!state) (~@ g!parameters)) - ((~ g!class) (~@ g!parameters)))) + (` ((~ g!parent) (~+ parent-mappings) + [((~ g!signature) (~+ interface-mappings) (~ g!recur)) + ((~ g!state) (~+ g!parameters)) + (~@ g!extension)])))))))) + + (` (struct: (~+ (csw.export export)) (~ g!struct) + (All [(~+ g!parameters) (~@ g!extension)] + ((~ g!signature) (~+ interface-mappings) + ((~ g!interface) (~+ interface-mappings) + (~@ g!extension) + (~+ g!inheritance) + ((~ g!state) (~+ g!parameters))))) + (~+ impls))) + + (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~@ g!init)) + (All [(~+ g!parameters)] + (-> (~+ g!inheritance) + ((~ g!state) (~+ g!parameters)) + ((~ g!class) (~+ g!parameters)))) (~ g!full-init))) )) ))) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index 262ccf9e4..cf59e25d4 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -68,10 +68,10 @@ (syntax: #export (unit: [export csr.export] [name s.local-symbol] [annotations (p.default cs.empty-annotations csr.annotations)]) - (wrap (list (` (type: (~@ (csw.export export)) (~ (code.local-symbol name)) + (wrap (list (` (type: (~+ (csw.export export)) (~ (code.local-symbol name)) (~ (csw.annotations annotations)) (primitive (~ (code.text (unit-name name)))))) - (` (def: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name))) + (` (def: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name))) (~ (code.local-symbol name)) (:!! []))) ))) @@ -92,10 +92,10 @@ [(^slots [#r.numerator #r.denominator]) ratio^] [annotations (p.default cs.empty-annotations csr.annotations)]) (let [g!scale (code.local-symbol name)] - (wrap (list (` (type: (~@ (csw.export export)) ((~ g!scale) (~' u)) + (wrap (list (` (type: (~+ (csw.export export)) ((~ g!scale) (~' u)) (~ (csw.annotations annotations)) (primitive (~ (code.text (scale-name name))) [(~' u)]))) - (` (struct: (~@ (csw.export export)) (~ (code.local-symbol (format "@" name))) + (` (struct: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name))) (..Scale (~ g!scale)) (def: (~' scale) (|>> ..out |