diff options
Diffstat (limited to 'stdlib')
52 files changed, 760 insertions, 401 deletions
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index caa233884..2f42c0176 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -7,7 +7,8 @@ [data [collection ["." list ("#@." functor fold)]]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)] ["." code]]]) @@ -53,7 +54,7 @@ (syntax: #export (do {[?name monad] ..named-monad} {context (s.tuple (p.some context))} expression) - (macro.with-gensyms [g!_ g!bind] + (meta.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 1ba47f1af..5f2b553d3 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -13,7 +13,8 @@ ["i" int] ["r" rev] ["f" frac]]] - ["." macro (#+ with-gensyms) + ["." meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:) ["cs" common @@ -56,15 +57,15 @@ (def: (singleton expander) (-> (Meta (List Code)) (Meta Code)) - (monad.do macro.monad + (monad.do meta.monad [expansion expander] (case expansion (#.Cons singleton #.Nil) (wrap singleton) _ - (macro.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line - (|> expansion (list@map %.code) (text.join-with " "))))))) + (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new-line + (|> expansion (list@map %.code) (text.join-with " "))))))) (syntax: #export (=> {aliases aliases^} {inputs stack^} @@ -77,17 +78,17 @@ (case [(|> inputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`)))) (|> outputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] - (monad.do macro.monad - [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) bottomI))) - outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) 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)))] (wrap (list (` (-> (~ (de-alias inputC)) (~ (de-alias outputC))))))) [?bottomI ?bottomO] (with-gensyms [g!stack] - (monad.do macro.monad - [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))))] + (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))))] (wrap (list (` (All [(~ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) @@ -115,8 +116,8 @@ (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) (with-gensyms [g! g!func g!stack g!output] - (monad.do {@ macro.monad} - [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))] + (monad.do {@ meta.monad} + [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/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index fb782b169..851a7c790 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -18,13 +18,13 @@ ["%" format (#+ format)]] [collection ["." list ("#@." monoid monad fold)]]] - ["." macro (#+ with-gensyms monad) + [macro ["." code] [syntax (#+ syntax:) ["cs" common ["csr" reader] ["csw" writer]]]] - [meta + ["." meta (#+ with-gensyms monad) ["." annotation]] [type abstract]] @@ -191,8 +191,8 @@ (def: (<resolve> name) (-> Name (Meta Name)) - (do macro.monad - [constant (macro.find-def name)] + (do meta.monad + [constant (meta.find-def name)] (case constant (#.Left de-aliased) (<resolve> de-aliased) @@ -203,7 +203,7 @@ (wrap actor-name) _ - (macro.fail (format "Definition is not " <desc> "."))))))] + (meta.fail (format "Definition is not " <desc> "."))))))] [with-actor resolve-actor #..actor "an actor"] [with-message resolve-message #..message "a message"] @@ -268,8 +268,8 @@ #let [_ (log! "AFTER")]] (wrap output)))))} (with-gensyms [g!_ g!init] - (do macro.monad - [module macro.current-module-name + (do meta.monad + [module meta.current-module-name #let [g!type (code.local-identifier (state-name _name)) g!behavior (code.local-identifier (behavior-name _name)) g!actor (code.local-identifier _name) @@ -358,8 +358,8 @@ (let [state' (#.Cons value state)] (promise.resolved (#try.Success [state' state'])))))} (with-gensyms [g!_ g!return g!error g!task g!sent? g!resolve] - (do macro.monad - [current-module macro.current-module-name + (do meta.monad + [current-module meta.current-module-name actor-name (resolve-actor actor-name) #let [message-name [current-module (get@ #name signature)] g!type (code.identifier (product.both function.identity state-name actor-name)) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 3edcbd332..83e5ad005 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -16,8 +16,7 @@ ["." queue (#+ Queue)]]] [type abstract - ["." refinement]] - ["." macro]] + ["." refinement]]] [// ["." atom (#+ Atom)] ["." promise (#+ Promise Resolver)]]) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index d53f103cf..ca5a4d183 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -8,7 +8,8 @@ ["." function] [parser ["s" code]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]]]) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index f170baffe..5d0a04ea9 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -13,7 +13,8 @@ ["n" nat ("#@." decimal)]] [collection ["." list ("#@." functor fold)]]] - ["." macro + ["." meta] + [macro ["." code] [syntax (#+ syntax:) ["sc" common @@ -96,9 +97,9 @@ "Complex case:" (exception: #export [optional type variables] (some-exception {optional Text} {arguments Int}) optional-body))} - (macro.with-gensyms [g!descriptor] - (do macro.monad - [current-module macro.current-module-name + (meta.with-gensyms [g!descriptor] + (do meta.monad + [current-module meta.current-module-name #let [descriptor ($_ text@compose "{" current-module "." name "}" text.new-line) g!self (code.local-identifier name)]] (wrap (list (` (def: (~+ (scw.export export)) diff --git a/stdlib/source/lux/control/function/contract.lux b/stdlib/source/lux/control/function/contract.lux index 1c9236877..9333846fe 100644 --- a/stdlib/source/lux/control/function/contract.lux +++ b/stdlib/source/lux/control/function/contract.lux @@ -7,7 +7,8 @@ ["i" int]] [text ["%" format (#+ format)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code]]]) diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux index 24b1c2e61..442cf0a1c 100644 --- a/stdlib/source/lux/control/io.lux +++ b/stdlib/source/lux/control/io.lux @@ -9,7 +9,8 @@ ["s" code]]] [type abstract] - ["." macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." template]]]) diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux index e4330b129..08e20ca26 100644 --- a/stdlib/source/lux/control/parser/cli.lux +++ b/stdlib/source/lux/control/parser/cli.lux @@ -10,7 +10,8 @@ ["." list ("#@." monoid monad)]] ["." text ("#@." equivalence) ["%" format (#+ format)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]]] ["." // diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 23440ca83..fb9a8c6f7 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -12,7 +12,8 @@ ["i" int]] [collection ["." list ("#@." fold monad)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code]]]) diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux index 24bdacb03..c2ceb36ee 100644 --- a/stdlib/source/lux/control/remember.lux +++ b/stdlib/source/lux/control/remember.lux @@ -14,7 +14,8 @@ [time ["." instant] ["." date (#+ Date) ("#@." order)]] - ["." macro + ["." meta] + [macro ["." code] [syntax (#+ syntax:)]]]) @@ -54,7 +55,7 @@ #.None (list))) - (macro.fail (exception.construct ..must-remember [deadline today message focus]))))) + (meta.fail (exception.construct ..must-remember [deadline today message focus]))))) (template [<name> <message>] [(syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 54ea35281..485c1091c 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -15,7 +15,8 @@ ["." list ("#;." functor)]]] [type abstract] - ["." macro + ["." meta] + [macro ["." code] [syntax (#+ syntax:) [common @@ -45,11 +46,11 @@ {declaration reader.declaration} {annotations (<>.maybe reader.annotations)} {[forge input output] (<c>.form ($_ <>.and <c>.local-identifier <c>.any <c>.any))}) - (do {@ macro.monad} - [this-module macro.current-module-name + (do {@ meta.monad} + [this-module meta.current-module-name #let [[name vars] declaration] g!brand (:: @ map (|>> %.code code.text) - (macro.gensym (format (%.name [this-module name])))) + (meta.gensym (format (%.name [this-module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (writer.export export)) (~ (writer.declaration declaration)) diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index a2f03683a..9ae66df08 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -11,10 +11,11 @@ ["n" nat]] [collection ["." list ("#@." monoid fold)]]] - ["." macro + [macro ["." code]]]) -(def: error-message Text "Invariant violation") +(def: error-message + "Invariant violation") (type: Color #Red diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux index 6df0325cd..8c0ce748c 100644 --- a/stdlib/source/lux/data/collection/row.lux +++ b/stdlib/source/lux/data/collection/row.lux @@ -23,7 +23,8 @@ [collection ["." list ("#@." fold functor monoid)] ["." array (#+ Array) ("#@." functor fold)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]]]) diff --git a/stdlib/source/lux/data/collection/sequence.lux b/stdlib/source/lux/data/collection/sequence.lux index 98df00636..5755e8214 100644 --- a/stdlib/source/lux/data/collection/sequence.lux +++ b/stdlib/source/lux/data/collection/sequence.lux @@ -7,7 +7,8 @@ ["." continuation (#+ Cont pending)] ["p" parser ["s" code (#+ Parser)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]] [data diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux index eed5bd860..612d8be49 100644 --- a/stdlib/source/lux/data/collection/tree.lux +++ b/stdlib/source/lux/data/collection/tree.lux @@ -11,7 +11,7 @@ [data [collection ["." list ("#@." monad fold)]]] - ["." macro + [macro [syntax (#+ syntax:)] ["." code]]]) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 12e94a331..e9b6ab8b6 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -22,7 +22,8 @@ ["." list ("#@." fold functor)] ["." row (#+ Row row) ("#@." monad)] ["." dictionary (#+ Dictionary)]]] - ["." macro (#+ monad with-gensyms) + ["." meta (#+ monad with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code]]]) @@ -88,7 +89,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 ((~! dictionary.from-list) (~! text.hash) @@ -334,18 +335,18 @@ (wrap chars)))) (def: (kv~ json~) - (-> (-> Any (Parser JSON)) (Parser [String JSON])) + (-> (Parser JSON) (Parser [String JSON])) (do <>.monad [key string~ _ space~ _ (<t>.this ":") _ space~ - value (json~ [])] + value json~] (wrap [key value]))) (template [<name> <type> <open> <close> <elem-parser> <prep>] [(def: (<name> json~) - (-> (-> Any (Parser JSON)) (Parser <type>)) + (-> (Parser JSON) (Parser <type>)) (do <>.monad [_ (<t>.this <open>) _ space~ @@ -354,16 +355,24 @@ _ (<t>.this <close>)] (wrap (<prep> elems))))] - [array~ Array "[" "]" (json~ []) row.from-list] + [array~ Array "[" "]" json~ row.from-list] [object~ Object "{" "}" (kv~ json~) (dictionary.from-list text.hash)] ) -(def: (json~' _) - (-> Any (Parser JSON)) - ($_ <>.or null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) +(def: json~ + (Parser JSON) + (<>.rec + (function (_ json~) + ($_ <>.or + null~ + boolean~ + number~ + string~ + (array~ json~) + (object~ json~))))) (structure: #export codec (Codec Text JSON) (def: encode ..format) - (def: decode (<t>.run (json~' [])))) + (def: decode (<t>.run json~))) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 89b75d3b6..705e88682 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -11,7 +11,8 @@ ["s" code]] [concurrency ["." atom]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)]] [type abstract]]) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index ede5bb980..114398a9a 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -17,7 +17,7 @@ ["." text ("#;." monoid)] [collection ["." list ("#;." functor)]]] - ["." macro + [macro ["." code] [syntax (#+ syntax:)]]]) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index dcca35bf9..17bc1f2b4 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -19,7 +19,7 @@ ["n" nat ("#@." decimal)]] ["." text ("#@." monoid)]] ["." math] - ["." macro + [macro ["." code] [syntax (#+ syntax:)]]]) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 9f47c4292..335c120be 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -26,7 +26,7 @@ ["." date]] [math ["." modular]] - ["." macro + [macro ["." code] [syntax (#+ syntax:)]] ["." type]]) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 1777c2cac..98d33258b 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -14,7 +14,8 @@ ["n" nat ("#@." decimal)]] [collection ["." list ("#@." fold monad)]]] - ["." macro (#+ with-gensyms) + ["." meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code]]] ["." // @@ -458,13 +459,13 @@ (regex "a|b") (regex "a(.)(.)|b(.)(.)") )} - (do macro.monad - [current-module macro.current-module-name] + (do meta.monad + [current-module meta.current-module-name] (case (<t>.run (regex^ current-module) pattern) (#try.Failure error) - (macro.fail (format "Error while parsing regular-expression:" //.new-line - error)) + (meta.fail (format "Error while parsing regular-expression:" //.new-line + error)) (#try.Success regex) (wrap (list regex)) diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index a4254807b..b880d6e7d 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -11,7 +11,8 @@ ["." product] [collection ["." list ("#@." functor)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:)]] [tool diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 2770108cc..08a1bf830 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -15,7 +15,8 @@ ["." list ("#@." functor fold)]]] [type abstract] - ["." macro (#+ with-gensyms) + ["." meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code] ["." template]]]) @@ -237,7 +238,7 @@ (#Field [static? field fieldT]) (if static? (` ((~! syntax:) ((~ (qualify field))) - (:: (~! macro.monad) (~' wrap) + (:: (~! meta.monad) (~' wrap) (list (` (.:coerce (~ (nullable-type fieldT)) ("js constant" (~ (code.text (format real-class "." field)))))))))) (` (def: ((~ (qualify field)) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 4664a266f..14c8161c9 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -23,11 +23,11 @@ ["." array] ["." list ("#@." monad fold monoid)] ["." dictionary (#+ Dictionary)]]] - ["." macro (#+ with-gensyms) + [macro [syntax (#+ syntax:)] ["." code] ["." template]] - [meta + ["." meta (#+ with-gensyms) ["." annotation]] [target [jvm @@ -402,21 +402,21 @@ (def: (context compiler) (-> Lux Context) - (case (macro.run compiler - (: (Meta Context) - (do macro.monad - [current-module macro.current-module-name - definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Context Context) - (function (_ [short-name [_ _ meta _]] imports) - (case (annotation.text (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) - ..fresh - definitions))))) + (case (meta.run compiler + (: (Meta Context) + (do meta.monad + [current-module meta.current-module-name + definitions (meta.definitions current-module)] + (wrap (list@fold (: (-> [Text Definition] Context Context) + (function (_ [short-name [_ _ meta _]] imports) + (case (annotation.text (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports))) + ..fresh + definitions))))) (#.Left _) (list) (#.Right imports) imports)) @@ -1265,8 +1265,8 @@ "(::new! []) for calling the class's constructor." "(::resolve! container [value]) for calling the 'resolve' method." )} - (do macro.monad - [current-module macro.current-module-name + (do meta.monad + [current-module meta.current-module-name #let [fully-qualified-class-name (name.qualify current-module full-class-name) field-parsers (list@map (field->parser fully-qualified-class-name) fields) method-parsers (list@map (method->parser fully-qualified-class-name) methods) @@ -1295,8 +1295,8 @@ {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (do macro.monad - [current-module macro.current-module-name] + (do meta.monad + [current-module meta.current-module-name] (wrap (list (` ("jvm class interface" (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) [(~+ (list@map class$ supers))] @@ -1462,7 +1462,7 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do {@ macro.monad} + (do {@ meta.monad} [arg-inputs (monad.map @ (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) @@ -1480,7 +1480,7 @@ (wrap [arg-inputs input-jvm-types arg-types]))) _ - (:: macro.monad wrap [(list) (list) (list)]))) + (:: meta.monad wrap [(list) (list) (list)]))) (def: (decorate-return-maybe member never-null? unboxed return-term) (-> Import-Member-Declaration Bit (Type Value) Code Code) @@ -1605,7 +1605,7 @@ (let [[full-name class-tvars] (parser.declaration class)] (case member (#EnumDecl enum-members) - (do macro.monad + (do meta.monad [#let [enum-type (: Code (case class-tvars #.Nil @@ -1623,7 +1623,7 @@ (wrap (list@map getter-interop enum-members))) (#ConstructorDecl [commons _]) - (do macro.monad + (do meta.monad [#let [classT (type.class full-name (list)) def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) jvm-interop (|> [classT @@ -1643,7 +1643,7 @@ (#MethodDecl [commons method]) (with-gensyms [g!obj] - (do macro.monad + (do meta.monad [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) (^slots [#import-member-kind]) commons (^slots [#import-method-name]) method @@ -1696,7 +1696,7 @@ ((~' wrap) (.list (.` (~ jvm-interop)))))))))) (#FieldAccessDecl fad) - (do macro.monad + (do meta.monad [#let [(^open ".") fad getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)]) setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])] @@ -1746,7 +1746,7 @@ method-prefix (..internal (if long-name? full-name (short-class-name full-name)))] - (do macro.monad + (do meta.monad [=args (member-def-arg-bindings vars member)] (member-def-interop vars kind class =args member method-prefix)))) @@ -1769,12 +1769,12 @@ (let [[class-name _] (parser.declaration declaration)] (case (load-class class-name) (#.Right class) - (:: macro.monad wrap (if (interface? class) - #Interface - #Class)) + (:: meta.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 (..context *compiler*)]} @@ -1831,7 +1831,7 @@ (java/util/List::size [] my-list) Character$UnicodeScript::LATIN )} - (do {@ macro.monad} + (do {@ meta.monad} [kind (class-kind declaration) =members (monad.map @ (member-import$ class-type-vars long-name? kind declaration) members)] (wrap (list& (class-import$ long-name? declaration) (list@join =members))))) @@ -1866,18 +1866,18 @@ (exception.report ["Lux Type" (%.type type)])) -(with-expansions [<failure> (as-is (macro.fail (exception.construct ..cannot-convert-to-jvm-type [type])))] +(with-expansions [<failure> (as-is (meta.fail (exception.construct ..cannot-convert-to-jvm-type [type])))] (def: (lux-type->jvm-type type) (-> .Type (Meta (Type Value))) (if (lux-type@= Any type) - (:: macro.monad wrap $Object) + (:: meta.monad wrap $Object) (case type (#.Primitive name params) (`` (cond (~~ (template [<type>] [(text@= (..reflection <type>) name) (case params #.Nil - (:: macro.monad wrap <type>) + (:: meta.monad wrap <type>) _ <failure>)] @@ -1895,7 +1895,7 @@ [(text@= (..reflection (type.array <type>)) name) (case params #.Nil - (:: macro.monad wrap (type.array <type>)) + (:: meta.monad wrap (type.array <type>)) _ <failure>)] @@ -1912,7 +1912,7 @@ (text@= array.type-name name) (case params (#.Cons elementLT #.Nil) - (:: macro.monad map type.array + (:: meta.monad map type.array (lux-type->jvm-type elementLT)) _ @@ -1922,18 +1922,18 @@ (case params #.Nil (let [[_ unprefixed] (maybe.assume (text.split-with descriptor.array-prefix name))] - (:: macro.monad map type.array + (:: meta.monad map type.array (lux-type->jvm-type (#.Primitive unprefixed (list))))) _ <failure>) ## else - (:: macro.monad map (type.class name) + (:: meta.monad map (type.class name) (: (Meta (List (Type Parameter))) - (monad.map macro.monad + (monad.map meta.monad (function (_ paramLT) - (do macro.monad + (do meta.monad [paramJT (lux-type->jvm-type paramLT)] (case (parser.parameter? paramJT) (#.Some paramJT) @@ -1962,8 +1962,8 @@ (array-length my-array))} (case array [_ (#.Identifier array-name)] - (do macro.monad - [array-type (macro.find-type array-name) + (do meta.monad + [array-type (meta.find-type array-name) array-jvm-type (lux-type->jvm-type array-type) #let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>] [(:: type.equivalence = @@ -1998,8 +1998,8 @@ (array-read 10 my-array))} (case array [_ (#.Identifier array-name)] - (do macro.monad - [array-type (macro.find-type array-name) + (do meta.monad + [array-type (meta.find-type array-name) array-jvm-type (lux-type->jvm-type array-type) #let [g!idx (` (.|> (~ idx) (.: .Nat) @@ -2036,8 +2036,8 @@ (array-write 10 my-object my-array))} (case array [_ (#.Identifier array-name)] - (do macro.monad - [array-type (macro.find-type array-name) + (do meta.monad + [array-type (meta.find-type array-name) array-jvm-type (lux-type->jvm-type array-type) #let [g!idx (` (.|> (~ idx) (.: .Nat) @@ -2086,7 +2086,7 @@ => "java.lang.String")} (-> External (Meta External)) - (do macro.monad + (do meta.monad [*compiler* get-compiler] (wrap (qualify (..context *compiler*) class)))) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 59f6dd659..ee37cc55d 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -20,10 +20,10 @@ ["." array (#+ Array)] ["." list ("#@." monad fold monoid)]]] ["." type ("#@." equivalence)] - ["." macro (#+ with-gensyms) + [macro ["." code] [syntax (#+ syntax:)]] - [meta + ["." meta (#+ with-gensyms) ["." annotation]]]) (template [<name> <op> <from> <to>] @@ -366,21 +366,21 @@ (def: (class-imports compiler) (-> Lux Class-Imports) - (case (macro.run compiler - (: (Meta Class-Imports) - (do macro.monad - [current-module macro.current-module-name - definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) - (function (_ [short-name [_ _ meta _]] imports) - (case (annotation.text (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) - empty-imports - definitions))))) + (case (meta.run compiler + (: (Meta Class-Imports) + (do meta.monad + [current-module meta.current-module-name + definitions (meta.definitions current-module)] + (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) + (function (_ [short-name [_ _ meta _]] imports) + (case (annotation.text (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports))) + empty-imports + definitions))))) (#.Left _) (list) @@ -1344,8 +1344,8 @@ "(::new! []) for calling the class's constructor." "(::resolve! container [value]) for calling the 'resolve' method." )} - (do macro.monad - [current-module macro.current-module-name + (do meta.monad + [current-module meta.current-module-name #let [fully-qualified-class-name (format (sanitize 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) @@ -1542,7 +1542,7 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do {@ macro.monad} + (do {@ meta.monad} [arg-inputs (monad.map @ (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) @@ -1562,7 +1562,7 @@ (wrap [arg-inputs arg-classes arg-types]))) _ - (:: macro.monad wrap [(list) (list) (list)]))) + (:: meta.monad wrap [(list) (list) (list)]))) (def: (decorate-return-maybe member return-term) (-> Import-Member-Declaration Code Code) @@ -1648,7 +1648,7 @@ (list@map type-param->type-arg))] (case member (#EnumDecl enum-members) - (do {@ macro.monad} + (do {@ meta.monad} [#let [enum-type (: Code (case class-tvars #.Nil @@ -1668,7 +1668,7 @@ (wrap (list@map getter-interop enum-members))) (#ConstructorDecl [commons _]) - (do macro.monad + (do meta.monad [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))) jvm-interop (|> (` ((~ jvm-extension) @@ -1681,7 +1681,7 @@ (#MethodDecl [commons method]) (with-gensyms [g!obj] - (do macro.monad + (do meta.monad [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) (^slots [#import-member-kind]) commons (^slots [#import-method-name]) method @@ -1713,7 +1713,7 @@ ((~' wrap) (.list (.` (~ jvm-interop)))))))))) (#FieldAccessDecl fad) - (do macro.monad + (do meta.monad [#let [(^open ".") fad base-gtype (class->type import-field-mode type-params import-field-type) classC (class-decl-type$ class) @@ -1774,7 +1774,7 @@ method-prefix (if long-name? full-name (short-class-name full-name))] - (do macro.monad + (do meta.monad [=args (member-def-arg-bindings type-params class member)] (member-def-interop type-params kind class =args member method-prefix)))) @@ -1791,12 +1791,12 @@ (let [class-name (sanitize class-name)] (case (load-class class-name) (#.Right class) - (:: macro.monad wrap (if (interface? class) - #Interface - #Class)) + (:: meta.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*)]} @@ -1852,7 +1852,7 @@ (java/util/List::size [] my-list) Character$UnicodeScript::LATIN )} - (do {@ macro.monad} + (do {@ meta.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))))) @@ -1886,15 +1886,15 @@ (def: (type->class-name type) (-> Type (Meta Text)) (if (type@= Any type) - (:: macro.monad wrap "java.lang.Object") + (:: meta.monad wrap "java.lang.Object") (case type (#.Primitive name params) - (:: macro.monad wrap name) + (:: meta.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')) @@ -1903,15 +1903,15 @@ (type->class-name type') _ - (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) {#.doc (doc "Loads an element from an array." (array-read 10 my-array))} (case array [_ (#.Identifier array-name)] - (do macro.monad - [array-type (macro.find-type array-name) + (do meta.monad + [array-type (meta.find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [<type> <array-op>] @@ -1939,8 +1939,8 @@ (array-write 10 my-object my-array))} (case array [_ (#.Identifier array-name)] - (do macro.monad - [array-type (macro.find-type array-name) + (do meta.monad + [array-type (meta.find-type array-name) array-jvm-type (type->class-name array-type)] (case array-jvm-type (^template [<type> <array-op>] @@ -1980,7 +1980,7 @@ => "java.lang.String")} (-> Text (Meta Text)) - (do macro.monad + (do meta.monad [*compiler* get-compiler] (wrap (qualify (class-imports *compiler*) class)))) diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux index 5205c2f85..b49909be6 100644 --- a/stdlib/source/lux/locale.lux +++ b/stdlib/source/lux/locale.lux @@ -9,8 +9,7 @@ ["%" format (#+ format)] ["." encoding (#+ Encoding)]]] [type - abstract] - ["." macro]] + abstract]] [/ ["." language (#+ Language)] ["." territory (#+ Territory)]]) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 033a06e84..32c549a90 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -15,7 +15,8 @@ [collection ["." list ("#@." fold functor)] ["." dictionary]]] - ["." macro (#+ with-gensyms) + ["." meta (#+ with-gensyms)] + [macro ["." code] [syntax (#+ syntax:) [common @@ -28,19 +29,19 @@ body) (with-gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] - (wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) {(~ g!type) s.identifier}) - (do macro.monad - [(~ g!type) (macro.find-type-def (~ g!type))] - (case (: (.Either .Text .Code) - ((~! <type>.run) (p.rec - (function ((~ g!_) (~ g!name)) - (~ body))) - (~ g!type))) - (#.Left (~ g!output)) - (macro.fail (~ g!output)) + (wrap (.list (` ((~! syntax:) (~+ (csw.export export)) ((~ g!name) {(~ g!type) (~! s.identifier)}) + ((~! do) (~! meta.monad) + [(~ g!type) ((~! meta.find-type-def) (~ g!type))] + (case (: (.Either .Text .Code) + ((~! <type>.run) ((~! p.rec) + (function ((~ g!_) (~ g!name)) + (~ body))) + (~ g!type))) + (#.Left (~ g!output)) + ((~! meta.fail) (~ g!output)) - (#.Right (~ g!output)) - ((~' wrap) (.list (~ g!output)))))))))))) + (#.Right (~ g!output)) + ((~' wrap) (.list (~ g!output)))))))))))) (def: (common-poly-name? poly-func) (-> Text Bit) @@ -56,8 +57,8 @@ {?name (p.maybe s.local-identifier)} {[poly-func poly-args] (s.form (p.and s.identifier (p.many s.identifier)))} {?custom-impl (p.maybe s.any)}) - (do {@ macro.monad} - [poly-args (monad.map @ macro.normalize poly-args) + (do {@ meta.monad} + [poly-args (monad.map @ meta.normalize poly-args) name (case ?name (#.Some name) (wrap name) @@ -110,11 +111,11 @@ (~ (to-code env right))))) ([#.Function] [#.Apply]) - (^template [<tag> <macro> <flattener>] + (^template [<macro> <tag> <flattener>] (<tag> left right) (` (<macro> (~+ (list@map (to-code env) (<flattener> type)))))) - ([#.Sum | type.flatten-variant] - [#.Product & type.flatten-tuple]) + ([| #.Sum type.flatten-variant] + [& #.Product type.flatten-tuple]) (#.Named name sub-type) (code.identifier name) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index b8c452311..4963ef943 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -14,8 +14,9 @@ ["." frac]] ["." text ("#@." monoid)] [collection - ["." list ("#@." functor)]]]] - ["." // (#+ with-gensyms) + ["." list ("#@." functor)]]] + ["." meta (#+ with-gensyms)]] + [// ["." code]]) (def: (join-pairs pairs) @@ -64,7 +65,7 @@ (case ?parts (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!error] - (do {@ //.monad} + (do {@ meta.monad} [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) (function (_ arg) @@ -76,11 +77,11 @@ (wrap [(code.identifier var-name) (` (~! </>.any))]) _ - (//.fail "Syntax pattern expects records or identifiers.")))) + (meta.fail "Syntax pattern expects records or identifiers.")))) args) - this-module //.current-module-name + this-module meta.current-module-name #let [g!state (code.identifier ["" "*compiler*"]) - error-msg (code.text (//.wrong-syntax-error [this-module name])) + error-msg (code.text (meta.wrong-syntax-error [this-module name])) export-ast (: (List Code) (if exported? (list (' #export)) @@ -100,4 +101,4 @@ (~ g!tokens))))))))) _ - (//.fail (//.wrong-syntax-error (name-of ..syntax:)))))) + (meta.fail (meta.wrong-syntax-error (name-of ..syntax:)))))) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 989d2a0e2..680162742 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -10,9 +10,10 @@ ["." product] ["." maybe] [collection - ["." list]]]] + ["." list]]] + ["." meta]] ["." // - ["#//" /// + [/// [syntax (#+ syntax:)]]]) (def: #export export @@ -106,8 +107,8 @@ (do {@ p.monad} [definition-raw s.any me-definition-raw (|> definition-raw - ////.expand-all - (////.run compiler) + meta.expand-all + (meta.run compiler) p.lift)] (s.local me-definition-raw (s.form (do @ diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 737efe433..22d8d9251 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -14,10 +14,11 @@ ["." rev ("#@." decimal)] ["." frac ("#@." decimal)]] [collection - ["." list ("#@." monad)]]]] - ["." // - ["." code] - [syntax (#+ syntax:)]]) + ["." list ("#@." monad)]]] + ["." meta]] + [// + [syntax (#+ syntax:)] + ["." code]]) (syntax: #export (splice {parts (s.tuple (p.some s.any))}) (wrap parts)) @@ -27,9 +28,9 @@ (syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))} body) - (do {@ //.monad} + (do {@ meta.monad} [g!locals (|> locals - (list@map //.gensym) + (list@map meta.gensym) (monad.seq @))] (wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals) (list@map (function (_ [name identifier]) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/meta.lux index 3dadc236d..4a05763ce 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/meta.lux @@ -15,9 +15,9 @@ ["i" int]] ["." text ("#@." monoid equivalence)] [collection - ["." list ("#@." monoid monad)]]]] - [/ - ["." code]]) + ["." list ("#@." monoid monad)]]] + [macro + ["." code]]]) ## (type: (Meta a) ## (-> Lux (Try [Lux a]))) @@ -569,20 +569,20 @@ {#.doc "All the modules imported by a specified module."} (-> Text (Meta (List Text))) (do ..monad - [(^slots [#.imports]) (find-module module-name)] + [(^slots [#.imports]) (..find-module module-name)] (wrap imports))) (def: #export (imported-by? import module) (-> Text Text (Meta Bit)) (do ..monad - [(^slots [#.imports]) (find-module module)] + [(^slots [#.imports]) (..find-module module)] (wrap (list.any? (text@= import) imports)))) (def: #export (imported? import) (-> Text (Meta Bit)) (let [(^open ".") ..monad] - (|> current-module-name - (map find-module) join + (|> ..current-module-name + (map ..find-module) join (map (|>> (get@ #.imports) (list.any? (text@= import))))))) (def: #export (resolve-tag tag) @@ -590,31 +590,31 @@ (-> Name (Meta [Nat (List Name) Type])) (do ..monad [#let [[module name] tag] - =module (find-module module) - this-module-name current-module-name + =module (..find-module module) + this-module-name ..current-module-name imported! (..imported? module)] (case (get name (get@ #.tags =module)) (#.Some [idx tag-list exported? type]) (if (or (text@= this-module-name module) (and imported! exported?)) (wrap [idx tag-list type]) - (fail ($_ text@compose "Cannot access tag: " (name@encode tag) " from module " this-module-name))) + (..fail ($_ text@compose "Cannot access tag: " (name@encode tag) " from module " this-module-name))) _ - (fail ($_ text@compose - "Unknown tag: " (name@encode tag) text.new-line - " Known tags: " (|> =module - (get@ #.tags) - (list@map (|>> product.left [module] name@encode (text.prefix text.new-line))) - (text.join-with "")) - ))))) + (..fail ($_ text@compose + "Unknown tag: " (name@encode tag) text.new-line + " Known tags: " (|> =module + (get@ #.tags) + (list@map (|>> product.left [module] name@encode (text.prefix text.new-line))) + (text.join-with "")) + ))))) (def: #export (tag-lists module) {#.doc "All the tag-lists defined in a module, with their associated types."} (-> Text (Meta (List [(List Name) Type]))) (do ..monad - [=module (find-module module) - this-module-name current-module-name] + [=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? @@ -641,7 +641,7 @@ {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [constant (find-def def-name)] + [constant (..find-def def-name)] (wrap (case constant (#.Left real-def-name) real-def-name diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index c849e9020..c9fd34125 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -16,7 +16,8 @@ ["." list ("#@." functor)]]] [type abstract] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro [syntax (#+ syntax:)] ["." code]]] ["." // #_ diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index e529fdd19..a62a056db 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -26,7 +26,8 @@ ["." duration (#+ Duration)]] [math ["." random (#+ Random) ("#@." monad)]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)] ["." code]]]) @@ -259,8 +260,8 @@ (code.text (name.short name))))) (syntax: (reference {name <c>.identifier}) - (do macro.monad - [_ (macro.find-export name)] + (do meta.monad + [_ (meta.find-export name)] (wrap (list (name-code name))))) (template [<macro> <function>] @@ -305,9 +306,9 @@ (syntax: #export (covering {module <c>.identifier} test) - (do macro.monad + (do meta.monad [#let [module (name.module module)] - definitions (macro.definitions module) + definitions (meta.definitions module) #let [coverage (|> definitions (list.filter (|>> product.right product.left)) (list@map product.left) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux index 1de24a1c0..5d5aa835d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux @@ -7,7 +7,7 @@ ["." try]] [type ["." check (#+ Check)]] - ["." macro]] + ["." meta]] ["." /// #_ ["#." extension] [// @@ -39,7 +39,7 @@ (def: #export (infer actualT) (-> Type (Operation Any)) (do ///.monad - [expectedT (///extension.lift macro.expected-type)] + [expectedT (///extension.lift meta.expected-type)] (with-env (check.check expectedT actualT)))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 0356d6b85..ed0dc3ce9 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -17,7 +17,8 @@ [collection ["." array] ["." list ("#@." functor monoid fold)]]] - ["." macro + ["." meta] + [macro ["." code] [syntax (#+ syntax:)]]]) @@ -356,9 +357,9 @@ s.any)}) (case input (#.Left valueN) - (do macro.monad - [cursor macro.cursor - valueT (macro.find-type valueN) + (do meta.monad + [cursor meta.cursor + valueT (meta.find-type valueN) #let [_ (log! ($_ text@compose (name@encode (name-of ..:log!)) " @ " (.cursor-description cursor) text.new-line "Value: " (name@encode valueN) text.new-line @@ -366,7 +367,7 @@ (wrap (list (code.identifier valueN)))) (#.Right valueC) - (macro.with-gensyms [g!value] + (meta.with-gensyms [g!value] (wrap (list (` (.let [(~ g!value) (~ valueC)] (..:log! (~ g!value))))))))) @@ -400,7 +401,7 @@ (syntax: #export (:share {type-vars type-parameters} {exemplar typed} {computation typed}) - (macro.with-gensyms [g!_] + (meta.with-gensyms [g!_] (let [shareC (` (: (All [(~+ (list@map code.local-identifier type-vars))] (-> (~ (get@ #type exemplar)) (~ (get@ #type computation)))) @@ -424,7 +425,7 @@ ["Type" (..to-text type)])) (syntax: #export (:hole) - (do macro.monad - [cursor macro.cursor - expectedT macro.expected-type] - (macro.fail (exception.construct ..hole-type [cursor expectedT])))) + (do meta.monad + [cursor meta.cursor + expectedT meta.expected-type] + (meta.fail (exception.construct ..hole-type [cursor expectedT])))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 227cfb3be..6f07e1deb 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -12,7 +12,8 @@ [collection ["." list ("#@." functor monoid)] ["." stack (#+ Stack)]]] - ["." macro ("#@." monad) + ["." meta] + [macro ["." code] [syntax (#+ syntax:) ["cs" common @@ -155,7 +156,7 @@ (template [<name> <from> <to>] [(syntax: #export (<name> {[scope value] cast}) - (do macro.monad + (do meta.monad [[name type-vars abstraction representation] (peek! scope)] (wrap (list (` ((~! :cast) [(~+ type-vars)] (~ <from>) (~ <to>) (~ value)))))))] @@ -190,8 +191,8 @@ representation-type {annotations (<>.default cs.empty-annotations csr.annotations)} {primitives (<>.some <c>.any)}) - (do macro.monad - [current-module macro.current-module-name + (do meta.monad + [current-module meta.current-module-name #let [type-varsC (list@map code.local-identifier type-vars) abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) representation-declaration (` ((~ (code.local-identifier (representation-definition-name name))) diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux index 1031f8f41..be017585e 100644 --- a/stdlib/source/lux/type/dynamic.lux +++ b/stdlib/source/lux/type/dynamic.lux @@ -7,7 +7,8 @@ [data [text ["%" format (#+ format)]]] - [macro (#+ with-gensyms) + [meta (#+ with-gensyms)] + [macro ["." syntax (#+ syntax:)]] ["." type abstract]]) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 9944fb488..4fb030df4 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -17,7 +17,8 @@ [collection ["." list ("#@." monad fold)] ["dict" dictionary (#+ Dictionary)]]] - ["." macro + ["." meta] + [macro ["." code] [syntax (#+ syntax:)]] [meta @@ -35,20 +36,20 @@ (find-type-var id' env) _ - (:: macro.monad wrap type)) + (:: meta.monad wrap type)) (#.Some [_ #.None]) - (macro.fail (format "Unbound type-var " (%.nat id))) + (meta.fail (format "Unbound type-var " (%.nat id))) #.None - (macro.fail (format "Unknown type-var " (%.nat id))) + (meta.fail (format "Unknown type-var " (%.nat id))) )) (def: (resolve-type var-name) (-> Name (Meta Type)) - (do macro.monad - [raw-type (macro.find-type var-name) - compiler macro.get-compiler] + (do meta.monad + [raw-type (meta.find-type var-name) + compiler meta.get-compiler] (case raw-type (#.Var id) (find-type-var id (get@ #.type-context compiler)) @@ -84,35 +85,35 @@ (-> Name (Meta Name)) (case member ["" simple-name] - (macro.either (do macro.monad - [member (macro.normalize member) - _ (macro.resolve-tag member)] - (wrap member)) - (do {@ macro.monad} - [this-module-name macro.current-module-name - imp-mods (macro.imported-modules this-module-name) - tag-lists (monad.map @ macro.tag-lists imp-mods) - #let [tag-lists (|> tag-lists list@join (list@map product.left) list@join) - candidates (list.filter (|>> product.right (text@= simple-name)) - tag-lists)]] - (case candidates - #.Nil - (macro.fail (format "Unknown tag: " (%.name member))) - - (#.Cons winner #.Nil) - (wrap winner) - - _ - (macro.fail (format "Too many candidate tags: " (%.list %.name candidates)))))) + (meta.either (do meta.monad + [member (meta.normalize member) + _ (meta.resolve-tag member)] + (wrap member)) + (do {@ meta.monad} + [this-module-name meta.current-module-name + imp-mods (meta.imported-modules this-module-name) + tag-lists (monad.map @ meta.tag-lists imp-mods) + #let [tag-lists (|> tag-lists list@join (list@map product.left) list@join) + candidates (list.filter (|>> product.right (text@= simple-name)) + tag-lists)]] + (case candidates + #.Nil + (meta.fail (format "Unknown tag: " (%.name member))) + + (#.Cons winner #.Nil) + (wrap winner) + + _ + (meta.fail (format "Too many candidate tags: " (%.list %.name candidates)))))) _ - (:: macro.monad wrap member))) + (:: meta.monad wrap member))) (def: (resolve-member member) (-> Name (Meta [Nat Type])) - (do macro.monad + (do meta.monad [member (find-member-name member) - [idx tag-list sig-type] (macro.resolve-tag member)] + [idx tag-list sig-type] (meta.resolve-tag member)] (wrap [idx sig-type]))) (def: (prepare-definitions source-module target-module constants) @@ -127,8 +128,8 @@ (def: local-env (Meta (List [Name Type])) - (do macro.monad - [local-batches macro.locals + (do meta.monad + [local-batches meta.locals #let [total-locals (list@fold (function (_ [name type] table) (try.default table (dict.try-put name type table))) (: (Dictionary Text Type) @@ -140,19 +141,19 @@ (def: local-structs (Meta (List [Name Type])) - (do {@ macro.monad} - [this-module-name macro.current-module-name] + (do {@ meta.monad} + [this-module-name meta.current-module-name] (:: @ map (prepare-definitions this-module-name this-module-name) - (macro.definitions this-module-name)))) + (meta.definitions this-module-name)))) (def: import-structs (Meta (List [Name Type])) - (do {@ macro.monad} - [this-module-name macro.current-module-name - imp-mods (macro.imported-modules this-module-name) + (do {@ meta.monad} + [this-module-name meta.current-module-name + imp-mods (meta.imported-modules this-module-name) export-batches (monad.map @ (function (_ imp-mod) (:: @ map (prepare-definitions imp-mod this-module-name) - (macro.definitions imp-mod))) + (meta.definitions imp-mod))) imp-mods)] (wrap (list@join export-batches)))) @@ -207,8 +208,8 @@ (-> (-> Lux Type-Context Type (Check Instance)) Type-Context Type (List [Name Type]) (Meta (List Instance))) - (do macro.monad - [compiler macro.get-compiler] + (do meta.monad + [compiler meta.get-compiler] (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context @@ -226,18 +227,18 @@ (list [alt-name =deps])))) list@join) #.Nil - (macro.fail (format "No candidates for provisioning: " (%.type dep))) + (meta.fail (format "No candidates for provisioning: " (%.type dep))) found (wrap found)))) (def: (provision compiler context dep) (-> Lux Type-Context Type (Check Instance)) - (case (macro.run compiler - ($_ macro.either - (do macro.monad [alts ..local-env] (..test-provision provision context dep alts)) - (do macro.monad [alts ..local-structs] (..test-provision provision context dep alts)) - (do macro.monad [alts ..import-structs] (..test-provision provision context dep alts)))) + (case (meta.run compiler + ($_ meta.either + (do meta.monad [alts ..local-env] (..test-provision provision context dep alts)) + (do meta.monad [alts ..local-structs] (..test-provision provision context dep alts)) + (do meta.monad [alts ..import-structs] (..test-provision provision context dep alts)))) (#.Left error) (check.fail error) @@ -255,9 +256,9 @@ (def: (test-alternatives sig-type member-idx input-types output-type alts) (-> Type Nat (List Type) Type (List [Name Type]) (Meta (List Instance))) - (do macro.monad - [compiler macro.get-compiler - context macro.type-context] + (do meta.monad + [compiler meta.get-compiler + context meta.type-context] (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context @@ -277,7 +278,7 @@ (list [alt-name =deps])))) list@join) #.Nil - (macro.fail (format "No alternatives for " (%.type (type.function input-types output-type)))) + (meta.fail (format "No alternatives for " (%.type (type.function input-types output-type)))) found (wrap found)))) @@ -285,10 +286,10 @@ (def: (find-alternatives sig-type member-idx input-types output-type) (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (test-alternatives sig-type member-idx input-types output-type)] - ($_ macro.either - (do macro.monad [alts local-env] (test alts)) - (do macro.monad [alts local-structs] (test alts)) - (do macro.monad [alts import-structs] (test alts))))) + ($_ meta.either + (do meta.monad [alts local-env] (test alts)) + (do meta.monad [alts local-structs] (test alts)) + (do meta.monad [alts import-structs] (test alts))))) (def: (var? input) (-> Code Bit) @@ -341,14 +342,14 @@ "Otherwise, this macro will not find it.")} (case args (#.Left [args _]) - (do {@ macro.monad} + (do {@ meta.monad} [[member-idx sig-type] (resolve-member member) input-types (monad.map @ resolve-type args) - output-type macro.expected-type + output-type meta.expected-type chosen-ones (find-alternatives sig-type member-idx input-types output-type)] (case chosen-ones #.Nil - (macro.fail (format "No structure option could be found for member: " (%.name member))) + (meta.fail (format "No structure option could be found for member: " (%.name member))) (#.Cons chosen #.Nil) (wrap (list (` (:: (~ (instance$ chosen)) @@ -356,31 +357,31 @@ (~+ (list@map code.identifier args)))))) _ - (macro.fail (format "Too many options available: " - (|> chosen-ones - (list@map (|>> product.left %.name)) - (text.join-with ", ")) - " --- for type: " (%.type sig-type))))) + (meta.fail (format "Too many options available: " + (|> chosen-ones + (list@map (|>> product.left %.name)) + (text.join-with ", ")) + " --- for type: " (%.type sig-type))))) (#.Right [args _]) - (do {@ macro.monad} - [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @))] + (do {@ meta.monad} + [labels (|> (meta.gensym "") (list.repeat (list.size args)) (monad.seq @))] (wrap (list (` (let [(~+ (|> (list.zip2 labels args) (list@map join-pair) list@join))] (..::: (~ (code.identifier member)) (~+ labels))))))) )) (def: (implicit-bindings amount) (-> Nat (Meta (List Code))) - (|> (macro.gensym "g!implicit") + (|> (meta.gensym "g!implicit") (list.repeat amount) - (monad.seq macro.monad))) + (monad.seq meta.monad))) (def: implicits (Parser (List Code)) (s.tuple (p.many s.any))) (syntax: #export (implicit {structures ..implicits} body) - (do macro.monad + (do meta.monad [g!implicit+ (implicit-bindings (list.size structures))] (wrap (list (` (let [(~+ (|> (list.zip2 g!implicit+ structures) (list@map (function (_ [g!implicit structure]) @@ -389,7 +390,7 @@ (~ body))))))) (syntax: #export (implicit: {structures ..implicits}) - (do macro.monad + (do meta.monad [g!implicit+ (implicit-bindings (list.size structures))] (wrap (|> (list.zip2 g!implicit+ structures) (list@map (function (_ [g!implicit structure]) diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux index 210dd18d3..1daa8ff1b 100644 --- a/stdlib/source/lux/type/refinement.lux +++ b/stdlib/source/lux/type/refinement.lux @@ -2,7 +2,8 @@ [lux (#- type) [abstract [predicate (#+ Predicate)]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)]] [type (#+ :by-example) abstract]]) @@ -80,7 +81,7 @@ (#.Cons head no)])))) (syntax: #export (type refiner) - (macro.with-gensyms [g!t g!r] + (meta.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 16bb08f50..0bd65325b 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -22,7 +22,8 @@ ["." set] ["." row (#+ Row)] ["." list ("#@." functor fold)]]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)]] [type abstract]]) @@ -154,15 +155,15 @@ (template [<name> <m> <monad>] [(syntax: #export (<name> {swaps ..indices}) - (macro.with-gensyms [g!_ g!context] + (meta.with-gensyms [g!_ g!context] (case swaps #.Nil (wrap (list (` ((~! no-op) <monad>)))) (#.Cons head tail) - (do {@ macro.monad} + (do {@ meta.monad} [#let [max-idx (list@fold n.max head tail)] - g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (macro.gensym "input")) + g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (meta.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad (function (_ from to) (do maybe.monad @@ -197,9 +198,9 @@ (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) - (macro.with-gensyms [g!_ g!context] - (do {@ macro.monad} - [g!keys (<| (monad.seq @) (list.repeat amount) (macro.gensym "keys"))] + (meta.with-gensyms [g!_ g!context] + (do {@ meta.monad} + [g!keys (<| (monad.seq @) (list.repeat amount) (meta.gensym "keys"))] (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] (Procedure (~! <m>) [<from> (~ g!context)] diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index ef954441a..a56c22e3e 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -15,7 +15,7 @@ ["." ratio (#+ Ratio)]] [text ["%" format (#+ format)]]] - ["." macro + [macro ["." code] [syntax (#+ syntax:) ["cs" common diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index bb037c7cc..0fec32a2d 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -31,11 +31,11 @@ ["." instant] ["." day] ["." month]] - ["." macro + [macro ["." code] + ["." poly (#+ poly:)] [syntax (#+ syntax:) - ["." common]] - ["." poly (#+ poly:)]] + ["." common]]] ["." type ["." unit]]] {1 diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 7381cc0b8..93d94e06b 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -14,7 +14,7 @@ ["%" format (#+ format)]] [collection ["." list ("#;." monad monoid)]]] - ["." macro + [macro ["." code] [syntax (#+ syntax:) ["." common]] diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 8992b7ab6..cae14c54b 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -33,7 +33,7 @@ ["." date] ["." day] ["." month]] - [macro (#+ with-gensyms) + [macro [syntax (#+ syntax:)] ["." code] ["." poly (#+ poly:)]] diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 508550a2a..bbcbabb95 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -1,12 +1,19 @@ (.module: - [lux (#- type) + [lux (#- Module type) [abstract [monad (#+ do)]] [control ["<>" parser ["<c>" code (#+ Parser)]]] [data - ["." text]] + ["." text] + [collection + ["." dictionary (#+ Dictionary)]]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]] [world [net (#+ URL)]]] [// @@ -14,6 +21,25 @@ ["//." artifact (#+ Artifact)] ["//." dependency]]) +(def: (as-input input) + (-> (Maybe Code) (List Code)) + (case input + (#.Some input) + (list input) + + #.None + (list))) + +(def: (singular input tag parser) + (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser a))) + (<c>.local (..as-input (dictionary.get tag input)) + parser)) + +(def: (plural input tag parser) + (All [a] (-> (Dictionary Text Code) Text (Parser a) (Parser (List a)))) + (<c>.local (..as-input (dictionary.get tag input)) + (<c>.tuple (<>.some parser)))) + (def: group (Parser //artifact.Group) <c>.text) @@ -42,42 +68,52 @@ (Parser /.SCM) ..url) +(def: description + (Parser Text) + <c>.text) + (def: license (Parser /.License) - (<c>.tuple ($_ <>.and - ..name - ..url - (<>.default #/.Repo - (<>.or (<c>.this! (' #repo)) - (<c>.this! (' #manual))))))) + (do {@ <>.monad} + [input (:: @ map + (dictionary.from-list text.hash) + (<c>.record (<>.some (<>.and <c>.local-tag + <c>.any))))] + (<c>.tuple ($_ <>.and + (..singular input "name" ..name) + (..singular input "url" ..url) + (<>.default #/.Repo + (..singular input "type" + (<>.or (<c>.this! (' #repo)) + (<c>.this! (' #manual))))))))) (def: organization (Parser /.Organization) - (<| <c>.form - (<>.after (<c>.this! (' #organization))) - ($_ <>.and - ..name - ..url))) - -(def: developer' - (Parser /.Developer) - ($_ <>.and - ..name - ..url - (<>.maybe ..organization) - )) + (do {@ <>.monad} + [input (:: @ map + (dictionary.from-list text.hash) + (<c>.record (<>.some (<>.and <c>.local-tag + <c>.any))))] + ($_ <>.and + (..singular input "name" ..name) + (..singular input "url" ..url)))) (def: developer (Parser /.Developer) - (<| <c>.form - (<>.after (<c>.this! (' #developer))) - ..developer')) + (do {@ <>.monad} + [input (:: @ map + (dictionary.from-list text.hash) + (<c>.record (<>.some (<>.and <c>.local-tag + <c>.any))))] + ($_ <>.and + (..singular input "name" ..name) + (..singular input "url" ..url) + (<>.maybe (..singular input "organization" ..organization)) + ))) (def: contributor (Parser /.Contributor) - (<| <c>.form - (<>.after (<c>.this! (' #contributor))) - ..developer')) + ..developer) (def: no-info /.Info @@ -89,26 +125,22 @@ #/.developers (list) #/.contributors (list)}) -(def: (singular tag parser) - (All [a] (-> Code (Parser a) (Parser a))) - (<c>.form (<>.after (<c>.this! tag) parser))) - -(def: (plural tag parser) - (All [a] (-> Code (Parser a) (Parser (List a)))) - (<c>.form (<>.after (<c>.this! tag) - (<>.some parser)))) - (def: info (Parser /.Info) - ($_ <>.and - (<>.maybe ..url) - (<>.maybe ..scm) - (<>.maybe <c>.text) - (<>.default (list) (..plural (' #licenses) ..license)) - (<>.maybe ..organization) - (<>.default (list) (..plural (' #developers) ..developer)) - (<>.default (list) (..plural (' #contributors) ..contributor)) - )) + (do {@ <>.monad} + [input (:: @ map + (dictionary.from-list text.hash) + (<c>.record (<>.some (<>.and <c>.local-tag + <c>.any))))] + ($_ <>.and + (<>.maybe (..singular input "url" ..url)) + (<>.maybe (..singular input "scm" ..scm)) + (<>.maybe (..singular input "description" ..description)) + (<>.default (list) (..plural input "licenses" ..license)) + (<>.maybe (..singular input "organization" ..organization)) + (<>.default (list) (..plural input "developers" ..developer)) + (<>.default (list) (..plural input "contributors" ..contributor)) + ))) (def: repository (Parser //dependency.Repository) @@ -130,25 +162,29 @@ (Parser /.Source) <c>.text) +(def: module + (Parser Module) + <c>.text) + (def: #export project (Parser /.Project) - (<| <c>.form - (<>.after (<c>.this! (' project:))) - (`` ($_ <>.and - ..artifact - (<| (<>.default ..no-info) - (..singular (' #info) ..info)) - (<| (<>.default (list)) - (..plural (' #repositories)) - ..repository) - (<| (<>.default (list)) - (..plural (' #dependencies)) - ..dependency) - (<| (<>.default (list "source")) - (..plural (' #sources)) - ..source) - (<| (<>.default "target") - (..singular (' #target) <c>.text)) - (<>.maybe (..singular (' #program) <c>.text)) - (<>.maybe (..singular (' #test) <c>.text)) - )))) + (do {@ <>.monad} + [input (:: @ map + (dictionary.from-list text.hash) + (<c>.record (<>.some (<>.and <c>.local-tag + <c>.any))))] + ($_ <>.and + (..singular input "identity" ..artifact) + (<>.default ..no-info + (..singular input "info" ..info)) + (<>.default (list) + (..plural input "repositories" ..repository)) + (<>.default (list) + (..plural input "dependencies" ..dependency)) + (<>.default (list "source") + (..plural input "sources" ..source)) + (<>.default "target" + (..singular input "target" <c>.text)) + (<>.maybe (..singular input "program" ..module)) + (<>.maybe (..singular input "test" ..module)) + ))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 66add3672..f9b261c9f 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -19,7 +19,8 @@ ["." date (#+ Date)] ["." instant] ["." duration]] - ["." macro + ["." meta] + [macro ["." code] ["." syntax (#+ syntax:)]]] {1 @@ -67,11 +68,11 @@ prng (random.pcg-32 [123 (instant.to-millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] - (do macro.monad - [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))))] + (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))))] (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/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 49f20a726..bef97b853 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -14,7 +14,8 @@ ["." text ("#@." equivalence)]] [math ["r" random]] - ["." macro + ["." meta] + [macro [syntax (#+ syntax:)]]] {1 ["." /]}) @@ -50,7 +51,7 @@ false))) (syntax: (should-check pattern regex input) - (macro.with-gensyms [g!message g!_] + (meta.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 3b95e6f3a..35476eee0 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,8 +1,6 @@ (.module: [lux #* ["_" test (#+ Test)]] - {1 - ["." /]} ["." / #_ ["#." code] ["#." template] diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 8280e000e..bfd0a2540 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -18,7 +18,7 @@ ["." text] [collection ["." list]]] - ["." macro + [macro [poly (#+ derived:)]]]) (type: Variant diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 549967643..77ede35f3 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -19,7 +19,7 @@ ["." int] ["." rev] ["." frac]]] - ["." macro + [macro ["." code]]] {1 ["." / (#+ syntax:)]}) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index d0a531404..ec400d5e3 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -1,14 +1,301 @@ (.module: [lux #* - ["_" test (#+ Test)]] - ## {1 - ## ["." /]} + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] + [control + ["." try]] + [data + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [number + ["n" nat]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]} ["." / #_ ["#." annotation]]) +(template: (!expect <pattern> <value>) + (case <value> + <pattern> true + _ false)) + +(def: compiler-related + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + expected-gensym (random.ascii/upper-alpha 1) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.run] + (|> (:: /.monad wrap expected) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual))))) + (_.cover [/.run'] + (|> (:: /.monad wrap expected) + (/.run' expected-lux) + (!expect (^multi (#try.Success [actual-lux actual]) + (and (is? expected-lux actual-lux) + (n.= expected actual)))))) + (_.cover [/.get-compiler] + (|> /.get-compiler + (/.run expected-lux) + (!expect (^multi (#try.Success actual-lux) + (is? expected-lux actual-lux))))) + ))) + +(def: error-handling + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.fail] + (|> (/.fail expected-error) + (: (Meta Any)) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error))))) + (_.cover [/.assert] + (and (|> (/.assert expected-error true) + (: (Meta Any)) + (/.run expected-lux) + (!expect (#try.Success []))) + (|> (/.assert expected-error false) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error)))))) + (_.cover [/.either] + (and (|> (/.either (:: /.monad wrap expected) + (: (Meta Nat) + (/.fail expected-error))) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))) + (|> (/.either (: (Meta Nat) + (/.fail expected-error)) + (:: /.monad wrap expected)) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))) + (|> (/.either (: (Meta Nat) + (/.fail expected-error)) + (: (Meta Nat) + (/.fail expected-error))) + (/.run expected-lux) + (!expect (^multi (#try.Failure actual-error) + (text@= expected-error actual-error)))) + (|> (/.either (:: /.monad wrap expected) + (:: /.monad wrap dummy)) + (/.run expected-lux) + (!expect (^multi (#try.Success actual) + (n.= expected actual)))))) + ))) + +(def: module-related + Test + (do random.monad + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + primitive-type (random.ascii/upper-alpha 1) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [..dummy-cursor 0 source-code] + #.cursor ..dummy-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some (#.Primitive primitive-type (list))) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.current-module-name] + (|> /.current-module-name + (/.run expected-lux) + (!expect (^multi (#try.Success actual-current-module) + (text@= expected-current-module actual-current-module))))) + (_.cover [/.normalize] + (and (|> (/.normalize ["" expected-short]) + (/.run expected-lux) + (!expect (^multi (#try.Success [actual-module actual-short]) + (and (text@= expected-current-module actual-module) + (is? expected-short actual-short))))) + (|> (/.normalize [dummy-module expected-short]) + (/.run expected-lux) + (!expect (^multi (#try.Success [actual-module actual-short]) + (and (text@= dummy-module actual-module) + (is? expected-short actual-short))))))) + ))) + +(def: random-cursor + (Random Cursor) + ($_ random.and + (random.ascii/upper-alpha 1) + random.nat + random.nat)) + +(def: injection + (Injection Meta) + (:: /.monad wrap)) + +(def: (comparison init) + (-> Lux (Comparison Meta)) + (function (_ == left right) + (case [(/.run init left) + (/.run init right)] + [(#try.Success left) (#try.Success right)] + (== left right) + + _ + false))) + (def: #export test Test - (<| ## (_.covering /._) + (<| (_.covering /._) ($_ _.and + (do {@ random.monad} + [target (random.ascii/upper-alpha 1) + version (random.ascii/upper-alpha 1) + source-code (random.ascii/upper-alpha 1) + expected-current-module (random.ascii/upper-alpha 1) + expected-type (:: @ map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper-alpha 1)) + expected-seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected-error (random.ascii/upper-alpha 1) + expected-short (random.ascii/upper-alpha 1) + dummy-module (random.filter (|>> (text@= expected-current-module) not) + (random.ascii/upper-alpha 1)) + expected-gensym (random.ascii/upper-alpha 1) + expected-cursor ..random-cursor + #let [expected-lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [.dummy-cursor 0 source-code] + #.cursor expected-cursor + #.current-module (#.Some expected-current-module) + #.modules (list) + #.scopes (list) + #.type-context {#.ex-counter 0 + #.var-counter 0 + #.var-bindings (list)} + #.expected (#.Some expected-type) + #.seed expected-seed + #.scope-type-vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection (..comparison expected-lux) /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection (..comparison expected-lux) /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection (..comparison expected-lux) /.monad)) + + ..compiler-related + ..error-handling + ..module-related + (_.cover [/.count] + (|> (do /.monad + [pre /.count + post /.count] + (wrap [pre post])) + (/.run expected-lux) + (!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 [/.cursor] + (|> /.cursor + (/.run expected-lux) + (!expect (^multi (#try.Success actual-cursor) + (is? expected-cursor actual-cursor))))) + (_.cover [/.expected-type] + (|> /.expected-type + (/.run expected-lux) + (!expect (^multi (#try.Success actual-type) + (is? expected-type actual-type))))) + )) + /annotation.test ))) |