diff options
Diffstat (limited to '')
191 files changed, 550 insertions, 659 deletions
diff --git a/documentation/research/database.md b/documentation/research/database.md index 3445b0aa7..0c6a9f78e 100644 --- a/documentation/research/database.md +++ b/documentation/research/database.md @@ -108,6 +108,7 @@ # Exemplar +1. [Irmin](https://irmin.org/) 1. [Database of Databases](https://dbdb.io/) ## General diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux index 6d3cbbd46..383415c0a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux @@ -92,7 +92,7 @@ (function (_ extension-name phase archive [input else conditionals]) (<| _.with-label (function (_ @end)) _.with-label (function (_ @else)) - (do phase.monad + (do {@ phase.monad} [inputG (phase archive input) elseG (phase archive else) conditionalsG+ (: (Operation (List [(List [Int Label]) diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux index d448d182c..7b90a8e4f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux @@ -716,7 +716,7 @@ (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) (function (_ extension-name generate archive [class method outputT inputsTS]) - (do phase.monad + (do {@ phase.monad} [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.fuse (list@map product.right inputsTI)) (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) @@ -728,7 +728,7 @@ (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) (function (_ extension-name generate archive [class method outputT objectS inputsTS]) - (do phase.monad + (do {@ phase.monad} [objectI (generate archive objectS) inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> objectI @@ -750,7 +750,7 @@ (..custom [($_ <>.and ..class (<>.some ..input)) (function (_ extension-name generate archive [class inputsTS]) - (do phase.monad + (do {@ phase.monad} [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] (wrap (|>> (_.NEW class) _.DUP @@ -911,7 +911,7 @@ (def: (anonymous-instance archive class env) (-> Archive (Type Class) Environment (Operation Inst)) - (do phase.monad + (do {@ phase.monad} [captureI+ (monad.map @ (///reference.variable archive) env)] (wrap (|>> (_.NEW class) _.DUP @@ -958,7 +958,7 @@ (function (_ extension-name generate archive [super-class super-interfaces inputsTS overriden-methods]) - (do phase.monad + (do {@ phase.monad} [[context _] (generation.with-new-context archive (wrap [])) #let [[module-id artifact-id] context anonymous-class-name (///.class-name context) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index fa91b41df..888ad9545 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -103,7 +103,7 @@ (def: (instance archive class arity env) (-> Archive (Type Class) Arity Environment (Operation Inst)) - (do phase.monad + (do {@ phase.monad} [captureI+ (monad.map @ (reference.variable archive) env) #let [argsI (if (poly-arg? arity) (|> (nullsI (dec arity)) @@ -317,7 +317,7 @@ (def: #export (call generate archive [functionS argsS]) (Generator Apply) - (do phase.monad + (do {@ phase.monad} [functionI (generate archive functionS) argsI (monad.map @ (generate archive) argsS) #let [applyI (|> argsI diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux index 14b305843..1f2168fed 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.lux @@ -35,7 +35,7 @@ (def: #export (recur translate archive argsS) (Generator (List Synthesis)) - (do phase.monad + (do {@ phase.monad} [[@begin start] generation.anchor #let [end (|> argsS list.size dec (n.+ start)) pairs (list.zip2 (list.n/range start end) @@ -66,7 +66,7 @@ (def: #export (scope translate archive [start initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) - (do phase.monad + (do {@ phase.monad} [@begin _.make-label initsI+ (monad.map @ (translate archive) initsS+) iterationI (generation.with-anchor [@begin start] diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux index 4eafecec0..6bcf4a2e5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.lux @@ -36,7 +36,7 @@ (def: (foreign archive variable) (-> Archive Register (Operation Inst)) - (do phase.monad + (do {@ phase.monad} [class-name (:: @ map //.class-name (generation.context archive))] (wrap (|>> (_.ALOAD 0) @@ -59,7 +59,7 @@ (def: #export (constant archive name) (-> Archive Name (Operation Inst)) - (do phase.monad + (do {@ phase.monad} [class-name (:: @ map //.class-name (generation.remember archive name))] (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value)))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux index 7cf9f4da0..46f87142a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.lux @@ -39,7 +39,7 @@ (def: #export (tuple generate archive members) (Generator (List Synthesis)) - (do phase.monad + (do {@ phase.monad} [#let [size (list.size members)] _ (phase.assert not-a-tuple size (n.>= 2 size)) diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux index 5ecf21c3c..f39a5e1a2 100644 --- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux @@ -16,7 +16,7 @@ (def: #export (translate-apply translate functionS argsS+) (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression)) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [functionO (translate functionS) argsO+ (monad.map @ translate argsS+)] (wrap (r.apply argsO+ functionO)))) @@ -50,7 +50,7 @@ (-> (-> ls.Synthesis (Meta Expression)) (List Variable) ls.Arity ls.Synthesis (Meta Expression)) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [[function-name bodyO] (//.with-sub-context (do @ [function-name //.context] diff --git a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux index c64973d8f..f1197e5ce 100644 --- a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux @@ -14,7 +14,7 @@ (def: #export (translate-loop translate offset initsS+ bodyS) (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis (Meta Expression)) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [loop-name (|> (macro.gensym "loop") (:: @ map (|>> %code lang.normalize-name))) initsO+ (monad.map @ translate initsS+) @@ -31,7 +31,7 @@ (def: #export (translate-recur translate argsS+) (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis) (Meta Expression)) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [[loop-name offset] //.anchor argsO+ (monad.map @ translate argsS+)] (wrap (r.apply argsO+ (r.global loop-name))))) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index f806805c0..85ccd90dc 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -63,7 +63,7 @@ (syntax: (arity: {name s.local-identifier} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] - (do @ + (do {@ macro.monad} [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) @@ -91,7 +91,7 @@ (-> Variadic (-> Text Proc)) (function (_ proc-name) (function (_ translate inputsS) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [inputsI (monad.map @ translate inputsS)] (wrap (proc inputsI)))))) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux index 2793b40e8..3bd33955f 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux @@ -36,7 +36,7 @@ ## (-> Text @.Proc) ## (case inputs ## (^ (list& functionS argsS+)) -## (do macro.Monad<Meta> +## (do {@ macro.Monad<Meta>} ## [functionO (translate functionS) ## argsO+ (monad.map @ translate argsS+)] ## (wrap (lua.apply functionO argsO+))) @@ -56,7 +56,7 @@ ## (-> Text @.Proc) ## (case inputs ## (^ (list& tableS [_ (#.Text field)] argsS+)) -## (do macro.Monad<Meta> +## (do {@ macro.Monad<Meta>} ## [tableO (translate tableS) ## argsO+ (monad.map @ translate argsS+)] ## (wrap (lua.method field tableO argsO+))) diff --git a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux index 7530e3669..1798cb56d 100644 --- a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux @@ -12,7 +12,7 @@ (def: #export (translate-def name expressionT expressionO metaV) (-> Text Type Expression Code (Meta Any)) - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [current-module macro.current-module-name #let [def-name [current-module name]]] (case (macro.get-identifier-ann (name-of #.alias) metaV) diff --git a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux index e9a528d2b..cea8fcd59 100644 --- a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux @@ -20,7 +20,7 @@ (translate singletonS) _ - (do macro.Monad<Meta> + (do {@ macro.Monad<Meta>} [elemsT+ (monad.map @ translate elemsS+)] (wrap (r.list elemsT+))))) diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux index d7186bed4..988d7c255 100644 --- a/stdlib/source/lux/abstract/comonad.lux +++ b/stdlib/source/lux/abstract/comonad.lux @@ -4,7 +4,7 @@ [number ["n" nat]] [collection - ["." list ("#;." fold)]]]] + ["." list ("#@." fold)]]]] [// ["." functor (#+ Functor)]]) @@ -32,13 +32,25 @@ (be comonad [inputs (iterate inc +2)] (square (head inputs)))))} - (case tokens - (#.Cons comonad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil))) + (case (: (Maybe [(Maybe Text) Code (List Code) Code]) + (case tokens + (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] comonad]))] [_ (#.Tuple bindings)] body)) + (#.Some [(#.Some name) comonad bindings body]) + + (^ (list comonad [_ (#.Tuple bindings)] body)) + (#.Some [#.None comonad bindings body]) + + _ + #.None)) + (#.Some [?name comonad bindings body]) (if (|> bindings list.size (n.% 2) (n.= 0)) - (let [g!_ (: Code [_cursor (#.Identifier ["" " _ "])]) - g!map (: Code [_cursor (#.Identifier ["" " map "])]) - g!split (: Code [_cursor (#.Identifier ["" " split "])]) - body' (list;fold (: (-> [Code Code] Code Code) + (let [[module short] (name-of ..be) + gensym (: (-> Text Code) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor])) + g!_ (gensym "_") + g!map (gensym "map") + g!split (gensym "split") + body' (list@fold (: (-> [Code Code] Code Code) (function (_ binding body') (let [[var value] binding] (case var @@ -50,15 +62,24 @@ )))) body (list.reverse (list.as-pairs bindings)))] - (#.Right [state (#.Cons (` ({(~' @) - ({{#&functor {#functor.map (~ g!map)} - #unwrap (~' unwrap) - #split (~ g!split)} - (~ body')} - (~' @))} - (~ comonad))) - #.Nil)])) + (#.Right [state (list (case ?name + (#.Some name) + (let [name [_cursor (#.Identifier ["" name])]] + (` ({(~ name) + ({{#..&functor {#functor.map (~ g!map)} + #..unwrap (~' unwrap) + #..split (~ g!split)} + (~ body')} + (~ name))} + (~ comonad)))) + + #.None + (` ({{#..&functor {#functor.map (~ g!map)} + #..unwrap (~' unwrap) + #..split (~ g!split)} + (~ body')} + (~ comonad)))))])) (#.Left "'be' bindings must have an even number of parts.")) - _ + #.None (#.Left "Wrong syntax for 'be'"))) diff --git a/stdlib/source/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux index 491f9b6a2..12f75e9ac 100644 --- a/stdlib/source/lux/abstract/monad.lux +++ b/stdlib/source/lux/abstract/monad.lux @@ -58,12 +58,24 @@ [y (f1 x) z (f2 z)] (wrap (f3 z))))} - (case tokens - (#.Cons monad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil))) + (case (: (Maybe [(Maybe Text) Code (List Code) Code]) + (case tokens + (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body)) + (#.Some [(#.Some name) monad bindings body]) + + (^ (list monad [_ (#.Tuple bindings)] body)) + (#.Some [#.None monad bindings body]) + + _ + #.None)) + (#.Some [?name monad bindings body]) (if (|> bindings list@size .int ("lux i64 %" +2) ("lux i64 =" +0)) - (let [g!_ (: Code [_cursor (#.Identifier ["" " _ "])]) - g!map (: Code [_cursor (#.Identifier ["" " map "])]) - g!join (: Code [_cursor (#.Identifier ["" " join "])]) + (let [[module short] (name-of ..do) + gensym (: (-> Text Code) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor])) + g!_ (gensym "_") + g!map (gensym "map") + g!join (gensym "join") body' (list@fold (: (-> [Code Code] Code Code) (function (_ binding body') (let [[var value] binding] @@ -76,15 +88,26 @@ )))) body (reverse (as-pairs bindings)))] - (#.Right [state (#.Cons (` ({(~' @) - ({[(~ g!map) (~' wrap) (~ g!join)] - (~ body')} - (~' @))} - (~ monad))) - #.Nil)])) + (#.Right [state (list (case ?name + (#.Some name) + (let [name [_cursor (#.Identifier ["" name])]] + (` ({(~ name) + ({{#..&functor {#functor.map (~ g!map)} + #..wrap (~' wrap) + #..join (~ g!join)} + (~ body')} + (~ name))} + (~ monad)))) + + #.None + (` ({{#..&functor {#functor.map (~ g!map)} + #..wrap (~' wrap) + #..join (~ g!join)} + (~ body')} + (~ monad)))))])) (#.Left "'do' bindings must have an even number of parts.")) - _ + #.None (#.Left "Wrong syntax for 'do'"))) (def: #export (bind monad f) diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux index 27bae03f0..caa233884 100644 --- a/stdlib/source/lux/abstract/monad/indexed.lux +++ b/stdlib/source/lux/abstract/monad/indexed.lux @@ -6,9 +6,10 @@ ["s" code (#+ Parser)]]] [data [collection - ["." list ("#;." functor fold)]]] + ["." list ("#@." functor fold)]]] ["." macro - [syntax (#+ syntax:)]]]) + [syntax (#+ syntax:)] + ["." code]]]) (signature: #export (IxMonad m) (: (All [p a] @@ -41,25 +42,42 @@ (All [a] (-> [a a] (List a))) (list binding value)) -(syntax: #export (do monad +(def: named-monad + (Parser [(Maybe Text) Code]) + (p.either (s.record (p.and (:: p.monad map (|>> #.Some) + s.local-identifier) + s.any)) + (:: p.monad map (|>> [#.None]) + s.any))) + +(syntax: #export (do {[?name monad] ..named-monad} {context (s.tuple (p.some context))} expression) (macro.with-gensyms [g!_ g!bind] - (wrap (list (` (let [(~' @) (~ monad) - {#..wrap (~' wrap) - #..bind (~ g!bind)} (~' @)] - (~ (list;fold (function (_ context next) - (case context - (#Let bindings) - (` (let [(~+ (|> bindings - (list;map pair-list) - list.concat))] - (~ next))) - - (#Bind [binding value]) - (` ((~ g!bind) - (.function ((~ g!_) (~ binding)) - (~ next)) - (~ value))))) - expression - (list.reverse context))))))))) + (let [body (list@fold (function (_ context next) + (case context + (#Let bindings) + (` (let [(~+ (|> bindings + (list@map pair-list) + list.concat))] + (~ next))) + + (#Bind [binding value]) + (` ((~ g!bind) + (.function ((~ g!_) (~ binding)) + (~ next)) + (~ value))))) + expression + (list.reverse context))] + (wrap (list (case ?name + (#.Some name) + (let [name (code.local-identifier name)] + (` (let [(~ name) (~ monad) + {#..wrap (~' wrap) + #..bind (~ g!bind)} (~ name)] + (~ body)))) + + #.None + (` (let [{#..wrap (~' wrap) + #..bind (~ g!bind)} (~ monad)] + (~ body))))))))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 0b6786c23..48c7cf2eb 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -77,7 +77,7 @@ (case [(|> inputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`)))) (|> outputs (get@ #bottom) (maybe@map (|>> code.nat (~) #.Parameter (`))))] [(#.Some bottomI) (#.Some bottomO)] - (monad.do @ + (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)))] (wrap (list (` (-> (~ (de-alias inputC)) @@ -85,7 +85,7 @@ [?bottomI ?bottomO] (with-gensyms [g!stack] - (monad.do @ + (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))))] (wrap (list (` (All [(~ g!stack)] @@ -115,7 +115,7 @@ (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) (with-gensyms [g! g!func g!stack g!output] - (monad.do @ + (monad.do {@ macro.monad} [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))] (wrap (list (` (: (All [(~+ 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 0f38c4c3d..a790fa89c 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -51,7 +51,7 @@ [(Promise [a Mailbox]) (Resolver [a Mailbox])]) (IO (List a)))) - (do io.monad + (do {@ io.monad} [current (promise.poll read)] (case current (#.Some [head tail]) @@ -97,7 +97,7 @@ (promise.promise [])) process (loop [state init [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] - (do promise.monad + (do {@ promise.monad} [[head tail] |mailbox| ?state' (handle head state self)] (case ?state' @@ -135,7 +135,7 @@ (def: #export (send message actor) {#.doc "Communicate with an actor through message passing."} (All [s] (-> (Message s) (Actor s) (IO Bit))) - (do io.monad + (do {@ io.monad} [alive? (..alive? actor)] (if alive? (let [entry [message (promise.promise [])]] @@ -266,7 +266,7 @@ #let [_ (log! "AFTER")]] (wrap output)))))} (with-gensyms [g!_ g!init] - (do @ + (do macro.monad [module macro.current-module-name #let [g!type (code.local-identifier (state-name _name)) g!behavior (code.local-identifier (behavior-name _name)) @@ -356,7 +356,7 @@ (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 @ + (do macro.monad [current-module macro.current-module-name actor-name (resolve-actor actor-name) #let [message-name [current-module (get@ #name signature)] diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index 17ae28f41..2850f454f 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -40,7 +40,7 @@ (structure (def: close (loop [_ []] - (do io.monad + (do {@ io.monad} [current (atom.read sink) stopped? (current #.None)] (if stopped? @@ -57,7 +57,7 @@ (def: (feed value) (loop [_ []] - (do io.monad + (do {@ io.monad} [current (atom.read sink) #let [[next resolve-next] (:share [a] {(promise.Resolver (Maybe [a (Channel a)])) @@ -124,7 +124,7 @@ (let [[output sink] (channel [])] (exec (: (Promise Any) (loop [mma mma] - (do promise.monad + (do {@ promise.monad} [?mma mma] (case ?mma (#.Some [ma mma']) @@ -185,7 +185,7 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Promise a))) - (do promise.monad + (do {@ promise.monad} [cons channel] (case cons #.None @@ -201,7 +201,7 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Channel a))) - (do promise.monad + (do {@ promise.monad} [cons channel] (case cons #.None @@ -265,7 +265,7 @@ (def: #export (consume channel) {#.doc "Reads the entirety of a channel's content and returns it as a list."} (All [a] (-> (Channel a) (Promise (List a)))) - (do promise.monad + (do {@ promise.monad} [cons channel] (case cons (#.Some [head tail]) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index d31edfb59..2060233e3 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -132,7 +132,7 @@ (def: #export run! (IO Any) (loop [_ []] - (do io.monad + (do {@ io.monad} [processes (atom.read runner)] (case processes ## And... we're done! diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index def999622..a0461e2c1 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -28,7 +28,7 @@ (All [a] (-> (Promise a) (Resolver a))) (function (resolve value) (let [promise (:representation promise)] - (do io.monad + (do {@ io.monad} [(^@ old [_value _observers]) (atom.read promise)] (case _value (#.Some _) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 39bac32a1..c69859138 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -76,7 +76,7 @@ (let [semaphore (:representation semaphore)] (promise.future (loop [_ []] - (do io.monad + (do {@ io.monad} [state (atom.read semaphore) #let [[?sink state' maxed-out?] (: [(Maybe (Resolver Any)) State Bit] (case (queue.peek (get@ #waiting-list state)) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 3065d8033..3c4c26f59 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -46,7 +46,7 @@ (def: (write! new-value var) (All [a] (-> a (Var a) (IO Any))) - (do io.monad + (do {@ io.monad} [#let [var' (:representation var)] (^@ old [old-value observers]) (atom.read var') succeeded? (atom.compare-and-swap old [new-value observers] var')] @@ -216,7 +216,7 @@ (def: (issue-commit commit) (All [a] (-> (Commit a) (IO Any))) (let [entry [commit (promise.promise [])]] - (do io.monad + (do {@ io.monad} [|commits|&resolve (atom.read pending-commits)] (loop [[|commits| resolve] |commits|&resolve] (do @ @@ -237,14 +237,14 @@ (let [[stm-proc output resolve] commit [finished-tx value] (stm-proc fresh-tx)] (if (can-commit? finished-tx) - (do io.monad + (do {@ io.monad} [_ (monad.map @ commit-var! finished-tx)] (resolve value)) (issue-commit commit)))) (def: init-processor! (IO Any) - (do io.monad + (do {@ io.monad} [flag (atom.read commit-processor-flag)] (if flag (wrap []) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 211976aa2..8cc4dfe94 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -97,7 +97,7 @@ (exception: #export [optional type variables] (some-exception {optional Text} {arguments Int}) optional-body))} (macro.with-gensyms [g!descriptor] - (do @ + (do macro.monad [current-module macro.current-module-name #let [descriptor ($_ text@compose "{" current-module "." name "}" text.new-line) g!self (code.local-identifier name)]] diff --git a/stdlib/source/lux/control/function/memo.lux b/stdlib/source/lux/control/function/memo.lux index 253506508..fb6456699 100644 --- a/stdlib/source/lux/control/function/memo.lux +++ b/stdlib/source/lux/control/function/memo.lux @@ -20,7 +20,7 @@ (Mixin (-> i (State (Dictionary i o) o)))) (function (_ delegate recur) (function (_ input) - (do state.monad + (do {@ state.monad} [memory state.get] (case (dictionary.get input memory) (#.Some output) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 6187a4d4f..88eefcdaf 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -200,7 +200,7 @@ (def: #export (sep-by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) - (do ..monad + (do {@ ..monad} [?x (maybe p)] (case ?x #.None diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 137094340..b2a1b1b52 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -87,7 +87,7 @@ ["Tag value" (%.nat byte)])) (template: (!variant <case>+) - (do //.monad + (do {@ //.monad} [flag (: (Parser Nat) ..bits/8)] (`` (case flag diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index dc3f101f3..d95c1c115 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -168,7 +168,7 @@ (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) - (do //.monad + (do {@ //.monad} [headT any funcI (:: @ map dictionary.size ..env) [num-args non-poly] (local (list headT) polymorphic') @@ -298,7 +298,7 @@ (def: #export (recursive poly) (All [a] (-> (Parser a) (Parser [Code a]))) - (do //.monad + (do {@ //.monad} [headT any] (case (type.un-name headT) (#.Apply (#.Named ["lux" "Nothing"] _) (#.UnivQ _ headT')) @@ -328,7 +328,7 @@ (def: #export recursive-call (Parser Code) - (do //.monad + (do {@ //.monad} [env ..env [funcT argsT] (apply (//.and any (//.many any))) _ (local (list funcT) (..parameter! 0)) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 23f3888b3..332546685 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -54,7 +54,7 @@ (All [m a] (-> (Monad m) (All [r] (Region r m a)) (m (Try a)))) - (do Monad<m> + (do {@ Monad<m>} [[cleaners output] (computation [[] (list)]) results (monad.map @ (function (_ cleaner) (cleaner [])) cleaners)] diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index d33f0f0e6..69cea5b19 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -46,7 +46,7 @@ {declaration reader.declaration} {annotations (p.maybe reader.annotations)} {[forge input output] (s.form ($_ p.and s.local-identifier s.any s.any))}) - (do @ + (do {@ macro.monad} [this-module macro.current-module-name #let [[name vars] declaration] g!brand (:: @ map (|>> %.code code.text) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index b4e958c6b..d42408984 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -80,7 +80,7 @@ (def: #export (while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) - (do ..monad + (do {@ ..monad} [execute? condition] (if execute? (do @ diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux index 32d1a7db1..a2f03683a 100644 --- a/stdlib/source/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux @@ -53,7 +53,7 @@ ## TODO: Must improve it as soon as bug is fixed. (def: #export (get key dict) (All [k v] (-> k (Dictionary k v) (Maybe v))) - (let [## (^open "T/.") (get@ #&order dict) + (let [## (^open "_@.") (get@ #&order dict) ] (loop [node (get@ #root dict)] (case node @@ -63,20 +63,20 @@ (#.Some node) (let [node-key (get@ #key node)] (cond (:: dict = node-key key) - ## (T/= node-key key) + ## (_@= node-key key) (#.Some (get@ #value node)) (:: dict < node-key key) - ## (T/< node-key key) + ## (_@< node-key key) (recur (get@ #left node)) - ## (T/> (get@ #key node) key) + ## (_@> (get@ #key node) key) (recur (get@ #right node)))) )))) (def: #export (contains? key dict) (All [k v] (-> k (Dictionary k v) Bit)) - (let [## (^open "T/.") (get@ #&order dict) + (let [## (^open "_@.") (get@ #&order dict) ] (loop [node (get@ #root dict)] (case node @@ -86,9 +86,9 @@ (#.Some node) (let [node-key (get@ #key node)] (or (:: dict = node-key key) - ## (T/= node-key key) + ## (_@= node-key key) (if (:: dict < node-key key) - ## (T/< node-key key) + ## (_@< node-key key) (recur (get@ #left node)) (recur (get@ #right node))))))))) @@ -249,7 +249,7 @@ (def: #export (put key value dict) (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) - (let [(^open "T/.") (get@ #&order dict) + (let [(^open "_@.") (get@ #&order dict) root' (loop [?root (get@ #root dict)] (case ?root #.None @@ -266,11 +266,11 @@ (#.Some (<add> (maybe.assume outcome) root))))] - [T/< #left add-left] + [_@< #left add-left] [(order.> (get@ #&order dict)) #right add-right] )) - ## (T/= reference key) + ## (_@= reference key) ?root ))) ))] @@ -472,7 +472,7 @@ (def: #export (remove key dict) (All [k v] (-> k (Dictionary k v) (Dictionary k v))) - (let [(^open "T/.") (get@ #&order dict) + (let [(^open "_@.") (get@ #&order dict) [?root found?] (loop [?root (get@ #root dict)] (case ?root #.None @@ -481,11 +481,11 @@ (#.Some root) (let [root-key (get@ #key root) root-val (get@ #value root)] - (if (T/= root-key key) + (if (_@= root-key key) [(prepend (get@ #left root) (get@ #right root)) #1] - (let [go-left? (T/< root-key key)] + (let [go-left? (_@< root-key key)] (case (recur (if go-left? (get@ #left root) (get@ #right root))) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 1c18dcf63..a705908d1 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -572,7 +572,7 @@ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap))) (def: (join MlMla) - (do monad + (do {@ monad} [lMla MlMla ## TODO: Remove this version ASAP and use one below. lla (`` (for {(~~ (static @.old)) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index c42093710..11aa27d3c 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -81,7 +81,7 @@ (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list@map wrapper members)))))))) [_ (#.Record pairs)] - (do ..monad + (do {@ ..monad} [pairs' (monad.map @ (function (_ [slot value]) (case slot @@ -280,7 +280,7 @@ (def: number~ (Parser Number) - (do p.monad + (do {@ p.monad} [signed? (l.this? "-") digits (l.many l.decimal) decimals (p.default "0" @@ -322,7 +322,7 @@ (Parser String) (<| (l.enclosed [text.double-quote text.double-quote]) (loop [_ []]) - (do p.monad + (do {@ p.monad} [chars (l.some (l.none-of (text@compose "\" text.double-quote))) stop l.peek]) (if (text@= "\" stop) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 1063fdb71..7c8395d71 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -82,7 +82,7 @@ (def: re-range^ (Parser Code) - (do p.monad + (do {@ p.monad} [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) _ (l.this "-") to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] @@ -228,7 +228,7 @@ (def: (re-counted-quantified^ current-module) (-> Text (Parser Code)) - (do p.monad + (do {@ p.monad} [base (re-simple^ current-module)] (l.enclosed ["{" "}"] ($_ p.either @@ -458,7 +458,7 @@ (regex "a|b") (regex "a(.)(.)|b(.)(.)") )} - (do @ + (do macro.monad [current-module macro.current-module-name] (case (l.run (p.before l.end (regex^ current-module)) diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux index f5bce33a7..4b0b7e4d2 100644 --- a/stdlib/source/lux/extension.lux +++ b/stdlib/source/lux/extension.lux @@ -72,9 +72,7 @@ (#.Right [(~+ (list@map (|>> product.left code.local-identifier) inputs))]) - ((~! monad.do) (~! phase.monad) - [] - (~ body)) + (~ body) (#.Left (~ g!error)) ((~! phase.fail) (~ g!error))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 1fb112a48..6fb29097f 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1220,7 +1220,8 @@ (type.class "java.lang.Object" (list))) (syntax: #export (class: - {#let [imports (..context *compiler*)]} + {#let [@ macro.monad + imports (..context *compiler*)]} {im inheritance-modifier^} {[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))} {#let [imports (add-import [(short-class-name full-class-name) full-class-name] @@ -1262,7 +1263,7 @@ "(::new! []) for calling the class's constructor." "(::resolve! container [value]) for calling the 'resolve' method." )} - (do @ + (do macro.monad [current-module macro.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) @@ -1280,7 +1281,8 @@ [(~+ (list@map (method-def$ replacer super) methods))])))))) (syntax: #export (interface: - {#let [imports (..context *compiler*)]} + {#let [@ macro.monad + imports (..context *compiler*)]} {[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))} {#let [imports (add-import [(short-class-name full-class-name) full-class-name] (..context *compiler*))]} @@ -1291,7 +1293,7 @@ {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (do @ + (do macro.monad [current-module macro.current-module-name] (wrap (list (` ("jvm class interface" (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars))) @@ -1458,7 +1460,7 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do macro.monad + (do {@ macro.monad} [arg-inputs (monad.map @ (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) @@ -1639,7 +1641,7 @@ (#MethodDecl [commons method]) (with-gensyms [g!obj] - (do @ + (do macro.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 @@ -1827,7 +1829,7 @@ (java/util/List::size [] my-list) Character$UnicodeScript::LATIN )} - (do macro.monad + (do {@ macro.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))))) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 2b62b01b0..906ccf639 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -1540,7 +1540,7 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do macro.monad + (do {@ macro.monad} [arg-inputs (monad.map @ (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) @@ -1646,7 +1646,7 @@ (list@map type-param->type-arg))] (case member (#EnumDecl enum-members) - (do macro.monad + (do {@ macro.monad} [#let [enum-type (: Code (case class-tvars #.Nil @@ -1679,7 +1679,7 @@ (#MethodDecl [commons method]) (with-gensyms [g!obj] - (do @ + (do macro.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 @@ -1850,7 +1850,7 @@ (java/util/List::size [] my-list) Character$UnicodeScript::LATIN )} - (do macro.monad + (do {@ macro.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))))) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index bd8beac14..8ffd78b2e 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -233,7 +233,7 @@ {#.doc <desc>} (-> Code (List Text)) (maybe.default (list) - (do maybe.monad + (do {@ maybe.monad} [_args (get-ann (name-of <tag>) anns) args (parse-tuple _args)] (monad.map @ parse-text args))))] @@ -407,7 +407,7 @@ )))} (case tokens (^ (list [_ (#.Tuple identifiers)] body)) - (do ..monad + (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))))))) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 536376f83..98a3a0d47 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -57,7 +57,7 @@ {?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 @ + (do {@ macro.monad} [poly-args (monad.map @ macro.normalize poly-args) name (case ?name (#.Some name) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 007694978..b8c452311 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -64,7 +64,7 @@ (case ?parts (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!error] - (do //.monad + (do {@ //.monad} [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) (function (_ arg) @@ -96,9 +96,7 @@ (: ((~! </>.Parser) (Meta (List Code))) ((~! do) (~! <>.monad) [(~+ (join-pairs vars+parsers))] - ((~' wrap) ((~! do) (~! //.monad) - [] - (~ body))))) + ((~' wrap) (~ body)))) (~ g!tokens))))))))) _ diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 02d947e47..5e2d3b0bc 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -103,7 +103,7 @@ (def: #export (definition compiler) {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} (-> Lux (Parser //.Definition)) - (do p.monad + (do {@ p.monad} [definition-raw s.any me-definition-raw (|> definition-raw ////.expand-all diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index ef4332a45..737efe433 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -27,7 +27,7 @@ (syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))} body) - (do @ + (do {@ //.monad} [g!locals (|> locals (list@map //.gensym) (monad.seq @))] diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 45944718a..1bca37621 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -189,7 +189,7 @@ (def: #export (or left right) {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Random a) (Random b) (Random (| a b)))) - (do ..monad + (do {@ ..monad} [? bit] (if ? (do @ @@ -217,7 +217,7 @@ (def: #export (maybe value-gen) (All [a] (-> (Random a) (Random (Maybe a)))) - (do ..monad + (do {@ ..monad} [some? bit] (if some? (do @ @@ -254,7 +254,7 @@ (def: #export (set Hash<a> size value-gen) (All [a] (-> (Hash a) Nat (Random a) (Random (Set a)))) (if (n.> 0 size) - (do ..monad + (do {@ ..monad} [xs (set Hash<a> (dec size) value-gen)] (loop [_ []] (do @ @@ -268,7 +268,7 @@ (def: #export (dictionary Hash<a> size key-gen value-gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v)))) (if (n.> 0 size) - (do ..monad + (do {@ ..monad} [kv (dictionary Hash<a> (dec size) key-gen value-gen)] (loop [_ []] (do @ diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index 9092445c7..e1c19c55d 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -183,7 +183,7 @@ (def: (bytecode consumption production registry [estimator bytecode] input) (All [a] (-> U2 U2 Registry [Estimator (-> [a] Instruction)] [a] (Bytecode Any))) (function (_ [pool environment tracker]) - (do try.monad + (do {@ try.monad} [environment' (|> environment (/environment.consumes consumption) (monad.bind @ (/environment.produces production)) @@ -631,7 +631,7 @@ (def: (jump @from @to) (-> Address Address (Try Any-Jump)) - (do try.monad + (do {@ try.monad} [jump (:: @ map //signed.value (/address.jump @from @to))] (let [big? (n.> (//unsigned.value //unsigned.maximum/2) @@ -793,7 +793,7 @@ (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] - (case (do maybe.monad + (case (do {@ maybe.monad} [@default (|> default get (monad.bind @ product.right)) @at-minimum (|> at-minimum get (monad.bind @ product.right)) @afterwards (|> afterwards @@ -801,7 +801,7 @@ (monad.bind @ (monad.map @ product.right)))] (wrap [@default @at-minimum @afterwards])) (#.Some [@default @at-minimum @afterwards]) - (do try.monad + (do {@ try.monad} [>default (:: @ map ..big-jump (..jump @from @default)) >at-minimum (:: @ map ..big-jump (..jump @from @at-minimum)) >afterwards (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump)) @@ -836,14 +836,14 @@ (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] - (case (do maybe.monad + (case (do {@ maybe.monad} [@default (|> default get (monad.bind @ product.right)) @cases (|> cases (monad.map @ (|>> product.right get)) (monad.bind @ (monad.map @ product.right)))] (wrap [@default @cases])) (#.Some [@default @cases]) - (do try.monad + (do {@ try.monad} [>default (:: @ map ..big-jump (..jump @from @default)) >cases (|> @cases (monad.map @ (|>> (..jump @from) (:: @ map ..big-jump))) diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index e729efdd3..366f65cfc 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -575,7 +575,7 @@ (function (_ [size mutation]) (let [padding (switch-padding size) tableswitch-size (try.assume - (do try.monad + (do {@ try.monad} [size (///unsigned.u2 size)] (:: @ map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) @@ -583,7 +583,7 @@ (function (_ [offset binary]) [(n.+ tableswitch-size offset) (try.assume - (do try.monad + (do {@ try.monad} [amount-of-afterwards (|> amount-of-afterwards .int ///signed.s4) maximum (///signed.+/4 minimum amount-of-afterwards) _ (binary.write/8 offset (hex "AA") binary) @@ -639,7 +639,7 @@ (function (_ [size mutation]) (let [padding (switch-padding size) lookupswitch-size (try.assume - (do try.monad + (do {@ try.monad} [size (///unsigned.u2 size)] (:: @ map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) @@ -647,7 +647,7 @@ (function (_ [offset binary]) [(n.+ lookupswitch-size offset) (try.assume - (do try.monad + (do {@ try.monad} [_ (binary.write/8 offset (hex "AB") binary) #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] _ (case padding diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index ec2832b19..db5ab9b4c 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -72,7 +72,7 @@ (def: (install-classes this super interfaces) (-> Internal Internal (List Internal) (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) - (do //constant/pool.monad + (do {@ //constant/pool.monad} [@this (//constant/pool.class this) @super (//constant/pool.class super) @interfaces (: (Resource (Row (Index //constant.Class))) diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 2e4ff9937..8028787d7 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -66,7 +66,7 @@ (#try.Failure _) (let [new (<tag> <value>')] - (do try.monad + (do {@ try.monad} [@new (//unsigned.u2 (//.size new)) next (: (Try Index) (|> current diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index 2764bad4a..f7d736766 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -122,7 +122,7 @@ (def: #export (store name bytecode library) (-> Text Binary Library (IO (Try Any))) - (do io.monad + (do {@ io.monad} [library' (atom.read library)] (if (dictionary.contains? name library') (wrap (exception.throw ..already-stored name)) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index cd62830ea..9f902f55e 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -53,7 +53,7 @@ (def: #export (method modifier name type attributes code) (-> (Modifier Method) UTF8 (Type //type/category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any)) (Resource Method)) - (do //constant/pool.monad + (do {@ //constant/pool.monad} [@name (//constant/pool.utf8 name) @descriptor (//constant/pool.descriptor (//type.descriptor type)) attributes (|> attributes diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux index 992ac9977..086de8175 100644 --- a/stdlib/source/lux/target/jvm/reflection.lux +++ b/stdlib/source/lux/target/jvm/reflection.lux @@ -151,7 +151,7 @@ (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)] (case (host.check java/lang/Class raw) (#.Some raw) - (do try.monad + (do {@ try.monad} [paramsT (|> reflection java/lang/reflect/ParameterizedType::getActualTypeArguments array.to-list @@ -341,7 +341,7 @@ (template [<name> <exception> <then?> <else?>] [(def: #export (<name> field class) (-> Text (java/lang/Class java/lang/Object) (Try [Bit (/.Type Value)])) - (do try.monad + (do {@ try.monad} [fieldJ (..field field class) #let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]] (case (java/lang/reflect/Modifier::isStatic modifiers) diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux index 0b7f8f31d..8c5d78de3 100644 --- a/stdlib/source/lux/target/jvm/type/lux.lux +++ b/stdlib/source/lux/target/jvm/type/lux.lux @@ -103,7 +103,7 @@ (<>.after (<t>.this //signature.parameters-start)) (<>.before (<t>.this //signature.parameters-end)) (<>.default (list)))] - (wrap (do check.monad + (wrap (do {@ check.monad} [parameters (monad.seq @ parameters)] (wrap (#.Primitive name parameters))))) (<>.after (<t>.this //descriptor.class-prefix)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 96535b886..003eb29af 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -259,7 +259,7 @@ (code.text (name.short name))))) (syntax: (reference {name <c>.identifier}) - (do @ + (do macro.monad [_ (macro.find-export name)] (wrap (list (name-code name))))) @@ -298,7 +298,7 @@ (syntax: #export (covering {module <c>.identifier} test) - (do @ + (do macro.monad [#let [module (name.module module)] definitions (macro.definitions module) #let [coverage (|> definitions @@ -322,7 +322,7 @@ io.io promise.future promise@join)))]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [assertions (monad.seq @ (list@map run! tests))] (wrap [(|> assertions (list@map product.left) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index ae03d19d5..ee51cd684 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -115,7 +115,7 @@ [#let [module (get@ #///.module input)] _ (///directive.set-current-module module)] (///directive.lift-analysis - (do ///phase.monad + (do {@ ///phase.monad} [_ (module.create hash module) _ (monad.map @ module.import dependencies) #let [source (///analysis.source (get@ #///.module input) (get@ #///.code input))] @@ -224,7 +224,7 @@ (let [dependencies (default-dependencies prelude input)] {#///.dependencies dependencies #///.process (function (_ state archive) - (do try.monad + (do {@ try.monad} [#let [hash (text@hash (get@ #///.code input))] [state [source buffer]] (<| (///phase.run' state) (..begin dependencies hash input)) @@ -258,7 +258,7 @@ (list@map product.left)) #///.process (function (_ state archive) (recur (<| (///phase.run' state) - (do ///phase.monad + (do {@ ///phase.monad} [analysis-module (<| (: (Operation .Module)) ///directive.lift-analysis extension.lift diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 75ef54731..4cec42038 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -251,7 +251,7 @@ (:assume (stm.var (dictionary.new text.hash)))})] (function (_ compile) (function (import! module) - (do promise.monad + (do {@ promise.monad} [[return signal] (:share [<type-vars>] {<Context> initial} @@ -260,7 +260,7 @@ <Signal>])]) (:assume (stm.commit - (do stm.monad + (do {@ stm.monad} [[archive state] (stm.read current)] (if (archive.archived? archive module) (wrap [(promise@wrap (#try.Success [archive state])) @@ -317,7 +317,7 @@ (def: (updated-state archive state) (All [<type-vars>] (-> Archive <State+> (Try <State+>))) - (do try.monad + (do {@ try.monad} [modules (monad.map @ (function (_ module) (do @ [[descriptor document] (archive.find module archive) @@ -373,7 +373,7 @@ compilation (base-compiler (:coerce ///.Input input)) all-dependencies (: (List Module) (list))] - (do (try.with promise.monad) + (do {@ (try.with promise.monad)} [#let [new-dependencies (get@ #///.dependencies compilation) all-dependencies (list@compose new-dependencies all-dependencies) continue! (:share [<type-vars>] diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 3d2e6b3a3..2500af6d3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -213,7 +213,7 @@ (def: #export (save! execute? name code) (All [anchor expression directive] (-> Bit Name directive (Operation anchor expression directive Any))) - (do phase.monad + (do {@ phase.monad} [_ (if execute? (do @ [label (..gensym "save")] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux index aa0ec7995..21a2b4d3f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -102,7 +102,7 @@ (/function.function compile function-name arg-name archive body) (^ (#.Form (list& functionC argsC+))) - (do //.monad + (do {@ //.monad} [[functionT functionA] (/type.with-inference (compile archive functionC))] (case functionA diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux index e85d5c9b4..4638c33d9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -183,7 +183,7 @@ [cursor (#.Tuple sub-patterns)] (/.with-cursor cursor - (do ///.monad + (do {@ ///.monad} [inputT' (simplify-case inputT)] (.case inputT' (#.Product _) @@ -298,7 +298,7 @@ (-> Phase (List [Code Code]) Phase) (.case branches (#.Cons [patternH bodyH] branchesT) - (do ///.monad + (do {@ ///.monad} [[inputT inputA] (//type.with-inference (analyse archive inputC)) outputH (analyse-pattern #.None inputT patternH (analyse archive bodyH)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index ec76fb1f5..896312463 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -238,7 +238,7 @@ (ex.throw redundant-pattern [so-far addition]) ## else - (do try.monad + (do {@ try.monad} [casesM (monad.fold @ (function (_ [tagA coverageA] casesSF') (case (dictionary.get tagA casesSF') @@ -319,7 +319,7 @@ ## This process must be repeated until no further productive ## merges can be done. [_ (#Alt leftS rightS)] - (do try.monad + (do {@ try.monad} [#let [fuse-once (: (-> Coverage (List Coverage) (Try [(Maybe Coverage) (List Coverage)])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index 6bf5fcf06..16bfb7c84 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -41,7 +41,7 @@ (def: #export (function analyse function-name arg-name archive body) (-> Phase Text Text Phase) - (do ///.monad + (do {@ ///.monad} [functionT (///extension.lift macro.expected-type)] (loop [expectedT functionT] (/.with-stack ..cannot-analyse [expectedT function-name arg-name body] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux index 76315bb6c..095120ac5 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -124,7 +124,7 @@ (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args)) (#.ExQ _) - (do ///.monad + (do {@ ///.monad} [[var-id varT] (//type.with-env check.var) output (general archive analyse (maybe.assume (type.apply (list varT) inferT)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux index a4022d942..efa6d96a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -223,7 +223,7 @@ (def: (ensure-undeclared-tags module-name tags) (-> Text (List Tag) (Operation Any)) - (do ///.monad + (do {@ ///.monad} [bindings (..tags module-name) _ (monad.map @ (function (_ tag) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 950c6a360..b4e0846a4 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -31,7 +31,7 @@ (def: (definition def-name) (-> Name (Operation Analysis)) (with-expansions [<return> (wrap (|> def-name ///reference.constant #/.Reference))] - (do ///.monad + (do {@ ///.monad} [constant (///extension.lift (macro.find-def def-name))] (case constant (#.Left real-def-name) @@ -54,7 +54,7 @@ (def: (variable var-name) (-> Text (Operation (Maybe Analysis))) - (do ///.monad + (do {@ ///.monad} [?var (//scope.find var-name)] (case ?var (#.Some [actualT ref]) @@ -69,7 +69,7 @@ (-> Name (Operation Analysis)) (case reference ["" simple-name] - (do ///.monad + (do {@ ///.monad} [?var (variable simple-name)] (case ?var (#.Some varA) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 8d3c03628..7201a68ee 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -90,7 +90,7 @@ (def: #export (sum analyse tag archive) (-> Phase Nat Phase) (function (recur valueC) - (do ///.monad + (do {@ ///.monad} [expectedT (///extension.lift macro.expected-type) expectedT' (//type.with-env (check.clean expectedT))] @@ -170,7 +170,7 @@ (def: (typed-product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) - (do ///.monad + (do {@ ///.monad} [expectedT (///extension.lift macro.expected-type) membersA+ (: (Operation (List Analysis)) (loop [membersT+ (type.flatten-tuple expectedT) @@ -197,7 +197,7 @@ (def: #export (product archive analyse membersC) (-> Archive Phase (List Code) (Operation Analysis)) - (do ///.monad + (do {@ ///.monad} [expectedT (///extension.lift macro.expected-type)] (/.with-stack ..cannot-analyse-tuple [expectedT membersC] (case expectedT @@ -264,7 +264,7 @@ (def: #export (tagged-sum analyse tag archive valueC) (-> Phase Name Phase) - (do ///.monad + (do {@ ///.monad} [tag (///extension.lift (macro.normalize tag)) [idx group variantT] (///extension.lift (macro.resolve-tag tag)) expectedT (///extension.lift macro.expected-type)] @@ -312,7 +312,7 @@ (:: ///.monad wrap [(list) Any]) (#.Cons [head-k head-v] _) - (do ///.monad + (do {@ ///.monad} [head-k (///extension.lift (macro.normalize head-k)) [_ tag-set recordT] (///extension.lift (macro.resolve-tag head-k)) #let [size-record (list.size record) @@ -352,7 +352,7 @@ (analyse archive singletonC) _ - (do ///.monad + (do {@ ///.monad} [members (normalize members) [membersC recordT] (order members) expectedT (///extension.lift macro.expected-type)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index 8a809c493..988d599b7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -44,7 +44,7 @@ (//extension.apply archive recur [name inputs]) (^ [_ (#.Form (list& macro inputs))]) - (do //.monad + (do {@ //.monad} [expansion (/.lift-analysis (do @ [macroA (//analysis/type.with-type Macro 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 0b9c4de2f..473390cd9 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 @@ -108,7 +108,7 @@ (custom [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase [constructorC inputsC]) - (do ////.monad + (do {@ ////.monad} [constructorA (typeA.with-type Any (phase constructorC)) inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC) @@ -132,7 +132,7 @@ (custom [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any))) (function (_ extension phase [methodC objectC inputsC]) - (do ////.monad + (do {@ ////.monad} [objectA (typeA.with-type Any (phase objectC)) inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC) @@ -168,7 +168,7 @@ (custom [($_ <>.and <c>.any (<>.some <c>.any)) (function (_ extension phase [abstractionC inputsC]) - (do ////.monad + (do {@ ////.monad} [abstractionA (typeA.with-type Any (phase abstractionC)) inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 3b001e9db..91d6a6447 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -288,7 +288,7 @@ (/////analysis.throw ..primitives-cannot-have-type-parameters class)) #.None - (do phase.monad + (do {@ phase.monad} [parametersJT (: (Operation (List (Type Parameter))) (monad.map @ (function (_ parameterT) @@ -485,7 +485,7 @@ (phase@map jvm.array)) (#.Primitive name parameters) - (do phase.monad + (do {@ phase.monad} [parameters (monad.map @ check-parameter parameters)] (phase@wrap (jvm.class name parameters))) @@ -511,7 +511,7 @@ (def: (check-object objectT) (-> .Type (Operation External)) - (do phase.monad + (do {@ phase.monad} [name (:: @ map ..reflection (check-jvm objectT))] (if (dictionary.contains? name ..boxes) (/////analysis.throw ..primitives-are-not-objects [name]) @@ -815,7 +815,7 @@ (def: (class-candidate-parents from-name fromT to-name to-class) (-> External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit]))) - (do phase.monad + (do {@ phase.monad} [from-class (phase.lift (reflection!.load from-name)) mapping (phase.lift (reflection!.correspond from-class fromT))] (monad.map @ @@ -842,7 +842,7 @@ (^ (#.Primitive _ (list& self-classT super-classT super-interfacesT+))) (monad.map phase.monad (function (_ superT) - (do phase.monad + (do {@ phase.monad} [super-name (:: @ map ..reflection (check-jvm superT)) super-class (phase.lift (reflection!.load super-name))] (wrap [[super-name superT] @@ -857,7 +857,7 @@ (function (_ extension-name analyse archive args) (case args (^ (list fromC)) - (do phase.monad + (do {@ phase.monad} [toT (///.lift macro.expected-type) to-name (:: @ map ..reflection (check-jvm toT)) [fromT fromA] (typeA.with-inference @@ -1128,7 +1128,7 @@ array.to-list (list@map (|>> java/lang/reflect/TypeVariable::getName))) [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] - (do phase.monad + (do {@ phase.monad} [inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to-list (monad.map @ (|>> reflection!.type phase.lift)) @@ -1166,7 +1166,7 @@ array.to-list (list@map (|>> java/lang/reflect/TypeVariable::getName))) [owner-tvarsT mapping] (jvm-type-var-mapping owner-tvars method-tvars)] - (do phase.monad + (do {@ phase.monad} [inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ (|>> reflection!.type phase.lift)) @@ -1220,7 +1220,7 @@ (def: (method-candidate actual-class-tvars class-name actual-method-tvars method-name method-style inputsJT) (-> (List (Type Var)) External (List (Type Var)) Text Method-Style (List (Type Value)) (Operation Method-Signature)) - (do phase.monad + (do {@ phase.monad} [class (phase.lift (reflection!.load class-name)) #let [expected-class-tvars (class-type-variables class)] candidates (|> class @@ -1252,7 +1252,7 @@ (def: (constructor-candidate actual-class-tvars class-name actual-method-tvars inputsJT) (-> (List (Type Var)) External (List (Type Var)) (List (Type Value)) (Operation Method-Signature)) - (do phase.monad + (do {@ phase.monad} [class (phase.lift (reflection!.load class-name)) #let [expected-class-tvars (class-type-variables class)] candidates (|> class @@ -1469,7 +1469,7 @@ <filter> (monad.map try.monad (function (_ method) - (do try.monad + (do {@ try.monad} [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to-list (monad.map @ reflection!.type)) @@ -1575,7 +1575,7 @@ (let [[visibility strict-fp? annotations vars exceptions self-name arguments super-arguments body] method] - (do phase.monad + (do {@ phase.monad} [annotationsA (monad.map @ (function (_ [name parameters]) (do @ [parametersA (monad.map @ (function (_ [name value]) @@ -1656,7 +1656,7 @@ final? strict-fp? annotations vars self-name arguments return exceptions body] method] - (do phase.monad + (do {@ phase.monad} [annotationsA (monad.map @ (function (_ [name parameters]) (do @ [parametersA (monad.map @ (function (_ [name value]) @@ -1729,7 +1729,7 @@ strict-fp? annotations vars exceptions arguments return body] method] - (do phase.monad + (do {@ phase.monad} [annotationsA (monad.map @ (function (_ [name parameters]) (do @ [parametersA (monad.map @ (function (_ [name value]) @@ -1803,7 +1803,7 @@ strict-fp? annotations vars self-name arguments return exceptions body] method] - (do phase.monad + (do {@ phase.monad} [annotationsA (monad.map @ (function (_ [name parameters]) (do @ [parametersA (monad.map @ (function (_ [name value]) @@ -1916,7 +1916,7 @@ super-interfaces constructor-args methods]) - (do phase.monad + (do {@ phase.monad} [parameters (typeA.with-env (..parameter-types parameters)) #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 1ae9bacf1..dd428c7dc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -54,7 +54,7 @@ (function (_ extension-name analyse archive args) (let [num-actual (list.size args)] (if (n.= num-expected num-actual) - (do ////.monad + (do {@ ////.monad} [_ (typeA.infer outputT) argsA (monad.map @ (function (_ [argT argC]) @@ -102,7 +102,7 @@ <c>.any))) <c>.any) (function (_ extension-name phase archive [input conditionals else]) - (do ////.monad + (do {@ ////.monad} [input (typeA.with-type text.Char (phase archive input)) expectedT (///.lift macro.expected-type) @@ -164,7 +164,7 @@ (function (_ extension-name analyse archive args) (case args (^ (list typeC valueC)) - (do ////.monad + (do {@ ////.monad} [count (///.lift macro.count) actualT (:: @ map (|>> (:coerce Type)) (eval archive count Type typeC)) @@ -180,7 +180,7 @@ (function (_ extension-name analyse archive args) (case args (^ (list typeC valueC)) - (do ////.monad + (do {@ ////.monad} [count (///.lift macro.count) actualT (:: @ map (|>> (:coerce Type)) (eval archive count Type typeC)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index cb3277591..5a2770b70 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -257,7 +257,7 @@ annotations fields methods]) - (do phase.monad + (do {@ phase.monad} [parameters (directive.lift-analysis (typeA.with-env (jvm.parameter-types parameters))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 96eb95f41..b9ae14372 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -111,7 +111,7 @@ (All [anchor expression directive] (-> Archive Name (Maybe Type) Code (Operation anchor expression directive [Type expression Any]))) - (do phase.monad + (do {@ phase.monad} [state (///.lift phase.get-state) #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) @@ -256,7 +256,7 @@ (..custom [($_ p.and s.any ..imports) (function (_ extension-name phase archive [annotationsC imports]) - (do phase.monad + (do {@ phase.monad} [[_ annotationsT annotationsV] (evaluate! archive Code annotationsC) #let [annotationsV (:coerce Code annotationsV)] _ (/////directive.lift-analysis diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 880ada9a2..6ef13f3a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -133,7 +133,7 @@ (<s>.tuple (<>.many <s>.i64)) <s>.any)))) (function (_ extension-name phase archive [input else conditionals]) - (do /////.monad + (do {@ /////.monad} [inputG (phase archive input) elseG (phase archive else) conditionalsG (: (Operation (List [(List Literal) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 1f526a0a8..16e5e5996 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -61,7 +61,7 @@ (custom [($_ <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [constructorS inputsS]) - (do ////////phase.monad + (do {@ ////////phase.monad} [constructorG (phase archive constructorS) inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.new constructorG inputsG))))])) @@ -80,7 +80,7 @@ (custom [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) - (do ////////phase.monad + (do {@ ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.do methodS inputsG objectG))))])) @@ -118,7 +118,7 @@ (custom [($_ <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) - (do ////////phase.monad + (do {@ ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map @ (phase archive) inputsS)] (wrap (_.apply/* abstractionG inputsG))))])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index f4db9b89a..f925a2877 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -105,7 +105,7 @@ (<s>.tuple (<>.many <s>.i64)) <s>.any)))) (function (_ extension-name phase archive [inputS elseS conditionalsS]) - (do /////.monad + (do {@ /////.monad} [@end ///runtime.forge-label inputG (phase archive inputS) elseG (phase archive elseS) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index ee5bbf4d6..026b31c70 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -749,7 +749,7 @@ (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) (function (_ extension-name generate archive [class method outputT inputsTS]) - (do //////.monad + (do {@ //////.monad} [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose (monad.map _.monad product.right inputsTG) @@ -762,7 +762,7 @@ (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) (function (_ extension-name generate archive [class method outputT objectS inputsTS]) - (do //////.monad + (do {@ //////.monad} [objectG (generate archive objectS) inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose @@ -782,7 +782,7 @@ (..custom [($_ <>.and ..class (<>.some ..input)) (function (_ extension-name generate archive [class inputsTS]) - (do //////.monad + (do {@ //////.monad} [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] (wrap ($_ _.compose (_.new class) @@ -946,7 +946,7 @@ (def: (anonymous-instance archive class env) (-> Archive (Type category.Class) Environment (Operation (Bytecode Any))) - (do //////.monad + (do {@ //////.monad} [captureG+ (monad.map @ (///reference.variable archive) env)] (wrap ($_ _.compose (_.new class) @@ -995,7 +995,7 @@ (function (_ extension-name generate archive [super-class super-interfaces inputsTS overriden-methods]) - (do //////.monad + (do {@ //////.monad} [[context _] (//////generation.with-new-context archive (wrap [])) #let [[module-id artifact-id] context anonymous-class-name (///runtime.class-name context) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/function.lux index 3dcc24448..22c34fd21 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/function.lux @@ -25,7 +25,7 @@ (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [functionG (generate functionS) argsG+ (monad.map @ generate argsS+)] (wrap (_.funcall/+ [functionG argsG+])))) @@ -40,7 +40,7 @@ (:: ////.monad wrap function-definition) _ - (do ////.monad + (do {@ ////.monad} [@closure (:: @ map _.var (///.gensym "closure"))] (wrap (_.labels (list [@closure [(|> (list.enumerate inits) (list@map (|>> product.left ..capture)) @@ -53,7 +53,7 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [[function-name bodyG] (///.with-context (do @ [function-name ///.context] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/loop.lux index a00fc2b12..7abad4556 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/loop.lux @@ -22,7 +22,7 @@ (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [@scope (:: @ map (|>> %.nat (format "scope") _.var) ///.next) initsG+ (monad.map @ generate initsS+) bodyG (///.with-anchor @scope @@ -36,7 +36,7 @@ (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [@scope ///.anchor argsO+ (monad.map @ generate argsS+)] (wrap (_.call/* @scope argsO+)))) 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 79b2f5ea3..fae712418 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 @@ -30,7 +30,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 @ + (do {@ macro.monad} [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)] @@ -59,6 +59,6 @@ (-> (Variadic expression) (generation.Handler anchor expression directive))) (function (_ extension-name) (function (_ phase archive inputsS) - (do ///.monad + (do {@ ///.monad} [inputsI (monad.map @ (phase archive) inputsS)] (wrap (extension inputsI)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 81b9752a3..4a61407da 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -27,7 +27,7 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [functionO (generate archive functionS) argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) @@ -55,7 +55,7 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context (do @ [function-name (:: @ map ///reference.artifact-name diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 53b0a3f19..01312ba83 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -24,7 +24,7 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @scope (generate archive bodyS)) @@ -37,7 +37,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@scope /////generation.anchor argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index aaea204bc..07fc172a6 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -25,7 +25,7 @@ (generate archive singletonS) _ - (do ///////phase.monad + (do {@ ///////phase.monad} [elemsT+ (monad.map @ (generate archive) elemsS+)] (wrap (_.array elemsT+))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 7694b6b34..788919379 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -116,7 +116,7 @@ (def: #export (apply generate archive [abstractionS inputsS]) (Generator Apply) - (do phase.monad + (do {@ phase.monad} [abstractionG (generate archive abstractionS) inputsG (monad.map @ (generate archive) inputsS)] (wrap ($_ _.compose diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index 991745ff0..ab8f4f911 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -52,7 +52,7 @@ (def: #export (instance archive class environment arity) (-> Archive (Type Class) Environment Arity (Operation (Bytecode Any))) - (do phase.monad + (do {@ phase.monad} [foreign* (monad.map @ (////reference.variable archive) environment)] (wrap (instance' foreign* class environment arity)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 86b9aa095..543c14a4b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -111,7 +111,7 @@ (_.putstatic (type.class bytecode-name (list)) ..value::field ..value::type) _.return)))) (row.row))] - (io.run (do (try.with io.monad) + (io.run (do {@ (try.with io.monad)} [bytecode (:: @ map (format.run class.writer) (io.io bytecode)) _ (loader.store eval-class bytecode library) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index d2a900a87..5e07ea35a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -37,7 +37,7 @@ (def: #export (recur translate archive updatesS) (Generator (List Synthesis)) - (do phase.monad + (do {@ phase.monad} [[@begin offset] generation.anchor updatesG (|> updatesS list.enumerate @@ -71,7 +71,7 @@ (def: #export (scope translate archive [offset initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) - (do phase.monad + (do {@ phase.monad} [@begin //runtime.forge-label initsI+ (monad.map @ (translate archive) initsS+) iterationG (generation.with-anchor [@begin offset] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index d60f9a8b3..7bd43b8aa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -39,7 +39,7 @@ (def: (foreign archive variable) (-> Archive Register (Operation (Bytecode Any))) - (do ////.monad + (do {@ ////.monad} [bytecode-name (:: @ map //runtime.class-name (generation.context archive))] (wrap ($_ _.compose @@ -59,7 +59,7 @@ (def: #export (constant archive name) (-> Archive Name (Operation (Bytecode Any))) - (do ////.monad + (do {@ ////.monad} [bytecode-name (:: @ map //runtime.class-name (generation.remember archive name))] (wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index a324b0bec..361218ece 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -34,7 +34,7 @@ (generate archive singletonS) _ - (do phase.monad + (do {@ phase.monad} [membersI (|> membersS list.enumerate (monad.map @ (function (_ [idx member]) @@ -45,7 +45,7 @@ _ (_.int (.i64 idx)) _ memberI] _.aastore))))))] - (wrap (do _.monad + (wrap (do {@ _.monad} [_ (_.int (.i64 (list.size membersS))) _ (_.anewarray $Object)] (monad.seq @ membersI)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 23697cfcb..c99ec5d8f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -27,7 +27,7 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [functionO (generate archive functionS) argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ functionO)))) @@ -45,7 +45,7 @@ (wrap (|> (_.var function-name) (_.apply/* inits)))) _ - (do ///////phase.monad + (do {@ ///////phase.monad} [@closure (:: @ map _.var (/////generation.gensym "closure")) _ (/////generation.save! true ["" (_.code @closure)] (_.function @closure @@ -61,7 +61,7 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context (do @ [function-name (:: @ map ///reference.artifact-name diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 993ac4312..df70c74aa 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -27,7 +27,7 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@loop (:: @ map ..loop-name /////generation.next) initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @loop @@ -41,7 +41,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@scope /////generation.anchor argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux index cbdbb1c70..bbe47a057 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -216,7 +216,7 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [initG (generate valueS) pattern-matching! (pattern-matching generate pathP) @case (..gensym "case") diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux index 6e75f37bc..fe24f7911 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -26,7 +26,7 @@ (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [functionG (generate functionS) argsG+ (monad.map @ generate argsS+)] (wrap (_.apply/* argsG+ functionG)))) @@ -39,7 +39,7 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [[function-name bodyG] (///.with-context (do @ [function-name ///.context] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 3ec2d2d40..1b68c0b7a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -22,7 +22,7 @@ (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [@loop (:: @ map (|>> %.nat (format "loop")) ///.next) #let [@loopG (_.global @loop) @loopL (_.var @loop)] @@ -43,7 +43,7 @@ (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation (Expression Any))) - (do ////.monad + (do {@ ////.monad} [@scope ///.anchor argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index ded751c2e..d10f54edc 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -27,7 +27,7 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [functionO (generate archive functionS) argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) @@ -45,7 +45,7 @@ (wrap (_.apply/* (_.var function-name) inits))) _ - (do ///////phase.monad + (do {@ ///////phase.monad} [@closure (:: @ map _.var (/////generation.gensym "closure")) _ (/////generation.save! true ["" (_.code @closure)] (_.def @closure @@ -61,7 +61,7 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context (do @ [function-name (:: @ map ///reference.artifact-name diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 61c534618..27c74faee 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -27,7 +27,7 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@loop (:: @ map ..loop-name /////generation.next) initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @loop @@ -41,7 +41,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@scope /////generation.anchor argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index b4b89e375..08691f6f2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -27,7 +27,7 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [functionO (generate archive functionS) argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.do "call" argsO+ functionO)))) @@ -54,7 +54,7 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context (do @ [function-name (:: @ map ///reference.artifact-name diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index 1112aa00d..f5a2f1615 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -27,7 +27,7 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@loop (:: @ map ..loop-name /////generation.next) initsO+ (monad.map @ (generate archive) initsS+) bodyO (/////generation.with-anchor @loop @@ -41,7 +41,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do ///////phase.monad + (do {@ ///////phase.monad} [@scope /////generation.anchor argsO+ (monad.map @ (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index 861032fc7..a413a878a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -164,7 +164,7 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) - (do ////.monad + (do {@ ////.monad} [valueO (generate valueS)] (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] [@savepoint (_.list/* (list))]))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index 19776e6f5..d5da7253a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -39,7 +39,7 @@ (syntax: (arity: {name s.local-identifier} {arity s.nat}) (with-gensyms [g!_ g!extension g!name g!phase g!inputs] - (do @ + (do {@ macro.monad} [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) @@ -66,7 +66,7 @@ (-> Variadic Handler) (function (_ extension-name) (function (_ phase inputsS) - (do /////.monad + (do {@ /////.monad} [inputsI (monad.map @ phase inputsS)] (wrap (extension inputsI)))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux index 797e31e1d..59311ce15 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux @@ -27,7 +27,7 @@ (def: #export (apply generate [functionS argsS+]) (-> Phase (Application Synthesis) (Operation Computation)) - (do ////.monad + (do {@ ////.monad} [functionO (generate functionS) argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* functionO argsO+)))) @@ -59,7 +59,7 @@ (def: #export (function generate [environment arity bodyS]) (-> Phase (Abstraction Synthesis) (Operation Computation)) - (do ////.monad + (do {@ ////.monad} [[function-name bodyO] (///.with-context (do @ [function-name ///.context] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux index 294b3ed2d..a8a8447ef 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux @@ -23,7 +23,7 @@ (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation Computation)) - (do ////.monad + (do {@ ////.monad} [initsO+ (monad.map @ generate initsS+) bodyO (///.with-anchor @scope (generate bodyS))] @@ -36,7 +36,7 @@ (def: #export (recur generate argsS+) (-> Phase (List Synthesis) (Operation Computation)) - (do ////.monad + (do {@ ////.monad} [@scope ///.anchor argsO+ (monad.map @ generate argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux index f435442cc..d56ae6504 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux @@ -22,7 +22,7 @@ (generate singletonS) _ - (do ///.monad + (do {@ ///.monad} [elemsT+ (monad.map @ generate elemsS+)] (wrap (_.vector/* elemsT+))))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index 572db842f..44b627b6c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -85,7 +85,7 @@ (#try.Failure _) (<| (phase.run' state) - (do phase.monad + (do {@ phase.monad} [argsS+ (monad.map @ phase' args)] (wrap (#/.Extension [name argsS+]))))))) ))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 56a0a1f2e..149d3e69a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -128,7 +128,7 @@ (def: #export (synthesize synthesize^ [headB tailB+] archive inputA) (-> Phase Match Phase) - (do ///.monad + (do {@ ///.monad} [inputS (synthesize^ archive inputA)] (with-expansions [<unnecesary-let> (as-is (^multi (^ (#///analysis.Reference (///reference.local outputR))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 7fe35a6c3..02258a7b1 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -44,7 +44,7 @@ (-> Phase Phase) (function (_ archive exprA) (let [[funcA argsA] (////analysis.application exprA)] - (do phase.monad + (do {@ phase.monad} [funcS (phase archive funcA) argsS (monad.map @ (phase archive) argsA) ## locals /.locals @@ -164,7 +164,7 @@ (#/.Loop loop) (case loop (#/.Scope [start initsS+ iterationS]) - (do phase.monad + (do {@ phase.monad} [initsS+' (monad.map @ (grow environment) initsS+) iterationS' (grow environment iterationS)] (wrap (/.loop/scope [start initsS+' iterationS']))) @@ -188,7 +188,7 @@ (list@compose pre-argsS+ argsS+)])) _ - (do phase.monad + (do {@ phase.monad} [funcS' (grow environment funcS) argsS+' (monad.map @ (grow environment) argsS+)] (wrap (/.function/apply [funcS' argsS+'])))))) @@ -203,7 +203,7 @@ (def: #export (abstraction phase environment archive bodyA) (-> Phase Environment Phase) - (do phase.monad + (do {@ phase.monad} [bodyS (phase archive bodyA)] (case bodyS (^ (/.function/abstraction [env' down-arity' bodyS'])) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 113d834dc..911c2796b 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -125,7 +125,7 @@ (def: #export parser (Parser Registry) (let [category (: (Parser Category) - (do <>.monad + (do {@ <>.monad} [tag <b>.nat] (case tag 0 (:: @ map (|>> #Anonymous) <b>.any) diff --git a/stdlib/source/lux/tool/compiler/meta/cache.lux b/stdlib/source/lux/tool/compiler/meta/cache.lux index fbf7fe128..72de6d285 100644 --- a/stdlib/source/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/lux/tool/compiler/meta/cache.lux @@ -55,7 +55,7 @@ (All [m] (-> (System m) File (m (List File)))) (|> root (//io/archive.archive System<m>) - (do> (:: System<m> &monad) + (do> {@ (:: System<m> &monad)} [(:: System<m> files)] [(monad.map @ (function (recur file) (do @ @@ -84,7 +84,7 @@ (All [m] (-> (System m) File Module (m Any))) (let [document (//io/archive.document System<m> root module)] (|> document - (do> (:: System<m> &monad) + (do> {@ (:: System<m> &monad)} [(:: System<m> files)] [(monad.map @ (function (_ file) (do @ @@ -101,7 +101,7 @@ (def: #export (clean System<m> root wanted-modules) (All [m] (-> (System m) File (Set Module) (m Any))) (|> root - (do> (:: System<m> &monad) + (do> {@ (:: System<m> &monad)} [(..cached System<m>)] [(list.filter (bit.complement (set.member? wanted-modules))) (monad.map @ (un-install System<m> root))]))) @@ -122,7 +122,7 @@ (def: (load-document System<m> contexts root key binary module) (All [m d] (-> (System m) (List File) File (Key d) (Format d) Module (m (Maybe [Dependency (Document d)])))) - (do (:: System<m> &monad) + (do {@ (:: System<m> &monad)} [document' (:: System<m> read (//io/archive.document System<m> root module)) [module' source-code] (//io/context.read System<m> contexts module) #let [current-hash (:: text.hash hash source-code)]] @@ -147,7 +147,7 @@ (def: #export (load-archive System<m> contexts root key binary) (All [m d] (-> (System m) (List Context) File (Key d) (Format d) (m Archive))) - (do (:: System<m> &monad) + (do {@ (:: System<m> &monad)} [candidate (|> root (do> @ [(..cached System<m>)] diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index ef73d321d..0dbabd454 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -79,7 +79,7 @@ (def: #export (prepare system host root module-id) (-> (file.System Promise) Host Path archive.ID (Promise (Try Any))) - (do promise.monad + (do {@ promise.monad} [#let [module (..module system host root module-id)] module-exists? (file.exists? promise.monad system module)] (if module-exists? @@ -163,7 +163,7 @@ (def: (analysis-state host archive) (-> Host Archive (Try .Lux)) - (do try.monad + (do {@ try.monad} [modules (: (Try (List [Module .Module])) (monad.map @ (function (_ module) (do @ @@ -175,7 +175,7 @@ (def: (cached-artifacts system host root module-id) (-> (file.System Promise) Host Path archive.ID (Promise (Try (Dictionary Text Binary)))) - (do (try.with promise.monad) + (do {@ (try.with promise.monad)} [module-dir (!.use (:: system directory) (..module system host root module-id)) cached-files (!.use (:: module-dir files) [])] (|> cached-files @@ -215,7 +215,7 @@ (All [expression directive] (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module) (Try [(Document .Module) Bundles]))) - (do try.monad + (do {@ try.monad} [[definitions bundles] (: (Try [Definitions Bundles]) (loop [input (row.to-list expected) definitions (: Definitions @@ -322,7 +322,7 @@ (Promise (Try [Archive .Lux Bundles])))) - (do (try.with promise.monad) + (do {@ (try.with promise.monad)} [pre-loaded-caches (|> archive archive.reservations (monad.map @ (function (_ [module-name module-id]) diff --git a/stdlib/source/lux/tool/interpreter.lux b/stdlib/source/lux/tool/interpreter.lux index 9eda33dc5..5a1b30d06 100644 --- a/stdlib/source/lux/tool/interpreter.lux +++ b/stdlib/source/lux/tool/interpreter.lux @@ -95,7 +95,7 @@ (def: (interpret-expression code) (All [anchor expression directive] (-> Code <Interpretation>)) - (do phase.monad + (do {@ phase.monad} [state (extension.lift phase.get-state) #let [analyse (get@ [#directive.analysis #directive.phase] state) synthesize (get@ [#directive.synthesis #directive.phase] state) @@ -193,7 +193,7 @@ Configuration (generation.Bundle anchor expression directive) (! Any))) - (do Monad<!> + (do {@ Monad<!>} [state (initialize Monad<!> Console<!> platform configuration)] (loop [context {#configuration configuration #state state diff --git a/stdlib/source/lux/tool/mediator/parallelism.lux b/stdlib/source/lux/tool/mediator/parallelism.lux deleted file mode 100644 index 10aaa0b0e..000000000 --- a/stdlib/source/lux/tool/mediator/parallelism.lux +++ /dev/null @@ -1,168 +0,0 @@ -(.module: - [lux (#- Source Module) - [control - ["." monad (#+ Monad do)] - ["." try (#+ Try) ("#;." monad)] - ["ex" exception (#+ exception:)]] - [concurrency - ["." promise (#+ Promise) ("#;." functor)] - ["." task (#+ Task)] - ["." stm (#+ Var STM)]] - [data - ["." text ("#;." equivalence)] - [collection - ["." list ("#;." functor)] - ["." dictionary (#+ Dictionary)]]] - ["." io]] - ["." // (#+ Source Mediator) - [// - ["." compiler (#+ Input Output Compilation Compiler) - [meta - ["." archive (#+ Archive) - ["." descriptor (#+ Module Descriptor)] - [document (#+ Document)]] - [io - ["." context]]]]]]) - -(exception: #export (self-dependency {module Module}) - (ex.report ["Module" module])) - -(exception: #export (circular-dependency {module Module} {dependency Module}) - (ex.report ["Module" module] - ["Dependency" dependency])) - -(type: Pending-Compilation - (Promise (Try (Ex [d] (Document d))))) - -(type: Active-Compilations - (Dictionary Module [Descriptor Pending-Compilation])) - -(def: (self-dependence? module dependency) - (-> Module Module Bit) - (text;= module dependency)) - -(def: (circular-dependence? active dependency) - (-> Active-Compilations Module Bit) - (case (dictionary.get dependency active) - (#.Some [descriptor pending]) - (case (get@ #descriptor.state descriptor) - #.Active - true - - _ - false) - - #.None - false)) - -(def: (ensure-valid-dependencies! active dependencies module) - (-> Active-Compilations (List Module) Module (Task Any)) - (do task.monad - [_ (: (Task Any) - (if (list.any? (self-dependence? module) dependencies) - (task.throw self-dependency module) - (wrap [])))] - (: (Task Any) - (case (list.find (circular-dependence? active) dependencies) - (#.Some dependency) - (task.throw circular-dependency module dependency) - - #.None - (wrap []))))) - -(def: (share-compilation archive pending) - (-> Active-Compilations Pending-Compilation (Task Archive)) - (promise;map (|>> (try;map (function (_ document) - (archive.add module document archive))) - try;join) - pending)) - -(def: (import Monad<!> mediate archive dependencies) - (All [!] (-> (Monad !) (Mediator !) Active-Compilations (List Module) (! (List Archive)))) - (|> dependencies - (list;map (mediate archive)) - (monad.seq Monad<!>))) - -(def: (step-compilation archive imports [dependencies process]) - (All [d o] (-> Archive (List Archive) (Compilation d o) - [Archive (Either (Compilation d o) - [(Document d) (Output o)])])) - (do try.monad - [archive' (monad.fold try.monad archive.merge archive imports) - outcome (process archive')] - (case outcome - (#.Right [document output]) - (do @ - [archive'' (archive.add module document archive')] - (wrap [archive'' (#.Right [document output])])) - - (#.Left continue) - (wrap [archive' outcome])))) - -(def: (request-compilation file-system sources module compilations) - (All [!] - (-> (file.System Task) (List Source) Module (Var Active-Compilations) - (Task (Either Pending-Compilation - [Pending-Compilation Active-Compilations Input])))) - (do (:: file-system &monad) - [current (|> (stm.read compilations) - stm.commit - task.from-promise)] - (case (dictionary.get module current) - (#.Some [descriptor pending]) - (wrap (#.Left pending)) - - #.None - (do @ - [input (context.read file-system sources module)] - (do stm.monad - [stale (stm.read compilations)] - (case (dictionary.get module stale) - (#.Some [descriptor pending]) - (wrap (#.Left [pending current])) - - #.None - (do @ - [#let [base-descriptor {#descriptor.hash (get@ #compiler.hash input) - #descriptor.name (get@ #compiler.module input) - #descriptor.file (get@ #compiler.file input) - #descriptor.references (list) - #descriptor.state #.Active} - pending (promise.promise (: (Maybe (Try (Ex [d] (Document d)))) - #.None))] - updated (stm.update (dictionary.put (get@ #compiler.module input) - [base-descriptor pending]) - compilations)] - (wrap (is? current stale) - (#.Right [pending updated input]))))))))) - -(def: (mediate-compilation Monad<!> mediate compiler input archive pending) - (All [! d o] (-> (Monad !) (Mediator ! d o) (Compiler d o) Input Archive Pending-Compilation (Task Archive))) - (loop [archive archive - compilation (compiler input)] - (do Monad<!> - [#let [[dependencies process] compilation] - _ (ensure-valid-dependencies! active dependencies (get@ #compiler.module input)) - imports (import @ mediate archive dependencies) - [archive' next] (promise;wrap (step-compilation archive imports compilation))] - (case next - (#.Left continue) - (recur archive' continue) - - (#.Right [document output]) - (exec (io.run (promise.resolve (#try.Success document) pending)) - (wrap archive')))))) - -(def: #export (mediator file-system sources compiler) - (//.Instancer Task) - (let [compilations (: (Var Active-Compilations) - (stm.var (dictionary.new text.hash)))] - (function (mediate archive module) - (do (:: file-system &monad) - [request (request-compilation file-system sources module compilations)] - (case request - (#.Left pending) - (share-compilation archive pending) - - (#.Right [pending active input]) - (mediate-compilation @ mediate compiler input archive pending)))))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 161cee0f7..73453902a 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -354,7 +354,7 @@ s.any)}) (case input (#.Left valueN) - (do @ + (do macro.monad [cursor macro.cursor valueT (macro.find-type valueN) #let [_ (log! ($_ text@compose @@ -422,7 +422,7 @@ ["Type" (..to-text type)])) (syntax: #export (:hole) - (do @ + (do macro.monad [cursor macro.cursor expectedT macro.expected-type] (macro.fail (exception.construct ..hole-type [cursor expectedT])))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index aa00fa4fd..f3631ea93 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -155,7 +155,7 @@ (template [<name> <from> <to>] [(syntax: #export (<name> {[scope value] cast}) - (do @ + (do macro.monad [[name type-vars abstraction representation] (peek! scope)] (wrap (list (` ((~! :cast) [(~+ type-vars)] (~ <from>) (~ <to>) (~ value)))))))] @@ -190,7 +190,7 @@ {annotations (<>.default cs.empty-annotations csr.annotations)} representation-type {primitives (<>.some <c>.any)}) - (do @ + (do macro.monad [current-module macro.current-module-name #let [type-varsC (list@map code.local-identifier type-vars) abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index b561823ee..98a463948 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -354,7 +354,7 @@ (do ..monad [_ (..bind type id)] then) - (do ..monad + (do {@ ..monad} [ring (..ring id) _ (assert "" (n.> 1 (set.size ring))) _ (monad.map @ (update type) (set.to-list ring))] @@ -382,7 +382,7 @@ (-> (Checker Type) (Checker Var)) (if (!n/= idE idA) (check@wrap assumptions) - (do ..monad + (do {@ ..monad} [ebound (attempt (peek idE)) abound (attempt (peek idA))] (case [ebound abound] @@ -695,7 +695,7 @@ (^template [<tag>] (<tag> envT+ unquantifiedT) - (do ..monad + (do {@ ..monad} [envT+' (monad.map @ clean envT+)] (wrap (<tag> envT+' unquantifiedT)))) ([#.UnivQ] [#.ExQ]) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 1e55c2ab1..c8cebcca9 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -86,7 +86,7 @@ [member (macro.normalize member) _ (macro.resolve-tag member)] (wrap member)) - (do macro.monad + (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) @@ -138,14 +138,14 @@ (def: local-structs (Meta (List [Name Type])) - (do macro.monad + (do {@ macro.monad} [this-module-name macro.current-module-name] (:: @ map (prepare-definitions this-module-name this-module-name) (macro.definitions this-module-name)))) (def: import-structs (Meta (List [Name Type])) - (do macro.monad + (do {@ macro.monad} [this-module-name macro.current-module-name imp-mods (macro.imported-modules this-module-name) export-batches (monad.map @ (function (_ imp-mod) @@ -210,7 +210,7 @@ (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context - (do check.monad + (do {@ check.monad} [[tvars alt-type] (concrete-type alt-type) #let [[deps alt-type] (type.flatten-function alt-type)] _ (check.check dep alt-type) @@ -259,7 +259,7 @@ (case (|> alts (list@map (function (_ [alt-name alt-type]) (case (check.run context - (do check.monad + (do {@ check.monad} [[tvars alt-type] (concrete-type alt-type) #let [[deps alt-type] (type.flatten-function alt-type)] _ (check.check alt-type sig-type) @@ -339,7 +339,7 @@ "Otherwise, this macro will not find it.")} (case args (#.Left [args _]) - (do @ + (do {@ macro.monad} [[member-idx sig-type] (resolve-member member) input-types (monad.map @ resolve-type args) output-type macro.expected-type @@ -361,7 +361,7 @@ " --- for type: " (%.type sig-type))))) (#.Right [args _]) - (do @ + (do {@ macro.monad} [labels (|> (macro.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))))))) @@ -378,7 +378,7 @@ (s.tuple (p.many s.any))) (syntax: #export (implicit {structures ..implicits} body) - (do @ + (do macro.monad [g!implicit+ (implicit-bindings (list.size structures))] (wrap (list (` (let [(~+ (|> (list.zip2 g!implicit+ structures) (list@map (function (_ [g!implicit structure]) @@ -387,7 +387,7 @@ (~ body))))))) (syntax: #export (implicit: {structures ..implicits}) - (do @ + (do macro.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/resource.lux b/stdlib/source/lux/type/resource.lux index 9f3a12680..a49c49f2a 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -134,7 +134,7 @@ (def: indices (Parser (List Nat)) (s.tuple (loop [seen (set.new n.hash)] - (do p.monad + (do {@ p.monad} [done? s.end?] (if done? (wrap (list)) @@ -157,7 +157,7 @@ (wrap (list (` ((~! no-op) <monad>)))) (#.Cons head tail) - (do macro.monad + (do {@ macro.monad} [#let [max-idx (list@fold n.max head tail)] g!inputs (<| (monad.seq @) (list.repeat (inc max-idx)) (macro.gensym "input")) #let [g!outputs (|> (monad.fold maybe.monad @@ -194,7 +194,7 @@ (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) (macro.with-gensyms [g!_ g!context] - (do macro.monad + (do {@ macro.monad} [g!keys (<| (monad.seq @) (list.repeat amount) (macro.gensym "keys"))] (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] (Procedure (~! <m>) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 469cc6e01..6cd802296 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -363,7 +363,7 @@ [(def: <name> (..can-query (function (<name> _) - (do (try.with io.monad) + (do {@ (try.with io.monad)} [?children (java/io/File::listFiles (java/io/File::new path))] (case ?children (#.Some children) @@ -541,7 +541,7 @@ (..can-query (function (<name> _) (io.io (let [fs (!fs)] - (do try.monad + (do {@ try.monad} [subs (Fs::readdirSync [path] fs) subs (monad.map @ (function (_ sub) (do @ diff --git a/stdlib/source/lux/world/net/http/query.lux b/stdlib/source/lux/world/net/http/query.lux index e5793021a..05946c427 100644 --- a/stdlib/source/lux/world/net/http/query.lux +++ b/stdlib/source/lux/world/net/http/query.lux @@ -20,7 +20,7 @@ (Parser Text) (p.rec (function (_ component) - (do p.monad + (do {@ p.monad} [head (l.some (l.none-of "+%&;"))] ($_ p.either (p.after (p.either l.end @@ -44,7 +44,7 @@ (do p.monad [_ l.end] (wrap context)) - (do p.monad + (do {@ p.monad} [key (l.some (l.none-of "=&;")) key (l.local key ..component)] (p.either (do @ diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index f62654091..804d24324 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -150,7 +150,7 @@ (def: #export (execute environment command arguments) (-> Context Text (List Text) (IO (Try (Console IO)))) (`` (for {(~~ (static host.old)) - (do (try.with io.monad) + (do {@ (try.with io.monad)} [windows? (:: @ map (|>> java/lang/String::toLowerCase ..windows?) (java/lang/System::getProperty "os.name")) #let [builder (java/lang/ProcessBuilder::new (arguments-array (list& (sanitize-command windows? command) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 5ecdaf12a..3ee6fb5c5 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -42,7 +42,7 @@ ["." /]}) (poly: #export equivalence - (`` (do @ + (`` (do {@ p.monad} [#let [g!_ (code.local-identifier "_____________")] *env* <type>.env inputT <type>.peek diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 747d3c811..4fdff71ef 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -24,7 +24,7 @@ ["." /]}) (poly: #export functor - (do @ + (do {@ p.monad} [#let [type-funcC (code.local-identifier "____________type-funcC") funcC (code.local-identifier "____________funcC") inputC (code.local-identifier "____________inputC")] diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index b8c43df31..e23d5648c 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -118,7 +118,7 @@ [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do @ + (do {@ p.monad} [*env* <type>.env #let [@JSON//encode (: (-> Type Code) (function (_ type) @@ -233,9 +233,8 @@ ## [instant.Instant instant.codec] [date.Date date.codec] [day.Day day.codec] - [month.Month month.codec]) - ] - (do @ + [month.Month month.codec])] + (do {@ p.monad} [*env* <type>.env #let [@JSON//decode (: (-> Type Code) (function (_ type) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index ecce5fa65..8993f21e7 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -84,7 +84,7 @@ Configuration [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path] (Promise Any))) - (do promise.monad + (do {@ promise.monad} [platform (promise.future platform) console (|> console.system promise.future diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index f44abef88..419e8a4c9 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -375,7 +375,7 @@ (def: (document-types module types) (-> Text (List Value) (Meta (Markdown Block))) - (do macro.monad + (do {@ macro.monad} [type-docs (monad.map @ (: (-> Value (Meta (Markdown Block))) (function (_ [name def-annotations type]) @@ -498,7 +498,7 @@ (wrap []))))) (macro: (gen-documentation! _) - (do macro.monad + (do {@ macro.monad} [all-modules macro.modules #let [lux-modules (|> all-modules (list.filter (function.compose lux-module? product.left)) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 414b468e2..b4fa47b99 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -64,7 +64,7 @@ [r.i64 synthesis.i64 synthesis.path/i64] [r.frac synthesis.f64 synthesis.path/f64] [(r.unicode 5) synthesis.text synthesis.path/text])) - (do r.monad + (do {@ r.monad} [size ..size idx (|> r.nat (:: @ map (n.% size))) [subS subP] case @@ -79,7 +79,7 @@ (synthesis.member/left idx)) subP)]] (wrap [caseS caseP])) - (do r.monad + (do {@ r.monad} [size ..size idx (|> r.nat (:: @ map (n.% size))) [subS subP] case diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index c2289571a..5868191c4 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -174,7 +174,7 @@ (def: (text run) (-> Runner Test) - (do r.monad + (do {@ r.monad} [sample-size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) sample-lower (r.ascii/lower-alpha sample-size) sample-upper (r.ascii/upper-alpha sample-size) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index 9af307287..3de0301b8 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -46,7 +46,7 @@ (def: #export (spec run) (-> Runner Test) - (do r.monad + (do {@ r.monad} [[arity local functionS] ..function partial-arity (|> r.nat (:: @ map (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe-frac) diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux index 5da59d0b4..8c53db6c6 100644 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -39,7 +39,7 @@ (def: (variable run) (-> Runner Test) - (do r.monad + (do {@ r.monad} [register (|> r.nat (:: @ map (n.% 100))) expected r.safe-frac] (_.test "Local variables." diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index 0697e5338..e16702d3e 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -30,7 +30,7 @@ (def: (variant run) (-> Runner Test) - (do r.monad + (do {@ r.monad} [num-tags (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tag-in (|> r.nat (:: @ map (n.% num-tags))) #let [last?-in (|> num-tags dec (n.= tag-in))] @@ -65,7 +65,7 @@ (def: (tuple run) (-> Runner Test) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tuple-in (r.list size r.i64)] (_.test (%.name (name-of synthesis.tuple)) diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index 61bdbb0b2..619d9c711 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -42,7 +42,7 @@ (def: period (Random (Period Nat)) - (do r.monad + (do {@ r.monad} [start (r.filter (|>> (n.= n@top) not) r.nat) #let [wiggle-room (n.- start n@top)] @@ -104,7 +104,7 @@ (def: (variable-list max-size gen-element) (All [a] (-> Nat (Random a) (Random (List a)))) - (do r.monad + (do {@ r.monad} [amount (:: @ map (n.% (n.max 1 max-size)) r.nat)] (r.list amount gen-element))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index c43c2abf4..14360da93 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -158,7 +158,7 @@ (def: identity Test - (do random.monad + (do {@ random.monad} [self (random.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." @@ -375,8 +375,7 @@ /world.test /host.test /extension.test - /target/jvm.test - )) + /target/jvm.test)) ))) (program: args diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index c9a6be500..29e3e9d6f 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -16,7 +16,7 @@ (def: (identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) @@ -25,7 +25,7 @@ (def: (homomorphism injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." @@ -35,7 +35,7 @@ (def: (interchange injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Interchange." @@ -45,7 +45,7 @@ (def: (composition injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat) decrease (:: @ map n.- random.nat)] diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 0702f00ef..fcceca39b 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -28,7 +28,7 @@ (def: (identity injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) @@ -37,7 +37,7 @@ (def: (homomorphism injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." @@ -47,7 +47,7 @@ (def: (composition injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat) increase (:: @ map n.+ random.nat) decrease (:: @ map n.- random.nat)] diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index c6f2cd36f..d57dfb5d2 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -137,7 +137,7 @@ (def: location Test - (do random.monad + (do {@ random.monad} [[l m r] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) @@ -159,7 +159,7 @@ (def: touch Test - (do random.monad + (do {@ random.monad} [[b t1 t2] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) @@ -185,7 +185,7 @@ (def: nested Test - (do random.monad + (do {@ random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) (:: @ map (|>> set.to-list @@ -218,7 +218,7 @@ (def: overlap Test - (do random.monad + (do {@ random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) (:: @ map (|>> set.to-list diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 4d85a6e90..cc504777c 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -16,7 +16,7 @@ (def: (left-identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat morphism (:: @ map (function (_ diff) (|>> (n.+ diff) _@wrap)) @@ -37,7 +37,7 @@ (def: (associativity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map (function (_ diff) (|>> (n.+ diff) _@wrap)) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index fe942a044..3831ac0fb 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -30,7 +30,7 @@ (let [/2? (multiple? 2) /3? (multiple? 3)] (<| (_.context (%.name (name-of /.Predicate))) - (do r.monad + (do {@ r.monad} [sample r.nat]) ($_ _.and (_.test (%.name (name-of /.none)) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index e6c8c179d..77c024d33 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -121,7 +121,7 @@ (_.claim [/.filter] (list@= (list.filter n.even? inputs) output)))) - (wrap (do promise.monad + (wrap (do {@ promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) channel (/.sequential 0 inputs)] diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/process.lux index 165fbad93..fc818e22d 100644 --- a/stdlib/source/test/lux/control/concurrency/process.lux +++ b/stdlib/source/test/lux/control/concurrency/process.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [dummy random.nat expected random.nat delay (|> random.nat (:: @ map (n.% 100)))] diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 3e2d8982b..2eb43c596 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -47,7 +47,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [to-wait (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) #let [extra-time (n.* 2 to-wait)] expected random.nat diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index e26c1a0f2..6b382f6de 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -29,7 +29,7 @@ Test (_.with-cover [/.Semaphore] ($_ _.and - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad @@ -41,10 +41,10 @@ #.None false))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) result (promise.time-out 10 (/.wait semaphore))] (_.claim [/.wait] @@ -54,10 +54,10 @@ #.None true))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) #let [block (/.wait semaphore)] result/0 (promise.time-out 10 block) @@ -70,7 +70,7 @@ _ false))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad @@ -88,7 +88,7 @@ Test (_.with-cover [/.Mutex] ($_ _.and - (do random.monad + (do {@ random.monad} [repetitions (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) #let [resource (atom.atom "") expected-As (text.join-with "" (list.repeat repetitions "A")) @@ -97,7 +97,7 @@ processA (<| (/.synchronize mutex) io.io promise.future - (do io.monad + (do {@ io.monad} [_ (<| (monad.seq @) (list.repeat repetitions) (atom.update (|>> (format "A")) resource))] @@ -105,7 +105,7 @@ processB (<| (/.synchronize mutex) io.io promise.future - (do io.monad + (do {@ io.monad} [_ (<| (monad.seq @) (list.repeat repetitions) (atom.update (|>> (format "B")) resource))] @@ -142,11 +142,11 @@ [_ (#.Some limit)] (and (n.> 0 raw) (n.= raw (refinement.un-refine limit)))))) - (do random.monad + (do {@ random.monad} [limit (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [barrier (/.barrier (maybe.assume (/.limit limit))) resource (atom.atom "")]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [#let [ending (|> "_" (list.repeat limit) (text.join-with "")) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 07d0c946b..ab795ea79 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -11,7 +11,6 @@ [control ["." io (#+ IO)]] [data - ["%" text/format (#+ format)] [number ["n" nat]] [collection @@ -47,7 +46,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [dummy random.nat expected random.nat iterations-per-process (|> random.nat (:: @ map (n.% 100)))] @@ -101,7 +100,7 @@ (list expected (n.* 2 expected)) changes)))) (wrap (let [var (/.var 0)] - (do promise.monad + (do {@ promise.monad} [_ (|> (list.repeat iterations-per-process []) (list@map (function (_ _) (/.commit (/.update inc var)))) (monad.seq @)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 8d6724614..1d07460c9 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -47,7 +47,7 @@ (_.test "Can use the current-continuation as a escape hatch." (n.= (n.* 2 sample) - (/.run (do /.monad + (/.run (do {@ /.monad} [value (/.call/cc (function (_ k) (do @ @@ -77,7 +77,7 @@ (_@wrap #.Nil) (#.Cons x xs') - (do /.monad + (do {@ /.monad} [output (/.shift (function (_ k) (do @ [tail (k xs')] diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 5d0fa3d47..8d54fa893 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -24,7 +24,7 @@ (def: #export test Test - (do random.monad + (do {@ random.monad} [expected random.nat wrong (|> random.nat (random.filter (|>> (n.= expected) not))) assertion-succeeded? random.bit diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f7d4d7678..5244ad60b 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -20,7 +20,7 @@ (def: #export test Test - (do random.monad + (do {@ random.monad} [expected random.nat f0 (:: @ map n.+ random.nat) f1 (:: @ map n.* random.nat) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index bcb958210..3c6501afe 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -75,7 +75,7 @@ (def: combinators-0 Test - (do random.monad + (do {@ random.monad} [expected0 random.nat variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) expected+ (random.list variadic random.nat) @@ -166,7 +166,7 @@ (def: combinators-1 Test - (do random.monad + (do {@ random.monad} [variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) times (:: @ map (n.% variadic) random.nat) expected random.nat diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index c41a33878..210a1b5b5 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -21,7 +21,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [num-args (|> r.nat (:: @ map (n.% 10))) #let [gen-arg (:: @ map n@encode r.nat)] yes gen-arg diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 441f2f5da..d4f2568eb 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -42,7 +42,7 @@ (|> (/.run /.end "") (case> (#.Right _) true _ false))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) sample (r.unicode size) non-sample (|> (r.unicode size) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index d705e23ca..7bf7e5e0f 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -18,7 +18,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [sample r.nat] ($_ _.and (do @ diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index eec4e6903..d911c15d5 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -66,7 +66,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected-clean-ups (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1))))] ($_ _.and ($functor.spec ..injection ..comparison (: (All [! r] @@ -81,7 +81,7 @@ (_.test (%.name (name-of /.run)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -89,7 +89,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -99,7 +99,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.fail)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -107,7 +107,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups)) _ (/.fail //@ (exception.construct ..oops []))] @@ -118,7 +118,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.throw)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -126,7 +126,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups)) _ (/.throw //@ ..oops [])] @@ -137,7 +137,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.acquire)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -146,7 +146,7 @@ (wrap (: (Try Any) (exception.throw ..oops [])))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -157,7 +157,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.lift)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @] outcome (/.run @ diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 0b5537ef0..66add3672 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -67,7 +67,7 @@ prng (random.pcg-32 [123 (instant.to-millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] - (do @ + (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))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 72284ba5c..2475692ff 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -83,7 +83,7 @@ (def: loops Test - (do random.monad + (do {@ random.monad} [limit (|> random.nat (:: @ map (n.% 10))) #let [condition (do /.monad [state /.get] diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 9889fa0ae..915260f35 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -55,7 +55,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [#let [gen-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 8))))] binary-size gen-size random-binary (binary binary-size) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index c6dc407eb..5ba6f453f 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -35,7 +35,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Array))) - (do r.monad + (do {@ r.monad} [size bounded-size] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.array size r.nat)) @@ -43,7 +43,7 @@ ($functor.spec ..injection /.equivalence /.functor) ($fold.spec ..injection /.equivalence /.fold) - (do r.monad + (do @ [size bounded-size original (r.array size r.nat)] ($_ _.and @@ -74,7 +74,7 @@ /.to-list /.from-list (:: (/.equivalence n.equivalence) = original))) )) - (do r.monad + (do @ [size bounded-size idx (:: @ map (n.% size) r.nat) array (|> (r.array size r.nat) @@ -99,7 +99,7 @@ (n.= size (n.+ (/.occupied array) (/.vacant array)))))) )) - (do r.monad + (do @ [size bounded-size array (|> (r.array size r.nat) (r.filter (|>> /.to-list (list.any? n.even?))))] diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 77e346116..60b939645 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -23,7 +23,7 @@ (def: #export bits (Random Bits) - (do r.monad + (do {@ r.monad} [size (size 1 1,000) idx (|> r.nat (:: @ map (n.% size)))] (wrap (|> /.empty (/.set idx))))) @@ -33,7 +33,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and ($equivalence.spec /.equivalence ..bits) - (do r.monad + (do {@ r.monad} [size (size 1 1,000) idx (|> r.nat (:: @ map (n.% size))) sample bits] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 19b124c40..f0d7c8222 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -40,7 +40,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Dictionary))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 100))) keys (r.set n.hash size r.nat) values (r.set n.hash size r.nat) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 954e3f15d..faa3dfda3 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -34,7 +34,7 @@ (def: signatures Test - (do r.monad + (do {@ r.monad} [size bounded-size] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.list size r.nat)) @@ -65,7 +65,7 @@ (def: #export test Test (<| (_.context (%.name (name-of .List))) - (do r.monad + (do {@ r.monad} [size bounded-size #let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor @@ -180,7 +180,7 @@ (/@map product.left enum-sample)) (/@= sample (/@map product.right enum-sample))))) - (do r.monad + (do @ [from (|> r.nat (:: @ map (n.% 10))) to (|> r.nat (:: @ map (n.% 10)))] (_.test "Ranges can be constructed forward and backwards." diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 64e9c5e56..a636e7164 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 100) r.nat) sample (r.queue size r.nat) non-member (|> r.nat diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 78e4bc2b8..7f9b42046 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -15,7 +15,7 @@ (def: #export (queue size) (-> Nat (Random (Queue Nat))) - (do r.monad + (do {@ r.monad} [inputs (r.list size r.nat)] (monad.fold @ (function (_ head tail) (do @ @@ -27,7 +27,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 100))) sample (..queue size) non-member-priority r.nat diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index c6f462825..1c7a5878a 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -27,7 +27,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.row size r.nat)) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 6e4f59930..4b204d37a 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -21,7 +21,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Sequence))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) offset (|> r.nat (:: @ map (n.% 100))) factor (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 30ff8f6db..45f73fd27 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -46,7 +46,7 @@ ($_ _.and ($equivalence.spec /.equivalence (..set n.order r.nat size)) )) - (do r.monad + (do {@ r.monad} [sizeL gen-nat sizeR gen-nat listL (|> (r.set n.hash sizeL gen-nat) (:: @ map //.to-list)) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index f42bc4f4d..862c5a973 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -48,7 +48,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Tree))) - (do r.monad + (do {@ r.monad} [size (:: @ map (|>> (n.% 100) (n.+ 1)) r.nat)] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat)) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 9ed7da62e..74fda6cc1 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Zipper))) - (do r.monad + (do {@ r.monad} [size (:: @ map (|>> (n.% 90) (n.+ 10)) r.nat) sample (//.tree size r.nat) mid-val r.nat diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 686edae01..ded118074 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -47,7 +47,7 @@ (def: #export json (Random JSON) (r.rec (function (_ recur) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 2) r.nat)] ($_ r.or (:: @ wrap []) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index a3dc6b0e0..47c16f72d 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -35,7 +35,7 @@ (def: char (Random Nat) - (do r.monad + (do {@ r.monad} [idx (|> r.nat (:: @ map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) @@ -73,7 +73,7 @@ ($equivalence.spec /.equivalence ..xml) ($codec.spec /.equivalence /.codec ..xml) - (do r.monad + (do {@ r.monad} [text (..text 1 10) num-children (|> r.nat (:: @ map (n.% 5))) children (r.list num-children (..text 1 10)) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 6190ab19a..57eed0237 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -31,7 +31,7 @@ (def: #export test Test (<| (_.context (%.name (name-of .Name))) - (do r.monad + (do {@ r.monad} [## First Name sizeM1 (|> r.nat (:: @ map (n.% 100))) sizeS1 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 5890ce0d4..c7131575d 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -34,7 +34,7 @@ (def: dimension (Random Frac) - (do r.monad + (do {@ r.monad} [factor (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1)))) measure (|> r.safe-frac (r.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) @@ -159,7 +159,7 @@ (def: trigonometry Test - (do r.monad + (do {@ r.monad} [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and @@ -183,7 +183,7 @@ (def: root Test - (do r.monad + (do {@ r.monad} [sample ..complex degree (|> r.nat (:: @ map (|>> (n.max 1) (n.% 5))))] (_.test "Can calculate the N roots for any complex number." diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/data/number/i16.lux index d44ce68f0..c90b17dc3 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/data/number/i16.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i16) diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/data/number/i32.lux index ae7e0ae41..eb643c9d3 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/data/number/i32.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i32) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 838746854..4305bf461 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -22,7 +22,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [pattern r.nat idx (:: @ map (//nat.% /.width) r.nat)] ($_ _.and diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/data/number/i8.lux index dc4b799fe..7cd4a5149 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/data/number/i8.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i8) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index b3cd2e735..c10d7a67e 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -32,7 +32,7 @@ ($equivalence.spec /.equivalence (r.ascii 2)) ($order.spec /.order (r.ascii 2)) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 10) r.nat) sample (r.unicode size)] ($_ _.and @@ -41,7 +41,7 @@ (_.test "Text with size 0 is considered 'empty'." (or (not (n.= 0 size)) (/.empty? sample))))) - (do r.monad + (do {@ r.monad} [size bounded-size idx (:: @ map (n.% size) r.nat) sample (r.unicode size)] @@ -110,7 +110,7 @@ _ #0))) )) - (do r.monad + (do {@ r.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 6160294c4..5efd43701 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -14,6 +14,7 @@ ["%" format (#+ format)]]] [tool [compiler + ["." phase] [language [lux ["." analysis] @@ -38,13 +39,13 @@ (as-is (generation: (..my-generation self phase {parameters (<>.some <a>.any)}) (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))} (as-is (analysis: (..my-analysis self phase {parameters (<>.some <c>.any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Text self)))) ## Synthesis (analysis: (..my-synthesis self phase {parameters (<>.some <c>.any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) @@ -53,7 +54,7 @@ ## Generation (analysis: (..my-generation self phase {parameters (<>.some <c>.any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) @@ -62,7 +63,7 @@ ## Directive (directive: (..my-directive self phase {parameters (<>.some <c>.any)}) - (do @ + (do phase.monad [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] (wrap directive.no-requirements))) diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index 2bba4c4a7..65011a929 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -93,8 +93,8 @@ (def: miscellaneous Test - (do r.monad - [sample (:: @ map (|>> (:coerce java/lang/Object )) + (do {@ r.monad} + [sample (:: @ map (|>> (:coerce java/lang/Object)) (r.ascii 1))] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -124,7 +124,7 @@ (def: arrays Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) idx (|> r.nat (:: @ map (n.% size))) value (:: @ map (|>> (:coerce java/lang/Long)) r.int)] diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index 9258aa5de..e297c1411 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -114,7 +114,7 @@ (def: arrays Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) idx (|> r.nat (:: @ map (n.% size))) value r.int] diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 00d734ee7..cc2d8012d 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -15,7 +15,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [bit r.bit nat r.nat int r.int diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 7ba3bbd13..8280e000e 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -49,7 +49,7 @@ (def: gen-record (Random Record) - (do random.monad + (do {@ random.monad} [size (:: @ map (n.% 2) random.nat) #let [gen-int (|> random.int (:: @ map (|>> i.abs (i.% +1,000,000))))]] ($_ random.and diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 063a20518..ae7c62655 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -89,7 +89,7 @@ (def: gen-record (Random Record) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 2) r.nat)] ($_ r.and r.bit diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 17ed2086c..c29b25b97 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -36,7 +36,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and (<| (_.context "Trigonometry") - (do r.monad + (do {@ r.monad} [angle (|> r.safe-frac (:: @ map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." @@ -47,7 +47,7 @@ (trigonometric-symmetry /.tan /.atan angle)) ))) (<| (_.context "Rounding") - (do r.monad + (do {@ r.monad} [sample (|> r.safe-frac (:: @ map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." @@ -66,12 +66,12 @@ (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") - (do r.monad + (do {@ r.monad} [sample (|> r.safe-frac (:: @ map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") - (do r.monad + (do {@ r.monad} [#let [gen-nat (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1))))] x gen-nat y gen-nat] diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index e53028522..eeace02be 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -141,7 +141,7 @@ (def: predicates-and-sets Test - (do random.monad + (do {@ random.monad} [#let [set-10 (set.from-list n.hash (list.n/range 0 10))] sample (|> random.nat (:: @ map (n.% 20)))] ($_ _.and diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index a4a13cbe4..0ccd4c5e3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -280,7 +280,7 @@ (template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>] [(def: <name> Test - (do random.monad + (do {@ random.monad} [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)] (<| (_.lift <message>) (..bytecode (|>> (:coerce <type>) <to-long> ("jvm leq" expected))) @@ -327,7 +327,7 @@ instruction))))) shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do random.monad + (do {@ random.monad} [parameter (:: @ map (|>> (n.% 32) .int host.long-to-int) random.nat) subject ..$Integer::random] (int (reference parameter subject) @@ -400,7 +400,7 @@ instruction))))) shift (: (-> (-> Nat Int Int) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do random.monad + (do {@ random.monad} [parameter (:: @ map (n.% 64) random.nat) subject ..$Long::random] (long (reference parameter subject) @@ -816,7 +816,7 @@ (-> a Any Bit) Test)) (function (_ constructor random literal [*store *load *wrap] test) - (do random.monad + (do {@ random.monad} [size (:: @ map (|>> (n.% 1024) (n.max 1)) random.nat) value random] ($_ _.and @@ -853,7 +853,7 @@ (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] (function (_ expected) (|>> (:coerce Text) (text@= expected))))) (<| (_.context "multi") - (do random.monad + (do {@ random.monad} [#let [size (:: @ map (|>> (n.% 10) (n.+ 1)) random.nat)] dimensions size @@ -867,7 +867,7 @@ _ (recur (dec dimensions) (/type.array type))))]] (<| (_.lift "MULTIANEWARRAY") (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" (.int sizesH)))) - (do /.monad + (do {@ /.monad} [_ (monad.map @ (|>> host.long-to-int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) @@ -974,7 +974,7 @@ (-> a (-> Any Bit)) (Random Bit))) (function (_ random-value literal *wrap [store load] test) - (do random.monad + (do {@ random.monad} [expected random-value register (:: @ map (n.% 128) random.nat)] (<| (..bytecode (test expected)) @@ -999,7 +999,7 @@ (function (_ expected actual) (|> actual (:coerce java/lang/Integer) ("jvm ieq" expected))))) (_.lift "IINC" - (do random.monad + (do {@ random.monad} [base ..$Byte::random increment (:: @ map (|>> (n.% 100) /unsigned.u1 try.assume) random.nat) @@ -1313,7 +1313,7 @@ Test ($_ _.and (<| (_.lift "TABLESWITCH") - (do random.monad + (do {@ random.monad} [expected ..$Long::random dummy ..$Long::random minimum (:: @ map (|>> (n.% 100) .int /signed.s4 try.assume) @@ -1334,7 +1334,7 @@ _ (/.set-label @return)] ..$Long::wrap)) (<| (_.lift "LOOKUPSWITCH") - (do random.monad + (do {@ random.monad} [options (:: @ map (|>> (n.% 10) (n.+ 1)) random.nat) choice (:: @ map (n.% options) random.nat) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index fe196cb29..12c4b41ba 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -37,7 +37,7 @@ [millis r.int] (_.test "Can convert from/to milliseconds." (|> millis /.from-millis /.to-millis (i.= millis)))) - (do r.monad + (do {@ r.monad} [sample (|> duration (:: @ map (/.frame /.day))) frame duration factor (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux index 2b53cbfdb..4baa57891 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (def: name-part^ (Random Text) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 20) (n.max 1))))] (r.ascii/lower-alpha size))) @@ -77,7 +77,7 @@ (def: code Test - (do r.monad + (do {@ r.monad} [sample code^] ($_ _.and (_.test "Can parse Lux code." diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux index 1a74a3cf2..1ca4718c1 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux @@ -57,7 +57,7 @@ (^template [<tag> <gen> <wrapper>] [_ (<tag> _)] (if allow-literals? - (do r.monad + (do {@ r.monad} [?sample (r.maybe <gen>)] (case ?sample (#.Some sample) @@ -78,7 +78,7 @@ (r@wrap (list (' []))) [_ (#.Tuple members)] - (do r.monad + (do {@ r.monad} [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving @@ -88,7 +88,7 @@ (r@wrap (list (' {}))) [_ (#.Record kvs)] - (do r.monad + (do {@ r.monad} [#let [ks (list@map product.left kvs) vs (list@map product.right kvs)] member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)] @@ -97,7 +97,7 @@ (list@map (|>> (list.zip2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) - (do r.monad + (do {@ r.monad} [bundles (monad.map @ (function (_ [_tag _code]) (do @ @@ -117,12 +117,12 @@ (function (_ input) ($_ r.either (r@map product.right _primitive.primitive) - (do r.monad + (do {@ r.monad} [choice (|> r.nat (:: @ map (n.% (list.size variant-tags)))) #let [choiceT (maybe.assume (list.nth choice variant-tags)) choiceC (maybe.assume (list.nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) elems (r.list size input)] (wrap (code.tuple elems))) @@ -135,7 +135,7 @@ (def: #export test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [module-name (r.unicode 5) variant-name (r.unicode 5) record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux index 721e17b14..fc07f8963 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux @@ -75,7 +75,7 @@ )))) (def: apply - (do r.monad + (do {@ r.monad} [full-args (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) partial-args (|> r.nat (:: @ map (n.% full-args))) var-idx (|> r.nat (:: @ map (|>> (n.% full-args) (n.max 1)))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux index 1c23b1c8a..9cb0c1170 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux @@ -45,7 +45,7 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do ///.monad + (|> (do {@ ///.monad} [_ (//module.with-module 0 def-module (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux index ad2233b26..05461adf6 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux @@ -113,7 +113,7 @@ false))) (def: sum - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) choice (|> r.nat (:: @ map (n.% size))) primitives (r.list size _primitive.primitive) @@ -165,7 +165,7 @@ )))) (def: product - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) primitives (r.list size _primitive.primitive) choice (|> r.nat (:: @ map (n.% size))) @@ -225,7 +225,7 @@ )))) (def: variant - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) choice (|> r.nat (:: @ map (n.% size))) @@ -271,7 +271,7 @@ )))) (def: record - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) primitives (r.list size _primitive.primitive) diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux index c659d9db0..df4e5a7e5 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -67,7 +67,7 @@ (def: i64 Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.nat (:: @ map code.nat)) signedC (|> r.int (:: @ map code.int)) paramC (|> r.nat (:: @ map code.nat))] @@ -94,7 +94,7 @@ (def: int Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.int (:: @ map code.int)) paramC (|> r.int (:: @ map code.int))] ($_ _.and @@ -114,7 +114,7 @@ (def: frac Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.safe-frac (:: @ map code.frac)) paramC (|> r.safe-frac (:: @ map code.frac)) encodedC (|> r.safe-frac (:: @ map (|>> %.frac code.text)))] @@ -149,7 +149,7 @@ (def: text Test - (do r.monad + (do {@ r.monad} [subjectC (|> (r.unicode 5) (:: @ map code.text)) paramC (|> (r.unicode 5) (:: @ map code.text)) replacementC (|> (r.unicode 5) (:: @ map code.text)) @@ -174,7 +174,7 @@ (def: io Test - (do r.monad + (do {@ r.monad} [logC (|> (r.unicode 5) (:: @ map code.text)) exitC (|> r.int (:: @ map code.int))] ($_ _.and diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux index 13418eba0..263f5e4a7 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux @@ -25,7 +25,7 @@ (def: dummy-vars Test - (do r.monad + (do {@ r.monad} [maskedA //primitive.primitive temp (|> r.nat (:: @ map (n.% 100))) #let [maskA (////analysis.control/case diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux index 32044f5dc..1a4993c92 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux @@ -35,7 +35,7 @@ (Random [Arity Analysis Analysis]) (r.rec (function (_ constant-function) - (do r.monad + (do {@ r.monad} [function? r.bit] (if function? (do @ @@ -53,7 +53,7 @@ (def: function-with-environment (Random [Arity Analysis Variable]) - (do r.monad + (do {@ r.monad} [num-locals (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) #let [indices (list.n/range 0 (dec num-locals)) local-env (list@map (|>> #////reference.Local) indices) @@ -102,7 +102,7 @@ (wrap [arity' (#////analysis.Function (list) bodyA) predictionA])) - (do r.monad + (do {@ r.monad} [chosen (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2))))] (wrap [arity (#////analysis.Reference (////reference.local chosen)) @@ -149,7 +149,7 @@ (def: application Test - (do r.monad + (do {@ r.monad} [arity (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) funcA //primitive.primitive argsA (r.list arity //primitive.primitive)] diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux index 087756562..d59065782 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux @@ -30,7 +30,7 @@ (def: variant Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.+ 2)))) tagA (|> r.nat (:: @ map (n.% size))) #let [right? (n.= (dec size) tagA) @@ -53,7 +53,7 @@ (def: tuple Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) membersA (r.list size //primitive.primitive)] (_.test "Can synthesize tuple." diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index f129f1c5a..eef749d8f 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -22,7 +22,7 @@ (def: short (r.Random Text) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 10)))] (r.unicode size))) @@ -83,7 +83,7 @@ (:: /.equivalence = (/.un-name base) (/.un-name aliased)))))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) members (|> ..type (r.filter (function (_ type) @@ -109,7 +109,7 @@ ["tuple" /.tuple /.flatten-tuple Any] )) ))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) members (M.seq @ (list.repeat size ..type)) extra (|> ..type @@ -132,7 +132,7 @@ (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] (n.= (list.size members) (list.size tparams)))) )) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) extra (|> ..type (r.filter (function (_ type) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 2184de475..96fd5fcbb 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -81,7 +81,7 @@ (def: (build-ring num-connections) (-> Nat (/.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do /.monad + (do {@ /.monad} [[head-id head-type] /.var ids+types (monad.seq @ (list.repeat num-connections /.var)) [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type]) @@ -188,7 +188,7 @@ _ (/.check var Nothing)] (/.check .Bit var)))) ) - (do r.monad + (do {@ r.monad} [num-connections (|> r.nat (:: @ map (n.% 100))) boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) pick-pcg (r.and r.nat r.nat)] @@ -209,7 +209,7 @@ expected-size? same-vars?)))))) (_.test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do /.monad + (type-checks? (do {@ /.monad} [[[head-id headT] ids+types tailT] (build-ring num-connections) #let [ids (list@map product.left ids+types)] _ (/.check headT boundT) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index d13a024e7..5f8d03273 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -68,7 +68,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [file-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) dataL (_binary.binary file-size) dataR (_binary.binary file-size) |