diff options
| author | Eduardo Julian | 2020-10-31 02:59:48 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2020-10-31 02:59:48 -0400 | 
| commit | eea741e9b4a47ae09832311d6d61f0bd6024f673 (patch) | |
| tree | 9d503f609c322c235811856ffa05232991b9c653 /stdlib/source/lux/tool | |
| parent | cb8f2b36352948108446c7e3b270faa97589bf7a (diff) | |
Easy to use Rev constants.
Diffstat (limited to '')
40 files changed, 344 insertions, 344 deletions
| diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index f30f9f8db..a3eaa03e3 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -116,9 +116,9 @@      [#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) +        _ (monad.map ! module.import dependencies)          #let [source (///analysis.source (get@ #///.module input) (get@ #///.code input))]          _ (///analysis.set-source-code source)]         (wrap [source [///generation.empty-buffer @@ -225,18 +225,18 @@        (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))                             #let [module (get@ #///.module input)]]                            (loop [iteration (<| (///phase.run' state)                                                 (..iterate archive expander module source buffer ///syntax.no-aliases))] -                            (do @ +                            (do !                                [[state ?source&requirements&temporary-payload] iteration]                                (case ?source&requirements&temporary-payload                                  #.None -                                (do @ +                                (do !                                    [[state [analysis-module [final-buffer final-registry]]] (///phase.run' state (..end module))                                     #let [descriptor {#descriptor.hash hash                                                       #descriptor.name module @@ -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 @@ -269,7 +269,7 @@                                                                                    (///generation.set-registry temporary-registry))                                                                                 _ (|> requirements                                                                                       (get@ #///directive.referrals) -                                                                                     (monad.map @ (execute! archive))) +                                                                                     (monad.map ! (execute! archive)))                                                                                 temporary-payload (..get-current-payload temporary-payload)]                                                                                (..iterate archive expander module source temporary-payload (..module-aliases analysis-module))))))})]))                                  )))))})))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index d15bec236..5e3ad19f9 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -345,7 +345,7 @@                            (stm.var ..independence))]          (function (_ compile)            (function (import! importer module) -            (do {@ promise.monad} +            (do {! promise.monad}                [[return signal] (:share [<type-vars>]                                         {<Context>                                          initial} @@ -354,10 +354,10 @@                                                                     <Signal>])])                                          (:assume                                           (stm.commit -                                          (do {@ stm.monad} +                                          (do {! stm.monad}                                              [dependence (if (text@= archive.runtime-module importer)                                                            (stm.read dependence) -                                                          (do @ +                                                          (do !                                                              [[_ dependence] (stm.update (..depend importer module) dependence)]                                                              (wrap dependence)))]                                              (case (..verify-dependencies importer module dependence) @@ -366,12 +366,12 @@                                                       #.None])                                                (#try.Success _) -                                              (do @ +                                              (do !                                                  [[archive state] (stm.read current)]                                                  (if (archive.archived? archive module)                                                    (wrap [(promise@wrap (#try.Success [archive state]))                                                           #.None]) -                                                  (do @ +                                                  (do !                                                      [@pending (stm.read pending)]                                                      (case (dictionary.get module @pending)                                                        (#.Some [return signal]) @@ -385,7 +385,7 @@                                                                  (wrap [module-id archive]))                                                                (archive.reserve module archive))                                                          (#try.Success [module-id archive]) -                                                        (do @ +                                                        (do !                                                            [_ (stm.write [archive state] current)                                                             #let [[return signal] (:share [<type-vars>]                                                                                           {<Context> @@ -406,7 +406,7 @@                     (wrap [])                     (#.Some [context module-id resolver]) -                   (do @ +                   (do !                       [result (compile import! module-id context module)                        result (case result                                 (#try.Failure error) @@ -427,9 +427,9 @@      (def: (updated-state archive state)        (All [<type-vars>]          (-> Archive <State+> (Try <State+>))) -      (do {@ try.monad} -        [modules (monad.map @ (function (_ module) -                                (do @ +      (do {! try.monad} +        [modules (monad.map ! (function (_ module) +                                (do !                                    [[descriptor document] (archive.find module archive)                                     lux-module (document.read $.key document)]                                    (wrap [module lux-module]))) @@ -474,7 +474,7 @@              compiler (..parallel                        context                        (function (_ import! module-id [archive state] module) -                        (do {@ (try.with promise.monad)} +                        (do {! (try.with promise.monad)}                            [#let [state (..set-current-module module state)]                             input (context.read (get@ #&file-system platform)                                                 import @@ -494,13 +494,13 @@                                                           (Action [Archive <State+>]))                                                       (:assume                                                        recur)})] -                              (do @ +                              (do !                                  [[archive state] (case new-dependencies                                                     #.Nil                                                     (wrap [archive state])                                                     (#.Cons _) -                                                   (do @ +                                                   (do !                                                       [archive,document+ (|> new-dependencies                                                                              (list@map (import! module))                                                                              (monad.seq ..monad)) @@ -523,7 +523,7 @@                                      (continue! [archive state] more all-dependencies)                                      (#.Right [[descriptor document] output]) -                                    (do @ +                                    (do !                                        [#let [_ (log! (..module-compilation-log state))                                               descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]                                         _ (..cache-module static platform module-id [[descriptor document] output])] @@ -536,7 +536,7 @@                                          (promise@wrap (#try.Failure error)))))                                    (#try.Failure error) -                                  (do @ +                                  (do !                                      [_ (ioW.freeze (get@ #&file-system platform) static archive)]                                      (promise@wrap (#try.Failure error))))))))))]          (compiler archive.runtime-module compilation-module))) 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 41c99534a..2d3b61280 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux @@ -109,16 +109,16 @@      (/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          (#/.Reference (#reference.Constant def-name)) -        (do @ +        (do !            [?macro (//extension.lift (meta.find-macro def-name))]            (case ?macro              (#.Some macro) -            (do @ +            (do !                [expansion (//extension.lift (/macro.expand-one expander def-name macro argsC+))]                (compile archive expansion)) 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 c9443b43f..2996ed6d0 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 @@ -184,7 +184,7 @@      [location (#.Tuple sub-patterns)]      (/.with-location location -      (do {@ ///.monad} +      (do {! ///.monad}          [inputT' (simplify-case inputT)]          (.case inputT'            (#.Product _) @@ -202,17 +202,17 @@                                ## (n.= num-subs num-sub-patterns)                                (list.zip/2 subs sub-patterns))] -            (do @ +            (do !                [[memberP+ thenA] (list@fold (: (All [a]                                                  (-> [Type Code] (Operation [(List Pattern) a])                                                      (Operation [(List Pattern) a])))                                                (function (_ [memberT memberC] then) -                                                (do @ +                                                (do !                                                    [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))                                                                                          analyse-pattern)                                                                                 #.None memberT memberC then)]                                                    (wrap [(list& memberP memberP+) thenA])))) -                                           (do @ +                                           (do !                                               [nextA next]                                               (wrap [(list) nextA]))                                             (list.reverse matches))] @@ -297,16 +297,16 @@    (-> 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)) -       outputT (monad.map @ +       outputT (monad.map !                            (function (_ [patternT bodyT])                              (analyse-pattern #.None inputT patternT (analyse archive bodyT)))                            branchesT)         outputHC (|> outputH product.left /coverage.determine) -       outputTC (monad.map @ (|>> product.left /coverage.determine) outputT) +       outputTC (monad.map ! (|>> product.left /coverage.determine) outputT)         _ (.case (monad.fold try.monad /coverage.merge outputHC outputTC)             (#try.Success coverage)             (///.assert non-exhaustive-pattern-matching [inputC branches coverage] 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 bb9eef8cb..792a779ab 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,12 +238,12 @@              (ex.throw redundant-pattern [so-far addition])              ## else -            (do {@ try.monad} -              [casesM (monad.fold @ +            (do {! try.monad} +              [casesM (monad.fold !                                    (function (_ [tagA coverageA] casesSF')                                      (case (dictionary.get tagA casesSF')                                        (#.Some coverageSF) -                                      (do @ +                                      (do !                                          [coverageM (merge coverageA coverageSF)]                                          (wrap (dictionary.put tagA coverageM 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)])) @@ -334,7 +334,7 @@                                    (#try.Success altMSF)                                    (case altMSF                                      (#Alt _) -                                    (do @ +                                    (do !                                        [[success altsSF+] (recur altsSF')]                                        (wrap [success (#.Cons altSF altsSF+)])) @@ -349,7 +349,7 @@               possibilitiesSF possibilitiesSF]          (case successA            (#.Some coverageA') -          (do @ +          (do !              [[successA' possibilitiesSF'] (fuse-once coverageA' possibilitiesSF)]              (recur successA' possibilitiesSF')) 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 2430ce82f..e06265806 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 @@ -43,7 +43,7 @@  (def: #export (function analyse function-name arg-name archive body)    (-> Phase Text Text Phase) -  (do {@ ///.monad} +  (do {! ///.monad}      [functionT (///extension.lift meta.expected-type)]      (loop [expectedT functionT]        (/.with-stack ..cannot-analyse [expectedT function-name arg-name body] @@ -61,14 +61,14 @@            (^template [<tag> <instancer>]              (<tag> _) -            (do @ +            (do !                [[_ instanceT] (//type.with-env <instancer>)]                (recur (maybe.assume (type.apply (list instanceT) expectedT)))))            ([#.UnivQ check.existential]             [#.ExQ check.var])            (#.Var id) -          (do @ +          (do !              [?expectedT' (//type.with-env                             (check.read id))]              (case ?expectedT' @@ -77,7 +77,7 @@                ## Inference                _ -              (do @ +              (do !                  [[input-id inputT] (//type.with-env check.var)                   [output-id outputT] (//type.with-env check.var)                   #let [functionT (#.Function inputT outputT)] @@ -88,7 +88,7 @@                ))            (#.Function inputT outputT) -          (<| (:: @ map (.function (_ [scope bodyA]) +          (<| (:: ! map (.function (_ [scope bodyA])                            (#/.Function (list@map (|>> /.variable)                                                   (//scope.environment scope))                                         bodyA))) 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 5f06a02cf..839fe1617 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)) @@ -133,7 +133,7 @@                    (check.bound? var-id))           _ (if bound?               (wrap []) -             (do @ +             (do !                 [newT new-named-type]                 (//type.with-env                   (check.check varT newT))))] 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 06b0c41c6..b04c02674 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,9 +223,9 @@  (def: (ensure-undeclared-tags module-name tags)    (-> Text (List Tag) (Operation Any)) -  (do {@ ///.monad} +  (do {! ///.monad}      [bindings (..tags module-name) -     _ (monad.map @ +     _ (monad.map !                    (function (_ tag)                      (case (plist.get tag bindings)                        #.None 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 827e36a2e..72e47e33d 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,21 +31,21 @@  (def: (definition def-name)    (-> Name (Operation Analysis))    (with-expansions [<return> (wrap (|> def-name ///reference.constant #/.Reference))] -    (do {@ ///.monad} +    (do {! ///.monad}        [constant (///extension.lift (meta.find-def def-name))]        (case constant          (#.Left real-def-name)          (definition real-def-name)          (#.Right [exported? actualT def-anns _]) -        (do @ +        (do !            [_ (//type.infer actualT)             (^@ def-name [::module ::name]) (///extension.lift (meta.normalize def-name))             current (///extension.lift meta.current-module-name)]            (if (text@= current ::module)              <return>              (if exported? -              (do @ +              (do !                  [imported! (///extension.lift (meta.imported-by? ::module current))]                  (if imported!                    <return> @@ -54,11 +54,11 @@  (def: (variable var-name)    (-> Text (Operation (Maybe Analysis))) -  (do {@ ///.monad} +  (do {! ///.monad}      [?var (//scope.find var-name)]      (case ?var        (#.Some [actualT ref]) -      (do @ +      (do !          [_ (//type.infer actualT)]          (wrap (#.Some (|> ref ///reference.variable #/.Reference)))) @@ -69,14 +69,14 @@    (-> Name (Operation Analysis))    (case reference      ["" simple-name] -    (do {@ ///.monad} +    (do {! ///.monad}        [?var (variable simple-name)]        (case ?var          (#.Some varA)          (wrap varA)          #.None -        (do @ +        (do !            [this-module (///extension.lift meta.current-module-name)]            (definition [this-module simple-name])))) 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 fd0b58449..3f8f023aa 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 @@ -92,7 +92,7 @@    (-> Phase Nat Bit Phase)    (let [tag (/.tag lefts right?)]      (function (recur valueC) -      (do {@ ///.monad} +      (do {! ///.monad}          [expectedT (///extension.lift meta.expected-type)           expectedT' (//type.with-env                        (check.clean expectedT))] @@ -102,7 +102,7 @@              (let [flat (type.flatten-variant expectedT)]                (case (list.nth tag flat)                  (#.Some variant-type) -                (do @ +                (do !                    [valueA (//type.with-type variant-type                              (analyse archive valueC))]                    (wrap (/.variant [lefts right? valueA]))) @@ -115,7 +115,7 @@                (recur valueC))              (#.Var id) -            (do @ +            (do !                [?expectedT' (//type.with-env                               (check.read id))]                (case ?expectedT' @@ -131,7 +131,7 @@              (^template [<tag> <instancer>]                (<tag> _) -              (do @ +              (do !                  [[instance-id instanceT] (//type.with-env <instancer>)]                  (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))                    (recur valueC)))) @@ -141,7 +141,7 @@              (#.Apply inputT funT)              (case funT                (#.Var funT-id) -              (do @ +              (do !                  [?funT' (//type.with-env (check.read funT-id))]                  (case ?funT'                    (#.Some funT') @@ -165,7 +165,7 @@  (def: (typed-product archive analyse members)    (-> Archive Phase (List Code) (Operation Analysis)) -  (do {@ ///.monad} +  (do {! ///.monad}      [expectedT (///extension.lift meta.expected-type)       membersA+ (: (Operation (List Analysis))                    (loop [membersT+ (type.flatten-tuple expectedT) @@ -173,14 +173,14 @@                      (case [membersT+ membersC+]                        [(#.Cons memberT #.Nil) _]                        (//type.with-type memberT -                        (:: @ map (|>> list) (analyse archive (code.tuple membersC+)))) +                        (:: ! map (|>> list) (analyse archive (code.tuple membersC+))))                        [_ (#.Cons memberC #.Nil)]                        (//type.with-type (type.tuple membersT+) -                        (:: @ map (|>> list) (analyse archive memberC))) +                        (:: ! map (|>> list) (analyse archive memberC)))                        [(#.Cons memberT membersT+') (#.Cons memberC membersC+')] -                      (do @ +                      (do !                          [memberA (//type.with-type memberT                                     (analyse archive memberC))                           memberA+ (recur membersT+' membersC+')] @@ -192,7 +192,7 @@  (def: #export (product archive analyse membersC)    (-> Archive Phase (List Code) (Operation Analysis)) -  (do {@ ///.monad} +  (do {! ///.monad}      [expectedT (///extension.lift meta.expected-type)]      (/.with-stack ..cannot-analyse-tuple [expectedT membersC]        (case expectedT @@ -204,7 +204,7 @@            (product archive analyse membersC))          (#.Var id) -        (do @ +        (do !            [?expectedT' (//type.with-env                           (check.read id))]            (case ?expectedT' @@ -214,8 +214,8 @@              _              ## Must do inference... -            (do @ -              [membersTA (monad.map @ (|>> (analyse archive) //type.with-inference) +            (do ! +              [membersTA (monad.map ! (|>> (analyse archive) //type.with-inference)                                      membersC)                 _ (//type.with-env                     (check.check expectedT @@ -224,7 +224,7 @@          (^template [<tag> <instancer>]            (<tag> _) -          (do @ +          (do !              [[instance-id instanceT] (//type.with-env <instancer>)]              (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))                (product archive analyse membersC)))) @@ -234,7 +234,7 @@          (#.Apply inputT funT)          (case funT            (#.Var funT-id) -          (do @ +          (do !              [?funT' (//type.with-env (check.read funT-id))]              (case ?funT'                (#.Some funT') @@ -259,7 +259,7 @@  (def: #export (tagged-sum analyse tag archive valueC)    (-> Phase Name Phase) -  (do {@ ///.monad} +  (do {! ///.monad}      [tag (///extension.lift (meta.normalize tag))       [idx group variantT] (///extension.lift (meta.resolve-tag tag))       #let [case-size (list.size group) @@ -267,7 +267,7 @@       expectedT (///extension.lift meta.expected-type)]      (case expectedT        (#.Var _) -      (do @ +      (do !          [inferenceT (//inference.variant idx case-size variantT)           [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC))]          (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) @@ -304,7 +304,7 @@      (:: ///.monad wrap [(list) Any])      (#.Cons [head-k head-v] _) -    (do {@ ///.monad} +    (do {! ///.monad}        [head-k (///extension.lift (meta.normalize head-k))         [_ tag-set recordT] (///extension.lift (meta.resolve-tag head-k))         #let [size-record (list.size record) @@ -314,9 +314,9 @@             (/.throw ..record-size-mismatch [size-ts size-record recordT record]))         #let [tuple-range (list.indices size-ts)               tag->idx (dictionary.from-list name.hash (list.zip/2 tag-set tuple-range))] -       idx->val (monad.fold @ +       idx->val (monad.fold !                              (function (_ [key val] idx->val) -                              (do @ +                              (do !                                  [key (///extension.lift (meta.normalize key))]                                  (case (dictionary.get key tag->idx)                                    (#.Some idx) @@ -344,13 +344,13 @@      (analyse archive singletonC)      _ -    (do {@ ///.monad} +    (do {! ///.monad}        [members (normalize members)         [membersC recordT] (order members)         expectedT (///extension.lift meta.expected-type)]        (case expectedT          (#.Var _) -        (do @ +        (do !            [inferenceT (//inference.record recordT)             [inferredT membersA] (//inference.general archive analyse inferenceT membersC)]            (wrap (/.tuple membersA))) 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 a58a3f323..855d1cf9f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -44,14 +44,14 @@            (//extension.apply archive recur [name inputs])            (^ [_ (#.Form (list& macro inputs))]) -          (do {@ //.monad} +          (do {! //.monad}              [expansion (/.lift-analysis -                        (do @ +                        (do !                            [macroA (//analysis/type.with-type Macro                                      (analyze archive macro))]                            (case macroA                              (^ (///analysis.constant macro-name)) -                            (do @ +                            (do !                                [?macro (//extension.lift (meta.find-macro macro-name))                                 macro (case ?macro                                         (#.Some macro) @@ -66,12 +66,12 @@              (case expansion                (^ (list& <lux_def_module> referrals))                (|> (recur archive <lux_def_module>) -                  (:: @ map (update@ #/.referrals (list@compose referrals)))) +                  (:: ! map (update@ #/.referrals (list@compose referrals))))                _                (|> expansion -                  (monad.map @ (recur archive)) -                  (:: @ map (list@fold /.merge-requirements /.no-requirements))))) +                  (monad.map ! (recur archive)) +                  (:: ! map (list@fold /.merge-requirements /.no-requirements)))))            _            (//.throw ..not-a-directive code)))))) 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 b195a11a2..708b93ddd 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 @@ -111,10 +111,10 @@    (custom     [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any)))      (function (_ extension phase archive [constructorC inputsC]) -      (do {@ phase.monad} +      (do {! phase.monad}          [constructorA (type.with-type Any                          (phase archive constructorC)) -         inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC) +         inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC)           _ (type.infer .Any)]          (wrap (#analysis.Extension extension (list& constructorA inputsA)))))])) @@ -135,10 +135,10 @@    (custom     [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any)))      (function (_ extension phase archive [methodC objectC inputsC]) -      (do {@ phase.monad} +      (do {! phase.monad}          [objectA (type.with-type Any                     (phase archive objectC)) -         inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC) +         inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC)           _ (type.infer .Any)]          (wrap (#analysis.Extension extension (list& (analysis.text methodC)                                                      objectA @@ -171,10 +171,10 @@    (custom     [($_ <>.and <c>.any (<>.some <c>.any))      (function (_ extension phase archive [abstractionC inputsC]) -      (do {@ phase.monad} +      (do {! phase.monad}          [abstractionA (type.with-type Any                          (phase archive abstractionC)) -         inputsA (monad.map @ (|>> (phase archive) (type.with-type Any)) inputsC) +         inputsA (monad.map ! (|>> (phase archive) (type.with-type Any)) inputsC)           _ (type.infer Any)]          (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) 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 9900c6764..cd8784056 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,9 +288,9 @@          (/////analysis.throw ..primitives-cannot-have-type-parameters class))        #.None -      (do {@ phase.monad} +      (do {! phase.monad}          [parametersJT (: (Operation (List (Type Parameter))) -                         (monad.map @ +                         (monad.map !                                      (function (_ parameterT)                                        (do phase.monad                                          [parameterJT (jvm-type parameterT)] @@ -485,8 +485,8 @@          (phase@map jvm.array))      (#.Primitive name parameters) -    (do {@ phase.monad} -      [parameters (monad.map @ check-parameter parameters)] +    (do {! phase.monad} +      [parameters (monad.map ! check-parameter parameters)]        (phase@wrap (jvm.class name parameters)))      (#.Named name anonymous) @@ -511,8 +511,8 @@  (def: (check-object objectT)    (-> .Type (Operation External)) -  (do {@ phase.monad} -    [name (:: @ map ..reflection (check-jvm objectT))] +  (do {! phase.monad} +    [name (:: ! map ..reflection (check-jvm objectT))]      (if (dictionary.contains? name ..boxes)        (/////analysis.throw ..primitives-are-not-objects [name])        (phase@wrap name)))) @@ -815,12 +815,12 @@  (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 @ +    (monad.map !                 (function (_ superJT) -                 (do @ +                 (do !                     [superJT (phase.lift (reflection!.type superJT))                      #let [super-name (|> superJT ..reflection)]                      super-class (phase.lift (reflection!.load super-name)) @@ -842,8 +842,8 @@      (^ (#.Primitive _ (list& self-classT super-classT super-interfacesT+)))      (monad.map phase.monad                 (function (_ superT) -                 (do {@ phase.monad} -                   [super-name (:: @ map ..reflection (check-jvm superT)) +                 (do {! phase.monad} +                   [super-name (:: ! map ..reflection (check-jvm superT))                      super-class (phase.lift (reflection!.load super-name))]                     (wrap [[super-name superT]                            (java/lang/Class::isAssignableFrom super-class to-class)]))) @@ -857,12 +857,12 @@    (function (_ extension-name analyse archive args)      (case args        (^ (list fromC)) -      (do {@ phase.monad} +      (do {! phase.monad}          [toT (///.lift meta.expected-type) -         to-name (:: @ map ..reflection (check-jvm toT)) +         to-name (:: ! map ..reflection (check-jvm toT))           [fromT fromA] (typeA.with-inference                           (analyse archive fromC)) -         from-name (:: @ map ..reflection (check-jvm fromT)) +         from-name (:: ! map ..reflection (check-jvm fromT))           can-cast? (: (Operation Bit)                        (`` (cond (~~ (template [<primitive> <object>]                                        [(let [=primitive (reflection.reflection <primitive>)] @@ -883,7 +883,7 @@                                        [reflection.char    box.char]))                                  ## else -                                (do @ +                                (do !                                    [_ (phase.assert ..primitives-are-not-objects [from-name]                                                     (not (dictionary.contains? from-name ..boxes)))                                     _ (phase.assert ..primitives-are-not-objects [to-name] @@ -891,14 +891,14 @@                                     to-class (phase.lift (reflection!.load to-name))                                     _ (if (text@= ..inheritance-relationship-type-name from-name)                                         (wrap []) -                                       (do @ +                                       (do !                                           [from-class (phase.lift (reflection!.load from-name))]                                           (phase.assert cannot-cast [fromT toT fromC]                                                         (java/lang/Class::isAssignableFrom from-class to-class))))]                                    (loop [[current-name currentT] [from-name fromT]]                                      (if (text@= to-name current-name)                                        (wrap true) -                                      (do @ +                                      (do !                                          [candidate-parents (: (Operation (List [[Text .Type] Bit]))                                                                (if (text@= ..inheritance-relationship-type-name current-name)                                                                  (inheritance-candidate-parents currentT to-class toT fromC) @@ -1128,11 +1128,11 @@                           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)) -                   (phase@map (monad.map @ (..reflection-type mapping))) +                   (monad.map ! (|>> reflection!.type phase.lift)) +                   (phase@map (monad.map ! (..reflection-type mapping)))                     phase@join)         outputT (|> method                     java/lang/reflect/Method::getGenericReturnType @@ -1142,8 +1142,8 @@                     phase@join)         exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method)                         array.to-list -                       (monad.map @ (|>> reflection!.type phase.lift)) -                       (phase@map (monad.map @ (..reflection-type mapping))) +                       (monad.map ! (|>> reflection!.type phase.lift)) +                       (phase@map (monad.map ! (..reflection-type mapping)))                         phase@join)         #let [methodT (<| (type.univ-q (dictionary.size mapping))                           (type.function (case method-style @@ -1166,16 +1166,16 @@                           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)) -                   (phase@map (monad.map @ (reflection-type mapping))) +                   (monad.map ! (|>> reflection!.type phase.lift)) +                   (phase@map (monad.map ! (reflection-type mapping)))                     phase@join)         exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor)                         array.to-list -                       (monad.map @ (|>> reflection!.type phase.lift)) -                       (phase@map (monad.map @ (reflection-type mapping))) +                       (monad.map ! (|>> reflection!.type phase.lift)) +                       (phase@map (monad.map ! (reflection-type mapping)))                         phase@join)         #let [objectT (#.Primitive (java/lang/Class::getName owner) owner-tvarsT)               constructorT (<| (type.univ-q (dictionary.size mapping)) @@ -1220,21 +1220,21 @@  (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                      java/lang/Class::getDeclaredMethods                      array.to-list                      (list.filter (|>> java/lang/reflect/Method::getName (text@= method-name))) -                    (monad.map @ (: (-> java/lang/reflect/Method (Operation Evaluation)) +                    (monad.map ! (: (-> java/lang/reflect/Method (Operation Evaluation))                                      (function (_ method) -                                      (do @ +                                      (do !                                          [#let [expected-method-tvars (method-type-variables method)                                                 aliasing (dictionary.merge (..aliasing expected-class-tvars actual-class-tvars)                                                                            (..aliasing expected-method-tvars actual-method-tvars))]                                           passes? (check-method aliasing class method-name method-style inputsJT method)] -                                        (:: @ map (if passes? +                                        (:: ! map (if passes?                                                      (|>> #Pass)                                                      (|>> #Hint))                                              (method-signature method-style method)))))))] @@ -1252,19 +1252,19 @@  (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                      java/lang/Class::getConstructors                      array.to-list -                    (monad.map @ (function (_ constructor) -                                   (do @ +                    (monad.map ! (function (_ constructor) +                                   (do !                                       [#let [expected-method-tvars (constructor-type-variables constructor)                                              aliasing (dictionary.merge (..aliasing expected-class-tvars actual-class-tvars)                                                                         (..aliasing expected-method-tvars actual-method-tvars))]                                        passes? (check-constructor aliasing class inputsJT constructor)] -                                     (:: @ map +                                     (:: ! map                                           (if passes? (|>> #Pass) (|>> #Hint))                                           (constructor-signature constructor))))))]      (case (list.all pass! candidates) @@ -1469,16 +1469,16 @@            <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)) +                                     (monad.map ! reflection!.type))                            return (|> method                                       java/lang/reflect/Method::getGenericReturnType                                       reflection!.return)                            exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)                                           array.to-list -                                         (monad.map @ reflection!.class))] +                                         (monad.map ! reflection!.class))]                           (wrap [(java/lang/reflect/Method::getName method)                                  (jvm.method [inputs return exceptions])]))))))] @@ -1575,26 +1575,26 @@    (let [[visibility strict-fp?           annotations vars exceptions           self-name arguments super-arguments body] method] -    (do {@ phase.monad} -      [annotationsA (monad.map @ (function (_ [name parameters]) -                                   (do @ -                                     [parametersA (monad.map @ (function (_ [name value]) -                                                                 (do @ +    (do {! phase.monad} +      [annotationsA (monad.map ! (function (_ [name parameters]) +                                   (do ! +                                     [parametersA (monad.map ! (function (_ [name value]) +                                                                 (do !                                                                     [valueA (analyse archive value)]                                                                     (wrap [name valueA])))                                                               parameters)]                                       (wrap [name parametersA])))                                 annotations) -       super-arguments (monad.map @ (function (_ [jvmT super-argC]) -                                      (do @ +       super-arguments (monad.map ! (function (_ [jvmT super-argC]) +                                      (do !                                          [luxT (reflection-type mapping jvmT)                                           super-argA (typeA.with-type luxT                                                        (analyse archive super-argC))]                                          (wrap [jvmT super-argA])))                                    super-arguments) -       arguments' (monad.map @ +       arguments' (monad.map !                               (function (_ [name jvmT]) -                               (do @ +                               (do !                                   [luxT (reflection-type mapping jvmT)]                                   (wrap [name luxT])))                               arguments) @@ -1657,20 +1657,20 @@           final? strict-fp? annotations vars           self-name arguments return exceptions           body] method] -    (do {@ phase.monad} -      [annotationsA (monad.map @ (function (_ [name parameters]) -                                   (do @ -                                     [parametersA (monad.map @ (function (_ [name value]) -                                                                 (do @ +    (do {! phase.monad} +      [annotationsA (monad.map ! (function (_ [name parameters]) +                                   (do ! +                                     [parametersA (monad.map ! (function (_ [name value]) +                                                                 (do !                                                                     [valueA (analyse archive value)]                                                                     (wrap [name valueA])))                                                               parameters)]                                       (wrap [name parametersA])))                                 annotations)         returnT (reflection-return mapping return) -       arguments' (monad.map @ +       arguments' (monad.map !                               (function (_ [name jvmT]) -                               (do @ +                               (do !                                   [luxT (reflection-type mapping jvmT)]                                   (wrap [name luxT])))                               arguments) @@ -1731,20 +1731,20 @@           strict-fp? annotations vars exceptions           arguments return           body] method] -    (do {@ phase.monad} -      [annotationsA (monad.map @ (function (_ [name parameters]) -                                   (do @ -                                     [parametersA (monad.map @ (function (_ [name value]) -                                                                 (do @ +    (do {! phase.monad} +      [annotationsA (monad.map ! (function (_ [name parameters]) +                                   (do ! +                                     [parametersA (monad.map ! (function (_ [name value]) +                                                                 (do !                                                                     [valueA (analyse archive value)]                                                                     (wrap [name valueA])))                                                               parameters)]                                       (wrap [name parametersA])))                                 annotations)         returnT (reflection-return mapping return) -       arguments' (monad.map @ +       arguments' (monad.map !                               (function (_ [name jvmT]) -                               (do @ +                               (do !                                   [luxT (reflection-type mapping jvmT)]                                   (wrap [name luxT])))                               arguments) @@ -1806,20 +1806,20 @@           strict-fp? annotations vars           self-name arguments return exceptions           body] method] -    (do {@ phase.monad} -      [annotationsA (monad.map @ (function (_ [name parameters]) -                                   (do @ -                                     [parametersA (monad.map @ (function (_ [name value]) -                                                                 (do @ +    (do {! phase.monad} +      [annotationsA (monad.map ! (function (_ [name parameters]) +                                   (do ! +                                     [parametersA (monad.map ! (function (_ [name value]) +                                                                 (do !                                                                     [valueA (analyse archive value)]                                                                     (wrap [name valueA])))                                                               parameters)]                                       (wrap [name parametersA])))                                 annotations)         returnT (reflection-return mapping return) -       arguments' (monad.map @ +       arguments' (monad.map !                               (function (_ [name jvmT]) -                               (do @ +                               (do !                                   [luxT (reflection-type mapping jvmT)]                                   (wrap [name luxT])))                               arguments) @@ -1920,7 +1920,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) @@ -1942,21 +1942,21 @@                                                                  super-classT                                                                  super-interfaceT+))))           _ (typeA.infer selfT) -         constructor-argsA+ (monad.map @ (function (_ [type term]) -                                           (do @ +         constructor-argsA+ (monad.map ! (function (_ [type term]) +                                           (do !                                               [argT (reflection-type mapping type)                                                termA (typeA.with-type argT                                                        (analyse archive term))]                                               (wrap [type termA])))                                         constructor-args) -         methodsA (monad.map @ (analyse-overriden-method analyse archive selfT mapping) methods) +         methodsA (monad.map ! (analyse-overriden-method analyse archive selfT mapping) methods)           required-abstract-methods (phase.lift (all-abstract-methods (list& super-class super-interfaces)))           available-methods (phase.lift (all-methods (list& super-class super-interfaces))) -         overriden-methods (monad.map @ (function (_ [parent-type method-name +         overriden-methods (monad.map ! (function (_ [parent-type method-name                                                        strict-fp? annotations vars                                                        self-name arguments return exceptions                                                        body]) -                                          (do @ +                                          (do !                                              [aliasing (super-aliasing parent-type)]                                              (wrap [method-name (|> (jvm.method [(list@map product.right arguments)                                                                                  return 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 1e3a18cba..0e6d9ba7d 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 @@ -52,9 +52,9 @@      (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 @ +             argsA (monad.map !                                (function (_ [argT argC])                                  (typeA.with-type argT                                    (analyse archive argC))) @@ -100,12 +100,12 @@                                       <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 meta.expected-type) -          conditionals (monad.map @ (function (_ [cases branch]) -                                      (do @ +          conditionals (monad.map ! (function (_ [cases branch]) +                                      (do !                                          [branch (typeA.with-type expectedT                                                    (phase archive branch))]                                          (wrap [cases branch]))) @@ -162,9 +162,9 @@    (function (_ extension-name analyse archive args)      (case args        (^ (list typeC valueC)) -      (do {@ ////.monad} +      (do {! ////.monad}          [count (///.lift meta.count) -         actualT (:: @ map (|>> (:coerce Type)) +         actualT (:: ! map (|>> (:coerce Type))                       (eval archive count Type typeC))           _ (typeA.infer actualT)]          (typeA.with-type actualT @@ -178,9 +178,9 @@    (function (_ extension-name analyse archive args)      (case args        (^ (list typeC valueC)) -      (do {@ ////.monad} +      (do {! ////.monad}          [count (///.lift meta.count) -         actualT (:: @ map (|>> (:coerce Type)) +         actualT (:: ! map (|>> (:coerce Type))                       (eval archive count Type typeC))           _ (typeA.infer actualT)           [valueT valueA] (typeA.with-inference @@ -195,7 +195,7 @@    (..custom     [<c>.any      (function (_ extension-name phase archive valueC) -      (do {@ ////.monad} +      (do {! ////.monad}          [_ (typeA.infer output)]          (typeA.with-type input            (phase archive valueC))))])) @@ -205,10 +205,10 @@    (..custom     [<c>.any      (function (_ extension-name phase archive valueC) -      (do {@ ////.monad} +      (do {! ////.monad}          [_ (typeA.infer .Macro)           input-type (loop [input-name (name-of .Macro')] -                      (do @ +                      (do !                          [input-type (///.lift (meta.find-def (name-of .Macro')))]                          (case input-type                            (#.Definition [exported? def-type def-data def-value]) 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 5a2770b70..b86c2488c 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))) @@ -280,7 +280,7 @@           #let [analyse (get@ [#directive.analysis #directive.phase] state)                 synthesize (get@ [#directive.synthesis #directive.phase] state)                 generate (get@ [#directive.generation #directive.phase] state)] -         methods (monad.map @ (..method-definition [mapping selfT] [analyse synthesize generate]) +         methods (monad.map ! (..method-definition [mapping selfT] [analyse synthesize generate])                              methods)           ## _ (directive.lift-generation           ##    (generation.save! true ["" name] 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 391c13cb1..d8d6ed817 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 @@ -120,7 +120,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) @@ -130,7 +130,7 @@                               (typeA.with-fresh-env                                 (case expected                                   #.None -                                 (do @ +                                 (do !                                     [[code//type codeA] (typeA.with-inference                                                           (analyse archive codeC))                                      code//type (typeA.with-env @@ -138,7 +138,7 @@                                     (wrap [code//type codeA]))                                   (#.Some expected) -                                 (do @ +                                 (do !                                     [codeA (typeA.with-type expected                                              (analyse archive codeC))]                                     (wrap [expected codeA])))))) @@ -265,13 +265,13 @@    (..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 -            (do @ -              [_ (monad.map @ (function (_ [module alias]) -                                (do @ +            (do ! +              [_ (monad.map ! (function (_ [module alias]) +                                (do !                                    [_ (module.import module)]                                    (case alias                                      "" (wrap []) 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 546477aac..13d67f8fa 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 @@ -155,13 +155,13 @@                                           (<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)                                                       Statement])) -                                   (monad.map @ (function (_ [chars branch]) -                                                  (do @ +                                   (monad.map ! (function (_ [chars branch]) +                                                  (do !                                                      [branchG (phase archive branch)]                                                      (wrap [(list@map (|>> .int _.int) chars)                                                             (_.return branchG)]))) 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 d9b52e450..f7cc747ff 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 @@ -65,9 +65,9 @@    (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)] +         inputsG (monad.map ! (phase archive) inputsS)]          (wrap (_.new constructorG inputsG))))]))  (def: object::get @@ -84,9 +84,9 @@    (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)] +         inputsG (monad.map ! (phase archive) inputsS)]          (wrap (_.do methodS inputsG objectG))))]))  (template [<!> <?> <unit>] @@ -122,21 +122,21 @@    (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)] +         inputsG (monad.map ! (phase archive) inputsS)]          (wrap (_.apply/* abstractionG inputsG))))]))  (def: js::function    (custom     [($_ <>.and <s>.i64 <s>.any)      (function (_ extension phase archive [arity abstractionS]) -      (do {@ ////////phase.monad} +      (do {! ////////phase.monad}          [abstractionG (phase archive abstractionS)           #let [variable (: (-> Text (Operation Var))                             (|>> generation.gensym -                                (:: @ map _.var)))] -         g!inputs (monad.map @ (function (_ _) (variable "input")) +                                (:: ! map _.var)))] +         g!inputs (monad.map ! (function (_ _) (variable "input"))                               (list.repeat (.nat arity) []))           g!abstraction (variable "abstraction")]          (wrap (_.closure g!inputs 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 313620611..68c69d153 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,14 +105,14 @@                                           (<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)                    conditionalsG+ (: (Operation (List [(List [S4 Label])                                                        (Bytecode Any)])) -                                    (monad.map @ (function (_ [chars branch]) -                                                   (do @ +                                    (monad.map ! (function (_ [chars branch]) +                                                   (do !                                                       [branchG (phase archive branch)                                                        @branch ///runtime.forge-label]                                                       (wrap [(list@map (function (_ char) 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 7c4d09936..f0f2fa635 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 @@ -750,8 +750,8 @@    (..custom     [($_ <>.and ..class <s>.text ..return (<>.some ..input))      (function (_ extension-name generate archive [class method outputT inputsTS]) -      (do {@ //////.monad} -        [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] +      (do {! //////.monad} +        [inputsTG (monad.map ! (generate-input generate archive) inputsTS)]          (wrap ($_ _.compose                    (monad.map _.monad product.right inputsTG)                    (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)])) @@ -763,9 +763,9 @@       (..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)] +            inputsTG (monad.map ! (generate-input generate archive) inputsTS)]             (wrap ($_ _.compose                       objectG                       (_.checkcast class) @@ -783,8 +783,8 @@    (..custom     [($_ <>.and ..class (<>.some ..input))      (function (_ extension-name generate archive [class inputsTS]) -      (do {@ //////.monad} -        [inputsTG (monad.map @ (generate-input generate archive) inputsTS)] +      (do {! //////.monad} +        [inputsTG (monad.map ! (generate-input generate archive) inputsTS)]          (wrap ($_ _.compose                    (_.new class)                    _.dup @@ -959,8 +959,8 @@  (def: (anonymous-instance generate archive class env)    (-> Phase Archive (Type category.Class) (Environment Synthesis) (Operation (Bytecode Any))) -  (do {@ //////.monad} -    [captureG+ (monad.map @ (generate archive) env)] +  (do {! //////.monad} +    [captureG+ (monad.map ! (generate archive) env)]      (wrap ($_ _.compose                (_.new class)                _.dup @@ -1008,7 +1008,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) @@ -1045,12 +1045,12 @@                                                   self-name arguments returnT exceptionsT                                                   (normalize-method-body local-mapping body)]))                                              overriden-methods)] -         inputsTI (monad.map @ (generate-input generate archive) inputsTS) -         method-definitions (monad.map @ (function (_ [ownerT name +         inputsTI (monad.map ! (generate-input generate archive) inputsTS) +         method-definitions (monad.map ! (function (_ [ownerT name                                                         strict-fp? annotations vars                                                         self-name arguments returnT exceptionsT                                                         bodyS]) -                                           (do @ +                                           (do !                                               [bodyG (//////generation.with-context artifact-id                                                        (generate archive bodyS))]                                               (wrap (method.method ($_ modifier@compose @@ -1068,7 +1068,7 @@                                                                                bodyG                                                                                (returnG returnT)))))))                                         normalized-methods) -         bytecode (<| (:: @ map (format.run class.writer)) +         bytecode (<| (:: ! map (format.run class.writer))                        //////.lift                        (class.class version.v6_0 ($_ modifier@compose class.public class.final)                                     (name.internal anonymous-class-name) 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 36c082daf..196938917 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,9 +25,9 @@  (def: #export (apply generate [functionS argsS+])    (-> Phase (Application Synthesis) (Operation (Expression Any))) -  (do {@ ////.monad} +  (do {! ////.monad}      [functionG (generate functionS) -     argsG+ (monad.map @ generate argsS+)] +     argsG+ (monad.map ! generate argsS+)]      (wrap (_.funcall/+ [functionG argsG+]))))  (def: #export capture @@ -40,8 +40,8 @@      (:: ////.monad wrap function-definition)      _ -    (do {@ ////.monad} -      [@closure (:: @ map _.var (///.gensym "closure"))] +    (do {! ////.monad} +      [@closure (:: ! map _.var (///.gensym "closure"))]        (wrap (_.labels (list [@closure [(|> (list.enumeration inits)                                             (list@map (|>> product.left ..capture))                                             _.args) @@ -53,14 +53,14 @@  (def: #export (function generate [environment arity bodyS])    (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) -  (do {@ ////.monad} +  (do {! ////.monad}      [[function-name bodyG] (///.with-context -                             (do @ +                             (do !                                 [function-name ///.context]                                 (///.with-anchor (_.var function-name)                                   (generate bodyS))))       closureG+ (: (Operation (List (Expression Any))) -                  (monad.map @ (:: //reference.system variable) environment)) +                  (monad.map ! (:: //reference.system variable) environment))       #let [@curried (_.var "curried")             @missing (_.var "missing")             arityG (|> arity .int _.int) 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 b5de4353e..3c3232e64 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,9 +22,9 @@  (def: #export (scope generate [start initsS+ bodyS])    (-> Phase (Scope Synthesis) (Operation (Expression Any))) -  (do {@ ////.monad} -    [@scope (:: @ map (|>> %.nat (format "scope") _.var) ///.next) -     initsG+ (monad.map @ generate initsS+) +  (do {! ////.monad} +    [@scope (:: ! map (|>> %.nat (format "scope") _.var) ///.next) +     initsG+ (monad.map ! generate initsS+)       bodyG (///.with-anchor @scope               (generate bodyS))]      (wrap (_.labels (list [@scope {#_.input (|> initsS+ @@ -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+)] +     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 64720073a..499ec7d37 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 @@ -31,8 +31,8 @@  (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 {@ meta.monad} -      [g!input+ (monad.seq @ (list.repeat arity (meta.gensym "input")))] +    (do {! meta.monad} +      [g!input+ (monad.seq ! (list.repeat arity (meta.gensym "input")))]        (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension))                         (All [(~ g!anchor) (~ g!expression) (~ g!directive)]                           (-> ((~ type) (~ g!expression)) @@ -60,6 +60,6 @@      (-> (Variadic expression) (generation.Handler anchor expression directive)))    (function (_ extension-name)      (function (_ phase archive inputsS) -      (do {@ ///.monad} -        [inputsI (monad.map @ (phase archive) inputsS)] +      (do {! ///.monad} +        [inputsI (monad.map ! (phase archive) inputsS)]          (wrap (extension inputsI)))))) 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 99a6c247e..a2c46f8fd 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 @@ -117,9 +117,9 @@  (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)] +     inputsG (monad.map ! (generate archive) inputsS)]      (wrap ($_ _.compose                abstractionG                (|> inputsG 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 a36289d05..1800064a2 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 @@ -53,8 +53,8 @@  (def: #export (instance generate archive class environment arity)    (-> Phase Archive (Type Class) (Environment Synthesis) Arity (Operation (Bytecode Any))) -  (do {@ phase.monad} -    [foreign* (monad.map @ (generate archive) environment)] +  (do {! phase.monad} +    [foreign* (monad.map ! (generate archive) environment)]      (wrap (instance' foreign* class environment arity))))  (def: #export (method 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 cdf03d7b0..d5ebb3fdc 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,8 +111,8 @@                                                          (_.putstatic (type.class bytecode-name (list)) ..value::field ..value::type)                                                          _.return))))                                (row.row))] -    (io.run (do {@ (try.with io.monad)} -              [bytecode (:: @ map (format.run class.writer) +    (io.run (do {! (try.with io.monad)} +              [bytecode (:: ! map (format.run class.writer)                              (io.io bytecode))                 _ (loader.store eval-class bytecode library)                 class (loader.load eval-class loader) 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 cea8fda10..8eaafb3a5 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 @@ -38,17 +38,17 @@  (def: #export (recur translate archive updatesS)    (Generator (List Synthesis)) -  (do {@ phase.monad} +  (do {! phase.monad}      [[@begin offset] generation.anchor       updatesG (|> updatesS                    list.enumeration                    (list@map (function (_ [index updateS])                                [(n.+ offset index) updateS])) -                  (monad.map @ (function (_ [register updateS]) +                  (monad.map ! (function (_ [register updateS])                                   (if (invariant? register updateS)                                     (wrap [..no-op                                            ..no-op]) -                                   (do @ +                                   (do !                                       [fetchG (translate archive updateS)                                        #let [storeG (_.astore register)]]                                       (wrap [fetchG storeG]))))))] @@ -72,9 +72,9 @@  (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+) +     initsI+ (monad.map ! (translate archive) initsS+)       iterationG (generation.with-anchor [@begin offset]                    (translate archive iterationS))       #let [initializationG (|> (list.enumeration initsI+) 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 b21c899e0..1d99c2736 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 @@ -40,8 +40,8 @@  (def: (foreign archive variable)    (-> Archive Register (Operation (Bytecode Any))) -  (do {@ ////.monad} -    [bytecode-name (:: @ map //runtime.class-name +  (do {! ////.monad} +    [bytecode-name (:: ! map //runtime.class-name                         (generation.context archive))]      (wrap ($_ _.compose                ..this @@ -60,7 +60,7 @@  (def: #export (constant archive name)    (-> Archive Name (Operation (Bytecode Any))) -  (do {@ ////.monad} -    [bytecode-name (:: @ map //runtime.class-name +  (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 eb786662c..bbf8f252c 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 @@ -35,21 +35,21 @@      (generate archive singletonS)      _ -    (do {@ phase.monad} +    (do {! phase.monad}        [membersI (|> membersS                      list.enumeration -                    (monad.map @ (function (_ [idx member]) -                                   (do @ +                    (monad.map ! (function (_ [idx member]) +                                   (do !                                       [memberI (generate archive member)]                                       (wrap (do _.monad                                               [_ _.dup                                                _ (_.int (.i64 idx))                                                _ memberI]                                               _.aastore))))))] -      (wrap (do {@ _.monad} +      (wrap (do {! _.monad}                [_ (_.int (.i64 (list.size membersS)))                 _ (_.anewarray $Object)] -              (monad.seq @ membersI)))))) +              (monad.seq ! membersI))))))  (def: #export (tag lefts right?)    (-> Nat Bit (Bytecode Any)) 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 d5da7253a..b13bc5834 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,8 +39,8 @@  (syntax: (arity: {name s.local-identifier} {arity s.nat})    (with-gensyms [g!_ g!extension g!name g!phase g!inputs] -    (do {@ macro.monad} -      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] +    (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)                             Handler) @@ -66,8 +66,8 @@    (-> Variadic Handler)    (function (_ extension-name)      (function (_ phase inputsS) -      (do {@ /////.monad} -        [inputsI (monad.map @ phase inputsS)] +      (do {! /////.monad} +        [inputsI (monad.map ! phase inputsS)]          (wrap (extension inputsI))))))  (def: bundle::lux 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 ba48ab2ec..2bf25cec9 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,9 +27,9 @@  (def: #export (apply generate [functionS argsS+])    (-> Phase (Application Synthesis) (Operation Computation)) -  (do {@ ////.monad} +  (do {! ////.monad}      [functionO (generate functionS) -     argsO+ (monad.map @ generate argsS+)] +     argsO+ (monad.map ! generate argsS+)]      (wrap (_.apply/* functionO argsO+))))  (def: #export capture @@ -59,14 +59,14 @@  (def: #export (function generate [environment arity bodyS])    (-> Phase (Abstraction Synthesis) (Operation Computation)) -  (do {@ ////.monad} +  (do {! ////.monad}      [[function-name bodyO] (///.with-context -                             (do @ +                             (do !                                 [function-name ///.context]                                 (///.with-anchor (_.var function-name)                                   (generate bodyS))))       closureO+ (: (Operation (List Expression)) -                  (monad.map @ (:: //reference.system variable) environment)) +                  (monad.map ! (:: //reference.system variable) environment))       #let [arityO (|> arity .int _.int)             apply-poly (.function (_ args func)                          (_.apply/2 (_.global "apply") func args)) 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 aac83a7dc..b4a9943ec 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,8 +23,8 @@  (def: #export (scope generate [start initsS+ bodyS])    (-> Phase (Scope Synthesis) (Operation Computation)) -  (do {@ ////.monad} -    [initsO+ (monad.map @ generate initsS+) +  (do {! ////.monad} +    [initsO+ (monad.map ! generate initsS+)       bodyO (///.with-anchor @scope               (generate bodyS))]      (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ @@ -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+)] +     argsO+ (monad.map ! generate argsS+)]      (wrap (_.apply/* @scope argsO+)))) 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 32db39342..268937c12 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 @@ -223,9 +223,9 @@  (def: #export (synthesize-case synthesize archive input [[headP headA] tailPA+])    (-> Phase Archive Synthesis Match (Operation Synthesis)) -  (do {@ ///.monad} +  (do {! ///.monad}      [headSP (path archive synthesize headP headA) -     tailSP+ (monad.map @ (product.uncurry (path archive synthesize)) tailPA+)] +     tailSP+ (monad.map ! (product.uncurry (path archive synthesize)) tailPA+)]      (wrap (/.branch/case [input (list@fold weave headSP tailSP+)]))))  (template: (!masking <variable> <output>) @@ -274,7 +274,7 @@  (def: #export (synthesize synthesize^ [headB tailB+] archive inputA)    (-> Phase Match Phase) -  (do {@ ///.monad} +  (do {! ///.monad}      [inputS (synthesize^ archive inputA)]      (case [headB tailB+]        (^ (!masking @variable @output)) 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 4f510e1b6..6c70612b4 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 @@ -47,15 +47,15 @@    (-> 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)] +         argsS (monad.map ! (phase archive) argsA)]          (with-expansions [<apply> (as-is (/.function/apply [funcS argsS]))]            (case funcS              (^ (/.function/abstraction functionS))              (if (n.= (get@ #/.arity functionS)                       (list.size argsS)) -              (do @ +              (do !                  [locals /.locals]                  (wrap (|> functionS                            (//loop.optimization true locals argsS) @@ -103,11 +103,11 @@      ([#/.Alt] [#/.Seq])      (#/.Bit-Fork when then else) -    (do {@ phase.monad} +    (do {! phase.monad}        [then (grow-path grow then)         else (case else                (#.Some else) -              (:: @ map (|>> #.Some) (grow-path grow else)) +              (:: ! map (|>> #.Some) (grow-path grow else))                #.None                (wrap #.None))] @@ -115,10 +115,10 @@      (^template [<tag>]        (<tag> [[test then] elses]) -      (do {@ phase.monad} +      (do {! phase.monad}          [then (grow-path grow then) -         elses (monad.map @ (function (_ [else-test else-then]) -                              (do @ +         elses (monad.map ! (function (_ [else-test else-then]) +                              (do !                                  [else-then (grow-path grow else-then)]                                  (wrap [else-test else-then])))                            elses)] @@ -197,8 +197,8 @@        (#/.Loop loop)        (case loop          (#/.Scope [start initsS+ iterationS]) -        (do {@ phase.monad} -          [initsS+' (monad.map @ (grow environment) initsS+) +        (do {! phase.monad} +          [initsS+' (monad.map ! (grow environment) initsS+)             iterationS' (grow environment iterationS)]            (wrap (/.loop/scope [(inc start) initsS+' iterationS']))) @@ -210,8 +210,8 @@        (#/.Function function)        (case function          (#/.Abstraction [_env _arity _body]) -        (do {@ phase.monad} -          [_env' (monad.map @ +        (do {! phase.monad} +          [_env' (monad.map !                              (|>> (case> (#/.Reference (#////reference.Variable (#////reference/variable.Foreign register)))                                          (..find-foreign environment register) @@ -221,9 +221,9 @@            (wrap (/.function/abstraction [_env' _arity _body])))          (#/.Apply funcS argsS+) -        (do {@ phase.monad} +        (do {! phase.monad}            [funcS (grow environment funcS) -           argsS+ (monad.map @ (grow environment) argsS+)] +           argsS+ (monad.map ! (grow environment) argsS+)]            (wrap (/.function/apply (case funcS                                      (^ (/.function/apply [(..self-reference) pre-argsS+]))                                      [(..self-reference) @@ -243,9 +243,9 @@  (def: #export (abstraction phase environment archive bodyA)    (-> Phase (Environment Analysis) Phase) -  (do {@ phase.monad} +  (do {! phase.monad}      [currying? /.currying? -     environment (monad.map @ (phase archive) environment) +     environment (monad.map ! (phase archive) environment)       bodyS (/.with-currying? true               (/.with-locals 2                 (phase archive bodyA))) @@ -254,7 +254,7 @@                        (^ (/.function/abstraction [env' down-arity' bodyS']))                        (|> bodyS'                            (grow env') -                          (:: @ map (function (_ body) +                          (:: ! map (function (_ body)                                        {#/.environment environment                                         #/.arity (inc down-arity')                                         #/.body body}))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 064aca2a7..eca662b25 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -39,11 +39,11 @@        ([#/.Alt] [#/.Seq])        (#/.Bit-Fork when then else) -      (do {@ maybe.monad} +      (do {! maybe.monad}          [then (recur then)           else (case else                  (#.Some else) -                (:: @ map (|>> #.Some) (recur else)) +                (:: ! map (|>> #.Some) (recur else))                  #.None                  (wrap #.None))] @@ -51,10 +51,10 @@        (^template [<tag>]          (<tag> [[test then] elses]) -        (do {@ maybe.monad} +        (do {! maybe.monad}            [then (recur then) -           elses (monad.map @ (function (_ [else-test else-then]) -                                (do @ +           elses (monad.map ! (function (_ [else-test else-then]) +                                (do !                                    [else-then (recur else-then)]                                    (wrap [else-test else-then])))                              elses)] @@ -136,10 +136,10 @@          (wrap (/.branch/get [path record])))        (^ (/.loop/scope scope)) -      (do {@ maybe.monad} +      (do {! maybe.monad}          [inits' (|> scope                      (get@ #/.inits) -                    (monad.map @ (recur false))) +                    (monad.map ! (recur false)))           iteration' (recur return? (get@ #/.iteration scope))]          (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register-optimization offset))                               #/.inits inits' @@ -151,8 +151,8 @@            (maybe@map (|>> /.loop/recur)))        (^ (/.function/abstraction [environment arity body])) -      (do {@ maybe.monad} -        [environment' (monad.map @ (recur false) environment)] +      (do {! maybe.monad} +        [environment' (monad.map ! (recur false) environment)]          (wrap (/.function/abstraction [environment' arity body])))        (^ (/.function/apply [abstraction arguments])) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 6b67ba5aa..ab0858583 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -251,11 +251,11 @@                       path])        (#/.Bit-Fork when then else) -      (do {@ try.monad} +      (do {! try.monad}          [[redundancy then] (recur [redundancy then])           [redundancy else] (case else                               (#.Some else) -                             (:: @ map +                             (:: ! map                                   (function (_ [redundancy else])                                     [redundancy (#.Some else)])                                   (recur [redundancy else])) @@ -266,11 +266,11 @@        (^template [<tag> <type>]          (<tag> [[test then] elses]) -        (do {@ try.monad} +        (do {! try.monad}            [[redundancy then] (recur [redundancy then])             [redundancy elses] (..list-optimization (: (Optimization [<type> Path])                                                        (function (_ [redundancy [else-test else-then]]) -                                                        (do @ +                                                        (do !                                                            [[redundancy else-then] (recur [redundancy else-then])]                                                            (wrap [redundancy [else-test else-then]]))))                                                     [redundancy elses])] @@ -415,7 +415,7 @@          (#/.Function function)          (case function            (#/.Abstraction [environment arity body]) -          (do {@ try.monad} +          (do {! try.monad}              [[redundancy environment] (..list-optimization optimization' [redundancy environment])               [_ body] (optimization' [(..default arity) body])]              (wrap [redundancy diff --git a/stdlib/source/lux/tool/compiler/language/lux/program.lux b/stdlib/source/lux/tool/compiler/language/lux/program.lux index aef6fdab6..85cb03670 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/program.lux @@ -33,12 +33,12 @@  (def: #export (context archive)    (-> Archive (Try Context)) -  (do {@ try.monad} +  (do {! try.monad}      [registries (|> archive                      archive.archived -                    (monad.map @ +                    (monad.map !                                 (function (_ module) -                                 (do @ +                                 (do !                                     [id (archive.id module archive)                                      [descriptor document] (archive.find module archive)]                                     (wrap [[module id] (get@ #descriptor.registry descriptor)])))))] diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 9e83cc367..1533816fc 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -91,14 +91,14 @@  (def: #export (prepare system static module-id)    (-> (file.System Promise) Static archive.ID (Promise (Try Any))) -  (do {@ promise.monad} +  (do {! promise.monad}      [#let [module (..module system static module-id)]       module-exists? (file.exists? promise.monad system module)]      (if module-exists?        (wrap (#try.Success [])) -      (do @ -        [_ (file.get-directory @ system (..unversioned-lux-archive system static)) -         _ (file.get-directory @ system (..versioned-lux-archive system static)) +      (do ! +        [_ (file.get-directory ! system (..unversioned-lux-archive system static)) +         _ (file.get-directory ! system (..versioned-lux-archive system static))           outcome (!.use (:: system create-directory) module)]          (case outcome            (#try.Success output) @@ -175,10 +175,10 @@  (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 @ +                (monad.map ! (function (_ module) +                               (do !                                   [[descriptor document] (archive.find module archive)                                    content (document.read $.key document)]                                   (wrap [module content]))) @@ -187,7 +187,7 @@  (def: (cached-artifacts system static module-id)    (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary)))) -  (do {@ (try.with promise.monad)} +  (do {! (try.with promise.monad)}      [module-dir (!.use (:: system directory) (..module system static module-id))       cached-files (!.use (:: module-dir files) [])]      (|> cached-files @@ -195,14 +195,14 @@                      [(!.use (:: file name) [])                       (!.use (:: file path) [])]))          (list.filter (|>> product.left (text@= ..module-descriptor-file) not)) -        (monad.map @ (function (_ [name path]) -                       (do @ +        (monad.map ! (function (_ [name path]) +                       (do !                           [file (: (Promise (Try (File Promise)))                                    (!.use (:: system file) path))                            data (: (Promise (Try Binary))                                    (!.use (:: file content) []))]                           (wrap [name data])))) -        (:: @ map (dictionary.from-list text.hash))))) +        (:: ! map (dictionary.from-list text.hash)))))  (type: Definitions (Dictionary Text Any))  (type: Analysers (Dictionary Text analysis.Handler)) @@ -227,7 +227,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 @@ -236,13 +236,13 @@                                  (let [[analysers synthesizers generators directives] bundles]                                    (case input                                      (#.Cons [[artifact-id artifact-category] input']) -                                    (case (do @ +                                    (case (do !                                              [data (try.from-maybe (dictionary.get (format (%.nat artifact-id) extension) actual))                                               #let [context [module-id artifact-id]                                                     directive (:: host ingest context data)]]                                              (case artifact-category                                                #artifact.Anonymous -                                              (do @ +                                              (do !                                                  [_ (:: host re-learn context directive)]                                                  (wrap [definitions                                                         [analysers @@ -257,7 +257,7 @@                                                          synthesizers                                                          generators                                                          directives]]) -                                                (do @ +                                                (do !                                                    [value (:: host re-load context directive)]                                                    (wrap [(dictionary.put name value definitions)                                                           [analysers @@ -266,7 +266,7 @@                                                            directives]])))                                                (#artifact.Analyser extension) -                                              (do @ +                                              (do !                                                  [value (:: host re-load context directive)]                                                  (wrap [definitions                                                         [(dictionary.put extension (:coerce analysis.Handler value) analysers) @@ -275,7 +275,7 @@                                                          directives]]))                                                (#artifact.Synthesizer extension) -                                              (do @ +                                              (do !                                                  [value (:: host re-load context directive)]                                                  (wrap [definitions                                                         [analysers @@ -284,7 +284,7 @@                                                          directives]]))                                                (#artifact.Generator extension) -                                              (do @ +                                              (do !                                                  [value (:: host re-load context directive)]                                                  (wrap [definitions                                                         [analysers @@ -293,7 +293,7 @@                                                          directives]]))                                                (#artifact.Directive extension) -                                              (do @ +                                              (do !                                                  [value (:: host re-load context directive)]                                                  (wrap [definitions                                                         [analysers @@ -309,13 +309,13 @@                                      #.None                                      (#try.Success [definitions bundles])))))       content (document.read $.key document) -     definitions (monad.map @ (function (_ [def-name def-global]) +     definitions (monad.map ! (function (_ [def-name def-global])                                  (case def-global                                    (#.Alias alias)                                    (wrap [def-name (#.Alias alias)])                                    (#.Definition [exported? type annotations _]) -                                  (do @ +                                  (do !                                      [value (try.from-maybe (dictionary.get def-name definitions))]                                      (wrap [def-name (#.Definition [exported? type annotations value])]))))                              (get@ #.definitions content))] @@ -336,10 +336,10 @@  (def: (purge! system static [module-name module-id])    (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any))) -  (do {@ (try.with promise.monad)} +  (do {! (try.with promise.monad)}      [cache (!.use (:: system directory) [(..module system static module-id)])       artifacts (!.use (:: cache files) []) -     _ (monad.map @ (function (_ artifact) +     _ (monad.map ! (function (_ artifact)                        (!.use (:: artifact delete) []))                    artifacts)]      (!.use (:: cache discard) []))) @@ -388,17 +388,17 @@    (All [expression directive]      (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive          (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]) -                                          (do @ +                           (monad.map ! (function (_ [module-name module-id]) +                                          (do !                                              [data (..read-module-descriptor system static module-id)                                               [descriptor document] (promise@wrap (<b>.run ..parser data))]                                              (if (text@= archive.runtime-module module-name)                                                (wrap [true                                                       [module-name [module-id [descriptor document]]]]) -                                              (do @ +                                              (do !                                                  [input (//context.read system import contexts (get@ #static.host-module-extension static) module-name)]                                                  (wrap [(..valid-cache? descriptor input)                                                         [module-name [module-id [descriptor document]]]]))))))) @@ -414,18 +414,18 @@       #let [purge (..full-purge pre-loaded-caches load-order)]       _ (|> purge             dictionary.entries -           (monad.map @ (..purge! system static))) +           (monad.map ! (..purge! system static)))       loaded-caches (|> load-order                         (list.filter (function (_ [module-name [module-id [descriptor document]]])                                        (not (dictionary.contains? module-name purge)))) -                       (monad.map @ (function (_ [module-name [module-id descriptor,document]]) -                                      (do @ +                       (monad.map ! (function (_ [module-name [module-id descriptor,document]]) +                                      (do !                                          [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)]                                          (wrap [[module-name descriptor,document]                                                 bundles])))))]      (promise@wrap -     (do {@ try.monad} -       [archive (monad.fold @ +     (do {! try.monad} +       [archive (monad.fold !                              (function (_ [[module descriptor,document] _bundle] archive)                                (archive.add module descriptor,document archive))                              archive diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index 7d6a56b63..c524f605f 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -78,16 +78,16 @@        (Promise (Try [Path Binary])))    ## Preference is explicitly being given to Lux files that have a host extension.    ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. -  (do {@ promise.monad} +  (do {! promise.monad}      [outcome (..find-source-file system contexts module (..full-host-extension partial-host-extension))]      (case outcome        (#try.Success [path file]) -      (do (try.with @) +      (do (try.with !)          [data (!.use (:: file content) [])]          (wrap [path data]))        (#try.Failure _) -      (do (try.with @) +      (do (try.with !)          [[path file] (..find-source-file system contexts module ..lux-extension)           data (!.use (:: file content) [])]          (wrap [path data]))))) @@ -113,7 +113,7 @@        (Promise (Try [Path Binary])))    ## Preference is explicitly being given to Lux files that have a host extension.    ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. -  (do {@ promise.monad} +  (do {! promise.monad}      [outcome (find-local-source-file system import contexts partial-host-extension module)]      (case outcome        (#try.Success [path data]) @@ -157,16 +157,16 @@  (def: (enumerate-context system context enumeration)    (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) -  (do {@ (try.with promise.monad)} +  (do {! (try.with promise.monad)}      [directory (!.use (:: system directory) [context])]      (loop [directory directory             enumeration enumeration] -      (do @ +      (do !          [files (!.use (:: directory files) []) -         enumeration (monad.fold @ (function (_ file enumeration) +         enumeration (monad.fold ! (function (_ file enumeration)                                       (let [path (!.use (:: file path) [])]                                         (if (text.ends-with? ..lux-extension path) -                                         (do @ +                                         (do !                                             [path (promise@wrap (..clean-path system context path))                                              source-code (!.use (:: file content) [])]                                             (promise@wrap @@ -175,7 +175,7 @@                                   enumeration                                   files)           directories (!.use (:: directory directories) [])] -        (monad.fold @ recur enumeration directories))))) +        (monad.fold ! recur enumeration directories)))))  (def: Action    (type (All [a] (Promise (Try a))))) diff --git a/stdlib/source/lux/tool/interpreter.lux b/stdlib/source/lux/tool/interpreter.lux index 5a1b30d06..efff99be8 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) @@ -103,7 +103,7 @@         [_ codeT codeA] (directive.lift-analysis                          (analysis.with-scope                            (type.with-fresh-env -                            (do @ +                            (do !                                [[codeT codeA] (type.with-inference                                                 (analyse code))                                 codeT (type.with-env @@ -113,7 +113,7 @@                (synthesize codeA))]        (directive.lift-generation         (generation.with-buffer -         (do @ +         (do !             [codeH (generate codeS)              count generation.next              codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] @@ -193,13 +193,13 @@          Configuration          (generation.Bundle anchor expression directive)          (! Any))) -  (do {@ Monad<!>} +  (do {! Monad<!>}      [state (initialize Monad<!> Console<!> platform configuration)]      (loop [context {#configuration configuration                      #state state                      #source ..fresh-source}             multi-line? #0] -      (do @ +      (do !          [_ (if multi-line?               (:: Console<!> write "  ")               (:: Console<!> write "> ")) @@ -209,7 +209,7 @@            (:: Console<!> write ..farewell-message)            (case (read-eval-print (update@ #source (add-line line) context))              (#try.Success [context' representation]) -            (do @ +            (do !                [_ (:: Console<!> write representation)]                (recur context' #0)) | 
