diff options
Diffstat (limited to 'stdlib/source/lux.lux')
| -rw-r--r-- | stdlib/source/lux.lux | 444 |
1 files changed, 222 insertions, 222 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index c93e834db..e31e96e7c 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -759,10 +759,10 @@ Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] default-def-meta-exported)))) -## (type: (Lux a) +## (type: (Meta a) ## (-> Compiler (Either Text [Compiler a]))) -(_lux_def Lux - (#Named ["lux" "Lux"] +(_lux_def Meta + (#Named ["lux" "Meta"] (#UnivQ #Nil (#Function Compiler (#Apply (#Product Compiler (#Bound +1)) @@ -776,10 +776,10 @@ default-def-meta-exported)))) ## (type: Macro -## (-> (List Code) (Lux (List Code)))) +## (-> (List Code) (Meta (List Code)))) (_lux_def Macro (#Named ["lux" "Macro"] - (#Function Code-List (#Apply Code-List Lux))) + (#Function Code-List (#Apply Code-List Meta))) (record$ (#Cons [(tag$ ["lux" "doc"]) (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] default-def-meta-exported))) @@ -1164,10 +1164,10 @@ (def:'' (parse-quantified-args args next) #;Nil - ## (-> (List Code) (-> (List Text) (Lux (List Code))) (Lux (List Code))) + ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) (#Function ($' List Code) - (#Function (#Function ($' List Text) (#Apply ($' List Code) Lux)) - (#Apply ($' List Code) Lux) + (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) + (#Apply ($' List Code) Meta) )) (_lux_case args #Nil @@ -1646,9 +1646,9 @@ #None #None (#Some a) (f a)))}) -(def:''' Monad<Lux> +(def:''' Monad<Meta> #Nil - ($' Monad Lux) + ($' Monad Meta) {#wrap (function' [x] (function' [state] @@ -1805,7 +1805,7 @@ (def:''' (resolve-global-symbol ident state) #Nil - (-> Ident ($' Lux Ident)) + (-> Ident ($' Meta Ident)) (let' [[module name] ident {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -1830,22 +1830,22 @@ (def:''' (splice replace? untemplate tag elems) #Nil - (-> Bool (-> Code ($' Lux Code)) Code ($' List Code) ($' Lux Code)) + (-> Bool (-> Code ($' Meta Code)) Code ($' List Code) ($' Meta Code)) (_lux_case replace? true (_lux_case (any? spliced? elems) true - (do Monad<Lux> - [elems' (_lux_: ($' Lux ($' List Code)) - (mapM Monad<Lux> - (_lux_: (-> Code ($' Lux Code)) + (do Monad<Meta> + [elems' (_lux_: ($' Meta ($' List Code)) + (mapM Monad<Meta> + (_lux_: (-> Code ($' Meta Code)) (function' [elem] (_lux_case elem [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] (wrap spliced) _ - (do Monad<Lux> + (do Monad<Meta> [=elem (untemplate elem)] (wrap (form$ (list (symbol$ ["" "_lux_:"]) (form$ (list (tag$ ["lux" "Apply"]) (tuple$ (list (symbol$ ["lux" "Code"]) (symbol$ ["lux" "List"]))))) @@ -1857,17 +1857,17 @@ elems'))))))) false - (do Monad<Lux> - [=elems (mapM Monad<Lux> untemplate elems)] + (do Monad<Meta> + [=elems (mapM Monad<Meta> untemplate elems)] (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) false - (do Monad<Lux> - [=elems (mapM Monad<Lux> untemplate elems)] + (do Monad<Meta> + [=elems (mapM Monad<Meta> untemplate elems)] (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) (def:''' (untemplate replace? subst token) #Nil - (-> Bool Text Code ($' Lux Code)) + (-> Bool Text Code ($' Meta Code)) (_lux_case [replace? token] [_ [_ (#Bool value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Bool"]) (bool$ value))))) @@ -1900,7 +1900,7 @@ (return (wrap-meta (form$ (list (tag$ ["lux" "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) [true [_ (#Symbol [module name])]] - (do Monad<Lux> + (do Monad<Meta> [real-name (_lux_case module "" (if (text/= "" subst) @@ -1925,18 +1925,18 @@ (untemplate false subst keep-quoted) [_ [meta (#Form elems)]] - (do Monad<Lux> + (do Monad<Meta> [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) #let [[_ form'] output]] (return [meta form'])) [_ [_ (#Record fields)]] - (do Monad<Lux> - [=fields (mapM Monad<Lux> - (_lux_: (-> (& Code Code) ($' Lux Code)) + (do Monad<Meta> + [=fields (mapM Monad<Meta> + (_lux_: (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] - (do Monad<Lux> + (do Monad<Meta> [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] (wrap (tuple$ (list =k =v))))))) @@ -1962,7 +1962,7 @@ (def:'' (current-module-name state) #Nil - ($' Lux Text) + ($' Meta Text) (_lux_case state {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -1985,7 +1985,7 @@ (~ body))))")]) (_lux_case tokens (#Cons template #Nil) - (do Monad<Lux> + (do Monad<Meta> [current-module current-module-name =template (untemplate true current-module template)] (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) @@ -2001,7 +2001,7 @@ (~ body))))")]) (_lux_case tokens (#Cons template #Nil) - (do Monad<Lux> + (do Monad<Meta> [=template (untemplate true "" template)] (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) @@ -2014,7 +2014,7 @@ (' \"YOLO\")")]) (_lux_case tokens (#Cons template #Nil) - (do Monad<Lux> + (do Monad<Meta> [=template (untemplate false "" template)] (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "Code"]) =template))))) @@ -2416,10 +2416,10 @@ (def:''' (normalize ident) #Nil - (-> Ident ($' Lux Ident)) + (-> Ident ($' Meta Ident)) (_lux_case ident ["" name] - (do Monad<Lux> + (do Monad<Meta> [module-name current-module-name] (wrap [module-name name])) @@ -2428,8 +2428,8 @@ (def:''' (find-macro ident) #Nil - (-> Ident ($' Lux ($' Maybe Macro))) - (do Monad<Lux> + (-> Ident ($' Meta ($' Maybe Macro))) + (do Monad<Meta> [current-module current-module-name] (let' [[module name] ident] (function' [state] @@ -2443,8 +2443,8 @@ (def:''' (macro? ident) #Nil - (-> Ident ($' Lux Bool)) - (do Monad<Lux> + (-> Ident ($' Meta Bool)) + (do Monad<Meta> [ident (normalize ident) output (find-macro ident)] (wrap (_lux_case output @@ -2473,10 +2473,10 @@ (def:''' (macro-expand-once token) #Nil - (-> Code ($' Lux ($' List Code))) + (-> Code ($' Meta ($' List Code))) (_lux_case token [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Lux> + (do Monad<Meta> [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro @@ -2491,17 +2491,17 @@ (def:''' (macro-expand token) #Nil - (-> Code ($' Lux ($' List Code))) + (-> Code ($' Meta ($' List Code))) (_lux_case token [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Lux> + (do Monad<Meta> [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro (#Some macro) - (do Monad<Lux> + (do Monad<Meta> [expansion (macro args) - expansion' (mapM Monad<Lux> macro-expand expansion)] + expansion' (mapM Monad<Meta> macro-expand expansion)] (wrap (list/join expansion'))) #None @@ -2512,40 +2512,40 @@ (def:''' (macro-expand-all syntax) #Nil - (-> Code ($' Lux ($' List Code))) + (-> Code ($' Meta ($' List Code))) (_lux_case syntax [_ (#Form (#Cons [_ (#Symbol macro-name)] args))] - (do Monad<Lux> + (do Monad<Meta> [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro (#Some macro) - (do Monad<Lux> + (do Monad<Meta> [expansion (macro args) - expansion' (mapM Monad<Lux> macro-expand-all expansion)] + expansion' (mapM Monad<Meta> macro-expand-all expansion)] (wrap (list/join expansion'))) #None - (do Monad<Lux> - [args' (mapM Monad<Lux> macro-expand-all args)] + (do Monad<Meta> + [args' (mapM Monad<Meta> macro-expand-all args)] (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) [_ (#Form members)] - (do Monad<Lux> - [members' (mapM Monad<Lux> macro-expand-all members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] (wrap (list (form$ (list/join members'))))) [_ (#Tuple members)] - (do Monad<Lux> - [members' (mapM Monad<Lux> macro-expand-all members)] + (do Monad<Meta> + [members' (mapM Monad<Meta> macro-expand-all members)] (wrap (list (tuple$ (list/join members'))))) [_ (#Record pairs)] - (do Monad<Lux> - [pairs' (mapM Monad<Lux> + (do Monad<Meta> + [pairs' (mapM Monad<Meta> (function' [kv] (let' [[key val] kv] - (do Monad<Lux> + (do Monad<Meta> [val' (macro-expand-all val)] (_lux_case val' (#;Cons val'' #;Nil) @@ -2584,7 +2584,7 @@ (type (All [a] (Maybe (List a))))")]) (_lux_case tokens (#Cons type #Nil) - (do Monad<Lux> + (do Monad<Meta> [type+ (macro-expand-all type)] (_lux_case type+ (#Cons type' #Nil) @@ -2636,12 +2636,12 @@ (def:''' (unfold-type-def type-codes) #Nil - (-> ($' List Code) ($' Lux (& Code ($' Maybe ($' List Text))))) + (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) (_lux_case type-codes (#Cons [_ (#Record pairs)] #;Nil) - (do Monad<Lux> - [members (mapM Monad<Lux> - (: (-> [Code Code] (Lux [Text Code])) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> [Code Code] (Meta [Text Code])) (function' [pair] (_lux_case pair [[_ (#Tag "" member-name)] member-type] @@ -2665,9 +2665,9 @@ (return [type #None])) (#Cons case cases) - (do Monad<Lux> - [members (mapM Monad<Lux> - (: (-> Code (Lux [Text Code])) + (do Monad<Meta> + [members (mapM Monad<Meta> + (: (-> Code (Meta [Text Code])) (function' [case] (_lux_case case [_ (#Tag "" member-name)] @@ -2690,7 +2690,7 @@ (def:''' (gensym prefix state) #Nil - (-> Text ($' Lux Code)) + (-> Text ($' Meta Code)) (_lux_case state {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -2843,30 +2843,30 @@ )) (def:' (expander branches) - (-> (List Code) (Lux (List Code))) + (-> (List Code) (Meta (List Code))) (_lux_case branches (#;Cons [_ (#Form (#Cons [_ (#Symbol macro-name)] macro-args))] (#;Cons body branches')) - (do Monad<Lux> + (do Monad<Meta> [??? (macro? macro-name)] (if ??? - (do Monad<Lux> + (do Monad<Meta> [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] (expander init-expansion)) - (do Monad<Lux> + (do Monad<Meta> [sub-expansion (expander branches')] (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) body sub-expansion))))) (#;Cons pattern (#;Cons body branches')) - (do Monad<Lux> + (do Monad<Meta> [sub-expansion (expander branches')] (wrap (list& pattern body sub-expansion))) #;Nil - (do Monad<Lux> [] (wrap (list))) + (do Monad<Meta> [] (wrap (list))) _ (fail ($_ text/compose "\"lux;case\" expects an even number of tokens: " (|> branches @@ -2887,7 +2887,7 @@ #None)")]) (_lux_case tokens (#Cons value branches) - (do Monad<Lux> + (do Monad<Meta> [expansion (expander branches)] (wrap (list (` (;_lux_case (~ value) (~@ expansion)))))) @@ -2906,7 +2906,7 @@ #None)")]) (case tokens (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) - (do Monad<Lux> + (do Monad<Meta> [pattern+ (macro-expand-all pattern)] (case pattern+ (#Cons pattern' #Nil) @@ -3297,12 +3297,12 @@ #None))] (case ?parts (#Some name args meta sigs) - (do Monad<Lux> + (do Monad<Meta> [name+ (normalize name) - sigs' (mapM Monad<Lux> macro-expand sigs) - members (: (Lux (List [Text Code])) - (mapM Monad<Lux> - (: (-> Code (Lux [Text Code])) + sigs' (mapM Monad<Meta> macro-expand sigs) + members (: (Meta (List [Text Code])) + (mapM Monad<Meta> + (: (-> Code (Meta [Text Code])) (function [token] (case token (^ [_ (#Form (list [_ (#Symbol _ "_lux_:")] type [_ (#Symbol ["" name])]))]) @@ -3554,7 +3554,7 @@ (#Some (list type)))) (def: (find-module name) - (-> Text (Lux Module)) + (-> Text (Meta Module)) (function [state] (let [{#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -3568,14 +3568,14 @@ (#Left ($_ text/compose "Unknown module: " name)))))) (def: get-current-module - (Lux Module) - (do Monad<Lux> + (Meta Module) + (do Monad<Meta> [module-name current-module-name] (find-module module-name))) (def: (resolve-tag [module name]) - (-> Ident (Lux [Nat (List Ident) Bool Type])) - (do Monad<Lux> + (-> Ident (Meta [Nat (List Ident) Bool Type])) + (do Monad<Meta> [=module (find-module module) #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-annotations _ #module-state _} =module]] (case (get name tags-table) @@ -3586,7 +3586,7 @@ (fail (text/compose "Unknown tag: " (ident/encode [module name])))))) (def: (resolve-type-tags type) - (-> Type (Lux (Maybe [(List Ident) (List Type)]))) + (-> Type (Meta (Maybe [(List Ident) (List Type)]))) (case type (#Apply arg func) (resolve-type-tags func) @@ -3598,7 +3598,7 @@ (resolve-type-tags body) (#Named [module name] unnamed) - (do Monad<Lux> + (do Monad<Meta> [=module (find-module module) #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} =module]] (case (get name types) @@ -3617,7 +3617,7 @@ (return #None))) (def: get-expected-type - (Lux Type) + (Meta Type) (function [state] (let [{#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -3632,11 +3632,11 @@ (macro: #export (struct tokens) {#;doc "Not meant to be used directly. Prefer \"struct:\"."} - (do Monad<Lux> - [tokens' (mapM Monad<Lux> macro-expand tokens) + (do Monad<Meta> + [tokens' (mapM Monad<Meta> macro-expand tokens) struct-type get-expected-type tags+type (resolve-type-tags struct-type) - tags (: (Lux (List Ident)) + tags (: (Meta (List Ident)) (case tags+type (#Some [tags _]) (return tags) @@ -3646,8 +3646,8 @@ #let [tag-mappings (: (List [Text Code]) (map (function [tag] [(second tag) (tag$ tag)]) tags))] - members (mapM Monad<Lux> - (: (-> Code (Lux [Code Code])) + members (mapM Monad<Meta> + (: (-> Code (Meta [Code Code])) (function [token] (case token (^ [_ (#Form (list [_ (#Symbol _ "_lux_def")] [_ (#Symbol "" tag-name)] value meta))]) @@ -3804,7 +3804,7 @@ #None))] (case parts (#Some name args meta type-codes) - (do Monad<Lux> + (do Monad<Meta> [type+tags?? (unfold-type-def type-codes) module-name current-module-name] (let [type-name (symbol$ ["" name]) @@ -3870,9 +3870,9 @@ #import-refer Refer}) (def: (extract-defs defs) - (-> (List Code) (Lux (List Text))) - (mapM Monad<Lux> - (: (-> Code (Lux Text)) + (-> (List Code) (Meta (List Text))) + (mapM Monad<Meta> + (: (-> Code (Meta Text)) (function [def] (case def [_ (#Symbol ["" name])] @@ -3883,7 +3883,7 @@ defs)) (def: (parse-alias tokens) - (-> (List Code) (Lux [(Maybe Text) (List Code)])) + (-> (List Code) (Meta [(Maybe Text) (List Code)])) (case tokens (^ (list& [_ (#Tag "" "as")] [_ (#Symbol "" alias)] tokens')) (return [(#Some alias) tokens']) @@ -3892,7 +3892,7 @@ (return [#None tokens]))) (def: (parse-referrals tokens) - (-> (List Code) (Lux [Referrals (List Code)])) + (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "refer"])] referral tokens')) (case referral @@ -3900,12 +3900,12 @@ (return [#All tokens']) (^ [_ (#Form (list& [_ (#Tag ["" "only"])] defs))]) - (do Monad<Lux> + (do Monad<Meta> [defs' (extract-defs defs)] (return [(#Only defs') tokens'])) (^ [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))]) - (do Monad<Lux> + (do Monad<Meta> [defs' (extract-defs defs)] (return [(#Exclude defs') tokens'])) @@ -3934,17 +3934,17 @@ [(reverse ys') xs'])) (def: (parse-short-referrals tokens) - (-> (List Code) (Lux [Referrals (List Code)])) + (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^ (list& [_ (#Tag "" "+")] tokens')) (let [[defs tokens'] (split-with symbol? tokens')] - (do Monad<Lux> + (do Monad<Meta> [defs' (extract-defs defs)] (return [(#Only defs') tokens']))) (^ (list& [_ (#Tag "" "-")] tokens')) (let [[defs tokens'] (split-with symbol? tokens')] - (do Monad<Lux> + (do Monad<Meta> [defs' (extract-defs defs)] (return [(#Exclude defs') tokens']))) @@ -3955,7 +3955,7 @@ (return [#Nothing tokens]))) (def: (extract-symbol syntax) - (-> Code (Lux Ident)) + (-> Code (Meta Ident)) (case syntax [_ (#Symbol ident)] (return ident) @@ -3964,7 +3964,7 @@ (fail "Not a symbol."))) (def: (parse-openings tokens) - (-> (List Code) (Lux [(List Openings) (List Code)])) + (-> (List Code) (Meta [(List Openings) (List Code)])) (case tokens (^ (list& [_ (#Tag "" "open")] [_ (#Form parts)] tokens')) (if (|> parts @@ -4002,7 +4002,7 @@ (return [(list) tokens]))) (def: (parse-short-openings parts) - (-> (List Code) (Lux [(List Openings) (List Code)])) + (-> (List Code) (Meta [(List Openings) (List Code)])) (if (|> parts (map (: (-> Code Bool) (function [part] @@ -4052,8 +4052,8 @@ (_lux_proc ["text" "replace-all"] [template pattern value])) (def: (clean-module module) - (-> Text (Lux Text)) - (do Monad<Lux> + (-> Text (Meta Text)) + (do Monad<Meta> [current-module current-module-name] (case (split-module module) (^ (list& "." parts)) @@ -4074,20 +4074,20 @@ )) (def: (parse-imports imports) - (-> (List Code) (Lux (List Importation))) - (do Monad<Lux> - [imports' (mapM Monad<Lux> - (: (-> Code (Lux (List Importation))) + (-> (List Code) (Meta (List Importation))) + (do Monad<Meta> + [imports' (mapM Monad<Meta> + (: (-> Code (Meta (List Importation))) (function [token] (case token [_ (#Symbol "" m-name)] - (do Monad<Lux> + (do Monad<Meta> [m-name (clean-module m-name)] (wrap (list [m-name #None {#refer-defs #All #refer-open (list)}]))) (^ [_ (#Form (list& [_ (#Symbol "" m-name)] extra))]) - (do Monad<Lux> + (do Monad<Meta> [m-name (clean-module m-name) alias+extra (parse-alias extra) #let [[alias extra] alias+extra] @@ -4106,7 +4106,7 @@ sub-imports)))) (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Symbol "" m-name)] extra))]) - (do Monad<Lux> + (do Monad<Meta> [m-name (clean-module m-name) referral+extra (parse-short-referrals extra) #let [[referral extra] referral+extra] @@ -4118,7 +4118,7 @@ #refer-open openings}}))) (^ [_ (#Tuple (list& [_ (#Symbol "" raw-m-name)] extra))]) - (do Monad<Lux> + (do Monad<Meta> [m-name (clean-module raw-m-name) referral+extra (parse-short-referrals extra) #let [[referral extra] referral+extra] @@ -4130,14 +4130,14 @@ #refer-open openings}}))) _ - (do Monad<Lux> + (do Monad<Meta> [current-module current-module-name] (fail (text/compose "Wrong syntax for import @ " current-module)))))) imports)] (wrap (list/join imports')))) (def: (exported-defs module state) - (-> Text (Lux (List Text))) + (-> Text (Meta (List Text))) (let [modules (case state {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -4234,7 +4234,7 @@ (#Some def-type))))) (def: (find-def-value name state) - (-> Ident (Lux [Type Top])) + (-> Ident (Meta [Type Top])) (let [[v-prefix v-name] name {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -4253,8 +4253,8 @@ (#Right [state [def-type def-value]]))))) (def: (find-type ident) - (-> Ident (Lux Type)) - (do Monad<Lux> + (-> Ident (Meta Type)) + (do Monad<Meta> [#let [[module name] ident] current-module current-module-name] (function [state] @@ -4361,7 +4361,7 @@ (macro: #hidden (^open' tokens) (case tokens (^ (list [_ (#Symbol name)] [_ (#Text prefix)] body)) - (do Monad<Lux> + (do Monad<Meta> [init-type (find-type name) struct-evidence (resolve-type-tags init-type)] (case struct-evidence @@ -4369,17 +4369,17 @@ (fail (text/compose "Can only \"open\" structs: " (Type/show init-type))) (#;Some tags&members) - (do Monad<Lux> - [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Lux Code)) + (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))] - (do Monad<Lux> - [enhanced-target (foldM Monad<Lux> + (do Monad<Meta> + [enhanced-target (foldM Monad<Meta> (function [[[_ m-name] m-type] enhanced-target] - (do Monad<Lux> + (do Monad<Meta> [m-structure (resolve-type-tags m-type)] (case m-structure (#;Some m-tags&members) @@ -4406,7 +4406,7 @@ (range' <= succ from to))"} (case tokens (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches)) - (do Monad<Lux> + (do Monad<Meta> [g!temp (gensym "temp")] (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) @@ -4462,7 +4462,7 @@ (getter my-record))"} (case tokens (^ (list [_ (#Tag slot')] record)) - (do Monad<Lux> + (do Monad<Meta> [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output] @@ -4489,7 +4489,7 @@ slots))) (^ (list selector)) - (do Monad<Lux> + (do Monad<Meta> [g!record (gensym "record")] (wrap (list (` (function [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) @@ -4497,15 +4497,15 @@ (fail "Wrong syntax for get@"))) (def: (open-field prefix [module name] source type) - (-> Text Ident Code Type (Lux (List Code))) - (do Monad<Lux> + (-> Text Ident Code Type (Meta (List Code))) + (do Monad<Meta> [output (resolve-type-tags type) #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]] (case output (#Some [tags members]) - (do Monad<Lux> - [decls' (mapM Monad<Lux> - (: (-> [Ident Type] (Lux (List Code))) + (do Monad<Meta> + [decls' (mapM Monad<Meta> + (: (-> [Ident Type] (Meta (List Code))) (function [[sname stype]] (open-field prefix sname source+ stype))) (zip2 tags members))] (return (list/join decls'))) @@ -4525,7 +4525,7 @@ ..."} (case tokens (^ (list& [_ (#Symbol struct-name)] tokens')) - (do Monad<Lux> + (do Monad<Meta> [@module current-module-name #let [prefix (case tokens' (^ (list [_ (#Text prefix)])) @@ -4538,9 +4538,9 @@ #let [source (symbol$ struct-name)]] (case output (#Some [tags members]) - (do Monad<Lux> - [decls' (mapM Monad<Lux> (: (-> [Ident Type] (Lux (List Code))) - (function [[sname stype]] (open-field prefix sname source stype))) + (do Monad<Meta> + [decls' (mapM Monad<Meta> (: (-> [Ident Type] (Meta (List Code))) + (function [[sname stype]] (open-field prefix sname source stype))) (zip2 tags members))] (return (list/join decls'))) @@ -4558,7 +4558,7 @@ (fold text/compose \"\" (interpose \" \" (map int/encode <arg>))))"} - (do Monad<Lux> + (do Monad<Meta> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) @@ -4570,29 +4570,29 @@ (fold text/compose \"\" (interpose \" \" (map int/encode <arg>))))"} - (do Monad<Lux> + (do Monad<Meta> [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (<| (~@ tokens) (~ g!arg)))))))) (def: (imported-by? import-name module-name) - (-> Text Text (Lux Bool)) - (do Monad<Lux> + (-> Text Text (Meta Bool)) + (do Monad<Meta> [module (find-module module-name) #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-annotations _ #module-state _} module]] (wrap (is-member? imports import-name)))) (def: (read-refer module-name options) - (-> Text (List Code) (Lux Refer)) - (do Monad<Lux> + (-> Text (List Code) (Meta Refer)) + (do Monad<Meta> [referral+options (parse-referrals options) #let [[referral options] referral+options] openings+options (parse-openings options) #let [[openings options] openings+options] current-module current-module-name - #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) + #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Unit))) (function [module-name all-defs referred-defs] - (mapM Monad<Lux> - (: (-> Text (Lux Unit)) + (mapM Monad<Meta> + (: (-> Text (Meta Unit)) (function [_def] (if (is-member? all-defs _def) (return []) @@ -4611,13 +4611,13 @@ (fold text/compose ""))))))) (def: (write-refer module-name [r-defs r-opens]) - (-> Text Refer (Lux (List Code))) - (do Monad<Lux> + (-> Text Refer (Meta (List Code))) + (do Monad<Meta> [current-module current-module-name - #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) + #let [test-referrals (: (-> Text (List Text) (List Text) (Meta (List Unit))) (function [module-name all-defs referred-defs] - (mapM Monad<Lux> - (: (-> Text (Lux Unit)) + (mapM Monad<Meta> + (: (-> Text (Meta Unit)) (function [_def] (if (is-member? all-defs _def) (return []) @@ -4628,13 +4628,13 @@ (exported-defs module-name) (#Only +defs) - (do Monad<Lux> + (do Monad<Meta> [*defs (exported-defs module-name) _ (test-referrals module-name *defs +defs)] (wrap +defs)) (#Exclude -defs) - (do Monad<Lux> + (do Monad<Meta> [*defs (exported-defs module-name) _ (test-referrals module-name *defs -defs)] (wrap (filter (|>. (is-member? -defs) not) *defs))) @@ -4661,7 +4661,7 @@ (macro: #hidden (refer tokens) (case tokens (^ (list& [_ (#Text module-name)] options)) - (do Monad<Lux> + (do Monad<Meta> [=refer (read-refer module-name options)] (write-refer module-name =refer)) @@ -4719,7 +4719,7 @@ meta (macro code)) (.. [type \"\" Eq<Type>]))"} - (do Monad<Lux> + (do Monad<Meta> [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] (case tokens (^ (list& [_ (#Record _meta)] _imports)) @@ -4774,17 +4774,17 @@ (setter value my-record))"} (case tokens (^ (list [_ (#Tag slot')] value record)) - (do Monad<Lux> + (do Monad<Meta> [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output]] (case (resolve-struct-type type) (#Some members) - (do Monad<Lux> - [pattern' (mapM Monad<Lux> - (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) + (do Monad<Meta> + [pattern' (mapM Monad<Meta> + (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] - (do Monad<Lux> + (do Monad<Meta> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] @@ -4809,9 +4809,9 @@ (fail "Wrong syntax for set@") _ - (do Monad<Lux> - [bindings (mapM Monad<Lux> - (: (-> Code (Lux Code)) + (do Monad<Meta> + [bindings (mapM Monad<Meta> + (: (-> Code (Meta Code)) (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) @@ -4831,12 +4831,12 @@ (~ update-expr))))))) (^ (list selector value)) - (do Monad<Lux> + (do Monad<Meta> [g!record (gensym "record")] (wrap (list (` (function [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) - (do Monad<Lux> + (do Monad<Meta> [g!value (gensym "value") g!record (gensym "record")] (wrap (list (` (function [(~ g!value) (~ g!record)] (;;set@ (~ selector) (~ g!value) (~ g!record))))))) @@ -4860,17 +4860,17 @@ (updater func my-record))"} (case tokens (^ (list [_ (#Tag slot')] fun record)) - (do Monad<Lux> + (do Monad<Meta> [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output]] (case (resolve-struct-type type) (#Some members) - (do Monad<Lux> - [pattern' (mapM Monad<Lux> - (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) + (do Monad<Meta> + [pattern' (mapM Monad<Meta> + (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] - (do Monad<Lux> + (do Monad<Meta> [g!slot (gensym "")] (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] @@ -4895,7 +4895,7 @@ (fail "Wrong syntax for update@") _ - (do Monad<Lux> + (do Monad<Meta> [g!record (gensym "record") g!temp (gensym "temp")] (wrap (list (` (let [(~ g!record) (~ record) @@ -4903,12 +4903,12 @@ (set@ [(~@ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) - (do Monad<Lux> + (do Monad<Meta> [g!record (gensym "record")] (wrap (list (` (function [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) - (do Monad<Lux> + (do Monad<Meta> [g!fun (gensym "fun") g!record (gensym "record")] (wrap (list (` (function [(~ g!fun) (~ g!record)] (;;update@ (~ selector) (~ g!fun) (~ g!record))))))) @@ -5246,21 +5246,21 @@ vars (map first pairs) inits (map second pairs)] (if (every? symbol? inits) - (do Monad<Lux> - [inits' (: (Lux (List Ident)) + (do Monad<Meta> + [inits' (: (Meta (List Ident)) (case (mapM Monad<Maybe> get-ident inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (mapM Monad<Lux> find-type inits') + init-types (mapM Monad<Meta> find-type inits') expected get-expected-type] (return (list (` ((;_lux_: (-> (~@ (map type-to-code init-types)) (~ (type-to-code expected))) (function (~ (symbol$ ["" "recur"])) [(~@ vars)] (~ body))) (~@ inits)))))) - (do Monad<Lux> - [aliases (mapM Monad<Lux> - (: (-> Code (Lux Code)) + (do Monad<Meta> + [aliases (mapM Monad<Meta> + (: (-> Code (Meta Code)) (function [_] (gensym ""))) inits)] (return (list (` (let [(~@ (interleave aliases inits))] @@ -5277,8 +5277,8 @@ (f foo bar baz)))} (case tokens (^ (list& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) - (do Monad<Lux> - [slots (: (Lux [Ident (List Ident)]) + (do Monad<Meta> + [slots (: (Meta [Ident (List Ident)]) (case (: (Maybe [Ident (List Ident)]) (do Monad<Maybe> [hslot (get-tag hslot') @@ -5291,7 +5291,7 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (mapM Monad<Lux> normalize tslots) + tslots (mapM Monad<Meta> normalize tslots) output (resolve-tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output @@ -5377,7 +5377,7 @@ (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings (^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings')) - (do Monad<Lux> + (do Monad<Meta> [expansion (macro-expand-once macro-expr)] (case (place-tokens var-name expansion (` (;with-expansions [(~@ bindings')] @@ -5417,8 +5417,8 @@ type)) (def: (anti-quote-def name) - (-> Ident (Lux Code)) - (do Monad<Lux> + (-> Ident (Meta Code)) + (do Monad<Meta> [type+value (find-def-value name) #let [[type value] type+value]] (case (flatten-alias type) @@ -5436,34 +5436,34 @@ (fail (text/compose "Cannot anti-quote type: " (ident/encode name)))))) (def: (anti-quote token) - (-> Code (Lux Code)) + (-> Code (Meta Code)) (case token [_ (#Symbol [def-prefix def-name])] (if (text/= "" def-prefix) - (:: Monad<Lux> return token) + (:: Monad<Meta> return token) (anti-quote-def [def-prefix def-name])) (^template [<tag>] [meta (<tag> parts)] - (do Monad<Lux> - [=parts (mapM Monad<Lux> anti-quote parts)] + (do Monad<Meta> + [=parts (mapM Monad<Meta> anti-quote parts)] (wrap [meta (<tag> =parts)]))) ([#Form] [#Tuple]) [meta (#Record pairs)] - (do Monad<Lux> - [=pairs (mapM Monad<Lux> - (: (-> [Code Code] (Lux [Code Code])) + (do Monad<Meta> + [=pairs (mapM Monad<Meta> + (: (-> [Code Code] (Meta [Code Code])) (function [[slot value]] - (do Monad<Lux> + (do Monad<Meta> [=value (anti-quote value)] (wrap [slot =value])))) pairs)] (wrap [meta (#Record =pairs)])) _ - (:: Monad<Lux> return token) + (:: Monad<Meta> return token) )) (macro: #export (^~ tokens) @@ -5479,12 +5479,12 @@ false)))} (case tokens (^ (list& [_ (#Form (list pattern))] body branches)) - (do Monad<Lux> + (do Monad<Meta> [module-name current-module-name pattern+ (macro-expand-all pattern)] (case pattern+ (^ (list pattern')) - (do Monad<Lux> + (do Monad<Meta> [pattern'' (anti-quote pattern')] (wrap (list& pattern'' body branches))) @@ -5498,7 +5498,7 @@ [Code (List [Code Code])]) (def: (case-level^ level) - (-> Code (Lux [Code Code])) + (-> Code (Meta [Code Code])) (case level (^ [_ (#;Tuple (list expr binding))]) (return [expr binding]) @@ -5508,14 +5508,14 @@ )) (def: (multi-level-case^ levels) - (-> (List Code) (Lux Multi-Level-Case)) + (-> (List Code) (Meta Multi-Level-Case)) (case levels #;Nil (fail "Multi-level patterns cannot be empty.") (#;Cons init extras) - (do Monad<Lux> - [extras' (mapM Monad<Lux> case-level^ extras)] + (do Monad<Meta> + [extras' (mapM Monad<Meta> case-level^ extras)] (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) @@ -5552,7 +5552,7 @@ (#;Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens (^ (list& [_meta (#;Form levels)] body next-branches)) - (do Monad<Lux> + (do Monad<Meta> [mlc (multi-level-case^ levels) expected get-expected-type g!temp (gensym "temp")] @@ -5601,7 +5601,7 @@ [Int i.even? i.odd? i.% i.= 0 2]) (def: (get-scope-type-vars state) - (Lux (List Nat)) + (Meta (List Nat)) (case state {#info info #source source #modules modules #scopes scopes #type-context types #host host @@ -5632,7 +5632,7 @@ list)))} (case tokens (^ (list [_ (#Nat idx)])) - (do Monad<Lux> + (do Monad<Meta> [stvs get-scope-type-vars] (case (list-at idx (reverse stvs)) (#;Some var-id) @@ -5692,7 +5692,7 @@ (: Dinosaur (:!! (list 1 2 3))))} (case tokens (^ (list expr)) - (do Monad<Lux> + (do Monad<Meta> [type get-expected-type] (wrap (list (` (;_lux_:! (~ (type-to-code type)) (~ expr)))))) @@ -5721,7 +5721,7 @@ Int)} (case tokens (^ (list [_ (#;Symbol var-name)])) - (do Monad<Lux> + (do Monad<Meta> [var-type (find-type var-name)] (wrap (list (type-to-code var-type)))) @@ -5733,16 +5733,16 @@ #Hidden) (def: (parse-export-level tokens) - (-> (List Code) (Lux [(Maybe Export-Level') (List Code)])) + (-> (List Code) (Meta [(Maybe Export-Level') (List Code)])) (case tokens (^ (list& [_ (#Tag ["" "export"])] tokens')) - (:: Monad<Lux> wrap [(#;Some #Export) tokens']) + (:: Monad<Meta> wrap [(#;Some #Export) tokens']) (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (:: Monad<Lux> wrap [(#;Some #Hidden) tokens']) + (:: Monad<Meta> wrap [(#;Some #Hidden) tokens']) _ - (:: Monad<Lux> wrap [#;None tokens]) + (:: Monad<Meta> wrap [#;None tokens]) )) (def: (gen-export-level ?export-level) @@ -5759,11 +5759,11 @@ )) (def: (parse-complex-declaration tokens) - (-> (List Code) (Lux [[Text (List Text)] (List Code)])) + (-> (List Code) (Meta [[Text (List Text)] (List Code)])) (case tokens (^ (list& [_ (#Form (list& [_ (#Symbol ["" name])] args'))] tokens')) - (do Monad<Lux> - [args (mapM Monad<Lux> + (do Monad<Meta> + [args (mapM Monad<Meta> (function [arg'] (case arg' [_ (#Symbol ["" arg-name])] @@ -5779,33 +5779,33 @@ )) (def: (parse-any tokens) - (-> (List Code) (Lux [Code (List Code)])) + (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) - (:: Monad<Lux> wrap [token tokens']) + (:: Monad<Meta> wrap [token tokens']) _ (fail "Could not parse anything.") )) (def: (parse-end tokens) - (-> (List Code) (Lux Unit)) + (-> (List Code) (Meta Unit)) (case tokens (^ (list)) - (:: Monad<Lux> wrap []) + (:: Monad<Meta> wrap []) _ (fail "Expected input Codes to be empty.") )) (def: (parse-anns tokens) - (-> (List Code) (Lux [Code (List Code)])) + (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) - (:: Monad<Lux> wrap [(record$ _anns) tokens']) + (:: Monad<Meta> wrap [(record$ _anns) tokens']) _ - (:: Monad<Lux> wrap [(' {}) tokens]) + (:: Monad<Meta> wrap [(' {}) tokens]) )) (macro: #export (template: tokens) @@ -5813,7 +5813,7 @@ "For simple macros that do not need any fancy features." (template: (square x) (i.* x x)))} - (do Monad<Lux> + (do Monad<Meta> [?export-level|tokens (parse-export-level tokens) #let [[?export-level tokens] ?export-level|tokens] name+args|tokens (parse-complex-declaration tokens) |