diff options
author | Eduardo Julian | 2020-05-17 20:10:42 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-05-17 20:10:42 -0400 |
commit | d97f92842981501a8e0d95a1b4f1ba3d9e72f0d5 (patch) | |
tree | 3aa01a37da19e1e63bbf8cd204ae6743166e386a /stdlib/source/lux/tool | |
parent | 9219da9a9bf29b3a2f7f10d4865b939ded28e003 (diff) |
Local binding names for (co|indexed-)?monads are now explicitly set.
Diffstat (limited to 'stdlib/source/lux/tool')
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)))))) |