diff options
Diffstat (limited to '')
88 files changed, 831 insertions, 649 deletions
diff --git a/documentation/research/math.md b/documentation/research/math.md index 52dc2a6ce..a582bb64d 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -170,6 +170,7 @@ # Geometric Algebra | Clifford Algebra +1. [Euclidean Geometry and Geometric Algebra](http://geometry.mrao.cam.ac.uk/2020/06/euclidean-geometry-and-geometric-algebra/) 1. [Plane-based Geometric Algebra for Computer Science](https://bivector.net/PGA4CS.html) 1. [Differential geometric algebra foundations: Grassmann.jl Ascend](https://www.youtube.com/watch?v=7hlDRLEhc8o&feature=youtu.be) 1. [Projective Geometric Algebra Done Right](http://terathon.com/blog/projective-geometric-algebra-done-right/) diff --git a/documentation/research/paradigm/probabilistic_programming.md b/documentation/research/paradigm/probabilistic_programming.md index 937ab34c6..8cfcc3ce9 100644 --- a/documentation/research/paradigm/probabilistic_programming.md +++ b/documentation/research/paradigm/probabilistic_programming.md @@ -15,6 +15,7 @@ # Reference +1. [An unorthodox path for implementing a probabilistic programming language](http://hyperparameter.space/blog/an-unorthodox-path-for-implementing-a-probabilistic-programming-language/) 1. [The Distribution Monad](http://blog.russelldmatt.com/2018/10/15/the-distribution-monad.html) 1. ["New programming constructs for probabilistic AI" by Marco Cusumano-Towner](https://www.youtube.com/watch?v=xNutxms6SH4) 1. [A tour of probabilistic programming language APIs](https://colcarroll.github.io/ppl-api/) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index ac01d0735..259748caa 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -110,9 +110,9 @@ {#.doc "1-or-more combinator."} (All [s a] (-> (Parser s a) (Parser s (List a)))) - (do {@ ..monad} + (do {! ..monad} [head parser] - (:: @ map (|>> (list& head)) + (:: ! map (|>> (list& head)) (some parser)))) (def: #export (and p1 p2) @@ -199,14 +199,14 @@ (def: #export (sep-by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) - (do {@ ..monad} + (do {! ..monad} [?x (maybe p)] (case ?x #.None (wrap #.Nil) (#.Some x) - (do @ + (do ! [xs' (some (..and sep p))] (wrap (#.Cons x (list@map product.right xs')))) ))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 332546685..9965aee3e 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -54,9 +54,9 @@ (All [m a] (-> (Monad m) (All [r] (Region r m a)) (m (Try a)))) - (do {@ Monad<m>} + (do {! Monad<m>} [[cleaners output] (computation [[] (list)]) - results (monad.map @ (function (_ cleaner) (cleaner [])) + results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] (wrap (list@fold combine-outcomes output results)))) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index d42408984..d4aae98a6 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -80,10 +80,10 @@ (def: #export (while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) - (do {@ ..monad} + (do {! ..monad} [execute? condition] (if execute? - (do @ + (do ! [_ body] (while condition body)) (wrap [])))) diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux index 578f6f955..6345cf02d 100644 --- a/stdlib/source/lux/data/number/rev.lux +++ b/stdlib/source/lux/data/number/rev.lux @@ -446,3 +446,22 @@ (def: &equivalence ..equivalence) (def: hash .nat)) + +(template [<power> <name>] + [(def: #export <name> + Rev + (.rev (//i64.left-shift (//nat.- <power> 64) 1)))] + + [01 /2] + [02 /4] + [03 /8] + [04 /16] + [05 /32] + [06 /64] + [07 /128] + [08 /256] + [09 /512] + [10 /1024] + [11 /2048] + [12 /4096] + ) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index aace53f25..dd00517d0 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,8 +1,9 @@ (.module: {#.doc "Tools for unit & property-based/generative testing."} [lux (#- and) [abstract - ["." monad (#+ Monad do)]] + ["." monad (#+ do)]] [control + ["." try] ["." exception (#+ exception:)] ["." io] [concurrency @@ -140,12 +141,12 @@ (format documentation ..separator ..separator "Failed with this seed: " (%.nat seed))) -(exception: #export (must-try-test-at-least-once) "") +(exception: #export must-try-test-at-least-once) (def: #export (times amount test) (-> Nat Test Test) (cond (n.= 0 amount) - (fail (exception.construct must-try-test-at-least-once [])) + (fail (exception.construct ..must-try-test-at-least-once [])) (n.= 1 amount) test @@ -321,6 +322,10 @@ (~ (code.text coverage)) (~ test))))))) +(exception: #export (error-during-execution {error Text}) + (exception.report + ["Error" (%.text error)])) + (def: #export (in-parallel tests) (-> (List Test) Test) (do random.monad @@ -328,14 +333,21 @@ #let [prng (random.pcg-32 [..pcg-32-magic-inc seed]) run! (: (-> Test Assertion) (function (_ test) - (|> test - (random.run prng) - product.right + (|> (case (|> test + (random.run prng) + product.right + io.io + "lux try") + (#try.Success output) + output + + (#try.Failure error) + (..assert (exception.construct ..error-during-execution [error]) false)) io.io promise.future promise@join)))]] - (wrap (do {@ promise.monad} - [assertions (monad.seq @ (list@map run! tests))] + (wrap (do {! promise.monad} + [assertions (monad.seq ! (list@map run! tests))] (wrap [(|> assertions (list@map product.left) (list@fold ..add-counters ..start)) 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)) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 69c2d24fb..8826b9ed9 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -42,7 +42,7 @@ ["." /]}) (poly: #export equivalence - (`` (do {@ p.monad} + (`` (do {! p.monad} [#let [g!_ (code.local-identifier "_____________")] *env* <type>.env inputT <type>.peek @@ -52,7 +52,7 @@ ($_ p.either ## Basic types (~~ (template [<matcher> <eq>] - [(do @ + [(do ! [_ <matcher>] (wrap (` (: (~ (@Equivalence inputT)) <eq>))))] @@ -66,7 +66,7 @@ [(<type>.sub Text) (~! text.equivalence)])) ## Composite types (~~ (template [<name> <eq>] - [(do @ + [(do ! [[_ argC] (<type>.apply (p.and (<type>.exactly <name>) equivalence))] (wrap (` (: (~ (@Equivalence inputT)) @@ -80,7 +80,7 @@ [set.Set (~! set.equivalence)] [tree.Tree (~! tree.equivalence)] )) - (do @ + (do ! [[_ _ valC] (<type>.apply ($_ p.and (<type>.exactly dictionary.Dictionary) <type>.any @@ -89,7 +89,7 @@ ((~! dictionary.equivalence) (~ valC)))))) ## Models (~~ (template [<type> <eq>] - [(do @ + [(do ! [_ (<type>.exactly <type>)] (wrap (` (: (~ (@Equivalence inputT)) <eq>))))] @@ -100,13 +100,13 @@ [day.Day day.equivalence] [month.Month month.equivalence] )) - (do @ + (do ! [_ (<type>.apply (p.and (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@Equivalence inputT)) unit.equivalence)))) ## Variants - (do @ + (do ! [members (<type>.variant (p.many equivalence)) #let [last (dec (list.size members)) g!_ (code.local-identifier "_____________") @@ -127,7 +127,7 @@ (~ g!_) #0)))))) ## Tuples - (do @ + (do ! [g!eqs (<type>.tuple (p.many equivalence)) #let [g!_ (code.local-identifier "_____________") indices (list.indices (list.size g!eqs)) @@ -139,7 +139,7 @@ (list@map (function (_ [g!eq g!left g!right]) (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion - (do @ + (do ! [[g!self bodyC] (<type>.recursive equivalence) #let [g!_ (code.local-identifier "_____________")]] (wrap (` (: (~ (@Equivalence inputT)) @@ -147,13 +147,13 @@ (~ bodyC))))))) <type>.recursive-self ## Type applications - (do @ + (do ! [[funcC argsC] (<type>.apply (p.and equivalence (p.many equivalence)))] (wrap (` ((~ funcC) (~+ argsC))))) ## Parameters <type>.parameter ## Polymorphism - (do @ + (do ! [[funcC varsC bodyC] (<type>.polymorphic equivalence)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list@map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) @@ -163,6 +163,6 @@ <type>.recursive-call ## If all else fails... (|> <type>.any - (:: @ map (|>> %.type (format "Cannot create Equivalence for: ") p.fail)) - (:: @ join)) + (:: ! map (|>> %.type (format "Cannot create Equivalence for: ") p.fail)) + (:: ! join)) )))) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index d1219bf87..da14b2b6c 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -24,7 +24,7 @@ ["." /]}) (poly: #export functor - (do {@ p.monad} + (do {! p.monad} [#let [type-funcC (code.local-identifier "____________type-funcC") funcC (code.local-identifier "____________funcC") inputC (code.local-identifier "____________inputC")] @@ -49,7 +49,7 @@ _ (<type>.parameter! varI)] (wrap (` ((~ funcC) (~ valueC))))) ## Variants - (do @ + (do ! [_ (wrap []) membersC (<type>.variant (p.many (Arg<?> valueC))) #let [last (dec (list.size membersC))]] @@ -68,7 +68,7 @@ pairsCC (: (List [Code Code]) (list))] (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local-identifier)] - (do @ + (do ! [_ (wrap []) memberC (Arg<?> slotC)] (recur (inc idx) @@ -78,7 +78,7 @@ [(~+ (list;map product.left pairsCC))] [(~+ (list;map product.right pairsCC))])))) ## Functions - (do @ + (do ! [_ (wrap []) #let [g! (code.local-identifier "____________") outL (code.local-identifier "____________outL")] diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 1921ecd3a..9cc39c994 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -99,7 +99,7 @@ (poly: #export codec//encode (with-expansions [<basic> (template [<matcher> <encoder>] - [(do @ + [(do ! [#let [g!_ (code.local-identifier "_______")] _ <matcher>] (wrap (` (: (~ (@JSON//encode inputT)) @@ -112,7 +112,7 @@ [(<type>.sub Frac) (|>> #/.Number)] [(<type>.sub Text) (|>> #/.String)]) <time> (template [<type> <codec>] - [(do @ + [(do ! [_ (<type>.exactly <type>)] (wrap (` (: (~ (@JSON//encode inputT)) (|>> (:: (~! <codec>) (~' encode)) #/.String)))))] @@ -122,7 +122,7 @@ [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do {@ p.monad} + (do {! p.monad} [*env* <type>.env #let [@JSON//encode (: (-> Type Code) (function (_ type) @@ -131,12 +131,12 @@ ($_ p.either <basic> <time> - (do @ + (do ! [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON//encode inputT)) (:: (~! qty-codec) (~' encode)))))) - (do @ + (do ! [#let [g!_ (code.local-identifier "_______") g!key (code.local-identifier "_______key") g!val (code.local-identifier "_______val")] @@ -150,19 +150,19 @@ [(~ g!key) ((~ =val=) (~ g!val))])) ((~! d.from-list) (~! text.hash)) #/.Object))))) - (do @ + (do ! [[_ =sub=] (<type>.apply ($_ p.and (<type>.exactly .Maybe) codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) ((~! ..nullable) (~ =sub=)))))) - (do @ + (do ! [[_ =sub=] (<type>.apply ($_ p.and (<type>.exactly .List) codec//encode))] (wrap (` (: (~ (@JSON//encode inputT)) (|>> ((~! list@map) (~ =sub=)) ((~! row.from-list)) #/.Array))))) - (do @ + (do ! [#let [g!_ (code.local-identifier "_______") g!input (code.local-identifier "_______input")] members (<type>.variant (p.many codec//encode)) @@ -181,7 +181,7 @@ #0 ((~ g!encode) (~ g!input))]))))) (list.enumeration members)))))))))) - (do @ + (do ! [g!encoders (<type>.tuple (p.many codec//encode)) #let [g!_ (code.local-identifier "_______") g!members (|> (list.size g!encoders) @@ -193,7 +193,7 @@ (` ((~ g!encode) (~ g!member)))) (list.zip/2 g!members g!encoders)))])))))) ## Type recursion - (do @ + (do ! [[selfC non-recC] (<type>.recursive codec//encode) #let [g! (code.local-identifier "____________")]] (wrap (` (: (~ (@JSON//encode inputT)) @@ -201,11 +201,11 @@ (~ non-recC))))))) <type>.recursive-self ## Type applications - (do @ + (do ! [partsC (<type>.apply (p.many codec//encode))] (wrap (` ((~+ partsC))))) ## Polymorphism - (do @ + (do ! [[funcC varsC bodyC] (<type>.polymorphic codec//encode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list@map (function (_ varC) (` (-> (~ varC) /.JSON))) @@ -223,7 +223,7 @@ (poly: #export codec//decode (with-expansions [<basic> (template [<matcher> <decoder>] - [(do @ + [(do ! [_ <matcher>] (wrap (` (: (~ (@JSON//decode inputT)) (~! <decoder>)))))] @@ -235,7 +235,7 @@ [(<type>.sub Frac) </>.number] [(<type>.sub Text) </>.string]) <time> (template [<type> <codec>] - [(do @ + [(do ! [_ (<type>.exactly <type>)] (wrap (` (: (~ (@JSON//decode inputT)) ((~! p.codec) (~! <codec>) (~! </>.string))))))] @@ -245,7 +245,7 @@ [date.Date date.codec] [day.Day day.codec] [month.Month month.codec])] - (do {@ p.monad} + (do {! p.monad} [*env* <type>.env #let [@JSON//decode (: (-> Type Code) (function (_ type) @@ -254,29 +254,29 @@ ($_ p.either <basic> <time> - (do @ + (do ! [unitT (<type>.apply (p.after (<type>.exactly unit.Qty) <type>.any))] (wrap (` (: (~ (@JSON//decode inputT)) ((~! p.codec) (~! qty-codec) (~! </>.any)))))) - (do @ + (do ! [[_ _ valC] (<type>.apply ($_ p.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) ((~! </>.dictionary) (~ valC)))))) - (do @ + (do ! [[_ subC] (<type>.apply (p.and (<type>.exactly .Maybe) codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) ((~! </>.nullable) (~ subC)))))) - (do @ + (do ! [[_ subC] (<type>.apply (p.and (<type>.exactly .List) codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) ((~! </>.array) ((~! p.some) (~ subC))))))) - (do @ + (do ! [members (<type>.variant (p.many codec//decode)) #let [last (dec (list.size members))]] (wrap (` (: (~ (@JSON//decode inputT)) @@ -292,12 +292,12 @@ ((~! p.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) ((~! </>.array)))))) (list.enumeration members)))))))) - (do @ + (do ! [g!decoders (<type>.tuple (p.many codec//decode))] (wrap (` (: (~ (@JSON//decode inputT)) ((~! </>.array) ($_ ((~! p.and)) (~+ g!decoders))))))) ## Type recursion - (do @ + (do ! [[selfC bodyC] (<type>.recursive codec//decode) #let [g! (code.local-identifier "____________")]] (wrap (` (: (~ (@JSON//decode inputT)) @@ -305,11 +305,11 @@ (~ bodyC))))))) <type>.recursive-self ## Type applications - (do @ + (do ! [[funcC argsC] (<type>.apply (p.and codec//decode (p.many codec//decode)))] (wrap (` ((~ funcC) (~+ argsC))))) ## Polymorphism - (do @ + (do ! [[funcC varsC bodyC] (<type>.polymorphic codec//decode)] (wrap (` (: (All [(~+ varsC)] (-> (~+ (list@map (|>> (~) </>.Parser (`)) varsC)) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 485277d88..d8d855bd0 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -81,7 +81,7 @@ error)))))) (program: [{[profile operation] /cli.command}] - (do {@ io.monad} + (do {! io.monad} [?profile (/input.read io.monad file.default profile)] (case ?profile (#try.Success profile) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index dc0892eb1..c29cc7b2d 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -9,8 +9,9 @@ [collection ["." list ("#@." monoid)]]] [world + ["." file (#+ Path)] [net - ["." uri]]]]) + ["." uri (#+ URI)]]]]) (type: #export Group Text) @@ -64,20 +65,28 @@ ..identity-separator (..identity value))) -(def: #export (path artifact) - (-> Artifact Text) +(def: (address separator artifact) + (-> Text Artifact Text) (let [directory (%.format (|> artifact (get@ #group) (text.split-all-with ..group-separator) - (text.join-with uri.separator)) - uri.separator + (text.join-with separator)) + separator (get@ #name artifact) - uri.separator + separator (get@ #version artifact))] (%.format directory - uri.separator + separator (..identity artifact)))) +(def: #export uri + (-> Artifact URI) + (..address uri.separator)) + +(def: #export (path system) + (All [!] (-> (file.System !) Artifact Path)) + (..address (:: system separator))) + (def: #export (local artifact) (-> Artifact (List Text)) (list@compose (|> artifact diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 738cae467..8150fa1f6 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -64,17 +64,17 @@ (promise.future (loop [path path] (let [file (java/io/File::new path)] - (do {@ (try.with io.monad)} + (do {! (try.with io.monad)} [exists? (java/io/File::exists file) directory? (java/io/File::isDirectory file)] (if (and exists? directory?) - (do @ + (do ! [children (java/io/File::listFiles file) children (|> children array.to-list - (monad.map @ (|>> java/io/File::getAbsolutePath))) - descendants (monad.map @ recur children)] + (monad.map ! (|>> java/io/File::getAbsolutePath))) + descendants (monad.map ! recur children)] (wrap (#.Cons path (list.concat descendants)))) (wrap (list)))))))) @@ -118,22 +118,22 @@ (def: #export (do! command profile) (All [a] (-> (Command a) (Command Any))) - (do {@ ///action.monad} + (do {! ///action.monad} [#let [fs (java/nio/file/FileSystems::getDefault)] watcher (promise.future (java/nio/file/FileSystem::newWatchService fs)) targets (|> profile (get@ #///.sources) set.to-list - (monad.map @ ..targets) - (:: @ map list.concat)) - _ (monad.map @ (..watch! watcher) targets) + (monad.map ! ..targets) + (:: ! map list.concat)) + _ (monad.map ! (..watch! watcher) targets) _ (command profile)] (loop [_ []] - (do @ + (do ! [?key (..poll! watcher) _ (case ?key (#.Some key) - (do @ + (do ! [_ (promise.future (..drain! watcher)) _ (command profile)] (wrap [])) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index b8ac5c97c..25b1a15aa 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -63,8 +63,8 @@ {#///dependency.artifact identity #///dependency.type type} content))))] - (do {@ ///action.monad} - [library (:: @ map (binary.run tar.writer) + (do {! ///action.monad} + [library (:: ! map (binary.run tar.writer) (export.library (file.async file.default) (set.to-list (get@ #/.sources profile)))) pom (promise@wrap (///pom.write profile)) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 57df92d2a..46d32a4f7 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -56,21 +56,21 @@ (def: (download url) (-> URL (IO (Try Binary))) - (do {@ (try.with io.monad)} + (do {! (try.with io.monad)} [input (|> (java/net/URL::new url) java/net/URL::openStream - (:: @ map (|>> java/io/BufferedInputStream::new))) + (:: ! map (|>> java/io/BufferedInputStream::new))) #let [buffer (binary.create ..buffer-size)]] (loop [output (:: binary.monoid identity)] - (do @ + (do ! [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)] (case bytes-read - -1 (do @ + -1 (do ! [_ (java/lang/AutoCloseable::close input)] (wrap output)) _ (if (n.= ..buffer-size bytes-read) (recur (:: binary.monoid compose output buffer)) - (do @ + (do ! [chunk (:: io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))] (recur (:: binary.monoid compose output chunk))))))))) @@ -116,7 +116,7 @@ (def: #export (resolve repository dependency) (-> Repository Dependency (IO (Try Package))) (let [[artifact type] dependency - prefix (format repository uri.separator (///artifact.path artifact))] + prefix (format repository uri.separator (///artifact.uri artifact))] (do (try.with io.monad) [library (..download (format prefix (///artifact/extension.extension type))) sha1 (..verified-hash dependency library (format prefix ///artifact/extension.sha1) ///hash.sha1 ///hash.sha1-codec ..sha1-does-not-match) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 674d99f04..7a4cf070e 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -14,7 +14,7 @@ ["<.>" xml]]] [data [binary (#+ Binary)] - ["." text + [text ["%" format (#+ format)] ["." encoding]] [collection @@ -26,9 +26,7 @@ ["." tar] ["." xml]]] [world - ["." file (#+ Path File Directory)] - [net - ["." uri]]]] + ["." file (#+ Path File Directory)]]] [program [compositor ["." export]]] @@ -42,7 +40,7 @@ ["#." dependency (#+ Dependency) ["#/." resolution (#+ Package Resolution)]]]) -(def: (repository system) +(def: #export (repository system) (All [a] (-> (file.System a) Path)) (let [/ (:: system separator)] (format "~" / ".m2" / "repository"))) @@ -51,8 +49,7 @@ (All [a] (-> (file.System a) Artifact Path)) (format (..repository system) (:: system separator) - (text.replace-all uri.separator (:: system separator) - (//artifact.path artifact)))) + (//artifact.path system artifact))) (def: (save! system content file) (-> (file.System Promise) Binary Path (Promise (Try Any))) @@ -103,8 +100,8 @@ (def: #export (cache-all system resolution) (-> (file.System Promise) Resolution (Promise (Try Any))) - (do {@ (try.with promise.monad)} - [_ (monad.map @ (function (_ [dependency package]) + (do {! (try.with promise.monad)} + [_ (monad.map ! (function (_ [dependency package]) (..cache system dependency package)) (dictionary.entries resolution))] (wrap []))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 867b3b81f..4fa6612c0 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -77,8 +77,8 @@ (def: license (Parser /.License) - (do {@ <>.monad} - [input (:: @ map + (do {! <>.monad} + [input (:: ! map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag <c>.any))))] @@ -92,8 +92,8 @@ (def: organization (Parser /.Organization) - (do {@ <>.monad} - [input (:: @ map + (do {! <>.monad} + [input (:: ! map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag <c>.any))))] @@ -103,8 +103,8 @@ (def: developer (Parser /.Developer) - (do {@ <>.monad} - [input (:: @ map + (do {! <>.monad} + [input (:: ! map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag <c>.any))))] @@ -120,8 +120,8 @@ (def: info (Parser /.Info) - (do {@ <>.monad} - [input (:: @ map + (do {! <>.monad} + [input (:: ! map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag <c>.any))))] @@ -171,8 +171,8 @@ (def: profile (Parser /.Profile) - (do {@ <>.monad} - [input (:: @ map + (do {! <>.monad} + [input (:: ! map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag <c>.any)))) @@ -187,15 +187,15 @@ (..singular input "info" ..info))) ^repositories (: (Parser (Set //dependency.Repository)) (|> (..plural input "repositories" ..repository) - (:: @ map (set.from-list text.hash)) + (:: ! map (set.from-list text.hash)) (<>.default (set.new text.hash)))) ^dependencies (: (Parser (Set //dependency.Dependency)) (|> (..plural input "dependencies" ..dependency) - (:: @ map (set.from-list //dependency.hash)) + (:: ! map (set.from-list //dependency.hash)) (<>.default (set.new //dependency.hash)))) ^sources (: (Parser (Set /.Source)) (|> (..plural input "sources" ..source) - (:: @ map (set.from-list text.hash)) + (:: ! map (set.from-list text.hash)) (<>.default (set.from-list text.hash (list /.default-source))))) ^target (: (Parser (Maybe /.Target)) (<>.maybe @@ -207,7 +207,7 @@ (<>.maybe (..singular input "test" ..module))) ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository)) - (<| (:: @ map (dictionary.from-list text.hash)) + (<| (:: ! map (dictionary.from-list text.hash)) (<>.default (list)) (..singular input "deploy-repositories" ..deploy-repository)))]] ($_ <>.and diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 4f7d8a4fd..259a3f769 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -150,8 +150,8 @@ (def: parse-dependency (Parser Dependency) - (do {@ <>.monad} - [properties (:: @ map (dictionary.from-list name.hash) + (do {! <>.monad} + [properties (:: ! map (dictionary.from-list name.hash) (<xml>.children (<>.some ..parse-property)))] (<| <>.lift try.from-maybe @@ -168,16 +168,16 @@ (def: parse-dependencies (Parser (List Dependency)) - (do {@ <>.monad} + (do {! <>.monad} [_ (<xml>.node ["" ..dependencies-tag])] (<xml>.children (<>.some ..parse-dependency)))) (def: #export parser (Parser /.Profile) - (do {@ <>.monad} + (do {! <>.monad} [_ (<xml>.node ["" ..project-tag])] (<xml>.children - (do @ + (do ! [dependencies (<xml>.somewhere ..parse-dependencies) _ (<>.some <xml>.ignore)] (wrap (|> (:: /.monoid identity) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 9bc80c462..b084e0a3d 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -59,8 +59,8 @@ (exception.throw ..circular-dependency [ouroboros name]) #.None - (do {@ try.monad} - [parents (monad.map @ (profile' (set.add name lineage) project) + (do {! try.monad} + [parents (monad.map ! (profile' (set.add name lineage) project) (get@ #//.parents profile))] (wrap (list@fold (function (_ parent child) (:: //.monoid compose child parent)) diff --git a/stdlib/source/program/aedifex/shell.lux b/stdlib/source/program/aedifex/shell.lux index 72150a016..5ef30cf91 100644 --- a/stdlib/source/program/aedifex/shell.lux +++ b/stdlib/source/program/aedifex/shell.lux @@ -82,12 +82,12 @@ (def: #export (execute command working-directory) (-> Text Path (Action Any)) (promise.future - (do {@ io.monad} + (do {! io.monad} [runtime (java/lang/Runtime::getRuntime) ?process (java/lang/Runtime::exec command #.None (java/io/File::new working-directory) runtime)] (case ?process (#try.Success process) - (do @ + (do ! [_ (..consume-stream working-directory command (java/lang/Process::getInputStream process)) _ (..consume-stream working-directory command (java/lang/Process::getErrorStream process)) ?exit-code (java/lang/Process::waitFor process)] diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux index c4572de9d..f5834fa61 100644 --- a/stdlib/source/program/aedifex/upload.lux +++ b/stdlib/source/program/aedifex/upload.lux @@ -38,7 +38,7 @@ (-> Repository Dependency URL) (format repository uri.separator - (//artifact.path (get@ #//dependency.artifact dependency)) + (//artifact.uri (get@ #//dependency.artifact dependency)) "." (get@ #//dependency.type dependency))) @@ -82,7 +82,7 @@ (def: #export (upload repository user password dependency content) (-> Repository User Password Dependency Binary (Action Any)) - (do {@ ..monad} + (do {! ..monad} [connection (|> (..url repository dependency) java/net/URL::new java/net/URL::openConnection) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 3bc870f9b..e7884bf70 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -120,7 +120,7 @@ Service [Packager Path] (Promise Any))) - (do {@ promise.monad} + (do {! promise.monad} [platform (promise.future platform)] (case service (#/cli.Compilation compilation) @@ -156,9 +156,9 @@ ## TODO: Fix the interpreter... (undefined) ## (<| (or-crash! "Interpretation failed:") - ## (do {@ promise.monad} + ## (do {! promise.monad} ## [console (|> console.default ## promise.future - ## (:: @ map (|>> try.assume console.async)))] + ## (:: ! map (|>> try.assume console.async)))] ## (interpreter.run (try.with promise.monad) console platform interpretation generation-bundle))) )))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 2e53e0976..d69915cbb 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -39,9 +39,9 @@ (!.use (:: system file) [library])) binary (!.use (:: library content) [])] (promise@wrap - (do {@ try.monad} + (do {! try.monad} [tar (<b>.run tar.parser binary)] - (monad.fold @ (function (_ entry import) + (monad.fold ! (function (_ entry import) (case entry (#tar.Normal [path instant mode ownership content]) (dictionary.try-put (tar.from-path path) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 1cb0ee21a..9ad2c59a4 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -376,8 +376,8 @@ (def: (document-types module types) (-> Text (List Value) (Meta (Markdown Block))) - (do {@ macro.monad} - [type-docs (monad.map @ + (do {! macro.monad} + [type-docs (monad.map ! (: (-> Value (Meta (Markdown Block))) (function (_ [name def-annotations type]) (do macro.monad @@ -499,16 +499,16 @@ (wrap []))))) (macro: (gen-documentation! _) - (do {@ macro.monad} + (do {! macro.monad} [all-modules macro.modules #let [lux-modules (|> all-modules (list.filter (function.compose lux-module? product.left)) (list.sort name-sort))] - lux-exports (monad.map @ (function.compose macro.exports product.left) + lux-exports (monad.map ! (function.compose macro.exports product.left) lux-modules) module-documentation (|> (list@map organize-definitions lux-exports) (list.zip/2 lux-modules) - (monad.map @ document-module)) + (monad.map ! document-module)) #let [_ (io.run (monad.map io.monad save-documentation! module-documentation))]] (wrap (list)))) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index b4fa47b99..764d7351b 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -64,9 +64,9 @@ [r.i64 synthesis.i64 synthesis.path/i64] [r.frac synthesis.f64 synthesis.path/f64] [(r.unicode 5) synthesis.text synthesis.path/text])) - (do {@ r.monad} + (do {! r.monad} [size ..size - idx (|> r.nat (:: @ map (n.% size))) + idx (|> r.nat (:: ! map (n.% size))) [subS subP] case #let [unitS (synthesis.text synthesis.unit) caseS (synthesis.tuple @@ -79,9 +79,9 @@ (synthesis.member/left idx)) subP)]] (wrap [caseS caseP])) - (do {@ r.monad} + (do {! r.monad} [size ..size - idx (|> r.nat (:: @ map (n.% size))) + idx (|> r.nat (:: ! map (n.% size))) [subS subP] case #let [right? (tail? size idx) caseS (synthesis.variant diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index 5868191c4..9060675f6 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -174,13 +174,13 @@ (def: (text run) (-> Runner Test) - (do {@ r.monad} - [sample-size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! r.monad} + [sample-size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 1)))) sample-lower (r.ascii/lower-alpha sample-size) sample-upper (r.ascii/upper-alpha sample-size) sample-alpha (|> (r.ascii/alpha sample-size) (r.filter (|>> (text@= sample-upper) not))) - char-idx (|> r.nat (:: @ map (n.% sample-size))) + char-idx (|> r.nat (:: ! map (n.% sample-size))) #let [sample-lowerS (synthesis.text sample-lower) sample-upperS (synthesis.text sample-upper) sample-alphaS (synthesis.text sample-alpha) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index e3112d799..fefe039f7 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -47,9 +47,9 @@ (def: #export (spec run) (-> Runner Test) - (do {@ r.monad} + (do {! r.monad} [[arity local functionS] ..function - partial-arity (|> r.nat (:: @ map (|>> (n.% arity) (n.max 1)))) + partial-arity (|> r.nat (:: ! map (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe-frac) #let [expectation (maybe.assume (list.nth (dec local) inputs)) inputsS (list@map (|>> synthesis.f64) inputs)]] diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux index 8c53db6c6..f1e12ff96 100644 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -39,8 +39,8 @@ (def: (variable run) (-> Runner Test) - (do {@ r.monad} - [register (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [register (|> r.nat (:: ! map (n.% 100))) expected r.safe-frac] (_.test "Local variables." (|> (synthesis.branch/let [(synthesis.f64 expected) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index c0539a975..cd790c6d2 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -30,9 +30,9 @@ (def: (variant run) (-> Runner Test) - (do {@ r.monad} - [num-tags (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) - tag-in (|> r.nat (:: @ map (n.% num-tags))) + (do {! r.monad} + [num-tags (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) + tag-in (|> r.nat (:: ! map (n.% num-tags))) #let [last?-in (|> num-tags dec (n.= tag-in))] value-in r.i64] (_.test (%.name (name-of synthesis.variant)) @@ -65,8 +65,8 @@ (def: (tuple run) (-> Runner Test) - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) tuple-in (r.list size r.i64)] (_.test (%.name (name-of synthesis.tuple)) (|> (synthesis.tuple (list@map (|>> synthesis.i64) tuple-in)) diff --git a/stdlib/source/spec/lux/abstract/apply.lux b/stdlib/source/spec/lux/abstract/apply.lux index 4220de34c..a9925b928 100644 --- a/stdlib/source/spec/lux/abstract/apply.lux +++ b/stdlib/source/spec/lux/abstract/apply.lux @@ -17,8 +17,8 @@ (def: (identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {@ random.monad} - [sample (:: @ map injection random.nat)] + (do {! random.monad} + [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) (_@apply (injection function.identity) sample) @@ -26,9 +26,9 @@ (def: (homomorphism injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map n.+ random.nat)] + increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) (_@apply (injection increase) (injection sample)) @@ -36,9 +36,9 @@ (def: (interchange injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map n.+ random.nat)] + increase (:: ! map n.+ random.nat)] (_.test "Interchange." ((comparison n.=) (_@apply (injection increase) (injection sample)) @@ -46,10 +46,10 @@ (def: (composition injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map n.+ random.nat) - decrease (:: @ map n.- random.nat)] + increase (:: ! map n.+ random.nat) + decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) (_$ _@apply diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux index e434f6ab1..b69581037 100644 --- a/stdlib/source/spec/lux/abstract/comonad.lux +++ b/stdlib/source/spec/lux/abstract/comonad.lux @@ -15,9 +15,9 @@ (def: (left-identity injection (^open "_@.")) (All [f] (-> (Injection f) (CoMonad f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - morphism (:: @ map (function (_ diff) + morphism (:: ! map (function (_ diff) (|>> _@unwrap (n.+ diff))) random.nat) #let [start (injection sample)]] @@ -37,12 +37,12 @@ (def: (associativity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map (function (_ diff) + increase (:: ! map (function (_ diff) (|>> _@unwrap (n.+ diff))) random.nat) - decrease (:: @ map (function (_ diff) + decrease (:: ! map (function (_ diff) (|>> _@unwrap(n.- diff))) random.nat) #let [start (injection sample) diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux index 2cb086b7a..d40ded1a2 100644 --- a/stdlib/source/spec/lux/abstract/functor.lux +++ b/stdlib/source/spec/lux/abstract/functor.lux @@ -24,8 +24,8 @@ (def: (identity injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {@ random.monad} - [sample (:: @ map injection random.nat)] + (do {! random.monad} + [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) (/@map function.identity sample) @@ -33,9 +33,9 @@ (def: (homomorphism injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map n.+ random.nat)] + increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) (/@map increase (injection sample)) @@ -43,10 +43,10 @@ (def: (composition injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do {@ random.monad} - [sample (:: @ map injection random.nat) - increase (:: @ map n.+ random.nat) - decrease (:: @ map n.- random.nat)] + (do {! random.monad} + [sample (:: ! map injection random.nat) + increase (:: ! map n.+ random.nat) + decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) (|> sample (/@map increase) (/@map decrease)) diff --git a/stdlib/source/spec/lux/abstract/monad.lux b/stdlib/source/spec/lux/abstract/monad.lux index d2eac535f..c9abf9b25 100644 --- a/stdlib/source/spec/lux/abstract/monad.lux +++ b/stdlib/source/spec/lux/abstract/monad.lux @@ -13,9 +13,9 @@ (def: (left-identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - morphism (:: @ map (function (_ diff) + morphism (:: ! map (function (_ diff) (|>> (n.+ diff) _@wrap)) random.nat)] (_.test "Left identity." @@ -34,12 +34,12 @@ (def: (associativity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do {@ random.monad} + (do {! random.monad} [sample random.nat - increase (:: @ map (function (_ diff) + increase (:: ! map (function (_ diff) (|>> (n.+ diff) _@wrap)) random.nat) - decrease (:: @ map (function (_ diff) + decrease (:: ! map (function (_ diff) (|>> (n.- diff) _@wrap)) random.nat)] (_.test "Associativity." diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index fd92d9b40..c40939b47 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -10,6 +10,7 @@ ["#." input] ["#." command #_ ["#/." pom]] + ["#." local] ["#." dependency] ["#." profile] ["#." project] @@ -24,6 +25,7 @@ /artifact.test /input.test /command/pom.test + /local.test /dependency.test /profile.test /project.test diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 376f26717..9a4607306 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -7,8 +7,17 @@ {[0 #spec] [/ ["$." equivalence]]}] + [control + [concurrency + [promise (#+ Promise)]]] + [data + ["." text ("#@." equivalence)]] [math - ["." random (#+ Random)]]] + ["." random (#+ Random)]] + [world + ["." file] + [net + ["." uri]]]] ["." / #_ ["#." type] ["#." extension]] @@ -31,6 +40,15 @@ (_.with-cover [/.equivalence] ($equivalence.spec /.equivalence ..random)) + (do random.monad + [sample ..random + #let [fs (: (file.System Promise) + (file.mock (:: file.default separator)))]] + (_.cover [/.uri /.path] + (|> (/.path fs sample) + (text.replace-all uri.separator (:: fs separator)) + (text@= (/.uri sample))))) + /type.test /extension.test )))) diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux new file mode 100644 index 000000000..a883f565e --- /dev/null +++ b/stdlib/source/test/aedifex/local.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [concurrency + [promise (#+ Promise)]]] + [data + ["." text]] + [math + ["." random (#+ Random)]] + [world + ["." file]]] + [// + ["@." artifact]] + {#program + ["." / + ["/#" // #_ + ["#." artifact]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [sample @artifact.random + #let [fs (: (file.System Promise) + (file.mock (:: file.default separator)))]] + ($_ _.and + (_.cover [/.repository /.path] + (let [path (/.path fs sample)] + (and (text.starts-with? (/.repository fs) + path) + (text.ends-with? (//artifact.path fs sample) + path)))) + )))) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 993082e79..93549712f 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -9,66 +9,108 @@ ["$." equivalence] ["$." monoid]]}] [data + ["." bit ("#@." equivalence)] [number ["n" nat]] [collection ["." list]]] [math - ["r" random]]] + ["." random (#+ Random)]]] {1 ["." /]}) (def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n.% 100)))) + (Random Nat) + (:: random.monad map (n.% 100) + random.nat)) (def: #export test Test - (<| (_.context (%.name (name-of /.Set))) - (do r.monad - [size gen-nat] + (<| (_.covering /._) + (_.with-cover [/.Set]) + (let [(^open "/@.") /.equivalence]) + (do random.monad + [size ..gen-nat] ($_ _.and - ($equivalence.spec /.equivalence (r.set n.hash size r.nat)) - ($monoid.spec /.equivalence (/.monoid n.hash) (r.set n.hash size r.nat)) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) - (do r.monad - [sizeL gen-nat - sizeR gen-nat - setL (r.set n.hash sizeL gen-nat) - setR (r.set n.hash sizeR gen-nat) - non-member (|> gen-nat - (r.filter (|>> (/.member? setL) not))) - #let [(^open "/@.") /.equivalence]] + (do random.monad + [sizeL ..gen-nat + sizeR ..gen-nat + setL (random.set n.hash sizeL random.nat) + setR (random.set n.hash sizeR random.nat) + non-memberL (random.filter (|>> (/.member? setL) not) + random.nat)] ($_ _.and - (_.test "I can query the size of a set." - (and (n.= sizeL (/.size setL)) - (n.= sizeR (/.size setR)))) - (_.test "Converting sets to/from lists can't change their values." - (|> setL - /.to-list (/.from-list n.hash) - (/@= setL))) - (_.test "Every set is a sub-set of the union of itself with another." - (let [setLR (/.union setL setR)] - (and (/.sub? setLR setL) - (/.sub? setLR setR)))) - (_.test "Every set is a super-set of the intersection of itself with another." - (let [setLR (/.intersection setL setR)] - (and (/.super? setLR setL) - (/.super? setLR setR)))) - (_.test "Union with the empty set leaves a set unchanged." - (/@= setL - (/.union (/.new n.hash) - setL))) - (_.test "Intersection with the empty set results in the empty set." - (let [empty-set (/.new n.hash)] - (/@= empty-set - (/.intersection empty-set setL)))) - (_.test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (/.difference setR setL)] - (not (list.any? (/.member? sub) (/.to-list setR))))) - (_.test "Every member of a set must be identifiable." - (and (not (/.member? setL non-member)) - (/.member? (/.add non-member setL) non-member) - (not (/.member? (/.remove non-member (/.add non-member setL)) non-member)))) + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit@= (/.empty? setL) + (n.= 0 (/.size setL)))) + (_.cover [/.to-list /.from-list] + (|> setL /.to-list (/.from-list n.hash) (/@= setL))) + (_.cover [/.member?] + (and (list.every? (/.member? setL) (/.to-list setL)) + (not (/.member? setL non-memberL)))) + (_.cover [/.add] + (let [before-addition! + (not (/.member? setL non-memberL)) + + after-addition! + (/.member? (/.add non-memberL setL) non-memberL) + + size-increase! + (n.= (inc (/.size setL)) + (/.size (/.add non-memberL setL)))] + (and before-addition! + after-addition!))) + (_.cover [/.remove] + (let [symmetry! + (|> setL + (/.add non-memberL) + (/.remove non-memberL) + (/@= setL)) + + idempotency! + (|> setL + (/.remove non-memberL) + (/@= setL))] + (and symmetry! + idempotency!))) + (_.cover [/.union /.sub?] + (let [setLR (/.union setL setR) + + sets-are-subs-of-their-unions! + (and (/.sub? setLR setL) + (/.sub? setLR setR)) + + union-with-empty-set! + (|> setL + (/.union (/.new n.hash)) + (/@= setL))] + (and sets-are-subs-of-their-unions! + union-with-empty-set!))) + (_.cover [/.intersection /.super?] + (let [setLR (/.intersection setL setR) + + sets-are-supers-of-their-intersections! + (and (/.super? setLR setL) + (/.super? setLR setR)) + + intersection-with-empty-set! + (|> setL + (/.intersection (/.new n.hash)) + /.empty?)] + (and sets-are-supers-of-their-intersections! + intersection-with-empty-set!))) + (_.cover [/.difference] + (let [setL+R (/.union setR setL) + setL-R (/.difference setR setL+R)] + (and (list.every? (/.member? setL+R) (/.to-list setR)) + (not (list.any? (/.member? setL-R) (/.to-list setR)))))) + (_.cover [/.predicate] + (list.every? (/.predicate setL) (/.to-list setL))) )))))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 548dbebdd..c1341aae0 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -47,10 +47,10 @@ (def: #export json (Random JSON) (r.rec (function (_ recur) - (do {@ r.monad} - [size (:: @ map (n.% 2) r.nat)] + (do {! r.monad} + [size (:: ! map (n.% 2) r.nat)] ($_ r.or - (:: @ wrap []) + (:: ! wrap []) r.bit r.safe-frac (r.unicode size) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 17f18e005..0e274a6e6 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -35,7 +35,7 @@ (def: path Test (_.with-cover [/.Path] - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/lower-alpha /.path-size) invalid (random.ascii/lower-alpha (inc /.path-size)) not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) @@ -68,7 +68,7 @@ (def: name Test (_.with-cover [/.Name] - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) @@ -101,9 +101,9 @@ (def: small Test (_.with-cover [/.Small] - (do {@ random.monad} - [expected (|> random.nat (:: @ map (n.% /.small-limit))) - invalid (|> random.nat (:: @ map (n.max /.small-limit)))] + (do {! random.monad} + [expected (|> random.nat (:: ! map (n.% /.small-limit))) + invalid (|> random.nat (:: ! map (n.max /.small-limit)))] (`` ($_ _.and (_.cover [/.small /.from-small] (case (/.small expected) @@ -125,9 +125,9 @@ (def: big Test (_.with-cover [/.Big] - (do {@ random.monad} - [expected (|> random.nat (:: @ map (n.% /.big-limit))) - invalid (|> random.nat (:: @ map (n.max /.big-limit)))] + (do {! random.monad} + [expected (|> random.nat (:: ! map (n.% /.big-limit))) + invalid (|> random.nat (:: ! map (n.max /.big-limit)))] (`` ($_ _.and (_.cover [/.big /.from-big] (case (/.big expected) @@ -150,12 +150,12 @@ (def: entry Test - (do {@ random.monad} + (do {! random.monad} [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (:: @ map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) + expected-moment (:: ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) random.nat) chunk (random.ascii/lower-alpha chunk-size) - chunks (:: @ map (n.% 100) random.nat) + chunks (:: ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) (text.join-with "") @@ -218,7 +218,7 @@ (def: random-mode (Random /.Mode) - (do {@ random.monad} + (do {! random.monad} [] (random.either (random.either (random.either (wrap /.execute-by-other) (wrap /.write-by-other)) @@ -236,7 +236,7 @@ (def: mode Test (_.with-cover [/.Mode /.mode] - (do {@ random.monad} + (do {! random.monad} [path (random.ascii/lower-alpha 10) modes (random.list 4 ..random-mode) #let [expected-mode (list@fold /.and /.none modes)]] @@ -308,7 +308,7 @@ (def: ownership Test - (do {@ random.monad} + (do {! random.monad} [path (random.ascii/lower-alpha /.path-size) expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 6cf842827..e0a1a5c05 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -35,8 +35,8 @@ (def: char (Random Nat) - (do {@ r.monad} - [idx (|> r.nat (:: @ map (n.% (text.size char-range))))] + (do {! r.monad} + [idx (|> r.nat (:: ! map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) @@ -73,9 +73,9 @@ ($equivalence.spec /.equivalence ..xml) ($codec.spec /.equivalence /.codec ..xml) - (do {@ r.monad} + (do {! r.monad} [text (..text 1 10) - num-children (|> r.nat (:: @ map (n.% 5))) + num-children (|> r.nat (:: ! map (n.% 5))) children (r.list num-children (..text 1 10)) tag xml-identifier^ attribute xml-identifier^ diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 836f75aa1..bf5c6e876 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -32,14 +32,14 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [## First Name - sizeM1 (|> random.nat (:: @ map (n.% 100))) - sizeS1 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM1 (|> random.nat (:: ! map (n.% 100))) + sizeS1 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) ## Second Name - sizeM2 (|> random.nat (:: @ map (n.% 100))) - sizeS2 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM2 (|> random.nat (:: ! map (n.% 100))) + sizeS2 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] (_.with-cover [.Name] ($_ _.and diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux index 876cf4c4d..d8b0ad3bf 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/data/number.lux @@ -12,12 +12,38 @@ ["r" rev] ["f" frac]]]] {1 - ["." /]}) + ["." /]} + ["." / #_ + ["#." i8] + ["#." i16] + ["#." i32] + ["#." i64] + ["#." nat] + ["#." int] + ["#." rev] + ["#." frac] + ["#." ratio] + ["#." complex]]) (def: clean-commas (-> Text Text) (text.replace-all "," "")) +(def: sub + Test + ($_ _.and + /i8.test + /i16.test + /i32.test + /i64.test + /nat.test + /int.test + /rev.test + /frac.test + /ratio.test + /complex.test + )) + (def: #export test Test (<| (_.covering /._) @@ -85,4 +111,5 @@ [f.= f.hex "+dead.BEEF"] [f.= f.hex "-dead,BE.EF"] ))))) + ..sub ))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index dfb484fc8..90a29c6d3 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -48,4 +48,22 @@ (oct ".615,243")) (/.= (hex ".deadBEEF") (hex ".dead,BEEF")))) + (~~ (template [<half> <whole>] + [(_.cover [<half>] + (/.= <whole> + (/.+ <half> <half>)))] + + [/./2 .0] + [/./4 /./2] + [/./8 /./4] + [/./16 /./8] + [/./32 /./16] + [/./64 /./32] + [/./128 /./64] + [/./256 /./128] + [/./512 /./256] + [/./1024 /./512] + [/./2048 /./1024] + [/./4096 /./2048] + )) )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 3bbf65bc9..6a4130229 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -23,7 +23,7 @@ Test (<| (_.covering /._) (_.with-cover [.|]) - (do {@ random.monad} + (do {! random.monad} [expected random.nat shift random.nat]) ($_ _.and @@ -59,8 +59,8 @@ (: (| Nat Nat)) (/.each (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) - (do @ - [size (:: @ map (n.% 5) random.nat) + (do ! + [size (:: ! map (n.% 5) random.nat) expected (random.list size random.nat)] ($_ _.and (_.cover [/.lefts] diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 6fbee6ec5..5a6b2e4bb 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -29,8 +29,8 @@ (def: size Test - (do {@ random.monad} - [size (:: @ map (n.% 10) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 10) random.nat) sample (random.unicode size)] ($_ _.and (_.cover [/.size] @@ -41,7 +41,7 @@ (def: affix Test - (do {@ random.monad} + (do {! random.monad} [inner (random.unicode 1) outer (random.filter (|>> (:: /.equivalence = inner) not) (random.unicode 1)) @@ -70,7 +70,7 @@ (def: index Test - (do {@ random.monad} + (do {! random.monad} [inner (random.unicode 1) outer (random.filter (|>> (:: /.equivalence = inner) not) (random.unicode 1)) @@ -154,11 +154,11 @@ (_.cover [/.line-feed] (:: /.equivalence = /.new-line /.line-feed)) ))) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 10) inc) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 10) inc) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) #let [sample (|> characters set.to-list /.concat)] - expected (:: @ map (n.% size) random.nat)] + expected (:: ! map (n.% size) random.nat)] (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) @@ -186,8 +186,8 @@ (def: manipulation Test - (do {@ random.monad} - [size (:: @ map (|>> (n.% 10) (n.+ 2)) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 10) (n.+ 2)) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.filter (|>> (set.member? characters) not) (random.ascii/alpha 1)) @@ -274,13 +274,13 @@ _ #0))) )) - (do {@ random.monad} + (do {! random.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> random.nat (:: @ map (|>> (n.% 128) (n.max 1))))] + normal-char-gen (|> random.nat (:: ! map (|>> (n.% 128) (n.max 1))))] sep1 (random.text normal-char-gen 1) sep2 (random.text normal-char-gen 1) #let [part-gen (|> (random.text normal-char-gen sizeP) diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index d5b44b481..355be630f 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -93,8 +93,8 @@ (def: miscellaneous Test - (do {@ r.monad} - [sample (:: @ map (|>> (:coerce java/lang/Object)) + (do {! r.monad} + [sample (:: ! map (|>> (:coerce java/lang/Object)) (r.ascii 1))] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -124,10 +124,10 @@ (def: arrays Test - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) - idx (|> r.nat (:: @ map (n.% size))) - value (:: @ map (|>> (:coerce java/lang/Long)) r.int)] + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 100) (n.max 1)))) + idx (|> r.nat (:: ! map (n.% size))) + value (:: ! map (|>> (:coerce java/lang/Long)) r.int)] ($_ _.and (_.test "Can create arrays of some length." (n.= size (/.array-length (/.array java/lang/Long size)))) diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index f8f569bde..f0ff06160 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -35,14 +35,14 @@ (def: (random-sequence random) (All [a] (-> (Random a) (Random (List a)))) - (do {@ random.monad} - [size (|> random.nat (:: @ map (nat.% 3)))] + (do {! random.monad} + [size (|> random.nat (:: ! map (nat.% 3)))] (random.list size random))) (def: (random-record random) (All [a] (-> (Random a) (Random (List [a a])))) - (do {@ random.monad} - [size (|> random.nat (:: @ map (nat.% 3)))] + (do {! random.monad} + [size (|> random.nat (:: ! map (nat.% 3)))] (random.list size (random.and random random)))) (template: (!expect <pattern> <value>) @@ -57,11 +57,11 @@ (def: typed-value Test - (do {@ random.monad} + (do {! random.monad} [key ..random-key] (`` ($_ _.and (~~ (template [<definition> <random> <constructor> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<definition>] (|> expected <constructor> @@ -86,10 +86,10 @@ (def: flag Test - (do {@ random.monad} + (do {! random.monad} [key ..random-key] (`` ($_ _.and - (do {@ random.monad} + (do ! [dummy ..random-key expected random.bit] (_.cover [/.flagged?] @@ -101,7 +101,7 @@ (..annotation dummy) (/.flagged? key)))))) (~~ (template [<definition> <tag>] - [(do {@ random.monad} + [(do ! [expected random.bit] (_.cover [<definition>] (and (|> expected code.bit @@ -120,11 +120,11 @@ (def: arguments Test - (do {@ random.monad} + (do {! random.monad} [key ..random-key] (`` ($_ _.and (~~ (template [<definition> <tag>] - [(do {@ random.monad} + [(do ! [expected (random.list 5 (random.ascii/alpha 1))] (_.cover [<definition>] (and (|> expected (list@map code.text) code.tuple @@ -145,10 +145,10 @@ Test (<| (_.covering /._) (_.with-cover [/.Annotation]) - (do {@ random.monad} + (do {! random.monad} [key ..random-key] ($_ _.and - (do {@ random.monad} + (do ! [expected _code.random] (_.cover [/.value] (|> expected @@ -159,7 +159,7 @@ ..typed-value - (do {@ random.monad} + (do ! [expected (random.ascii/alpha 10)] (_.cover [/.documentation] (and (not (|> expected code.text diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index e42e139d1..2667eedac 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -30,14 +30,14 @@ (Scenario Synthesis) (`` ($_ random.either (~~ (template [<synthesis> <random>] - [(do {@ random.monad} - [example (:: @ map (|>> <synthesis>) <random>)] + [(do {! random.monad} + [example (:: ! map (|>> <synthesis>) <random>)] (wrap [next [example example]]))] [//.bit random.bit] - [//.i64 (:: @ map .i64 random.nat)] + [//.i64 (:: ! map .i64 random.nat)] [//.f64 random.frac] [//.text (random.unicode 1)] )) @@ -54,8 +54,8 @@ (def: (variable offset arity next) (Scenario Variable) - (let [local (do {@ random.monad} - [register (:: @ map (|>> (n.% arity) inc) random.nat)] + (let [local (do {! random.monad} + [register (:: ! map (|>> (n.% arity) inc) random.nat)] (wrap [next [(#variable.Local (/.register-optimization offset register)) (#variable.Local register)]]))] @@ -63,8 +63,8 @@ 0 local _ ($_ random.either local - (do {@ random.monad} - [foreign (:: @ map (n.% offset) random.nat)] + (do {! random.monad} + [foreign (:: ! map (n.% offset) random.nat)] (wrap [next [(#variable.Local foreign) (#variable.Foreign foreign)]])))))) @@ -73,7 +73,7 @@ (Scenario Synthesis) (`` ($_ random.either (~~ (template [<tag> <random>] - [(do {@ random.monad} + [(do {! random.monad} [[next [exampleE exampleA]] (<random> offset arity next)] (wrap [next [(<tag> exampleE) @@ -86,7 +86,7 @@ (def: (structure offset arity next) (Scenario Synthesis) ($_ random.either - (do {@ random.monad} + (do {! random.monad} [lefts random.nat right? random.bit [next [valueE valueA]] (..reference offset arity next)] @@ -99,7 +99,7 @@ {#analysis.lefts lefts #analysis.right? right? #analysis.value valueA})]])) - (do {@ random.monad} + (do {! random.monad} [[next [leftE leftA]] (..reference offset arity next) [next [rightE rightA]] (..reference offset arity next)] (wrap [next @@ -116,20 +116,20 @@ [//.path/pop //.path/pop]]) (~~ (template [<path> <random>] - [(do {@ random.monad} - [example (:: @ map (|>> <path>) <random>)] + [(do {! random.monad} + [example (:: ! map (|>> <path>) <random>)] (wrap [next [example example]]))] [//.path/bit random.bit] - [//.path/i64 (:: @ map .i64 random.nat)] + [//.path/i64 (:: ! map .i64 random.nat)] [//.path/f64 random.frac] [//.path/text (random.unicode 1)] )) (~~ (template [<path>] - [(do {@ random.monad} - [example (:: @ map (|>> <path>) + [(do {! random.monad} + [example (:: ! map (|>> <path>) (random.or random.nat random.nat))] (wrap [next @@ -166,13 +166,13 @@ random.nat))] ($_ random.either ($_ random.either - (do {@ random.monad} + (do {! random.monad} [[next [inputE inputA]] (..reference offset arity next) [next [bodyE bodyA]] (..reference offset arity next)] (wrap [next [(//.branch/let [inputE (/.register-optimization offset next) bodyE]) (//.branch/let [inputA next bodyA])]])) - (do {@ random.monad} + (do {! random.monad} [[next [testE testA]] (..reference offset arity next) [next [thenE thenA]] (..reference offset arity next) [next [elseE elseA]] (..reference offset arity next)] @@ -180,14 +180,14 @@ [(//.branch/if [testE thenE elseE]) (//.branch/if [testA thenA elseA])]]))) ($_ random.either - (do {@ random.monad} + (do {! random.monad} [[next [recordE recordA]] (..reference offset arity next) - path-length (:: @ map (|>> (n.% 5) inc) random.nat) + path-length (:: ! map (|>> (n.% 5) inc) random.nat) path (random.list path-length random-member)] (wrap [next [(//.branch/get [path recordE]) (//.branch/get [path recordA])]])) - (do {@ random.monad} + (do {! random.monad} [[next [inputE inputA]] (..reference offset arity next) [next [pathE pathA]] (..path offset arity next)] (wrap [next @@ -216,10 +216,10 @@ (def: (function offset arity next) (Scenario Synthesis) ($_ random.either - (do {@ random.monad} + (do {! random.monad} [[next [firstE firstA]] (..variable offset arity next) [next [secondE secondA]] (..variable offset arity next) - arity (:: @ map (n.max 1) random.nat) + arity (:: ! map (n.max 1) random.nat) [next [bodyE bodyA]] (..primitive 0 arity next)] (wrap [next [(//.function/abstraction @@ -265,11 +265,11 @@ Test (<| (_.covering /._) ($_ _.and - (do {@ random.monad} - [expected-offset (:: @ map (|>> (n.% 5) (n.+ 2)) random.nat) - arity (:: @ map (|>> (n.% 5) inc) random.nat) + (do {! random.monad} + [expected-offset (:: ! map (|>> (n.% 5) (n.+ 2)) random.nat) + arity (:: ! map (|>> (n.% 5) inc) random.nat) expected-inits (|> random.nat - (:: @ map (|>> .i64 //.i64)) + (:: ! map (|>> .i64 //.i64)) (random.list arity)) [_ [expected iteration]] (..scenario expected-offset arity 0)] (_.cover [/.Transform /.optimization /.register-optimization] |