From 6ffd0692d840298850307497f5275c44d0ff8f5d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Oct 2017 23:24:21 -0400 Subject: - Re-named "Lux" type to "Meta". - Moved lux/type/* under lux/meta/*. --- stdlib/source/lux.lux | 444 +++++++-------- stdlib/source/lux/cli.lux | 6 +- stdlib/source/lux/concurrency/actor.lux | 30 +- stdlib/source/lux/concurrency/frp.lux | 4 +- stdlib/source/lux/concurrency/promise.lux | 4 +- stdlib/source/lux/concurrency/space.lux | 12 +- stdlib/source/lux/concurrency/stm.lux | 6 +- stdlib/source/lux/concurrency/task.lux | 4 +- stdlib/source/lux/control/concatenative.lux | 30 +- stdlib/source/lux/control/cont.lux | 6 +- stdlib/source/lux/control/contract.lux | 8 +- stdlib/source/lux/control/exception.lux | 14 +- stdlib/source/lux/control/pipe.lux | 10 +- stdlib/source/lux/data/coll/ordered/dict.lux | 6 +- stdlib/source/lux/data/coll/ordered/set.lux | 6 +- stdlib/source/lux/data/coll/sequence.lux | 6 +- stdlib/source/lux/data/coll/stream.lux | 4 +- stdlib/source/lux/data/coll/tree/rose.lux | 6 +- stdlib/source/lux/data/coll/tree/zipper.lux | 6 +- stdlib/source/lux/data/color.lux | 2 +- stdlib/source/lux/data/format/json.lux | 16 +- stdlib/source/lux/data/lazy.lux | 8 +- stdlib/source/lux/data/number/complex.lux | 8 +- stdlib/source/lux/data/number/ratio.lux | 8 +- stdlib/source/lux/data/store.lux | 2 +- stdlib/source/lux/data/tainted.lux | 2 +- stdlib/source/lux/data/text/format.lux | 10 +- stdlib/source/lux/data/text/lexer.lux | 2 +- stdlib/source/lux/data/text/regex.lux | 16 +- stdlib/source/lux/data/trace.lux | 3 +- stdlib/source/lux/host.js.lux | 6 +- stdlib/source/lux/host.jvm.lux | 110 ++-- stdlib/source/lux/macro.lux | 657 ----------------------- stdlib/source/lux/macro/code.lux | 143 ----- stdlib/source/lux/macro/poly.lux | 448 ---------------- stdlib/source/lux/macro/poly/eq.lux | 151 ------ stdlib/source/lux/macro/poly/functor.lux | 95 ---- stdlib/source/lux/macro/poly/json.lux | 312 ----------- stdlib/source/lux/macro/syntax.lux | 294 ---------- stdlib/source/lux/macro/syntax/common.lux | 27 - stdlib/source/lux/macro/syntax/common/reader.lux | 150 ------ stdlib/source/lux/macro/syntax/common/writer.lux | 24 - stdlib/source/lux/math.lux | 6 +- stdlib/source/lux/meta.lux | 657 +++++++++++++++++++++++ stdlib/source/lux/meta/code.lux | 143 +++++ stdlib/source/lux/meta/poly.lux | 448 ++++++++++++++++ stdlib/source/lux/meta/poly/eq.lux | 151 ++++++ stdlib/source/lux/meta/poly/functor.lux | 95 ++++ stdlib/source/lux/meta/poly/json.lux | 312 +++++++++++ stdlib/source/lux/meta/syntax.lux | 294 ++++++++++ stdlib/source/lux/meta/syntax/common.lux | 27 + stdlib/source/lux/meta/syntax/common/reader.lux | 150 ++++++ stdlib/source/lux/meta/syntax/common/writer.lux | 24 + stdlib/source/lux/meta/type.lux | 354 ++++++++++++ stdlib/source/lux/meta/type/auto.lux | 363 +++++++++++++ stdlib/source/lux/meta/type/check.lux | 541 +++++++++++++++++++ stdlib/source/lux/meta/type/object.lux | 515 ++++++++++++++++++ stdlib/source/lux/meta/type/opaque.lux | 164 ++++++ stdlib/source/lux/meta/type/unit.lux | 183 +++++++ stdlib/source/lux/test.lux | 20 +- stdlib/source/lux/time/duration.lux | 2 +- stdlib/source/lux/time/instant.lux | 2 +- stdlib/source/lux/type.lux | 354 ------------ stdlib/source/lux/type/auto.lux | 363 ------------- stdlib/source/lux/type/check.lux | 541 ------------------- stdlib/source/lux/type/object.lux | 515 ------------------ stdlib/source/lux/type/opaque.lux | 164 ------ stdlib/source/lux/type/unit.lux | 183 ------- stdlib/source/lux/world/net/tcp.jvm.lux | 2 +- stdlib/source/lux/world/net/udp.jvm.lux | 2 +- 70 files changed, 4840 insertions(+), 4841 deletions(-) delete mode 100644 stdlib/source/lux/macro.lux delete mode 100644 stdlib/source/lux/macro/code.lux delete mode 100644 stdlib/source/lux/macro/poly.lux delete mode 100644 stdlib/source/lux/macro/poly/eq.lux delete mode 100644 stdlib/source/lux/macro/poly/functor.lux delete mode 100644 stdlib/source/lux/macro/poly/json.lux delete mode 100644 stdlib/source/lux/macro/syntax.lux delete mode 100644 stdlib/source/lux/macro/syntax/common.lux delete mode 100644 stdlib/source/lux/macro/syntax/common/reader.lux delete mode 100644 stdlib/source/lux/macro/syntax/common/writer.lux create mode 100644 stdlib/source/lux/meta.lux create mode 100644 stdlib/source/lux/meta/code.lux create mode 100644 stdlib/source/lux/meta/poly.lux create mode 100644 stdlib/source/lux/meta/poly/eq.lux create mode 100644 stdlib/source/lux/meta/poly/functor.lux create mode 100644 stdlib/source/lux/meta/poly/json.lux create mode 100644 stdlib/source/lux/meta/syntax.lux create mode 100644 stdlib/source/lux/meta/syntax/common.lux create mode 100644 stdlib/source/lux/meta/syntax/common/reader.lux create mode 100644 stdlib/source/lux/meta/syntax/common/writer.lux create mode 100644 stdlib/source/lux/meta/type.lux create mode 100644 stdlib/source/lux/meta/type/auto.lux create mode 100644 stdlib/source/lux/meta/type/check.lux create mode 100644 stdlib/source/lux/meta/type/object.lux create mode 100644 stdlib/source/lux/meta/type/opaque.lux create mode 100644 stdlib/source/lux/meta/type/unit.lux delete mode 100644 stdlib/source/lux/type.lux delete mode 100644 stdlib/source/lux/type/auto.lux delete mode 100644 stdlib/source/lux/type/check.lux delete mode 100644 stdlib/source/lux/type/object.lux delete mode 100644 stdlib/source/lux/type/opaque.lux delete mode 100644 stdlib/source/lux/type/unit.lux (limited to 'stdlib/source') 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 +(def:''' Monad #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 - [elems' (_lux_: ($' Lux ($' List Code)) - (mapM Monad - (_lux_: (-> Code ($' Lux Code)) + (do Monad + [elems' (_lux_: ($' Meta ($' List Code)) + (mapM Monad + (_lux_: (-> Code ($' Meta Code)) (function' [elem] (_lux_case elem [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [spliced #Nil])]))] (wrap spliced) _ - (do Monad + (do Monad [=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 - [=elems (mapM Monad untemplate elems)] + (do Monad + [=elems (mapM Monad untemplate elems)] (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) false - (do Monad - [=elems (mapM Monad untemplate elems)] + (do Monad + [=elems (mapM Monad 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 + (do Monad [real-name (_lux_case module "" (if (text/= "" subst) @@ -1925,18 +1925,18 @@ (untemplate false subst keep-quoted) [_ [meta (#Form elems)]] - (do Monad + (do Monad [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "Form"]) elems) #let [[_ form'] output]] (return [meta form'])) [_ [_ (#Record fields)]] - (do Monad - [=fields (mapM Monad - (_lux_: (-> (& Code Code) ($' Lux Code)) + (do Monad + [=fields (mapM Monad + (_lux_: (-> (& Code Code) ($' Meta Code)) (function' [kv] (let' [[k v] kv] - (do Monad + (do Monad [=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 + (do Monad [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 + (do Monad [=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 + (do Monad [=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 + (do Monad [module-name current-module-name] (wrap [module-name name])) @@ -2428,8 +2428,8 @@ (def:''' (find-macro ident) #Nil - (-> Ident ($' Lux ($' Maybe Macro))) - (do Monad + (-> Ident ($' Meta ($' Maybe Macro))) + (do Monad [current-module current-module-name] (let' [[module name] ident] (function' [state] @@ -2443,8 +2443,8 @@ (def:''' (macro? ident) #Nil - (-> Ident ($' Lux Bool)) - (do Monad + (-> Ident ($' Meta Bool)) + (do Monad [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 + (do Monad [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 + (do Monad [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro (#Some macro) - (do Monad + (do Monad [expansion (macro args) - expansion' (mapM Monad macro-expand expansion)] + expansion' (mapM Monad 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 + (do Monad [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] (_lux_case ?macro (#Some macro) - (do Monad + (do Monad [expansion (macro args) - expansion' (mapM Monad macro-expand-all expansion)] + expansion' (mapM Monad macro-expand-all expansion)] (wrap (list/join expansion'))) #None - (do Monad - [args' (mapM Monad macro-expand-all args)] + (do Monad + [args' (mapM Monad macro-expand-all args)] (wrap (list (form$ (#Cons (symbol$ macro-name) (list/join args')))))))) [_ (#Form members)] - (do Monad - [members' (mapM Monad macro-expand-all members)] + (do Monad + [members' (mapM Monad macro-expand-all members)] (wrap (list (form$ (list/join members'))))) [_ (#Tuple members)] - (do Monad - [members' (mapM Monad macro-expand-all members)] + (do Monad + [members' (mapM Monad macro-expand-all members)] (wrap (list (tuple$ (list/join members'))))) [_ (#Record pairs)] - (do Monad - [pairs' (mapM Monad + (do Monad + [pairs' (mapM Monad (function' [kv] (let' [[key val] kv] - (do Monad + (do Monad [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 + (do Monad [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 - [members (mapM Monad - (: (-> [Code Code] (Lux [Text Code])) + (do Monad + [members (mapM Monad + (: (-> [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 - [members (mapM Monad - (: (-> Code (Lux [Text Code])) + (do Monad + [members (mapM Monad + (: (-> 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 + (do Monad [??? (macro? macro-name)] (if ??? - (do Monad + (do Monad [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] (expander init-expansion)) - (do Monad + (do Monad [sub-expansion (expander branches')] (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) body sub-expansion))))) (#;Cons pattern (#;Cons body branches')) - (do Monad + (do Monad [sub-expansion (expander branches')] (wrap (list& pattern body sub-expansion))) #;Nil - (do Monad [] (wrap (list))) + (do Monad [] (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 + (do Monad [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 + (do Monad [pattern+ (macro-expand-all pattern)] (case pattern+ (#Cons pattern' #Nil) @@ -3297,12 +3297,12 @@ #None))] (case ?parts (#Some name args meta sigs) - (do Monad + (do Monad [name+ (normalize name) - sigs' (mapM Monad macro-expand sigs) - members (: (Lux (List [Text Code])) - (mapM Monad - (: (-> Code (Lux [Text Code])) + sigs' (mapM Monad macro-expand sigs) + members (: (Meta (List [Text Code])) + (mapM Monad + (: (-> 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 + (Meta Module) + (do Monad [module-name current-module-name] (find-module module-name))) (def: (resolve-tag [module name]) - (-> Ident (Lux [Nat (List Ident) Bool Type])) - (do Monad + (-> Ident (Meta [Nat (List Ident) Bool Type])) + (do Monad [=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 + (do Monad [=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 - [tokens' (mapM Monad macro-expand tokens) + (do Monad + [tokens' (mapM Monad 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 - (: (-> Code (Lux [Code Code])) + members (mapM Monad + (: (-> 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 + (do Monad [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 - (: (-> Code (Lux Text)) + (-> (List Code) (Meta (List Text))) + (mapM Monad + (: (-> 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 + (do Monad [defs' (extract-defs defs)] (return [(#Only defs') tokens'])) (^ [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))]) - (do Monad + (do Monad [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 + (do Monad [defs' (extract-defs defs)] (return [(#Only defs') tokens']))) (^ (list& [_ (#Tag "" "-")] tokens')) (let [[defs tokens'] (split-with symbol? tokens')] - (do Monad + (do Monad [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 + (-> Text (Meta Text)) + (do Monad [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 - [imports' (mapM Monad - (: (-> Code (Lux (List Importation))) + (-> (List Code) (Meta (List Importation))) + (do Monad + [imports' (mapM Monad + (: (-> Code (Meta (List Importation))) (function [token] (case token [_ (#Symbol "" m-name)] - (do Monad + (do Monad [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 + (do Monad [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 + (do Monad [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 + (do Monad [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 + (do Monad [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 + (-> Ident (Meta Type)) + (do Monad [#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 + (do Monad [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 - [full-body ((: (-> Ident [(List Ident) (List Type)] Code (Lux Code)) + (do Monad + [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 - [enhanced-target (foldM Monad + (do Monad + [enhanced-target (foldM Monad (function [[[_ m-name] m-type] enhanced-target] - (do Monad + (do Monad [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 + (do Monad [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 + (do Monad [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output] @@ -4489,7 +4489,7 @@ slots))) (^ (list selector)) - (do Monad + (do Monad [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 + (-> Text Ident Code Type (Meta (List Code))) + (do Monad [output (resolve-type-tags type) #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]] (case output (#Some [tags members]) - (do Monad - [decls' (mapM Monad - (: (-> [Ident Type] (Lux (List Code))) + (do Monad + [decls' (mapM Monad + (: (-> [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 + (do Monad [@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 - [decls' (mapM Monad (: (-> [Ident Type] (Lux (List Code))) - (function [[sname stype]] (open-field prefix sname source stype))) + (do Monad + [decls' (mapM Monad (: (-> [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 ))))"} - (do Monad + (do Monad [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) @@ -4570,29 +4570,29 @@ (fold text/compose \"\" (interpose \" \" (map int/encode ))))"} - (do Monad + (do Monad [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 + (-> Text Text (Meta Bool)) + (do Monad [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 + (-> Text (List Code) (Meta Refer)) + (do Monad [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 - (: (-> Text (Lux Unit)) + (mapM Monad + (: (-> 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 + (-> Text Refer (Meta (List Code))) + (do Monad [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 - (: (-> Text (Lux Unit)) + (mapM Monad + (: (-> Text (Meta Unit)) (function [_def] (if (is-member? all-defs _def) (return []) @@ -4628,13 +4628,13 @@ (exported-defs module-name) (#Only +defs) - (do Monad + (do Monad [*defs (exported-defs module-name) _ (test-referrals module-name *defs +defs)] (wrap +defs)) (#Exclude -defs) - (do Monad + (do Monad [*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 + (do Monad [=refer (read-refer module-name options)] (write-refer module-name =refer)) @@ -4719,7 +4719,7 @@ meta (macro code)) (.. [type \"\" Eq]))"} - (do Monad + (do Monad [#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 + (do Monad [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output]] (case (resolve-struct-type type) (#Some members) - (do Monad - [pattern' (mapM Monad - (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) + (do Monad + [pattern' (mapM Monad + (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] - (do Monad + (do Monad [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 - [bindings (mapM Monad - (: (-> Code (Lux Code)) + (do Monad + [bindings (mapM Monad + (: (-> Code (Meta Code)) (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) @@ -4831,12 +4831,12 @@ (~ update-expr))))))) (^ (list selector value)) - (do Monad + (do Monad [g!record (gensym "record")] (wrap (list (` (function [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) - (do Monad + (do Monad [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 + (do Monad [slot (normalize slot') output (resolve-tag slot) #let [[idx tags exported? type] output]] (case (resolve-struct-type type) (#Some members) - (do Monad - [pattern' (mapM Monad - (: (-> [Ident [Nat Type]] (Lux [Ident Nat Code])) + (do Monad + [pattern' (mapM Monad + (: (-> [Ident [Nat Type]] (Meta [Ident Nat Code])) (function [[r-slot-name [r-idx r-type]]] - (do Monad + (do Monad [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 + (do Monad [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 + (do Monad [g!record (gensym "record")] (wrap (list (` (function [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) - (do Monad + (do Monad [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 - [inits' (: (Lux (List Ident)) + (do Monad + [inits' (: (Meta (List Ident)) (case (mapM Monad get-ident inits) (#Some inits') (return inits') #None (fail "Wrong syntax for loop"))) - init-types (mapM Monad find-type inits') + init-types (mapM Monad 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 - [aliases (mapM Monad - (: (-> Code (Lux Code)) + (do Monad + [aliases (mapM Monad + (: (-> 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 - [slots (: (Lux [Ident (List Ident)]) + (do Monad + [slots (: (Meta [Ident (List Ident)]) (case (: (Maybe [Ident (List Ident)]) (do Monad [hslot (get-tag hslot') @@ -5291,7 +5291,7 @@ (fail "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) - tslots (mapM Monad normalize tslots) + tslots (mapM Monad 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 + (do Monad [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 + (-> Ident (Meta Code)) + (do Monad [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 return token) + (:: Monad return token) (anti-quote-def [def-prefix def-name])) (^template [] [meta ( parts)] - (do Monad - [=parts (mapM Monad anti-quote parts)] + (do Monad + [=parts (mapM Monad anti-quote parts)] (wrap [meta ( =parts)]))) ([#Form] [#Tuple]) [meta (#Record pairs)] - (do Monad - [=pairs (mapM Monad - (: (-> [Code Code] (Lux [Code Code])) + (do Monad + [=pairs (mapM Monad + (: (-> [Code Code] (Meta [Code Code])) (function [[slot value]] - (do Monad + (do Monad [=value (anti-quote value)] (wrap [slot =value])))) pairs)] (wrap [meta (#Record =pairs)])) _ - (:: Monad return token) + (:: Monad return token) )) (macro: #export (^~ tokens) @@ -5479,12 +5479,12 @@ false)))} (case tokens (^ (list& [_ (#Form (list pattern))] body branches)) - (do Monad + (do Monad [module-name current-module-name pattern+ (macro-expand-all pattern)] (case pattern+ (^ (list pattern')) - (do Monad + (do Monad [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 - [extras' (mapM Monad case-level^ extras)] + (do Monad + [extras' (mapM Monad 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 + (do Monad [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 + (do Monad [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 + (do Monad [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 + (do Monad [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 wrap [(#;Some #Export) tokens']) + (:: Monad wrap [(#;Some #Export) tokens']) (^ (list& [_ (#Tag ["" "hidden"])] tokens')) - (:: Monad wrap [(#;Some #Hidden) tokens']) + (:: Monad wrap [(#;Some #Hidden) tokens']) _ - (:: Monad wrap [#;None tokens]) + (:: Monad 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 - [args (mapM Monad + (do Monad + [args (mapM Monad (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 wrap [token tokens']) + (:: Monad wrap [token tokens']) _ (fail "Could not parse anything.") )) (def: (parse-end tokens) - (-> (List Code) (Lux Unit)) + (-> (List Code) (Meta Unit)) (case tokens (^ (list)) - (:: Monad wrap []) + (:: Monad 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 wrap [(record$ _anns) tokens']) + (:: Monad wrap [(record$ _anns) tokens']) _ - (:: Monad wrap [(' {}) tokens]) + (:: Monad 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 + (do Monad [?export-level|tokens (parse-export-level tokens) #let [[?export-level tokens] ?export-level|tokens] name+args|tokens (parse-complex-declaration tokens) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index ef8b05e41..8f44d3df9 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -8,9 +8,9 @@ ["E" error] [sum]) [io] - [macro #+ with-gensyms Functor Monad] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) ## [Types] (type: #export (CLI a) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index b42a54a33..c09cde8bc 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -7,14 +7,14 @@ (data text/format (coll [list "L/" Monoid Monad Fold]) [product]) - [macro #+ with-gensyms Monad] - (macro [code] - ["s" syntax #+ syntax: Syntax] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))) - [type] - (type opaque)) + [meta #+ with-gensyms Monad] + (meta [code] + ["s" syntax #+ syntax: Syntax] + (syntax ["cs" common] + (common ["csr" reader] + ["csw" writer])) + [type] + (type opaque))) (.. ["A" atom] ["P" promise "P/" Monad] ["T" task] @@ -150,16 +150,16 @@ (code;tag name)]))) (def: #hidden ( name) - (-> Ident (Lux Ident)) - (do Monad - [name (macro;normalize name) - [_ annotations _] (macro;find-def name)] - (case (macro;get-tag-ann (ident-for ) annotations) + (-> Ident (Meta Ident)) + (do Monad + [name (meta;normalize name) + [_ annotations _] (meta;find-def name)] + (case (meta;get-tag-ann (ident-for ) annotations) (#;Some actor-name) (wrap actor-name) _ - (macro;fail (format "Definition is not " ".")))))] + (meta;fail (format "Definition is not " ".")))))] [with-actor resolve-actor #;;actor "an actor"] [with-message resolve-message #;;message "a message"] @@ -224,7 +224,7 @@ (wrap output)))))} (with-gensyms [g!message g!self g!state g!init g!error g!return g!output] (do @ - [module macro;current-module-name + [module meta;current-module-name #let [g!type (code;local-symbol (state-name _name)) g!behavior (code;local-symbol (behavior-name _name)) g!actor (code;local-symbol _name) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index d59b96563..57789d708 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -8,8 +8,8 @@ [io #- run] (data (coll [list "L/" Monoid]) text/format) - [macro] - (macro ["s" syntax #+ syntax: Syntax])) + [meta] + (meta ["s" syntax #+ syntax: Syntax])) (.. ["&" promise])) ## [Types] diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 1e6bb72e9..b41a20e41 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -9,8 +9,8 @@ ["A" applicative] ["M" monad #+ do Monad] ["p" parser]) - [macro] - (macro ["s" syntax #+ syntax: Syntax]) + [meta] + (meta ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom]) )) diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux index 8fe9fa583..df0ec47a9 100644 --- a/stdlib/source/lux/concurrency/space.lux +++ b/stdlib/source/lux/concurrency/space.lux @@ -9,12 +9,12 @@ (data [product] (coll [list "L/" Functor Fold])) [io #- run] - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))))) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax:] + (syntax ["cs" common] + (common ["csr" reader] + ["csw" writer]))))) (with-expansions [ [e (A;Actor Top) (Space e)] diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 7886dda36..d1762ee01 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -12,9 +12,9 @@ maybe [number "Nat/" Codec] text/format) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]) (concurrency [atom #+ Atom atom] ["P" promise] [frp]) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 374acee46..fbc3cbf1e 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -6,8 +6,8 @@ monad ["ex" exception #+ Exception]) (concurrency ["P" promise]) - [macro] - (macro ["s" syntax #+ syntax: Syntax]) + [meta] + (meta ["s" syntax #+ syntax: Syntax]) )) (type: #export (Task a) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 1459a41ab..549ac19b0 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -9,12 +9,12 @@ text/format [maybe "m/" Monad] (coll [list "L/" Fold Functor])) - [macro #+ with-gensyms Monad] - (macro [code] - ["s" syntax #+ syntax:] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))))) + [meta #+ with-gensyms Monad] + (meta [code] + ["s" syntax #+ syntax:] + (syntax ["cs" common] + (common ["csr" reader] + ["csw" writer]))))) ## [Syntax] (type: Alias [Text Code]) @@ -49,16 +49,16 @@ tops)) (def: (singleton expander) - (-> (Lux (List Code)) (Lux Code)) - (monad;do Monad + (-> (Meta (List Code)) (Meta Code)) + (monad;do Monad [expansion expander] (case expansion (#;Cons singleton #;Nil) (wrap singleton) _ - (macro;fail (format "Cannot expand to more than a single AST/Code node:\n" - (|> expansion (L/map %code) (text;join-with " "))))))) + (meta;fail (format "Cannot expand to more than a single AST/Code node:\n" + (|> expansion (L/map %code) (text;join-with " "))))))) (syntax: #export (=> [aliases aliases^] [inputs stack^] @@ -72,16 +72,16 @@ (|> outputs (get@ #bottom) (m/map (|>. code;nat (~) #;Bound (`))))] [(#;Some bottomI) (#;Some bottomO)] (monad;do @ - [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) bottomI))) - outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) bottomO)))] + [inputC (singleton (meta;expand-all (stack-fold (get@ #top inputs) bottomI))) + outputC (singleton (meta;expand-all (stack-fold (get@ #top outputs) bottomO)))] (wrap (list (` (-> (~ (de-alias inputC)) (~ (de-alias outputC))))))) [?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))))] + [inputC (singleton (meta;expand-all (stack-fold (get@ #top inputs) (maybe;default g!stack ?bottomI)))) + outputC (singleton (meta;expand-all (stack-fold (get@ #top outputs) (maybe;default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) @@ -124,7 +124,7 @@ (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 @))] + [g!inputs (|> (meta;gensym "input") (list;repeat arity) (monad;seq @))] (wrap (list (` (: (All [(~@ g!inputs) (~ g!output)] (-> (-> (~@ g!inputs) (~ g!output)) (=> [(~@ g!inputs)] [(~ g!output)]))) diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index 81f62eccb..0db72d0fc 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -4,9 +4,9 @@ ["A" applicative] monad) function - [macro #+ with-gensyms] - (macro [code] - [syntax #+ syntax:]))) + [meta #+ with-gensyms] + (meta [code] + [syntax #+ syntax:]))) (type: #export (Cont i o) {#;doc "Continuations."} diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux index ef46bcb19..5ff6309ec 100644 --- a/stdlib/source/lux/control/contract.lux +++ b/stdlib/source/lux/control/contract.lux @@ -2,9 +2,9 @@ lux (lux (control monad) (data text/format) - [macro #+ Monad] - (macro [code] - ["s" syntax #+ syntax:]))) + [meta] + (meta [code] + ["s" syntax #+ syntax:]))) (def: #export (assert! message test) (-> Text Bool []) @@ -30,7 +30,7 @@ (post i.even? (i.+ 2 2)))} (do @ - [g!output (macro;gensym "")] + [g!output (meta;gensym "")] (wrap (list (` (let [(~ g!output) (~ expr)] (exec (assert! (~ (code;text (format "Post-condition failed: " (%code test)))) ((~ test) (~ g!output))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index b8be7b70d..abc729129 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -4,12 +4,12 @@ (data ["E" error] [maybe] [text "text/" Monoid]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax] + (syntax ["cs" common] + (common ["csr" reader] + ["csw" writer]))))) ## [Types] (type: #export Exception @@ -71,7 +71,7 @@ "It moslty just serves as a way to tag error messages for later catching." (exception: #export Some-Exception))} (do @ - [current-module macro;current-module-name + [current-module meta;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)) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 543c4c769..937935684 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -3,9 +3,9 @@ (lux (control ["M" monad #+ do Monad] ["p" parser]) (data (coll [list #+ Monad "L/" Fold Monad])) - [macro #+ with-gensyms Monad] - (macro ["s" syntax #+ syntax: Syntax] - [code]) + [meta #+ with-gensyms] + (meta ["s" syntax #+ syntax: Syntax] + [code]) )) ## [Syntax] @@ -108,7 +108,7 @@ (~> [int-to-nat %n log!]) (i.* 10)))} (do @ - [g!temp (macro;gensym "")] + [g!temp (meta;gensym "")] (wrap (list (` (let [(~ g!temp) (~ prev)] (exec (|> (~ g!temp) (~@ body)) (~ g!temp)))))))) @@ -122,7 +122,7 @@ [Int/encode])) "Will become: [50 2 \"5\"]")} (do @ - [g!temp (macro;gensym "")] + [g!temp (meta;gensym "")] (wrap (list (` (let [(~ g!temp) (~ prev)] [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body)))) paths))])))))) diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index 677a24190..21cd20eb8 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -6,9 +6,9 @@ (data (coll [list "L/" Monad Monoid Fold]) ["p" product] [maybe]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) (def: error-message Text "Invariant violation") diff --git a/stdlib/source/lux/data/coll/ordered/set.lux b/stdlib/source/lux/data/coll/ordered/set.lux index 376624033..90026feab 100644 --- a/stdlib/source/lux/data/coll/ordered/set.lux +++ b/stdlib/source/lux/data/coll/ordered/set.lux @@ -7,9 +7,9 @@ (ordered ["d" dict])) ["p" product] ["M" maybe #+ Functor]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) (type: #export (Set a) (d;Dict a a)) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index f85558c5e..c76735d3c 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -12,9 +12,9 @@ [array "array/" Functor Fold]) [bit] [product]) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax: Syntax]) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax: Syntax]) )) ## [Utils] diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index 43ed0087c..61e3b3e6c 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -5,8 +5,8 @@ comonad [cont #+ pending Cont] ["p" parser]) - [macro #+ with-gensyms] - (macro ["s" syntax #+ syntax: Syntax]) + [meta #+ with-gensyms] + (meta ["s" syntax #+ syntax: Syntax]) (data (coll [list "List/" Monad]) bool))) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index 546982dba..b07f1ed84 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -6,9 +6,9 @@ ["p" parser] fold) (data (coll [list "L/" Monad Fold])) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) ## [Types] (type: #export (Tree a) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index c8f9a9059..ddab9d121 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -6,9 +6,9 @@ (tree [rose #+ Tree "T/" Functor]) [stack #+ Stack]) [maybe "M/" Monad]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) ## Adapted from the clojure.zip namespace in the Clojure standard library. diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 61ee1249a..490e31094 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -3,7 +3,7 @@ (lux (control [eq]) (data (coll [list "L/" Functor])) [math] - (type opaque))) + (meta (type opaque)))) (def: rgb Nat +256) (def: top Nat (n.dec rgb)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index e00783c0b..899cd652a 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -17,11 +17,11 @@ (coll [list "list/" Fold Monad] [sequence #+ Sequence sequence "sequence/" Monad] [dict #+ Dict])) - [macro #+ Monad with-gensyms] - (macro ["s" syntax #+ syntax:] - [code] - [poly #+ poly:]) - [type] + [meta #+ Monad with-gensyms] + (meta ["s" syntax #+ syntax:] + [code] + [poly #+ poly:] + [type]) )) (do-template [ ] @@ -61,7 +61,7 @@ (json ["this" "is" "an" "array"]) (json {"this" "is" "an" "object"}))} - (let [(^open) Monad + (let [(^open) Monad wrapper (function [x] (` (;;json (~ x))))] (case token (^template [ ] @@ -78,7 +78,7 @@ (wrap (list (` (: JSON (#Array (sequence (~@ (list/map wrapper members)))))))) [_ (#;Record pairs)] - (do Monad + (do Monad [pairs' (monad;map @ (function [[slot value]] (case slot @@ -86,7 +86,7 @@ (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) _ - (macro;fail "Wrong syntax for JSON object."))) + (meta;fail "Wrong syntax for JSON object."))) pairs)] (wrap (list (` (: JSON (#Object (dict;from-list text;Hash (list (~@ pairs'))))))))) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index e344c6a0a..0b0bf8a1d 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -5,9 +5,9 @@ ["A" applicative] monad) (concurrency ["a" atom]) - [macro] - (macro ["s" syntax #+ syntax:]) - (type opaque))) + [meta] + (meta ["s" syntax #+ syntax:] + (type opaque)))) (opaque: #export (Lazy a) (-> [] a) @@ -31,7 +31,7 @@ (syntax: #export (freeze expr) (do @ - [g!_ (macro;gensym "_")] + [g!_ (meta;gensym "_")] (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) (struct: #export _ (F;Functor Lazy) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index e1fbccb36..ffe40e20e 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -12,9 +12,9 @@ ["E" error] [maybe] (coll [list "L/" Monad])) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) ## Based on org.apache.commons.math4.complex.Complex ## https://github.com/apache/commons-math/blob/master/src/main/java/org/apache/commons/math4/complex/Complex.java @@ -30,7 +30,7 @@ (complex real))} (wrap (list (` {#;;real (~ real) #;;imaginary (~ (maybe;default (' 0.0) - ?imaginary))})))) + ?imaginary))})))) (def: #export i Complex (complex 0.0 1.0)) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 8db271d7d..d14e5e1f1 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -13,9 +13,9 @@ ["E" error] [product] [maybe]) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax]))) (type: #export Ratio {#numerator Nat @@ -157,4 +157,4 @@ (ratio numerator))} (wrap (list (` (normalize {#;;numerator (~ numerator) #;;denominator (~ (maybe;default (' +1) - ?denominator))}))))) + ?denominator))}))))) diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux index ef92b68c4..f798078dd 100644 --- a/stdlib/source/lux/data/store.lux +++ b/stdlib/source/lux/data/store.lux @@ -2,7 +2,7 @@ lux (lux (control ["F" functor] comonad) - (type auto))) + (meta (type auto)))) (type: #export (Store s a) {#cursor s diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux index ffe128022..ad91ea8ab 100644 --- a/stdlib/source/lux/data/tainted.lux +++ b/stdlib/source/lux/data/tainted.lux @@ -1,7 +1,7 @@ (;module: lux (lux (data [product]) - (type opaque))) + (meta (type opaque)))) (opaque: #export (Tainted a) a diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index f0b9d0e6f..323ce1efb 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -12,10 +12,10 @@ (time [instant] [duration] [date]) - [type] - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]))) + [meta] + (meta [code] + ["s" syntax #+ syntax: Syntax] + [type]))) ## [Syntax] (def: #hidden _compose_ @@ -23,7 +23,7 @@ (:: text;Monoid compose)) (syntax: #export (format [fragments (p;many s;any)]) - {#;doc (doc "Text interpolation as a macro." + {#;doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} (wrap (list (` ($_ _compose_ (~@ fragments)))))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 3803414e4..7ad4a0954 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -7,7 +7,7 @@ [maybe] ["E" error] (coll [list])) - (macro [code]))) + (meta [code]))) (type: Offset Nat) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index a425224cb..bcefa4331 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -10,9 +10,9 @@ ["E" error] [maybe] (coll [list "L/" Fold Monad])) - [macro #- run] - (macro [code] - ["s" syntax #+ syntax:]))) + [meta #- run] + (meta [code] + ["s" syntax #+ syntax:]))) ## [Utils] (def: regex-char^ @@ -458,13 +458,13 @@ (regex "a(.)(.)|b(.)(.)") )} (do @ - [current-module macro;current-module-name] + [current-module meta;current-module-name] (case (|> (regex^ current-module) (p;before l;end) (l;run pattern)) (#E;Error error) - (macro;fail (format "Error while parsing regular-expression:\n" - error)) + (meta;fail (format "Error while parsing regular-expression:\n" + error)) (#E;Success regex) (wrap (list regex)) @@ -485,10 +485,10 @@ _ do-something-else))} (do @ - [g!temp (macro;gensym "temp")] + [g!temp (meta;gensym "temp")] (wrap (list& (` (^multi (~ g!temp) [(l;run (~ g!temp) (regex (~ (code;text pattern)))) (#E;Success (~ (maybe;default g!temp - bindings)))])) + bindings)))])) body branches)))) diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux index ffae2164f..acb059dc0 100644 --- a/stdlib/source/lux/data/trace.lux +++ b/stdlib/source/lux/data/trace.lux @@ -2,8 +2,7 @@ lux (lux (control ["m" monoid] ["F" functor] - comonad) - [macro])) + comonad))) (type: #export (Trace t a) {#monoid (m;Monoid t) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 5f334fb46..4abafbdf3 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -3,9 +3,9 @@ (lux (control monad ["p" parser]) (data (coll [list #* "L/" Fold])) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax: Syntax]) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax: Syntax]) )) (do-template [ ] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index c4ee39c4b..319615411 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -11,10 +11,10 @@ [text "text/" Eq Monoid] text/format [bool "bool/" Codec]) - [macro #+ with-gensyms Functor Monad] - (macro [code] - ["s" syntax #+ syntax: Syntax]) - [type] + [meta #+ with-gensyms Functor Monad] + (meta [code] + ["s" syntax #+ syntax: Syntax] + [type]) )) (do-template [ ] @@ -352,21 +352,21 @@ (def: (class-imports compiler) (-> Compiler ClassImports) - (case (macro;run compiler - (: (Lux ClassImports) - (do Monad - [current-module macro;current-module-name - defs (macro;defs current-module)] - (wrap (list/fold (: (-> [Text Def] ClassImports ClassImports) - (function [[short-name [_ meta _]] imports] - (case (macro;get-text-ann (ident-for #;;jvm-class) meta) - (#;Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) - empty-imports - defs))))) + (case (meta;run compiler + (: (Meta ClassImports) + (do Monad + [current-module meta;current-module-name + defs (meta;defs current-module)] + (wrap (list/fold (: (-> [Text Def] ClassImports ClassImports) + (function [[short-name [_ meta _]] imports] + (case (meta;get-text-ann (ident-for #;;jvm-class) meta) + (#;Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports))) + empty-imports + defs))))) (#;Left _) (list) (#;Right imports) imports)) @@ -1304,8 +1304,8 @@ "(.new! []) for calling the class's constructor." "(.resolve! container [value]) for calling the \"resolve\" method." )} - (do Monad - [current-module macro;current-module-name + (do Monad + [current-module meta;current-module-name #let [fully-qualified-class-name (format (text;replace-all "/" "." current-module) "." full-class-name) field-parsers (list/map (field->parser fully-qualified-class-name) fields) method-parsers (list/map (method->parser (product;right class-decl) fully-qualified-class-name) methods) @@ -1435,7 +1435,7 @@ #;None (do @ - [g!obj (macro;gensym "obj")] + [g!obj (meta;gensym "obj")] (wrap (list (` (: (-> (host (~' java.lang.Object)) Bool) (function [(~ g!obj)] (;_lux_proc ["jvm" (~ (code;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ g!obj)]))))))) @@ -1500,13 +1500,13 @@ class-tvars)) (def: (member-def-arg-bindings type-params class member) - (-> (List TypeParam) ClassDecl ImportMemberDecl (Lux [(List Code) (List Code) (List Text) (List Code)])) + (-> (List TypeParam) ClassDecl ImportMemberDecl (Meta [(List Code) (List Code) (List Text) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do Monad + (do Monad [arg-inputs (monad;map @ - (: (-> [Bool GenericType] (Lux [Code Code])) + (: (-> [Bool GenericType] (Meta [Code Code])) (function [[maybe? _]] (with-gensyms [arg-name] (wrap [arg-name (if maybe? @@ -1528,19 +1528,19 @@ (wrap [arg-function-inputs arg-method-inputs arg-classes arg-types]))) _ - (:: Monad wrap [(list) (list) (list) (list)]))) + (:: Monad wrap [(list) (list) (list) (list)]))) (def: (member-def-return mode type-params class member) - (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Lux Code)) + (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Meta Code)) (case member (#ConstructorDecl _) - (:: Monad wrap (class-decl-type$ class)) + (:: Monad wrap (class-decl-type$ class)) (#MethodDecl [_ method]) - (:: Monad wrap (class->type mode type-params (get@ #import-method-return method))) + (:: Monad wrap (class->type mode type-params (get@ #import-method-return method))) _ - (macro;fail "Only methods have return values."))) + (meta;fail "Only methods have return values."))) (def: (decorate-return-maybe member [return-type return-term]) (-> ImportMemberDecl [Code Code] [Code Code]) @@ -1668,14 +1668,14 @@ _ 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 (Lux (List Code))) + (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code))) (let [[full-name class-tvars] class all-params (|> (member-type-vars class-tvars member) (list;filter free-type-param?) (list/map type-param->type-arg))] (case member (#EnumDecl enum-members) - (do Monad + (do Monad [#let [enum-type (: Code (case class-tvars #;Nil @@ -1695,7 +1695,7 @@ (wrap (list/map getter-interop enum-members))) (#ConstructorDecl [commons _]) - (do Monad + (do Monad [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) #let [def-name (code;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) def-params (list (code;tuple arg-function-inputs)) @@ -1755,7 +1755,7 @@ (~ jvm-interop))))))) (#FieldAccessDecl fad) - (do Monad + (do Monad [#let [(^open) fad base-gtype (class->type import-field-mode type-params import-field-type) g!class (class-decl-type$ class) @@ -1817,12 +1817,12 @@ ))) (def: (member-import$ type-params long-name? kind class member) - (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Lux (List Code))) + (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Meta (List Code))) (let [[full-name _] class method-prefix (if long-name? full-name (short-class-name full-name))] - (do Monad + (do Monad [=args (member-def-arg-bindings type-params class member)] (member-def-interop type-params kind class =args member method-prefix)))) @@ -1835,15 +1835,15 @@ (try (_lux_proc ["jvm" "invokestatic:java.lang.Class:forName:java.lang.String"] [class-name]))) (def: (class-kind [class-name _]) - (-> ClassDecl (Lux ClassKind)) + (-> ClassDecl (Meta ClassKind)) (case (load-class class-name) (#;Right class) - (:: Monad wrap (if (interface? class) - #Interface - #Class)) + (:: Monad wrap (if (interface? class) + #Interface + #Class)) (#;Left _) - (macro;fail (format "Unknown class: " class-name)))) + (meta;fail (format "Unknown class: " class-name)))) (syntax: #export (import [#let [imports (class-imports *compiler*)]] [long-name? (s;this? (' #long))] @@ -1898,7 +1898,7 @@ (java.util.List.size [] my-list) Character$UnicodeScript.LATIN )} - (do Monad + (do Monad [kind (class-kind class-decl) =members (monad;map @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)] (wrap (list& (class-import$ long-name? class-decl) (list/join =members))))) @@ -1930,15 +1930,15 @@ (wrap (list (` (;_lux_proc ["jvm" "arraylength"] [(~ array)]))))) (def: (type->class-name type) - (-> Type (Lux Text)) + (-> Type (Meta Text)) (case type (#;Host name params) - (:: Monad wrap name) + (:: Monad wrap name) (#;Apply A F) (case (type;apply (list A) F) #;None - (macro;fail (format "Cannot apply type: " (type;to-text F) " to " (type;to-text A))) + (meta;fail (format "Cannot apply type: " (type;to-text F) " to " (type;to-text A))) (#;Some type') (type->class-name type')) @@ -1947,10 +1947,10 @@ (type->class-name type') #;Unit - (:: Monad wrap "java.lang.Object") + (:: Monad wrap "java.lang.Object") (^or #;Void (#;Var _) (#;Ex _) (#;Bound _) (#;Sum _) (#;Product _) (#;Function _) (#;UnivQ _) (#;ExQ _)) - (macro;fail (format "Cannot convert to JvmType: " (type;to-text type))) + (meta;fail (format "Cannot convert to JvmType: " (type;to-text type))) )) (syntax: #export (array-read idx array) @@ -1958,8 +1958,8 @@ (array-read +10 my-array))} (case array [_ (#;Symbol array-name)] - (do Monad - [array-type (macro;find-type array-name) + (do Monad + [array-type (meta;find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [ ] @@ -1987,8 +1987,8 @@ (array-write +10 my-object my-array))} (case array [_ (#;Symbol array-name)] - (do Monad - [array-type (macro;find-type array-name) + (do Monad + [array-type (meta;find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [ ] @@ -2045,7 +2045,7 @@ (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (code;text (simple-class$ (list) type)))]))))) (def: get-compiler - (Lux Compiler) + (Meta Compiler) (function [compiler] (#;Right [compiler compiler]))) @@ -2065,15 +2065,15 @@ (resolve-class "String") => "java.lang.String")} - (-> Text (Lux Text)) - (do Monad + (-> Text (Meta Text)) + (do Monad [*compiler* get-compiler] (case (fully-qualify-class-name+ (class-imports *compiler*) class) (#;Some fqcn) (wrap fqcn) #;None - (macro;fail (text/compose "Unknown class: " class))))) + (meta;fail (text/compose "Unknown class: " class))))) (syntax: #export (type [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))]) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux deleted file mode 100644 index 4fb0b08a4..000000000 --- a/stdlib/source/lux/macro.lux +++ /dev/null @@ -1,657 +0,0 @@ -(;module: {#;doc "Functions for extracting information from the state of the compiler."} - lux - (lux (macro [code]) - (control ["F" functor] - ["A" applicative] - ["M" monad #+ do Monad]) - (data [number] - [product] - [ident "ident/" Codec Eq] - [maybe] - ["E" error] - [text "text/" Monoid Eq] - (coll [list "list/" Monoid Monad])))) - -## (type: (Lux a) -## (-> Compiler (E;Error [Compiler a]))) - -(struct: #export _ (F;Functor Lux) - (def: (map f fa) - (function [state] - (case (fa state) - (#E;Error msg) - (#E;Error msg) - - (#E;Success [state' a]) - (#E;Success [state' (f a)]))))) - -(struct: #export _ (A;Applicative Lux) - (def: functor Functor) - - (def: (wrap x) - (function [state] - (#E;Success [state x]))) - - (def: (apply ff fa) - (function [state] - (case (ff state) - (#E;Success [state' f]) - (case (fa state') - (#E;Success [state'' a]) - (#E;Success [state'' (f a)]) - - (#E;Error msg) - (#E;Error msg)) - - (#E;Error msg) - (#E;Error msg))))) - -(struct: #export _ (Monad Lux) - (def: applicative Applicative) - - (def: (join mma) - (function [state] - (case (mma state) - (#E;Error msg) - (#E;Error msg) - - (#E;Success [state' ma]) - (ma state'))))) - -(def: (get k plist) - (All [a] - (-> Text (List [Text a]) (Maybe a))) - (case plist - #;Nil - #;None - - (#;Cons [k' v] plist') - (if (text/= k k') - (#;Some v) - (get k plist')))) - -(def: #export (run' compiler action) - (All [a] (-> Compiler (Lux a) (E;Error [Compiler a]))) - (action compiler)) - -(def: #export (run compiler action) - (All [a] (-> Compiler (Lux a) (E;Error a))) - (case (action compiler) - (#E;Error error) - (#E;Error error) - - (#E;Success [_ output]) - (#E;Success output))) - -(def: #export (either left right) - {#;doc "Pick whichever computation succeeds."} - (All [a] (-> (Lux a) (Lux a) (Lux a))) - (function [compiler] - (case (left compiler) - (#E;Error error) - (right compiler) - - (#E;Success [compiler' output]) - (#E;Success [compiler' output])))) - -(def: #export (assert message test) - {#;doc "Fails with the given message if the test is false."} - (-> Text Bool (Lux Unit)) - (function [compiler] - (if test - (#E;Success [compiler []]) - (#E;Error message)))) - -(def: #export (fail msg) - {#;doc "Fails with the given message."} - (All [a] - (-> Text (Lux a))) - (function [_] - (#E;Error msg))) - -(def: #export (find-module name) - (-> Text (Lux Module)) - (function [state] - (case (get name (get@ #;modules state)) - (#;Some module) - (#E;Success [state module]) - - _ - (#E;Error ($_ text/compose "Unknown module: " name))))) - -(def: #export current-module-name - (Lux Text) - (function [state] - (case (list;last (get@ #;scopes state)) - (#;Some scope) - (case (get@ #;name scope) - (#;Cons m-name #;Nil) - (#E;Success [state m-name]) - - _ - (#E;Error "Improper name for scope.")) - - _ - (#E;Error "Empty environment!") - ))) - -(def: #export current-module - (Lux Module) - (do Monad - [this-module-name current-module-name] - (find-module this-module-name))) - -(def: #export (get-ann tag anns) - {#;doc "Looks-up a particular annotation's value within the set of annotations."} - (-> Ident Code (Maybe Code)) - (case anns - [_ (#;Record anns)] - (loop [anns anns] - (case anns - (#;Cons [key value] anns') - (case key - [_ (#;Tag tag')] - (if (ident/= tag tag') - (#;Some value) - (recur anns')) - - _ - (recur anns')) - - #;Nil - #;None)) - - _ - #;None)) - -(do-template [ ] - [(def: #export ( tag anns) - (-> Ident Code (Maybe )) - (case (get-ann tag anns) - (#;Some [_ ( value)]) - (#;Some value) - - _ - #;None))] - - [get-bool-ann #;Bool Bool] - [get-int-ann #;Int Int] - [get-frac-ann #;Frac Frac] - [get-text-ann #;Text Text] - [get-symbol-ann #;Symbol Ident] - [get-tag-ann #;Tag Ident] - [get-form-ann #;Form (List Code)] - [get-tuple-ann #;Tuple (List Code)] - [get-record-ann #;Record (List [Code Code])] - ) - -(def: #export (get-doc anns) - {#;doc "Looks-up a definition's documentation."} - (-> Code (Maybe Text)) - (get-text-ann ["lux" "doc"] anns)) - -(def: #export (flag-set? flag-name anns) - {#;doc "Finds out whether an annotation-as-a-flag is set (has value 'true')."} - (-> Ident Code Bool) - (maybe;default false (get-bool-ann flag-name anns))) - -(do-template [ ] - [(def: #export - {#;doc (code;text ($_ text/compose "Checks whether a definition is " "."))} - (-> Code Bool) - (flag-set? (ident-for )))] - - [export? #;export? "exported"] - [hidden? #;hidden? "hidden"] - [macro? #;macro? "a macro"] - [type? #;type? "a type"] - [struct? #;struct? "a structure"] - [type-rec? #;type-rec? "a recursive type"] - [sig? #;sig? "a signature"] - ) - -(do-template [ ] - [(def: ( input) - (-> Code (Maybe )) - (case input - [_ ( actual-value)] - (#;Some actual-value) - - _ - #;None))] - - [parse-tuple #;Tuple (List Code)] - [parse-text #;Text Text] - ) - -(do-template [ ] - [(def: #export ( anns) - {#;doc (code;text ($_ text/compose "Looks up the arguments of a " "."))} - (-> Code (List Text)) - (maybe;default (list) - (do maybe;Monad - [_args (get-ann (ident-for ) anns) - args (parse-tuple _args)] - (M;map @ parse-text args))))] - - [func-args #;func-args "function"] - [type-args #;type-args "parameterized type"] - ) - -(def: (find-macro' modules this-module module name) - (-> (List [Text Module]) Text Text Text - (Maybe Macro)) - (do maybe;Monad - [$module (get module modules) - [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] - (if (and (macro? def-anns) - (or (export? def-anns) (text/= module this-module))) - (#;Some (:! Macro def-value)) - (case (get-symbol-ann ["lux" "alias"] def-anns) - (#;Some [r-module r-name]) - (find-macro' modules this-module r-module r-name) - - _ - #;None)))) - -(def: #export (find-macro ident) - (-> Ident (Lux (Maybe Macro))) - (do Monad - [this-module current-module-name] - (let [[module name] ident] - (: (Lux (Maybe Macro)) - (function [state] - (#E;Success [state (find-macro' (get@ #;modules state) this-module module name)])))))) - -(def: #export (normalize ident) - {#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix. - - Otherwise, returns the identifier as-is."} - (-> Ident (Lux Ident)) - (case ident - ["" name] - (do Monad - [module-name current-module-name] - (wrap [module-name name])) - - _ - (:: Monad wrap ident))) - -(def: #export (expand-once syntax) - {#;doc "Given code that requires applying a macro, does it once and returns the result. - - Otherwise, returns the code as-is."} - (-> Code (Lux (List Code))) - (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] - (do Monad - [name' (normalize name) - ?macro (find-macro name')] - (case ?macro - (#;Some macro) - (macro args) - - #;None - (:: Monad wrap (list syntax)))) - - _ - (:: Monad wrap (list syntax)))) - -(def: #export (expand syntax) - {#;doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left. - - Otherwise, returns the code as-is."} - (-> Code (Lux (List Code))) - (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] - (do Monad - [name' (normalize name) - ?macro (find-macro name')] - (case ?macro - (#;Some macro) - (do Monad - [expansion (macro args) - expansion' (M;map Monad expand expansion)] - (wrap (list/join expansion'))) - - #;None - (:: Monad wrap (list syntax)))) - - _ - (:: Monad wrap (list syntax)))) - -(def: #export (expand-all syntax) - {#;doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} - (-> Code (Lux (List Code))) - (case syntax - [_ (#;Form (#;Cons [[_ (#;Symbol name)] args]))] - (do Monad - [name' (normalize name) - ?macro (find-macro name')] - (case ?macro - (#;Some macro) - (do Monad - [expansion (macro args) - expansion' (M;map Monad expand-all expansion)] - (wrap (list/join expansion'))) - - #;None - (do Monad - [parts' (M;map Monad expand-all (list& (code;symbol name) args))] - (wrap (list (code;form (list/join parts'))))))) - - [_ (#;Form (#;Cons [harg targs]))] - (do Monad - [harg+ (expand-all harg) - targs+ (M;map Monad expand-all targs)] - (wrap (list (code;form (list/compose harg+ (list/join (: (List (List Code)) targs+))))))) - - [_ (#;Tuple members)] - (do Monad - [members' (M;map Monad expand-all members)] - (wrap (list (code;tuple (list/join members'))))) - - _ - (:: Monad wrap (list syntax)))) - -(def: #export (gensym prefix) - {#;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 (Lux Code)) - (function [state] - (#E;Success [(update@ #;seed n.inc state) - (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec encode (get@ #;seed state)))])]))) - -(def: (get-local-symbol ast) - (-> Code (Lux Text)) - (case ast - [_ (#;Symbol [_ name])] - (:: Monad wrap name) - - _ - (fail (text/compose "Code is not a local symbol: " (code;to-text ast))))) - -(macro: #export (with-gensyms tokens) - {#;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))))) - )))} - (case tokens - (^ (list [_ (#;Tuple symbols)] body)) - (do Monad - [symbol-names (M;map @ get-local-symbol symbols) - #let [symbol-defs (list/join (list/map (: (-> Text (List Code)) - (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) - symbol-names))]] - (wrap (list (` (do Monad - [(~@ symbol-defs)] - (~ body)))))) - - _ - (fail "Wrong syntax for with-gensyms"))) - -(def: #export (expand-1 token) - {#;doc "Works just like expand, except that it ensures that the output is a single Code token."} - (-> Code (Lux Code)) - (do Monad - [token+ (expand token)] - (case token+ - (^ (list token')) - (wrap token') - - _ - (fail "Macro expanded to more than 1 element.")))) - -(def: #export (module-exists? module) - (-> Text (Lux Bool)) - (function [state] - (#E;Success [state (case (get module (get@ #;modules state)) - (#;Some _) - true - - #;None - false)]))) - -(def: (try-both f x1 x2) - (All [a b] - (-> (-> a (Maybe b)) a a (Maybe b))) - (case (f x1) - #;None (f x2) - (#;Some y) (#;Some y))) - -(def: #export (find-var-type name) - {#;doc "Looks-up the type of a local variable somewhere in the environment."} - (-> Text (Lux Type)) - (function [state] - (let [test (: (-> [Text [Type Top]] Bool) - (|>. product;left (text/= name)))] - (case (do maybe;Monad - [scope (list;find (function [env] - (or (list;any? test (: (List [Text [Type Top]]) - (get@ [#;locals #;mappings] env))) - (list;any? test (: (List [Text [Type Top]]) - (get@ [#;captured #;mappings] env))))) - (get@ #;scopes state)) - [_ [type _]] (try-both (list;find test) - (: (List [Text [Type Top]]) - (get@ [#;locals #;mappings] scope)) - (: (List [Text [Type Top]]) - (get@ [#;captured #;mappings] scope)))] - (wrap type)) - (#;Some var-type) - (#E;Success [state var-type]) - - #;None - (#E;Error ($_ text/compose "Unknown variable: " name)))))) - -(def: #export (find-def name) - {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} - (-> Ident (Lux Def)) - (function [state] - (case (: (Maybe Def) - (do maybe;Monad - [#let [[v-prefix v-name] name] - (^slots [#;defs]) (get v-prefix (get@ #;modules state))] - (get v-name defs))) - (#;Some _anns) - (#E;Success [state _anns]) - - _ - (#E;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) - -(def: #export (find-def-type name) - {#;doc "Looks-up a definition's type in the available modules (including the current one)."} - (-> Ident (Lux Type)) - (do Monad - [[def-type def-data def-value] (find-def name)] - (wrap def-type))) - -(def: #export (find-type name) - {#;doc "Looks-up the type of either a local variable or a definition."} - (-> Ident (Lux Type)) - (do Monad - [#let [[_ _name] name]] - (either (find-var-type _name) - (do @ - [name (normalize name)] - (find-def-type name))))) - -(def: #export (find-type-def name) - {#;doc "Finds the value of a type definition (such as Int, Top or Compiler)."} - (-> Ident (Lux Type)) - (do Monad - [[def-type def-data def-value] (find-def name)] - (wrap (:! Type def-value)))) - -(def: #export (defs module-name) - {#;doc "The entire list of definitions in a module (including the unexported/private ones)."} - (-> Text (Lux (List [Text Def]))) - (function [state] - (case (get module-name (get@ #;modules state)) - #;None (#E;Error ($_ text/compose "Unknown module: " module-name)) - (#;Some module) (#E;Success [state (get@ #;defs module)]) - ))) - -(def: #export (exports module-name) - {#;doc "All the exported definitions in a module."} - (-> Text (Lux (List [Text Def]))) - (do Monad - [defs (defs module-name)] - (wrap (list;filter (function [[name [def-type def-anns def-value]]] - (and (export? def-anns) - (not (hidden? def-anns)))) - defs)))) - -(def: #export modules - {#;doc "All the available modules (including the current one)."} - (Lux (List [Text Module])) - (function [state] - (|> state - (get@ #;modules) - [state] - #E;Success))) - -(def: #export (tags-of type-name) - {#;doc "All the tags associated with a type definition."} - (-> Ident (Lux (List Ident))) - (do Monad - [#let [[module name] type-name] - module (find-module module)] - (case (get name (get@ #;types module)) - (#;Some [tags _]) - (wrap tags) - - _ - (wrap (list))))) - -(def: #export cursor - {#;doc "The cursor of the current expression being analyzed."} - (Lux Cursor) - (function [state] - (#E;Success [state (get@ #;cursor state)]))) - -(def: #export expected-type - {#;doc "The expected type of the current expression being analyzed."} - (Lux Type) - (function [state] - (case (get@ #;expected state) - (#;Some type) - (#E;Success [state type]) - - #;None - (#E;Error "Not expecting any type.")))) - -(def: #export (imported-modules module-name) - {#;doc "All the modules imported by a specified module."} - (-> Text (Lux (List Text))) - (do Monad - [(^slots [#;imports]) (find-module module-name)] - (wrap imports))) - -(def: #export (resolve-tag tag) - {#;doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."} - (-> Ident (Lux [Nat (List Ident) Type])) - (do Monad - [#let [[module name] tag] - =module (find-module module) - this-module-name current-module-name] - (case (get name (get@ #;tags =module)) - (#;Some [idx tag-list exported? type]) - (if (or exported? - (text/= this-module-name module)) - (wrap [idx tag-list type]) - (fail ($_ text/compose "Cannot access tag: " (ident/encode tag) " from module " this-module-name))) - - _ - (fail ($_ text/compose "Unknown tag: " (ident/encode tag)))))) - -(def: #export (tag-lists module) - {#;doc "All the tag-lists defined in a module, with their associated types."} - (-> Text (Lux (List [(List Ident) Type]))) - (do Monad - [=module (find-module module) - this-module-name current-module-name] - (wrap (|> (get@ #;types =module) - (list;filter (function [[type-name [tag-list exported? type]]] - (or exported? - (text/= this-module-name module)))) - (list/map (function [[type-name [tag-list exported? type]]] - [tag-list type])))))) - -(def: #export locals - {#;doc "All the local variables currently in scope, separated in different scopes."} - (Lux (List (List [Text Type]))) - (function [state] - (case (list;inits (get@ #;scopes state)) - #;None - (#E;Error "No local environment") - - (#;Some scopes) - (#E;Success [state - (list/map (|>. (get@ [#;locals #;mappings]) - (list/map (function [[name [type _]]] - [name type]))) - scopes)])))) - -(def: #export (un-alias def-name) - {#;doc "Given an aliased definition's name, returns the original definition being referenced."} - (-> Ident (Lux Ident)) - (do Monad - [def-name (normalize def-name) - [_ def-anns _] (find-def def-name)] - (case (get-symbol-ann (ident-for #;alias) def-anns) - (#;Some real-def-name) - (wrap real-def-name) - - _ - (wrap def-name)))) - -(def: #export get-compiler - {#;doc "Obtains the current state of the compiler."} - (Lux Compiler) - (function [compiler] - (#E;Success [compiler compiler]))) - -(def: #export type-context - (Lux Type-Context) - (function [compiler] - (#E;Success [compiler (get@ #;type-context compiler)]))) - -(do-template [ ] - [(macro: #export ( tokens) - {#;doc (doc "Performs a macro-expansion and logs the resulting code." - "You can either use the resulting code, or omit them." - "By omitting them, this macro produces nothing (just like the lux;comment macro)." - ( #omit - (def: (foo bar baz) - (-> Int Int Int) - (i.+ bar baz))))} - (case tokens - (^ (list [_ (#;Tag ["" "omit"])] - token)) - (do Monad - [output ( token) - #let [_ (list/map (. log! code;to-text) - output)]] - (wrap (list))) - - (^ (list token)) - (do Monad - [output ( token) - #let [_ (list/map (. log! code;to-text) - output)]] - (wrap output)) - - _ - (fail ($_ text/compose "Wrong syntax for " "."))))] - - [log-expand expand "log-expand"] - [log-expand-all expand-all "log-expand-all"] - [log-expand-once expand-once "log-expand-once"] - ) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux deleted file mode 100644 index 0f5465f2b..000000000 --- a/stdlib/source/lux/macro/code.lux +++ /dev/null @@ -1,143 +0,0 @@ -(;module: - lux - (lux (control [eq #+ Eq]) - (data bool - number - [text #+ Eq "Text/" Monoid] - ident - (coll [list #* "" Functor Fold]) - ))) - -## [Types] -## (type: (Code' w) -## (#;Bool Bool) -## (#;Nat Nat) -## (#;Int Int) -## (#;Frac Frac) -## (#;Text Text) -## (#;Symbol Text Text) -## (#;Tag Text Text) -## (#;Form (List (w (Code' w)))) -## (#;Tuple (List (w (Code' w)))) -## (#;Record (List [(w (Code' w)) (w (Code' w))]))) - -## (type: Code -## (Meta Cursor (Code' (Meta Cursor)))) - -## [Utils] -(def: _cursor Cursor ["" +0 +0]) - -## [Functions] -(do-template [ ] - [(def: #export ( x) - (-> Code) - [_cursor ( x)])] - - [bool Bool #;Bool] - [nat Nat #;Nat] - [int Int #;Int] - [deg Deg #;Deg] - [frac Frac #;Frac] - [text Text #;Text] - [symbol Ident #;Symbol] - [tag Ident #;Tag] - [form (List Code) #;Form] - [tuple (List Code) #;Tuple] - [record (List [Code Code]) #;Record] - ) - -(do-template [ ] - [(def: #export ( name) - {#;doc } - (-> Text Code) - [_cursor ( ["" name])])] - - [local-symbol #;Symbol "Produces a local symbol (a symbol with no module prefix)."] - [local-tag #;Tag "Produces a local tag (a tag with no module prefix)."]) - -## [Structures] -(struct: #export _ (Eq Code) - (def: (= x y) - (case [x y] - (^template [ ] - [[_ ( x')] [_ ( y')]] - (:: = x' y')) - ([#;Bool Eq] - [#;Nat Eq] - [#;Int Eq] - [#;Deg Eq] - [#;Frac Eq] - [#;Text Eq] - [#;Symbol Eq] - [#;Tag Eq]) - - (^template [] - [[_ ( xs')] [_ ( ys')]] - (and (:: Eq = (size xs') (size ys')) - (fold (function [[x' y'] old] - (and old (= x' y'))) - true - (zip2 xs' ys')))) - ([#;Form] - [#;Tuple]) - - [[_ (#;Record xs')] [_ (#;Record ys')]] - (and (:: Eq = (size xs') (size ys')) - (fold (function [[[xl' xr'] [yl' yr']] old] - (and old (= xl' yl') (= xr' yr'))) - true - (zip2 xs' ys'))) - - _ - false))) - -## [Values] -(def: #export (to-text ast) - (-> Code Text) - (case ast - (^template [ ] - [_ ( value)] - (:: encode value)) - ([#;Bool Codec] - [#;Nat Codec] - [#;Int Codec] - [#;Deg Codec] - [#;Frac Codec] - [#;Symbol Codec]) - - [_ (#;Text value)] - (text;encode value) - - [_ (#;Tag ident)] - (Text/compose "#" (:: Codec encode ident)) - - (^template [ ] - [_ ( members)] - ($_ Text/compose (|> members (map to-text) (interpose " ") (text;join-with "")) )) - ([#;Form "(" ")"] - [#;Tuple "[" "]"]) - - [_ (#;Record pairs)] - ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}") - )) - -(def: #export (replace original substitute ast) - {#;doc "Replaces all code that looks like the 'original' with the 'substitute'."} - (-> Code Code Code Code) - (if (:: Eq = original ast) - substitute - (case ast - (^template [] - [cursor ( parts)] - [cursor ( (map (replace original substitute) parts))]) - ([#;Form] - [#;Tuple]) - - [cursor (#;Record parts)] - [cursor (#;Record (map (function [[left right]] - [(replace original substitute left) - (replace original substitute right)]) - parts))] - - _ - ast))) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux deleted file mode 100644 index fc6c7120f..000000000 --- a/stdlib/source/lux/macro/poly.lux +++ /dev/null @@ -1,448 +0,0 @@ -(;module: - [lux #- function] - (lux (control [monad #+ do Monad] - [eq] - ["p" parser]) - [function] - (data [text "text/" Monoid] - (coll [list "list/" Fold Monad Monoid] - [dict #+ Dict]) - [number "nat/" Codec] - [product] - [bool] - [maybe] - [ident "ident/" Eq Codec] - ["E" error]) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax: Syntax] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))) - [type] - (type [check]) - )) - -(type: #export Env (Dict Nat [Type Code])) - -(type: #export (Poly a) - (p;Parser [Env (List Type)] a)) - -(def: #export fresh Env (dict;new number;Hash)) - -(def: (run' env types poly) - (All [a] (-> Env (List Type) (Poly a) (E;Error a))) - (case (p;run [env types] poly) - (#E;Error error) - (#E;Error error) - - (#E;Success [[env' remaining] output]) - (case remaining - #;Nil - (#E;Success output) - - _ - (#E;Error (|> remaining - (list/map type;to-text) - (text;join-with ", ") - (text/compose "Unconsumed types: ")))))) - -(def: #export (run type poly) - (All [a] (-> Type (Poly a) (E;Error a))) - (run' fresh (list type) poly)) - -(def: #export env - (Poly Env) - (;function [[env inputs]] - (#E;Success [[env inputs] env]))) - -(def: (with-env temp poly) - (All [a] (-> Env (Poly a) (Poly a))) - (;function [[env inputs]] - (case (p;run [temp inputs] poly) - (#E;Error error) - (#E;Error error) - - (#E;Success [[_ remaining] output]) - (#E;Success [[env remaining] output])))) - -(def: #export peek - (Poly Type) - (;function [[env inputs]] - (case inputs - #;Nil - (#E;Error "Empty stream of types.") - - (#;Cons headT tail) - (#E;Success [[env inputs] headT])))) - -(def: #export any - (Poly Type) - (;function [[env inputs]] - (case inputs - #;Nil - (#E;Error "Empty stream of types.") - - (#;Cons headT tail) - (#E;Success [[env tail] headT])))) - -(def: #export (local types poly) - (All [a] (-> (List Type) (Poly a) (Poly a))) - (;function [[env pass-through]] - (case (run' env types poly) - (#E;Error error) - (#E;Error error) - - (#E;Success output) - (#E;Success [[env pass-through] output])))) - -(def: (label idx) - (-> Nat Code) - (code;local-symbol (text/compose "label\u0000" (nat/encode idx)))) - -(def: #export (with-extension type poly) - (All [a] (-> Type (Poly a) (Poly [Code a]))) - (;function [[env inputs]] - (let [current-id (dict;size env) - g!var (label current-id)] - (case (p;run [(dict;put current-id [type g!var] env) - inputs] - poly) - (#E;Error error) - (#E;Error error) - - (#E;Success [[_ inputs'] output]) - (#E;Success [[env inputs'] [g!var output]]))))) - -(do-template [ ] - [(def: #export - (Poly Unit) - (do p;Monad - [headT any] - (case (type;un-name headT) - - (wrap []) - - _ - (p;fail ($_ text/compose "Not " " type: " (type;to-text headT))))))] - - [void "Void" #;Void] - [unit "Unit" #;Unit] - [bool "Bool" (#;Host "#Bool" #;Nil)] - [nat "Nat" (#;Host "#Nat" #;Nil)] - [int "Int" (#;Host "#Int" #;Nil)] - [deg "Deg" (#;Host "#Deg" #;Nil)] - [frac "Frac" (#;Host "#Frac" #;Nil)] - [text "Text" (#;Host "#Text" #;Nil)] - ) - -(def: #export primitive - (Poly Type) - (do p;Monad - [headT any] - (case (run headT ($_ p;either - void - unit - bool - nat - int - deg - frac - text)) - (#E;Error error) - (p;fail error) - - (#E;Success _) - (wrap headT)))) - -(do-template [ ] - [(def: #export ( poly) - (All [a] (-> (Poly a) (Poly a))) - (do p;Monad - [headT any] - (let [members ( (type;un-name headT))] - (if (n.> +1 (list;size members)) - (local members poly) - (p;fail ($_ text/compose "Not a " (ident/encode (ident-for )) " type: " (type;to-text headT)))))))] - - [variant type;flatten-variant #;Sum] - [tuple type;flatten-tuple #;Product] - ) - -(def: polymorphic' - (Poly [Nat Type]) - (do p;Monad - [headT any - #let [[num-arg bodyT] (type;flatten-univ-q (type;un-name headT))]] - (if (n.= +0 num-arg) - (p;fail ($_ text/compose "Non-polymorphic type: " (type;to-text headT))) - (wrap [num-arg bodyT])))) - -(def: #export (polymorphic poly) - (All [a] (-> (Poly a) (Poly [Code (List Code) a]))) - (do p;Monad - [headT any - funcI (:: @ map dict;size ;;env) - [num-args non-poly] (local (list headT) polymorphic') - env ;;env - #let [funcL (label funcI) - [all-varsL env'] (loop [current-arg +0 - env' env - all-varsL (: (List Code) (list))] - (if (n.< num-args current-arg) - (if (n.= +0 current-arg) - (let [varL (label (n.inc funcI))] - (recur (n.inc current-arg) - (|> env' - (dict;put funcI [headT funcL]) - (dict;put (n.inc funcI) [(#;Bound (n.inc funcI)) varL])) - (#;Cons varL all-varsL))) - (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)) - (list/map (|>. (n.* +2) n.inc (n.+ funcI) label)) - list;reverse))))] - (recur (n.inc current-arg) - (|> env' - (dict;put partialI [;Void partialC]) - (dict;put partial-varI [(#;Bound partial-varI) partial-varL])) - (#;Cons partial-varL all-varsL)))) - [all-varsL env']))]] - (|> (do @ - [output poly] - (wrap [funcL all-varsL output])) - (local (list non-poly)) - (with-env env')))) - -(def: #export (function in-poly out-poly) - (All [i o] (-> (Poly i) (Poly o) (Poly [i o]))) - (do p;Monad - [headT any - #let [[inputsT outputT] (type;flatten-function (type;un-name headT))]] - (if (n.> +0 (list;size inputsT)) - (p;seq (local inputsT in-poly) - (local (list outputT) out-poly)) - (p;fail ($_ text/compose "Non-function type: " (type;to-text headT)))))) - -(def: #export (apply poly) - (All [a] (-> (Poly a) (Poly a))) - (do p;Monad - [headT any - #let [[funcT paramsT] (type;flatten-application (type;un-name headT))]] - (if (n.= +0 (list;size paramsT)) - (p;fail ($_ text/compose "Non-application type: " (type;to-text headT))) - (local (#;Cons funcT paramsT) poly)))) - -(def: #export (this expected) - (-> Type (Poly Unit)) - (do p;Monad - [actual any] - (if (check;checks? expected actual) - (wrap []) - (p;fail ($_ text/compose - "Types do not match." "\n" - "Expected: " (type;to-text expected) "\n" - " Actual: " (type;to-text actual)))))) - -(def: (adjusted-idx env idx) - (-> Env Nat Nat) - (let [env-level (n./ +2 (dict;size env)) - bound-level (n./ +2 idx) - bound-idx (n.% +2 idx)] - (|> env-level n.dec (n.- bound-level) (n.* +2) (n.+ bound-idx)))) - -(def: #export bound - (Poly Code) - (do p;Monad - [env ;;env - headT any] - (case headT - (#;Bound idx) - (case (dict;get (adjusted-idx env idx) env) - (#;Some [poly-type poly-ast]) - (wrap poly-ast) - - #;None - (p;fail ($_ text/compose "Unknown bound type: " (type;to-text headT)))) - - _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) - -(def: #export (var id) - (-> Nat (Poly Unit)) - (do p;Monad - [env ;;env - headT any] - (case headT - (#;Bound idx) - (if (n.= id (adjusted-idx env idx)) - (wrap []) - (p;fail ($_ text/compose "Wrong bound type.\n" - "Expected: " (nat/encode id) "\n" - " Actual: " (nat/encode idx)))) - - _ - (p;fail ($_ text/compose "Not a bound type: " (type;to-text headT)))))) - -(def: #export (recursive poly) - (All [a] (-> (Poly a) (Poly [Code a]))) - (do p;Monad - [headT any] - (case (type;un-name headT) - (#;Apply #;Void (#;UnivQ _ headT')) - (do @ - [[recT _ output] (|> poly - (with-extension #;Void) - (with-extension headT) - (local (list headT')))] - (wrap [recT output])) - - _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) - -(def: #export recursive-self - (Poly Code) - (do p;Monad - [env ;;env - headT any] - (case (type;un-name headT) - (^multi (#;Apply #;Void (#;Bound funcT-idx)) - (n.= +0 (adjusted-idx env funcT-idx)) - [(dict;get +0 env) (#;Some [self-type self-call])]) - (wrap self-call) - - _ - (p;fail ($_ text/compose "Not a recursive type: " (type;to-text headT)))))) - -(def: #export recursive-call - (Poly Code) - (do p;Monad - [env ;;env - [funcT argsT] (apply (p;seq any (p;many any))) - _ (local (list funcT) (var +0)) - allC (let [allT (list& funcT argsT)] - (|> allT - (monad;map @ (function;const bound)) - (local allT)))] - (wrap (` ((~@ allC)))))) - -(def: #export log - (All [a] (Poly a)) - (do p;Monad - [current any - #let [_ (log! ($_ text/compose - "{" (ident/encode (ident-for ;;log)) "} " - (type;to-text current)))]] - (p;fail "LOGGING"))) - -## [Syntax] -(syntax: #export (poly: [export csr;export] - [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]) - (do macro;Monad - [(~ g!type) (macro;find-type-def (~ g!type))] - (case (|> (~ body) - (;function [(~ g!name)]) - p;rec - (do p;Monad []) - (;;run (~ g!type)) - (: (;Either ;Text ;Code))) - (#;Left (~ g!output)) - (macro;fail (~ g!output)) - - (#;Right (~ g!output)) - ((~' wrap) (;list (~ g!output)))))))))))) - -(def: (common-poly-name? poly-func) - (-> Text Bool) - (text;contains? "?" poly-func)) - -(def: (derivation-name poly args) - (-> Text (List Text) (Maybe Text)) - (if (common-poly-name? poly) - (#;Some (list/fold (text;replace-once "?") poly args)) - #;None)) - -(syntax: #export (derived: [export csr;export] - [?name (p;maybe s;local-symbol)] - [[poly-func poly-args] (s;form (p;seq s;symbol (p;many s;symbol)))] - [?custom-impl (p;maybe s;any)]) - (do @ - [poly-args (monad;map @ macro;normalize poly-args) - name (case ?name - (#;Some name) - (wrap name) - - (^multi #;None - [(derivation-name (product;right poly-func) (list/map product;right poly-args)) - (#;Some derived-name)]) - (wrap derived-name) - - _ - (p;fail "derived: was given no explicit name, and cannot generate one from given information.")) - #let [impl (case ?custom-impl - (#;Some custom-impl) - custom-impl - - #;None - (` ((~ (code;symbol poly-func)) (~@ (list/map code;symbol poly-args)))))]] - (wrap (;list (` (def: (~@ (csw;export export)) - (~ (code;symbol ["" name])) - {#;struct? true} - (~ impl))))))) - -## [Derivers] -(def: #export (to-ast env type) - (-> Env Type Code) - (case type - (#;Host name params) - (` (#;Host (~ (code;text name)) - (list (~@ (list/map (to-ast env) params))))) - - (^template [] - - (` )) - ([#;Void] [#;Unit]) - - (^template [] - ( idx) - (` ( (~ (code;nat idx))))) - ([#;Var] [#;Ex]) - - (#;Bound idx) - (let [idx (adjusted-idx env idx)] - (if (n.= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) - (` (;$ (~ (code;nat (n.dec idx))))))) - - (#;Apply #;Void (#;Bound idx)) - (let [idx (adjusted-idx env idx)] - (if (n.= +0 idx) - (|> (dict;get idx env) maybe;assume product;left (to-ast env)) - (undefined))) - - (^template [] - ( left right) - (` ( (~ (to-ast env left)) - (~ (to-ast env right))))) - ([#;Function] [#;Apply]) - - (^template [ ] - ( left right) - (` ( (~@ (list/map (to-ast env) ( type)))))) - ([#;Sum | type;flatten-variant] - [#;Product & type;flatten-tuple]) - - (#;Named name sub-type) - (code;symbol name) - - (^template [] - ( scope body) - (` ( (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 deleted file mode 100644 index 4c376d742..000000000 --- a/stdlib/source/lux/macro/poly/eq.lux +++ /dev/null @@ -1,151 +0,0 @@ -(;module: - lux - (lux (control [monad #+ do Monad] - [eq] - ["p" parser]) - (data [text "text/" Monoid] - text/format - (coll [list "list/" Monad] - [sequence] - [array] - [queue] - [set] - [dict #+ Dict] - (tree [rose])) - [number "nat/" Codec] - [product] - [bool] - [maybe]) - (time ["du" duration] - ["da" date] - ["i" instant]) - [macro #+ Monad with-gensyms] - (macro [code] - [syntax #+ syntax: Syntax] - (syntax [common]) - [poly #+ poly:]) - [type] - (type [unit]) - )) - -## [Derivers] -(poly: #export Eq - (with-expansions - [ (do-template [ ] - [(do @ - [_ ] - (wrap (` (: (~ (@Eq inputT)) - ))))] - - [poly;unit (function [(~ g!_) (~ g!_)] true)] - [poly;bool bool;Eq] - [poly;nat number;Eq] - [poly;int number;Eq] - [poly;deg number;Eq] - [poly;frac number;Eq] - [poly;text text;Eq]) -