aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/tool
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/lux/tool
parent9219da9a9bf29b3a2f7f10d4865b939ded28e003 (diff)
Local binding names for (co|indexed-)?monads are now explicitly set.
Diffstat (limited to 'stdlib/source/lux/tool')
-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
55 files changed, 129 insertions, 297 deletions
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))))))