aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2020-05-17 20:10:42 -0400
committerEduardo Julian2020-05-17 20:10:42 -0400
commitd97f92842981501a8e0d95a1b4f1ba3d9e72f0d5 (patch)
tree3aa01a37da19e1e63bbf8cd204ae6743166e386a /stdlib/source
parent9219da9a9bf29b3a2f7f10d4865b939ded28e003 (diff)
Local binding names for (co|indexed-)?monads are now explicitly set.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/abstract/comonad.lux53
-rw-r--r--stdlib/source/lux/abstract/monad.lux47
-rw-r--r--stdlib/source/lux/abstract/monad/indexed.lux60
-rw-r--r--stdlib/source/lux/control/concatenative.lux6
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux10
-rw-r--r--stdlib/source/lux/control/concurrency/frp.lux12
-rw-r--r--stdlib/source/lux/control/concurrency/process.lux2
-rw-r--r--stdlib/source/lux/control/concurrency/promise.lux2
-rw-r--r--stdlib/source/lux/control/concurrency/semaphore.lux2
-rw-r--r--stdlib/source/lux/control/concurrency/stm.lux8
-rw-r--r--stdlib/source/lux/control/exception.lux2
-rw-r--r--stdlib/source/lux/control/function/memo.lux2
-rw-r--r--stdlib/source/lux/control/parser.lux2
-rw-r--r--stdlib/source/lux/control/parser/binary.lux2
-rw-r--r--stdlib/source/lux/control/parser/type.lux6
-rw-r--r--stdlib/source/lux/control/region.lux2
-rw-r--r--stdlib/source/lux/control/security/capability.lux2
-rw-r--r--stdlib/source/lux/control/state.lux2
-rw-r--r--stdlib/source/lux/data/collection/dictionary/ordered.lux26
-rw-r--r--stdlib/source/lux/data/collection/list.lux2
-rw-r--r--stdlib/source/lux/data/format/json.lux6
-rw-r--r--stdlib/source/lux/data/text/regex.lux6
-rw-r--r--stdlib/source/lux/extension.lux4
-rw-r--r--stdlib/source/lux/host.jvm.lux16
-rw-r--r--stdlib/source/lux/host.old.lux8
-rw-r--r--stdlib/source/lux/macro.lux4
-rw-r--r--stdlib/source/lux/macro/poly.lux2
-rw-r--r--stdlib/source/lux/macro/syntax.lux6
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux2
-rw-r--r--stdlib/source/lux/macro/template.lux2
-rw-r--r--stdlib/source/lux/math/random.lux8
-rw-r--r--stdlib/source/lux/target/jvm/bytecode.lux12
-rw-r--r--stdlib/source/lux/target/jvm/bytecode/instruction.lux8
-rw-r--r--stdlib/source/lux/target/jvm/class.lux2
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux2
-rw-r--r--stdlib/source/lux/target/jvm/loader.lux2
-rw-r--r--stdlib/source/lux/target/jvm/method.lux2
-rw-r--r--stdlib/source/lux/target/jvm/reflection.lux4
-rw-r--r--stdlib/source/lux/target/jvm/type/lux.lux2
-rw-r--r--stdlib/source/lux/test.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux32
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/function.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/common-lisp/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux6
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/artifact.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/cache.lux10
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux10
-rw-r--r--stdlib/source/lux/tool/interpreter.lux4
-rw-r--r--stdlib/source/lux/tool/mediator/parallelism.lux168
-rw-r--r--stdlib/source/lux/type.lux4
-rw-r--r--stdlib/source/lux/type/abstract.lux4
-rw-r--r--stdlib/source/lux/type/check.lux6
-rw-r--r--stdlib/source/lux/type/implicit.lux18
-rw-r--r--stdlib/source/lux/type/resource.lux6
-rw-r--r--stdlib/source/lux/world/file.lux4
-rw-r--r--stdlib/source/lux/world/net/http/query.lux4
-rw-r--r--stdlib/source/lux/world/shell.lux2
-rw-r--r--stdlib/source/poly/lux/abstract/equivalence.lux2
-rw-r--r--stdlib/source/poly/lux/abstract/functor.lux2
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux7
-rw-r--r--stdlib/source/program/compositor.lux2
-rw-r--r--stdlib/source/program/scriptum.lux4
-rw-r--r--stdlib/source/spec/compositor/generation/case.lux4
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux2
-rw-r--r--stdlib/source/spec/compositor/generation/function.lux2
-rw-r--r--stdlib/source/spec/compositor/generation/reference.lux2
-rw-r--r--stdlib/source/spec/compositor/generation/structure.lux4
-rw-r--r--stdlib/source/test/licentia.lux4
-rw-r--r--stdlib/source/test/lux.lux5
-rw-r--r--stdlib/source/test/lux/abstract/apply.lux8
-rw-r--r--stdlib/source/test/lux/abstract/functor.lux6
-rw-r--r--stdlib/source/test/lux/abstract/interval.lux8
-rw-r--r--stdlib/source/test/lux/abstract/monad.lux4
-rw-r--r--stdlib/source/test/lux/abstract/predicate.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/process.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/promise.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux22
-rw-r--r--stdlib/source/test/lux/control/concurrency/stm.lux5
-rw-r--r--stdlib/source/test/lux/control/continuation.lux4
-rw-r--r--stdlib/source/test/lux/control/exception.lux2
-rw-r--r--stdlib/source/test/lux/control/function.lux2
-rw-r--r--stdlib/source/test/lux/control/parser.lux4
-rw-r--r--stdlib/source/test/lux/control/parser/cli.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux2
-rw-r--r--stdlib/source/test/lux/control/pipe.lux2
-rw-r--r--stdlib/source/test/lux/control/region.lux20
-rw-r--r--stdlib/source/test/lux/control/remember.lux2
-rw-r--r--stdlib/source/test/lux/control/state.lux2
-rw-r--r--stdlib/source/test/lux/data/binary.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux8
-rw-r--r--stdlib/source/test/lux/data/collection/bits.lux4
-rw-r--r--stdlib/source/test/lux/data/collection/dictionary/ordered.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/list.lux6
-rw-r--r--stdlib/source/test/lux/data/collection/queue.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/queue/priority.lux4
-rw-r--r--stdlib/source/test/lux/data/collection/row.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/sequence.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/set/ordered.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/tree.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/tree/zipper.lux2
-rw-r--r--stdlib/source/test/lux/data/format/json.lux2
-rw-r--r--stdlib/source/test/lux/data/format/xml.lux4
-rw-r--r--stdlib/source/test/lux/data/name.lux2
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux6
-rw-r--r--stdlib/source/test/lux/data/number/i16.lux2
-rw-r--r--stdlib/source/test/lux/data/number/i32.lux2
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux2
-rw-r--r--stdlib/source/test/lux/data/number/i8.lux2
-rw-r--r--stdlib/source/test/lux/data/text.lux6
-rw-r--r--stdlib/source/test/lux/extension.lux9
-rw-r--r--stdlib/source/test/lux/host.jvm.lux6
-rw-r--r--stdlib/source/test/lux/host.old.lux2
-rw-r--r--stdlib/source/test/lux/macro/code.lux2
-rw-r--r--stdlib/source/test/lux/macro/poly/equivalence.lux2
-rw-r--r--stdlib/source/test/lux/macro/poly/json.lux2
-rw-r--r--stdlib/source/test/lux/math.lux8
-rw-r--r--stdlib/source/test/lux/math/logic/fuzzy.lux2
-rw-r--r--stdlib/source/test/lux/target/jvm.lux20
-rw-r--r--stdlib/source/test/lux/time/duration.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/default/syntax.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux14
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux8
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux10
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux2
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux8
-rw-r--r--stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux4
-rw-r--r--stdlib/source/test/lux/type.lux8
-rw-r--r--stdlib/source/test/lux/type/check.lux6
-rw-r--r--stdlib/source/test/lux/world/file.lux2
178 files changed, 526 insertions, 636 deletions
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)