diff options
Diffstat (limited to 'stdlib')
46 files changed, 653 insertions, 394 deletions
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index 0b79a230e..b6c603d0c 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -7,8 +7,7 @@ [data [collection ["." list ("#\." functor fold)]]] - ["." meta] - [macro + ["." macro [syntax (#+ syntax:)] ["." code]]]) @@ -54,7 +53,7 @@ (syntax: #export (do {[?name monad] ..named_monad} {context (s.tuple (p.some context))} expression) - (meta.with_gensyms [g!_ g!bind] + (macro.with_gensyms [g!_ g!bind] (let [body (list\fold (function (_ context next) (case context (#Let bindings) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 23411ad27..51c2604b6 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Alias if loop) - ["." meta (#+ with_gensyms)] + ["." meta] [abstract ["." monad]] [data @@ -9,7 +9,7 @@ ["%" format (#+ format)]] [collection ["." list ("#\." fold functor)]]] - [macro + ["." macro (#+ with_gensyms) ["." code] [syntax (#+ syntax:) ["|.|" export] @@ -79,16 +79,16 @@ (|> outputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] (monad.do meta.monad - [inputC (singleton (meta.expand_all (stack_fold (get@ #top inputs) bottomI))) - outputC (singleton (meta.expand_all (stack_fold (get@ #top outputs) bottomO)))] + [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) bottomI))) + outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) bottomO)))] (wrap (list (` (-> (~ (de_alias inputC)) (~ (de_alias outputC))))))) [?bottomI ?bottomO] (with_gensyms [g!stack] (monad.do meta.monad - [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))))] + [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] (-> (~ (de_alias inputC)) (~ (de_alias outputC)))))))))))) @@ -117,7 +117,7 @@ (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) (with_gensyms [g! g!func g!stack g!output] (monad.do {! meta.monad} - [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq !))] + [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq !))] (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] (-> (-> (~+ g!inputs) (~ g!output)) (=> [(~+ g!inputs)] [(~ g!output)]))) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 5c6baa792..3828b6d83 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -16,7 +16,7 @@ ["%" format (#+ format)]] [collection ["." list ("#\." monoid monad fold)]]] - [macro + ["." macro (#+ with_gensyms) ["." code] [syntax (#+ syntax:) ["|.|" input] @@ -25,7 +25,7 @@ [math [number ["n" nat]]] - ["." meta (#+ with_gensyms monad) + ["." meta (#+ monad) ["." annotation]] [type (#+ :share) ["." abstract (#+ abstract: :representation :abstraction)]]] @@ -311,7 +311,7 @@ <examples>)} (with_gensyms [g!_] (do meta.monad - [g!type (meta.gensym (format name "_abstract_type")) + [g!type (macro.gensym (format name "_abstract_type")) #let [g!actor (code.local_identifier name) g!vars (list\map code.local_identifier vars)]] (wrap (list (` ((~! abstract:) (~+ (|export|.format export)) ((~ g!type) (~+ g!vars)) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index df79b2c2d..8aef0d9b1 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -8,10 +8,9 @@ ["." function] [parser ["s" code]]] - [meta (#+ with_gensyms)] - [macro - ["." code] - [syntax (#+ syntax:)]]]) + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]]]) (type: #export (Cont i o) {#.doc "Continuations."} diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 8f05916d7..fdac9ca3c 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -1,5 +1,6 @@ (.module: {#.doc "Exception-handling functionality."} [lux #* + ["." macro] ["." meta] [abstract [monad (#+ do)]] @@ -99,7 +100,7 @@ "Complex case:" (exception: #export [optional type variables] (some_exception {optional Text} {arguments Int}) optional_body))} - (meta.with_gensyms [g!descriptor] + (macro.with_gensyms [g!descriptor] (do meta.monad [current_module meta.current_module_name #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index f49e7d1c5..fef0280c7 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -1,12 +1,11 @@ (.module: [lux #* - [meta (#+ with_gensyms)] [control ["." exception (#+ exception:)]] [data [text ["%" format (#+ format)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [math diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux index ff6b8d304..2b5946322 100644 --- a/stdlib/source/lux/control/io.lux +++ b/stdlib/source/lux/control/io.lux @@ -9,8 +9,7 @@ ["s" code]]] [type abstract] - [meta (#+ with_gensyms)] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." template]]]) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index bfed2a99a..3453b1779 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -1,6 +1,5 @@ (.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} [lux #* - [meta (#+ with_gensyms)] [abstract [monad (#+ do)]] [control @@ -11,7 +10,7 @@ ["." identity] [collection ["." list ("#\." fold monad)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [math diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 301753e2f..db3e38c26 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -16,7 +16,7 @@ [type abstract] ["." meta] - [macro + ["." macro ["." code] [syntax (#+ syntax:) ["|.|" export] @@ -50,7 +50,7 @@ [this_module meta.current_module_name #let [[name vars] declaration] g!brand (\ ! map (|>> %.code code.text) - (meta.gensym (format (%.name [this_module name])))) + (macro.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (|export|.format export)) (~ (|declaration|.format declaration)) diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 2248abb83..e7780b6f9 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [meta (#+ with_gensyms)] ["@" target] [abstract [functor (#+ Functor)] @@ -21,9 +20,9 @@ [collection ["." list ("#\." fold functor monoid)] ["." array (#+ Array) ("#\." functor fold)]]] - [macro - ["." code] - [syntax (#+ syntax:)]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] [math [number ["." i64] diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index 4a26e8120..118b75a61 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [meta (#+ with_gensyms)] [abstract [functor (#+ Functor)] [comonad (#+ CoMonad)]] @@ -8,7 +7,7 @@ ["//" continuation (#+ Cont)] ["<>" parser ["<.>" code (#+ Parser)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [data diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 22d587352..b1bd3d95e 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -1,7 +1,7 @@ (.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." "For more information, please see: http://www.json.org/")} [lux #* - ["." meta (#+ monad with_gensyms)] + ["." meta (#+ monad)] [abstract [equivalence (#+ Equivalence)] [codec (#+ Codec)] @@ -21,7 +21,7 @@ ["." list ("#\." fold functor)] ["." row (#+ Row row) ("#\." monad)] ["." dictionary (#+ Dictionary)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [math diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index d92050e90..85944d022 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -11,8 +11,7 @@ ["s" code]] [concurrency ["." atom]]] - [meta (#+ with_gensyms)] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)]] [type abstract]]) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 9fbfecf36..cc30732d2 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -165,17 +165,19 @@ (-> Text Text Text Text) (<| (maybe.default template) (do maybe.monad - [[pre post] (split_with pattern template)] + [[pre post] (..split_with pattern template)] (wrap ($_ "lux text concat" pre replacement post))))) (def: #export (replace_all pattern replacement template) (-> Text Text Text Text) - (case (..split_with pattern template) - (#.Some [pre post]) - ($_ "lux text concat" pre replacement (replace_all pattern replacement post)) - - #.None - template)) + (loop [left "" + right template] + (case (..split_with pattern right) + (#.Some [pre post]) + (recur ($_ "lux text concat" left pre replacement) post) + + #.None + ("lux text concat" left right)))) (structure: #export equivalence (Equivalence Text) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index c94797a6d..47b559d15 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." meta (#+ with_gensyms)] + ["." meta] [abstract monad] [control @@ -13,7 +13,7 @@ ["." maybe] [collection ["." list ("#\." fold monad)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [math diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index 85bd050c0..4f02d6ebe 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -11,8 +11,7 @@ ["." product] [collection ["." list ("#\." functor)]]] - [meta (#+ with_gensyms)] - [macro + [macro (#+ with_gensyms) ["." code] [syntax (#+ syntax:)]] [tool diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 7ca58be58..9b990ae07 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." meta (#+ with_gensyms)] + ["." meta] [abstract [monad (#+ do)]] [control @@ -16,7 +16,7 @@ ["." list ("#\." functor fold)]]] [type abstract] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code] ["." template]]]) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index bf975129a..ad087f95b 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -20,11 +20,11 @@ ["." array] ["." list ("#\." monad fold monoid)] ["." dictionary (#+ Dictionary)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code] ["." template]] - ["." meta (#+ with_gensyms) + ["." meta ["." annotation]] [target [jvm diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 95e2cb1ed..0d95d6e9e 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -19,10 +19,10 @@ [collection ["." array (#+ Array)] ["." list ("#\." monad fold monoid)]]] - [macro - ["." code] - [syntax (#+ syntax:)]] - ["." meta (#+ with_gensyms) + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + ["." meta ["." annotation]]]) (template [<name> <op> <from> <to>] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux new file mode 100644 index 000000000..5a7511349 --- /dev/null +++ b/stdlib/source/lux/macro.lux @@ -0,0 +1,194 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [data + ["." text ("#\." monoid)] + ["." name ("#\." codec)] + [collection + ["." list ("#\." monoid monad)]]] + [macro + ["." code]] + [math + [number + ["." nat] + ["." int]]]] + ["." // #_ + ["#" meta + ["." location]]]) + +(def: #export (expand_once syntax) + {#.doc (doc "Given code that requires applying a macro, does it once and returns the result." + "Otherwise, returns the code as-is.")} + (-> Code (Meta (List Code))) + (case syntax + [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] + (do //.monad + [?macro (//.find_macro name)] + (case ?macro + (#.Some macro) + ((:coerce Macro' macro) args) + + #.None + (\ //.monad wrap (list syntax)))) + + _ + (\ //.monad wrap (list syntax)))) + +(def: #export (expand syntax) + {#.doc (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 (Meta (List Code))) + (case syntax + [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] + (do //.monad + [?macro (//.find_macro name)] + (case ?macro + (#.Some macro) + (do //.monad + [expansion ((:coerce Macro' macro) args) + expansion' (monad.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 (Meta (List Code))) + (case syntax + [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] + (do //.monad + [?macro (//.find_macro name)] + (case ?macro + (#.Some macro) + (do //.monad + [expansion ((:coerce Macro' macro) args) + expansion' (monad.map //.monad expand_all expansion)] + (wrap (list\join expansion'))) + + #.None + (do //.monad + [parts' (monad.map //.monad expand_all (list& (code.identifier name) args))] + (wrap (list (code.form (list\join parts'))))))) + + [_ (#.Form (#.Cons [harg targs]))] + (do //.monad + [harg+ (expand_all harg) + targs+ (monad.map //.monad expand_all targs)] + (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) + + [_ (#.Tuple members)] + (do //.monad + [members' (monad.map //.monad expand_all members)] + (wrap (list (code.tuple (list\join members'))))) + + _ + (\ //.monad wrap (list syntax)))) + +(def: #export (gensym prefix) + {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)." + "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")} + (-> Text (Meta Code)) + (do //.monad + [id //.count] + (wrap (|> id + (\ nat.decimal encode) + ($_ text\compose "__gensym__" prefix) + [""] code.identifier)))) + +(def: (get_local_identifier ast) + (-> Code (Meta Text)) + (case ast + [_ (#.Identifier [_ name])] + (\ //.monad wrap name) + + _ + (//.fail (text\compose "Code is not a local identifier: " (code.format ast))))) + +(def: #export wrong_syntax_error + (-> Name Text) + (|>> name\encode + (text\compose "Wrong syntax for "))) + +(macro: #export (with_gensyms tokens) + {#.doc (doc "Creates new identifiers 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 identifiers)] body)) + (do {! //.monad} + [identifier_names (monad.map ! ..get_local_identifier identifiers) + #let [identifier_defs (list\join (list\map (: (-> Text (List Code)) + (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) + identifier_names))]] + (wrap (list (` ((~! do) (~! //.monad) + [(~+ identifier_defs)] + (~ body)))))) + + _ + (//.fail (..wrong_syntax_error (name_of ..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 (Meta Code)) + (do //.monad + [token+ (..expand token)] + (case token+ + (^ (list token')) + (wrap token') + + _ + (//.fail "Macro expanded to more than 1 element.")))) + +(template [<macro> <func>] + [(macro: #export (<macro> 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)." + (<macro> #omit + (def: (foo bar baz) + (-> Int Int Int) + (int.+ bar baz))))} + (let [[module _] (name_of .._) + [_ short] (name_of <macro>) + macro_name [module short]] + (case (: (Maybe [Bit Code]) + (case tokens + (^ (list [_ (#.Tag ["" "omit"])] + token)) + (#.Some [#1 token]) + + (^ (list token)) + (#.Some [#0 token]) + + _ + #.None)) + (#.Some [omit? token]) + (do //.monad + [location //.location + output (<func> token) + #let [_ ("lux io log" ($_ text\compose (name\encode macro_name) " @ " (location.format location))) + _ (list\map (|>> code.format "lux io log") + output) + _ ("lux io log" "")]] + (wrap (if omit? + (list) + output))) + + #.None + (//.fail (..wrong_syntax_error macro_name)))))] + + [log_expand_once! expand_once] + [log_expand! expand] + [log_expand_all! expand_all] + ) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index f97199209..f5c83a792 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." meta (#+ with_gensyms)] + ["." meta] ["." type] [abstract ["." monad (#+ do)]] @@ -15,7 +15,7 @@ [collection ["." list ("#\." fold functor)] ["." dictionary]]] - [macro + [macro (#+ with_gensyms) ["." code] [syntax (#+ syntax:) ["|.|" export]]] diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 4dcbc725f..738ae2a22 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,6 +1,7 @@ (.module: [lux #* - ["." meta (#+ with_gensyms)] + ["." macro (#+ with_gensyms)] + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -104,7 +105,7 @@ args) this_module meta.current_module_name #let [g!state (code.identifier ["" "*compiler*"]) - error_msg (code.text (meta.wrong_syntax_error [this_module name])) + error_msg (code.text (macro.wrong_syntax_error [this_module name])) export_ast (: (List Code) (if exported? (list (' #export)) @@ -124,4 +125,4 @@ (~ g!tokens))))))))) _ - (meta.fail (meta.wrong_syntax_error (name_of ..syntax:)))))) + (meta.fail (macro.wrong_syntax_error (name_of ..syntax:)))))) diff --git a/stdlib/source/lux/macro/syntax/definition.lux b/stdlib/source/lux/macro/syntax/definition.lux index ac233d069..bbb72fb37 100644 --- a/stdlib/source/lux/macro/syntax/definition.lux +++ b/stdlib/source/lux/macro/syntax/definition.lux @@ -1,6 +1,5 @@ (.module: [lux (#- Definition) - ["." meta] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] @@ -17,9 +16,9 @@ ["%" format]] [collection ["." list]]] - [macro + ["." macro ["." code]] - [meta + ["." meta ["." location]]] ["." // ["#." annotations (#+ Annotations)] @@ -105,7 +104,7 @@ (do {! <>.monad} [raw <code>.any me_raw (|> raw - meta.expand_all + macro.expand_all (meta.run compiler) <>.lift)] (<| (<code>.local me_raw) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 4a5a15606..f7094f25f 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -21,7 +21,7 @@ ["." int ("#\." decimal)] ["." rev ("#\." decimal)] ["." frac ("#\." decimal)]]]] - [// + ["." // [syntax (#+ syntax:)] ["." code]]) @@ -35,7 +35,7 @@ body) (do {! meta.monad} [g!locals (|> locals - (list\map meta.gensym) + (list\map //.gensym) (monad.seq !))] (wrap (list (` (.with_expansions [(~+ (|> (list.zip/2 locals g!locals) (list\map (function (_ [name identifier]) @@ -199,7 +199,7 @@ (do meta.monad [here_name meta.current_module_name here meta.current_module] - (meta.with_gensyms [g!body] + (//.with_gensyms [g!body] (function (_ compiler) (do try.monad [here (monad.fold try.monad (..push here_name) here locals) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 9b12c6ae9..e081280be 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -206,145 +206,12 @@ (find_macro' (get@ #.modules compiler) this_module module name))] (#try.Success [compiler macro])))))) -(def: #export (expand_once syntax) - {#.doc (doc "Given code that requires applying a macro, does it once and returns the result." - "Otherwise, returns the code as-is.")} - (-> Code (Meta (List Code))) - (case syntax - [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] - (do ..monad - [?macro (find_macro name)] - (case ?macro - (#.Some macro) - ((:coerce Macro' macro) args) - - #.None - (\ ..monad wrap (list syntax)))) - - _ - (\ ..monad wrap (list syntax)))) - -(def: #export (expand syntax) - {#.doc (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 (Meta (List Code))) - (case syntax - [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] - (do ..monad - [?macro (find_macro name)] - (case ?macro - (#.Some macro) - (do ..monad - [expansion ((:coerce Macro' macro) args) - expansion' (monad.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 (Meta (List Code))) - (case syntax - [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] - (do ..monad - [?macro (find_macro name)] - (case ?macro - (#.Some macro) - (do ..monad - [expansion ((:coerce Macro' macro) args) - expansion' (monad.map ..monad expand_all expansion)] - (wrap (list\join expansion'))) - - #.None - (do ..monad - [parts' (monad.map ..monad expand_all (list& (code.identifier name) args))] - (wrap (list (code.form (list\join parts'))))))) - - [_ (#.Form (#.Cons [harg targs]))] - (do ..monad - [harg+ (expand_all harg) - targs+ (monad.map ..monad expand_all targs)] - (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) - - [_ (#.Tuple members)] - (do ..monad - [members' (monad.map ..monad expand_all members)] - (wrap (list (code.tuple (list\join members'))))) - - _ - (\ ..monad wrap (list syntax)))) - (def: #export count (Meta Nat) (function (_ compiler) (#try.Success [(update@ #.seed inc compiler) (get@ #.seed compiler)]))) -(def: #export (gensym prefix) - {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)." - "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")} - (-> Text (Meta Code)) - (do ..monad - [id ..count] - (wrap (|> id - (\ n.decimal encode) - ($_ text\compose "__gensym__" prefix) - [""] code.identifier)))) - -(def: (get_local_identifier ast) - (-> Code (Meta Text)) - (case ast - [_ (#.Identifier [_ name])] - (\ ..monad wrap name) - - _ - (fail (text\compose "Code is not a local identifier: " (code.format ast))))) - -(def: #export wrong_syntax_error - (-> Name Text) - (|>> name\encode - (text\compose "Wrong syntax for "))) - -(macro: #export (with_gensyms tokens) - {#.doc (doc "Creates new identifiers 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 identifiers)] body)) - (do {! ..monad} - [identifier_names (monad.map ! get_local_identifier identifiers) - #let [identifier_defs (list\join (list\map (: (-> Text (List Code)) - (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) - identifier_names))]] - (wrap (list (` ((~! do) (~! ..monad) - [(~+ identifier_defs)] - (~ body)))))) - - _ - (fail (..wrong_syntax_error (name_of ..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 (Meta 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 (Meta Bit)) (function (_ compiler) @@ -673,46 +540,6 @@ (function (_ compiler) (#try.Success [compiler (get@ #.type_context compiler)]))) -(template [<macro> <func>] - [(macro: #export (<macro> 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)." - (<macro> #omit - (def: (foo bar baz) - (-> Int Int Int) - (i.+ bar baz))))} - (case (: (Maybe [Bit Code]) - (case tokens - (^ (list [_ (#.Tag ["" "omit"])] - token)) - (#.Some [#1 token]) - - (^ (list token)) - (#.Some [#0 token]) - - _ - #.None)) - (#.Some [omit? token]) - (do ..monad - [location ..location - output (<func> token) - #let [_ ("lux io log" ($_ text\compose (name\encode (name_of <macro>)) " @ " (location.format location))) - _ (list\map (|>> code.format "lux io log") - output) - _ ("lux io log" "")]] - (wrap (if omit? - (list) - output))) - - #.None - (fail (..wrong_syntax_error (name_of <macro>)))))] - - [log_expand! expand] - [log_expand_all! expand_all] - [log_expand_once! expand_once] - ) - (def: #export (lift result) (All [a] (-> (Try a) (Meta a))) (case result diff --git a/stdlib/source/lux/program.lux b/stdlib/source/lux/program.lux index 209a95221..55e9ec9b0 100644 --- a/stdlib/source/lux/program.lux +++ b/stdlib/source/lux/program.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [meta (#+ with_gensyms)] ["@" target] [abstract [monad (#+ do)]] @@ -15,7 +14,7 @@ ["." text] [collection ["." list ("#\." monad)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]]]) diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index 6f74aadbd..526efaf4f 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -1,6 +1,5 @@ (.module: [lux #* - [meta (#+ with_gensyms)] [abstract ["." equivalence (#+ Equivalence)] ["." monoid (#+ Monoid)]] @@ -11,7 +10,7 @@ [data [format [".F" binary (#+ Writer)]]] - [macro + [macro (#+ with_gensyms) [syntax (#+ syntax:)] ["." code]] [math @@ -32,6 +31,7 @@ (structure: #export equivalence (All [of] (Equivalence (Modifier of))) + (def: (= reference sample) (\ //unsigned.equivalence = (:representation reference) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 764479799..b15f22be5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -11,7 +11,7 @@ ["." array (#+ Array)] ["." dictionary] ["." list]]] - [type (#+ tuple) + ["." type ["." check]] ["@" target ["_" js]]] @@ -20,8 +20,8 @@ [// ["." bundle] [// - [analysis - ["." type]] + ["." analysis #_ + ["#/." type]] [// ["." analysis (#+ Analysis Operation Phase Handler Bundle)] [/// @@ -33,10 +33,10 @@ [<c>.any (function (_ extension phase archive lengthC) (do phase.monad - [lengthA (type.with_type Nat + [lengthA (analysis/type.with_type Nat (phase archive lengthC)) - [var_id varT] (type.with_env check.var) - _ (type.infer (type (Array varT)))] + [var_id varT] (analysis/type.with_env check.var) + _ (analysis/type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list lengthA)))))])) (def: array::length @@ -45,10 +45,10 @@ [<c>.any (function (_ extension phase archive arrayC) (do phase.monad - [[var_id varT] (type.with_env check.var) - arrayA (type.with_type (type (Array varT)) + [[var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) - _ (type.infer Nat)] + _ (analysis/type.infer Nat)] (wrap (#analysis.Extension extension (list arrayA)))))])) (def: array::read @@ -57,12 +57,12 @@ [(<>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (type.with_type Nat + [indexA (analysis/type.with_type Nat (phase archive indexC)) - [var_id varT] (type.with_env check.var) - arrayA (type.with_type (type (Array varT)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) - _ (type.infer varT)] + _ (analysis/type.infer varT)] (wrap (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write @@ -71,14 +71,14 @@ [($_ <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad - [indexA (type.with_type Nat + [indexA (analysis/type.with_type Nat (phase archive indexC)) - [var_id varT] (type.with_env check.var) - valueA (type.with_type varT + [var_id varT] (analysis/type.with_env check.var) + valueA (analysis/type.with_type varT (phase archive valueC)) - arrayA (type.with_type (type (Array varT)) + arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) - _ (type.infer (type (Array varT)))] + _ (analysis/type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete @@ -87,12 +87,12 @@ [($_ <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (type.with_type Nat + [indexA (analysis/type.with_type Nat (phase archive indexC)) - [var_id varT] (type.with_env check.var) - arrayA (type.with_type (type (Array varT)) + [var_id varT] (analysis/type.with_env check.var) + arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) - _ (type.infer (type (Array varT)))] + _ (analysis/type.infer (type (Array varT)))] (wrap (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array @@ -112,10 +112,10 @@ [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase archive [constructorC inputsC]) (do {! phase.monad} - [constructorA (type.with_type Any + [constructorA (analysis/type.with_type Any (phase archive constructorC)) - inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) - _ (type.infer .Any)] + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] (wrap (#analysis.Extension extension (list& constructorA inputsA)))))])) (def: object::get @@ -124,9 +124,9 @@ [($_ <>.and <c>.text <c>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad - [objectA (type.with_type Any + [objectA (analysis/type.with_type Any (phase archive objectC)) - _ (type.infer .Any)] + _ (analysis/type.infer .Any)] (wrap (#analysis.Extension extension (list (analysis.text fieldC) objectA)))))])) @@ -136,10 +136,10 @@ [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do {! phase.monad} - [objectA (type.with_type Any + [objectA (analysis/type.with_type Any (phase archive objectC)) - inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) - _ (type.infer .Any)] + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer .Any)] (wrap (#analysis.Extension extension (list& (analysis.text methodC) objectA inputsA)))))])) @@ -163,7 +163,7 @@ [<c>.text (function (_ extension phase archive name) (do phase.monad - [_ (type.infer Any)] + [_ (analysis/type.infer Any)] (wrap (#analysis.Extension extension (list (analysis.text name))))))])) (def: js::apply @@ -172,10 +172,10 @@ [($_ <>.and <c>.any (<>.some <c>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do {! phase.monad} - [abstractionA (type.with_type Any + [abstractionA (analysis/type.with_type Any (phase archive abstractionC)) - inputsA (monad.map ! (|>> (phase archive) (type.with_type Any)) inputsC) - _ (type.infer Any)] + inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) + _ (analysis/type.infer Any)] (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: js::type_of @@ -184,9 +184,9 @@ [<c>.any (function (_ extension phase archive objectC) (do phase.monad - [objectA (type.with_type Any + [objectA (analysis/type.with_type Any (phase archive objectC)) - _ (type.infer .Text)] + _ (analysis/type.infer .Text)] (wrap (#analysis.Extension extension (list objectA)))))])) (def: js::function @@ -195,11 +195,11 @@ [($_ <>.and <c>.nat <c>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad - [#let [inputT (tuple (list.repeat arity Any))] - abstractionA (type.with_type (-> inputT Any) + [#let [inputT (type.tuple (list.repeat arity Any))] + abstractionA (analysis/type.with_type (-> inputT Any) (phase archive abstractionC)) - _ (type.infer (for {@.js host.Function} - Any))] + _ (analysis/type.infer (for {@.js host.Function} + Any))] (wrap (#analysis.Extension extension (list (analysis.nat arity) abstractionA)))))])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux index 7dbfcd3f9..051b6357b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -8,8 +8,8 @@ [data [collection ["." list ("#\." functor)]]] - ["." meta (#+ with_gensyms)] - [macro + ["." meta] + ["." macro (#+ with_gensyms) ["." code] [syntax (#+ syntax:)]]] ["." /// #_ @@ -32,7 +32,7 @@ (syntax: (arity: {arity s.nat} {name s.local_identifier} type) (with_gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] (do {! meta.monad} - [g!input+ (monad.seq ! (list.repeat arity (meta.gensym "input")))] + [g!input+ (monad.seq ! (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local_identifier name)) (~ g!extension)) (All [(~ g!anchor) (~ g!expression) (~ g!directive)] (-> ((~ type) (~ g!expression)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 82d787b9a..a6cc85b10 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -15,7 +15,7 @@ [collection ["." list ("#\." functor)] ["." row]]] - [macro + ["." macro [syntax (#+ syntax:)] ["." code]] [math @@ -111,7 +111,7 @@ code) (case declaration (#.Left name) - (meta.with_gensyms [g!_] + (macro.with_gensyms [g!_] (let [[runtime_nameC runtime_nameC!] (..runtime_name name) nameC (code.local_identifier name)] (wrap (list (` (def: (~ runtime_nameC!) @@ -128,7 +128,7 @@ (~ code))))))))) (#.Right [name inputs]) - (meta.with_gensyms [g!_] + (macro.with_gensyms [g!_] (let [[runtime_nameC runtime_nameC!] (..runtime_name name) nameC (code.local_identifier name) code_nameC (code.local_identifier (format "@" name)) @@ -193,7 +193,7 @@ (def: #export variant_flag_field "_lux_flag") (def: #export variant_value_field "_lux_value") -(runtime: (variant//new tag last? value) +(runtime: variant//new (let [@this (_.var "this")] (with_vars [tag is_last value] (_.closure (list tag is_last value) @@ -285,7 +285,7 @@ (def: #export i64_low_field Text "_lux_low") (def: #export i64_high_field Text "_lux_high") -(runtime: (i64//new high low) +(runtime: i64//new (let [@this (_.var "this")] (with_vars [high low] (_.closure (list high low) @@ -323,12 +323,12 @@ (..i64 (_.i32 +0) (_.i32 +0))) (runtime: i64//min - (..i64 (_.i32 (hex "+80,00,00,00")) + (..i64 (_.i32 (.int (hex "80,00,00,00"))) (_.i32 +0))) (runtime: i64//max - (..i64 (_.i32 (hex "+7F,FF,FF,FF")) - (_.i32 (hex "+FF,FF,FF,FF")))) + (..i64 (_.i32 (.int (hex "7F,FF,FF,FF"))) + (_.i32 (.int (hex "FF,FF,FF,FF"))))) (runtime: i64//one (..i64 (_.i32 +0) (_.i32 +1))) @@ -342,7 +342,7 @@ (runtime: (i64//+ parameter subject) (let [up_16 (_.left_shift (_.i32 +16)) high_16 (_.logic_right_shift (_.i32 +16)) - low_16 (_.bit_and (_.i32 (hex "+FFFF"))) + low_16 (_.bit_and (_.i32 (.int (hex "FFFF")))) hh (|>> (_.the ..i64_high_field) high_16) hl (|>> (_.the ..i64_high_field) low_16) lh (|>> (_.the ..i64_low_field) high_16) @@ -494,7 +494,7 @@ ## Both are positive (let [up_16 (_.left_shift (_.i32 +16)) high_16 (_.logic_right_shift (_.i32 +16)) - low_16 (_.bit_and (_.i32 (hex "+FFFF"))) + low_16 (_.bit_and (_.i32 (.int (hex "FFFF")))) hh (|>> (_.the ..i64_high_field) high_16) hl (|>> (_.the ..i64_high_field) low_16) lh (|>> (_.the ..i64_low_field) high_16) diff --git a/stdlib/source/lux/tool/compiler/language/lux/version.lux b/stdlib/source/lux/tool/compiler/language/lux/version.lux index 5f3c7c9d0..53b3424ae 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/version.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/version.lux @@ -1,11 +1,8 @@ (.module: - [lux #* - ["@" target]] + [lux #*] [//// [version (#+ Version)]]) (def: #export version Version - (for {@.old - 00,05,99} - 00,06,00)) + 00,06,00) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index 1dd13c664..bf4b2315f 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -65,11 +65,12 @@ so_far artifacts)) -(def: #export (package header to_code sequence) +(def: #export (package header to_code sequence scope) (All [! directive] (-> directive (-> directive Text) (-> directive directive directive) + (-> directive directive) (Packager !))) (function (package monad file_system static archive program) (do {! (try.with monad)} @@ -84,4 +85,4 @@ row.to_list (list\map (|>> (get@ #artifact.id))))])) (monad.fold ! (..write_module monad file_system static sequence) header) - (\ ! map (|>> to_code (\ encoding.utf8 encode))))))) + (\ ! map (|>> scope to_code (\ encoding.utf8 encode))))))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index b34addbc5..bcc71cd12 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -15,7 +15,7 @@ [collection ["." array] ["." list ("#\." functor monoid fold)]]] - [macro + ["." macro [syntax (#+ syntax:)] ["." code]] [math @@ -356,7 +356,7 @@ _ (|> elem_type (array (dec depth)) (list) (#.Primitive array.type_name)))) (syntax: (new_secret_marker) - (meta.with_gensyms [g!_secret_marker_] + (macro.with_gensyms [g!_secret_marker_] (wrap (list g!_secret_marker_)))) (def: secret_marker @@ -384,7 +384,7 @@ (wrap (list (code.identifier valueN)))) (#.Right valueC) - (meta.with_gensyms [g!value] + (macro.with_gensyms [g!value] (wrap (list (` (.let [(~ g!value) (~ valueC)] (..:log! (~ valueC) (~ (code.identifier ..secret_marker)) (~ g!value))))))))) @@ -418,7 +418,7 @@ (syntax: #export (:share {type_vars type_parameters} {exemplar typed} {computation typed}) - (meta.with_gensyms [g!_] + (macro.with_gensyms [g!_] (let [shareC (` (: (All [(~+ (list\map code.local_identifier type_vars))] (-> (~ (get@ #type exemplar)) (~ (get@ #type computation)))) diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux index 21a0d6cf3..d8b3cd3f6 100644 --- a/stdlib/source/lux/type/dynamic.lux +++ b/stdlib/source/lux/type/dynamic.lux @@ -7,8 +7,7 @@ [data [text ["%" format (#+ format)]]] - [meta (#+ with_gensyms)] - [macro + [macro (#+ with_gensyms) ["." syntax (#+ syntax:)]] ["." type abstract]]) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index bf7e88a01..d8c4fbe1f 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -15,7 +15,7 @@ [collection ["." list ("#\." monad fold)] ["dict" dictionary (#+ Dictionary)]]] - [macro + ["." macro ["." code] [syntax (#+ syntax:)]] [math @@ -365,14 +365,14 @@ (#.Right [args _]) (do {! meta.monad} - [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq !))] + [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq !))] (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list\map join_pair) list\join))] (..\\ (~ (code.identifier member)) (~+ labels))))))) )) (def: (implicit_bindings amount) (-> Nat (Meta (List Code))) - (|> (meta.gensym "g!implicit") + (|> (macro.gensym "g!implicit") (list.repeat amount) (monad.seq meta.monad))) diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux index c38f6afef..bbf9630cc 100644 --- a/stdlib/source/lux/type/refinement.lux +++ b/stdlib/source/lux/type/refinement.lux @@ -1,9 +1,8 @@ (.module: [lux (#- type) - ["." meta] [abstract [predicate (#+ Predicate)]] - [macro + ["." macro [syntax (#+ syntax:)]] [type (#+ :by_example) abstract]]) @@ -81,7 +80,7 @@ (#.Cons head no)])))) (syntax: #export (type refiner) - (meta.with_gensyms [g!t g!r] + (macro.with_gensyms [g!t g!r] (wrap (list (` ((~! :by_example) [(~ g!t) (~ g!r)] {(..Refiner (~ g!t) (~ g!r)) (~ refiner)} diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index d45d7b4f5..a6d60074b 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -21,7 +21,7 @@ ["." set] ["." row (#+ Row)] ["." list ("#\." functor fold)]]] - [macro + ["." macro [syntax (#+ syntax:)]] [math [number @@ -156,7 +156,7 @@ (template [<name> <m> <monad>] [(syntax: #export (<name> {swaps ..indices}) - (meta.with_gensyms [g!_ g!context] + (macro.with_gensyms [g!_ g!context] (case swaps #.Nil (wrap (list (` ((~! no_op) <monad>)))) @@ -164,7 +164,7 @@ (#.Cons head tail) (do {! meta.monad} [#let [max_idx (list\fold n.max head tail)] - g!inputs (<| (monad.seq !) (list.repeat (inc max_idx)) (meta.gensym "input")) + g!inputs (<| (monad.seq !) (list.repeat (inc max_idx)) (macro.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) (do maybe.monad @@ -199,9 +199,9 @@ (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) - (meta.with_gensyms [g!_ g!context] + (macro.with_gensyms [g!_ g!context] (do {! meta.monad} - [g!keys (<| (monad.seq !) (list.repeat amount) (meta.gensym "keys"))] + [g!keys (<| (monad.seq !) (list.repeat amount) (macro.gensym "keys"))] (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] (Procedure (~! <m>) [<from> (~ g!context)] diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 205fbb7f8..92a5793bd 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -160,8 +160,8 @@ [#.None #.None] (..default_exit! code))) - (import: JS_Object - (entries [] (Array (Array host.String)))) + (import: Object + (#static entries [Object] (Array (Array host.String)))) (import: NodeJs_OS (homedir [] #io Path)) @@ -177,17 +177,16 @@ (for {@.old <jvm> @.jvm <jvm> @.js (io.io (if host.on_node_js? - (case (host.constant JS_Object [process env]) + (case (host.constant Object [process env]) (#.Some process/env) - (|> process/env - (JS_Object::entries []) - (array\fold (function (_ entry environment) - (<| (maybe.default environment) - (do maybe.monad - [variable (array.read 0 entry) - value (array.read 1 entry)] - (wrap (dictionary.put variable value environment))))) - environment.empty)) + (array\fold (function (_ entry environment) + (<| (maybe.default environment) + (do maybe.monad + [variable (array.read 0 entry) + value (array.read 1 entry)] + (wrap (dictionary.put variable value environment))))) + environment.empty + (Object::entries [process/env])) #.None (undefined)) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 7409a65e2..7d91ebed7 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -22,6 +22,7 @@ ["#." type] ["#." extension] ["#." value] + ["#." versioning] ["#." time_stamp ["#/." date] ["#/." time]]] @@ -47,6 +48,7 @@ /type.test /extension.test /value.test + /versioning.test /time_stamp.test /time_stamp/date.test /time_stamp/time.test diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux new file mode 100644 index 000000000..c0704440e --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -0,0 +1,43 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" xml]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Versioning) + ($_ random.and + random.instant + random.nat + (random.list 5 (random.ascii/lower_alpha 3)) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Versioning]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random + version (random.ascii/upper_alpha 3)] + (_.cover [/.format /.parser] + (|> expected + (/.format version) + (<xml>.run (/.parser version)) + (try\map (\ /.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index fb7517237..753130ea2 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." meta] [abstract ["." monad (#+ do)]] [control @@ -20,8 +21,7 @@ ["." date (#+ Date)] ["." instant] ["." duration]] - ["." meta] - [macro + ["." macro ["." code] ["." syntax (#+ syntax:)]]] {1 @@ -71,10 +71,10 @@ message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] (do meta.monad - [should_fail0 (..try (meta.expand (to_remember macro yesterday message #.None))) - should_fail1 (..try (meta.expand (to_remember macro yesterday message (#.Some expected)))) - should_succeed0 (..try (meta.expand (to_remember macro tomorrow message #.None))) - should_succeed1 (..try (meta.expand (to_remember macro tomorrow message (#.Some expected))))] + [should_fail0 (..try (macro.expand (to_remember macro yesterday message #.None))) + should_fail1 (..try (macro.expand (to_remember macro yesterday message (#.Some expected)))) + should_succeed0 (..try (macro.expand (to_remember macro tomorrow message #.None))) + should_succeed1 (..try (macro.expand (to_remember macro tomorrow message (#.Some expected))))] (wrap (list (code.bit (and (case should_fail0 (#try.Failure error) (and (test_failure yesterday message #.None error) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 4f14375d9..091f64b67 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -25,7 +25,7 @@ [number ["n" nat] ["." frac]]] - [macro + ["." macro ["." syntax (#+ syntax:)] ["." code]]] {1 @@ -58,7 +58,7 @@ (syntax: (string) (do meta.monad - [value (meta.gensym "string")] + [value (macro.gensym "string")] (wrap (list (code.text (%.code value)))))) (def: #export test diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 2cdead181..fd82fdee5 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -15,8 +15,7 @@ [math [number (#+ hex)] ["." random]] - ["." meta] - [macro + ["." macro [syntax (#+ syntax:)]]] {1 ["." /]}) @@ -52,7 +51,7 @@ false))) (syntax: (should_check pattern regex input) - (meta.with_gensyms [g!message g!_] + (macro.with_gensyms [g!message g!_] (wrap (list (` (|> (~ input) (<text>.run (~ regex)) (case> (^ (#try.Success (~ pattern))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 54370efb9..0b1077526 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,17 +1,185 @@ (.module: [lux #* - ["_" test (#+ Test)]] + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["<.>" code]]] + [data + ["." bit ("#\." equivalence)] + ["." name] + ["." text + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + ["." random (#+ Random)] + [number + ["." nat]]] + ["." meta + ["." location]]] + {1 + ["." / + [syntax (#+ syntax:)] + ["." code ("#\." equivalence)] + ["." template]]} ["." / #_ ["#." code] ["#." template] ["#." poly] ["#." syntax]]) +(template: (!expect <pattern> <value>) + (case <value> + <pattern> true + _ false)) + +(template: (!global <definition>) + (: [Text .Global] + [(template.text [<definition>]) (#.Definition [true .Macro (' []) <definition>])])) + +(syntax: (pow/2 number) + (wrap (list (` (nat.* (~ number) (~ number)))))) + +(syntax: (pow/4 number) + (wrap (list (` (..pow/2 (..pow/2 (~ number))))))) + +(syntax: (repeat {times <code>.nat} token) + (wrap (list.repeat times token))) + +(syntax: (fresh_identifier) + (do meta.monad + [g!fresh (/.gensym "fresh")] + (wrap (list g!fresh)))) + +(def: random_lux + (Random [Nat Text .Lux]) + (do {! random.monad} + [seed random.nat + gensym_prefix (random.ascii/upper_alpha 1) + #let [macro_module (name.module (name_of /._)) + current_module (name.module (name_of .._))]] + (wrap [seed + gensym_prefix + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some current_module) + #.modules (list [macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global /.log_expand_once!) + (!global /.log_expand!) + (!global /.log_expand_all!))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global ..pow/2) + (!global ..pow/4) + (!global ..repeat))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed seed + #.scope_type_vars (list) + #.extensions [] + #.host []}]))) + +(def: expander + Test + (do {! random.monad} + [[seed gensym_prefix lux] ..random_lux + + pow/1 (\ ! map code.nat random.nat) + + repetitions (\ ! map (nat.% 10) random.nat) + #let [expand_once (` (..pow/2 (..pow/2 (~ pow/1)))) + expand (` (nat.* (..pow/2 (~ pow/1)) + (..pow/2 (~ pow/1)))) + expand_all (` (nat.* (nat.* (~ pow/1) (~ pow/1)) + (nat.* (~ pow/1) (~ pow/1))))]] + (`` ($_ _.and + (~~ (template [<expander> <logger> <expansion>] + [(_.cover [<expander>] + (|> (<expander> (` (..pow/4 (~ pow/1)))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = + (list <expansion>))) + (try.default false))) + + (_.cover [<logger>] + (and (|> (/.expand_once (` (<logger> (~' #omit) (..pow/4 (~ pow/1))))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = (list))) + (try.default false)) + (|> (/.expand_once (` (<logger> (..pow/4 (~ pow/1))))) + (meta.run lux) + (try\map (\ (list.equivalence code.equivalence) = (list <expansion>))) + (try.default false))))] + + [/.expand_once /.log_expand_once! expand_once] + [/.expand /.log_expand! expand] + [/.expand_all /.log_expand_all! expand_all] + )) + (_.cover [/.expand_1] + (bit\= (not (nat.= 1 repetitions)) + (|> (/.expand_1 (` (..repeat (~ (code.nat repetitions)) (~ pow/1)))) + (meta.run lux) + (!expect (#try.Failure _))))) + )))) + (def: #export test Test - ($_ _.and - /code.test - /template.test - /syntax.test - /poly.test - )) + (<| (_.covering /._) + ($_ _.and + (do {! random.monad} + [[seed gensym_prefix lux] ..random_lux] + ($_ _.and + (_.cover [/.gensym] + (|> (/.gensym gensym_prefix) + (\ meta.monad map %.code) + (meta.run lux) + (!expect (^multi (#try.Success actual_gensym) + (and (text.contains? gensym_prefix actual_gensym) + (text.contains? (%.nat seed) actual_gensym)))))) + (_.cover [/.wrong_syntax_error] + (|> (/.expand_once (` (/.log_expand_once!))) + (meta.run lux) + (!expect (^multi (#try.Failure error) + (text.contains? (/.wrong_syntax_error (name_of /.log_expand_once!)) + error))))) + (_.cover [/.with_gensyms] + (with_expansions [<expected> (fresh_identifier)] + (|> (/.with_gensyms [<expected>] + (\ meta.monad wrap <expected>)) + (meta.run lux) + (!expect (^multi (#try.Success [_ (#.Identifier ["" actual])]) + (text.contains? (template.text [<expected>]) + actual)))))) + )) + + ..expander + + /code.test + /template.test + /syntax.test + /poly.test + ))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index e740c1237..c1e0e8e03 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -49,7 +49,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) #let [expected_lux {#.info {#.target target #.version version #.mode #.Build} @@ -292,7 +291,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [type_context {#.ex_counter 0 #.var_counter 0 @@ -321,13 +319,6 @@ (!expect (^multi (#try.Success [actual_pre actual_post]) (and (n.= expected_seed actual_pre) (n.= (inc expected_seed) actual_post)))))) - (_.cover [/.gensym] - (|> (/.gensym expected_gensym) - (\ /.monad map %.code) - (/.run expected_lux) - (!expect (^multi (#try.Success actual_gensym) - (and (text.contains? expected_gensym actual_gensym) - (text.contains? (%.nat expected_seed) actual_gensym)))))) (_.cover [/.location] (|> /.location (/.run expected_lux) @@ -781,7 +772,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [expected_lux {#.info {#.target target #.version version diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 9ed1df446..4f6080b48 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -1,9 +1,9 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] + ["." host] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] @@ -11,48 +11,96 @@ ["$." enum] ["$." codec]]}] [control + ["." function] ["." try]] [data - ["." text]] + [collection + ["." list ("#\." fold)]]] [math - ["." random (#+ Random)] - [number - ["i" int]]] + ["." random]] [time - ["@d" duration] - ["@." date]]] + ["." duration (#+ Duration)] + ["." day (#+ Day) ("#\." enum)]]] {1 - ["." / (#+ Instant)]}) - -(def: #export instant - (Random Instant) - (\ random.monad map /.from_millis random.int)) + ["." /]}) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) + (_.for [/.Instant]) ($_ _.and - ($equivalence.spec /.equivalence ..instant) - ($order.spec /.order ..instant) - ($enum.spec /.enum ..instant) - ($codec.spec /.equivalence /.codec ..instant) + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.instant)) + (_.for [/.order] + ($order.spec /.order random.instant)) + (_.for [/.enum] + ($enum.spec /.enum random.instant)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.instant)) (do random.monad - [millis random.int] - (_.test "Can convert from/to milliseconds." - (|> millis /.from_millis /.to_millis (i.= millis)))) + [#let [(^open "\.") /.equivalence] + expected random.instant] + ($_ _.and + (_.cover [/.to_millis /.from_millis] + (|> expected /.to_millis /.from_millis (\= expected))) + (_.cover [/.relative /.absolute] + (|> expected /.relative /.absolute (\= expected))) + (_.cover [/.date /.time /.from_date_time] + (\= expected + (/.from_date_time (/.date expected) + (/.time expected)))) + )) (do random.monad - [sample instant - span random.duration - #let [(^open "@/.") /.equivalence - (^open "@d/.") @d.equivalence]] + [#let [(^open "\.") /.equivalence + (^open "duration\.") duration.equivalence] + from random.instant + to random.instant] ($_ _.and - (_.test "The span of a instant and itself has an empty duration." - (|> sample (/.span sample) (@d/= @d.empty))) - (_.test "Can shift a instant by a duration." - (|> sample (/.shift span) (/.span sample) (@d/= span))) - (_.test "Can obtain the time-span between the epoch and an instant." - (|> sample /.relative /.absolute (@/= sample))) - (_.test "All instants are relative to the epoch." - (|> /.epoch (/.shift (/.relative sample)) (@/= sample))))) + (_.cover [/.span] + (|> from (/.span from) (duration\= duration.empty))) + (_.cover [/.shift] + (|> from (/.shift (/.span from to)) (\= to))) + (_.cover [/.epoch] + (duration\= (/.relative to) + (/.span /.epoch to))) + )) + (do random.monad + [instant random.instant + #let [d0 (/.day_of_week instant)]] + (_.cover [/.day_of_week] + (let [apply (: (-> (-> Duration Duration) (-> Day Day) Nat Bit) + (function (_ polarity move steps) + (let [day_shift (list\fold (function.constant move) + d0 + (list.repeat steps [])) + instant_shift (|> instant + (/.shift (polarity (duration.up steps duration.day))) + /.day_of_week)] + (day\= day_shift + instant_shift))))] + (and (apply function.identity day\succ 0) + (apply function.identity day\succ 1) + (apply function.identity day\succ 2) + (apply function.identity day\succ 3) + (apply function.identity day\succ 4) + (apply function.identity day\succ 5) + (apply function.identity day\succ 6) + (apply function.identity day\succ 7) + + (apply duration.inverse day\pred 0) + (apply duration.inverse day\pred 1) + (apply duration.inverse day\pred 2) + (apply duration.inverse day\pred 3) + (apply duration.inverse day\pred 4) + (apply duration.inverse day\pred 5) + (apply duration.inverse day\pred 6) + (apply duration.inverse day\pred 7))))) + (_.cover [/.now] + (case (host.try /.now) + (#try.Success _) + true + + (#try.Failure _) + false)) ))) |