diff options
| author | Eduardo Julian | 2020-10-31 20:26:37 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2020-10-31 20:26:37 -0400 |
| commit | 69272f598d831e89da83bdc8c9290d5607dfb14d (patch) | |
| tree | 4915f241708344209d4c35ccdc8b8e57bab68e4c /stdlib/source | |
| parent | eea741e9b4a47ae09832311d6d61f0bd6024f673 (diff) | |
Re-named the directory for my bookmarks to better reflect what they are.
Diffstat (limited to '')
79 files changed, 643 insertions, 470 deletions
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 5f2b553d3..dabd82b7d 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -116,8 +116,8 @@ (syntax: #export (apply {arity (|> <c>.nat (<>.filter (n.> 0)))}) (with-gensyms [g! g!func g!stack g!output] - (monad.do {@ meta.monad} - [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq @))] + (monad.do {! meta.monad} + [g!inputs (|> (meta.gensym "input") (list.repeat arity) (monad.seq !))] (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] (-> (-> (~+ g!inputs) (~ g!output)) (=> [(~+ g!inputs)] [(~ g!output)]))) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index 7a4c46856..5e1bf7c3c 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -146,7 +146,7 @@ (def: #export (run! _) (-> Any (IO Any)) - (do {@ io.monad} + (do {! io.monad} [processes (atom.read ..runner)] (case processes ## And... we're done! @@ -154,7 +154,7 @@ (wrap []) _ - (do @ + (do ! [#let [now (.nat ("lux io current-time")) [ready pending] (list.partition (function (_ process) (|> (get@ #creation process) @@ -163,8 +163,8 @@ processes)] swapped? (atom.compare-and-swap processes pending ..runner)] (if swapped? - (do @ - [_ (monad.map @ (get@ #action) ready)] + (do ! + [_ (monad.map ! (get@ #action) ready)] (run! [])) (error! (ex.construct ..cannot-continue-running-processes [])))) ))) diff --git a/stdlib/source/lux/control/function/memo.lux b/stdlib/source/lux/control/function/memo.lux index c03237cf8..324fae7d1 100644 --- a/stdlib/source/lux/control/function/memo.lux +++ b/stdlib/source/lux/control/function/memo.lux @@ -20,14 +20,14 @@ (Mixin i (State (Dictionary i o) o))) (function (_ delegate recur) (function (_ input) - (do {@ state.monad} + (do {! state.monad} [memory state.get] (case (dictionary.get input memory) (#.Some output) (wrap output) #.None - (do @ + (do ! [output (delegate input) _ (state.update (dictionary.put input output))] (wrap output))))))) diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 485c1091c..e69493f69 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -46,10 +46,10 @@ {declaration reader.declaration} {annotations (<>.maybe reader.annotations)} {[forge input output] (<c>.form ($_ <>.and <c>.local-identifier <c>.any <c>.any))}) - (do {@ meta.monad} + (do {! meta.monad} [this-module meta.current-module-name #let [[name vars] declaration] - g!brand (:: @ map (|>> %.code code.text) + g!brand (:: ! map (|>> %.code code.text) (meta.gensym (format (%.name [this-module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] (wrap (list (` (type: (~+ (writer.export export)) diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux index 38a9bf63b..d35df1b53 100644 --- a/stdlib/source/lux/data/collection/list.lux +++ b/stdlib/source/lux/data/collection/list.lux @@ -581,13 +581,13 @@ (def: wrap (|>> (:: ..monad wrap) (:: monad wrap))) (def: (join MlMla) - (do {@ monad} + (do {! monad} [lMla MlMla ## TODO: Remove this version ASAP and use one below. lla (for {@.old (: (($ 0) (List (List ($ 1)))) - (monad.seq @ lMla))} - (monad.seq @ lMla))] + (monad.seq ! lMla))} + (monad.seq ! lMla))] (wrap (concat lla))))) (def: #export (lift monad) diff --git a/stdlib/source/lux/data/collection/stack.lux b/stdlib/source/lux/data/collection/stack.lux index 089398ca5..e9a7f8bf4 100644 --- a/stdlib/source/lux/data/collection/stack.lux +++ b/stdlib/source/lux/data/collection/stack.lux @@ -5,51 +5,61 @@ [functor (#+ Functor)]] [data [collection - ["//" list]]]]) + ["//" list]]] + [type + abstract]]) -(type: #export (Stack a) - (List a)) +(abstract: #export (Stack a) + (List a) -(def: #export empty - Stack - (list)) + (def: #export empty + Stack + (:abstraction (list))) -(def: #export size - (All [a] (-> (Stack a) Nat)) - //.size) + (def: #export size + (All [a] (-> (Stack a) Nat)) + (|>> :representation //.size)) -(def: #export empty? - (All [a] (-> (Stack a) Bit)) - //.empty?) + (def: #export empty? + (All [a] (-> (Stack a) Bit)) + (|>> :representation //.empty?)) -(def: #export (peek stack) - (All [a] (-> (Stack a) (Maybe a))) - (case stack - #.Nil - #.None - - (#.Cons value _) - (#.Some value))) - -(def: #export (pop stack) - (All [a] (-> (Stack a) (Maybe (Stack a)))) - (case stack - #.Nil - #.None + (def: #export (peek stack) + (All [a] (-> (Stack a) (Maybe a))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons value _) + (#.Some value))) + + (def: #export (pop stack) + (All [a] (-> (Stack a) (Maybe [a (Stack a)]))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons top stack') + (#.Some [top (:abstraction stack')]))) + + (def: #export (push value stack) + (All [a] (-> a (Stack a) (Stack a))) + (:abstraction (#.Cons value (:representation stack)))) + + (structure: #export (equivalence super) + (All [a] + (-> (Equivalence a) + (Equivalence (Stack a)))) + + (def: (= reference subject) + (:: (//.equivalence super) = (:representation reference) (:representation subject)))) + + (structure: #export functor + (Functor Stack) - (#.Cons _ stack') - (#.Some stack'))) - -(def: #export (push value stack) - (All [a] (-> a (Stack a) (Stack a))) - (#.Cons value stack)) - -(def: #export equivalence - (All [a] - (-> (Equivalence a) - (Equivalence (Stack a)))) - //.equivalence) - -(def: #export functor - (Functor Stack) - //.functor) + (def: (map f value) + (|> value + :representation + (:: //.functor map f) + :abstraction))) + ) diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux index 612d8be49..aab50c4f3 100644 --- a/stdlib/source/lux/data/collection/tree.lux +++ b/stdlib/source/lux/data/collection/tree.lux @@ -43,14 +43,15 @@ <>.rec <>.some <c>.record - (<>.and <c>.any) - <c>.tuple)) + (<>.and <c>.any))) (syntax: #export (tree {root tree^}) {#.doc (doc "Tree literals." - (tree Int [+10 {+20 {} - +30 {} - +40 {}}]))} + (: (Tree Nat) + (tree 10 + {20 {} + 30 {} + 40 {}})))} (wrap (list (` (~ (loop [[value children] root] (` {#value (~ value) #children (list (~+ (list@map recur children)))}))))))) diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux index d4b7ec4f6..a0b9eca9c 100644 --- a/stdlib/source/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/lux/data/collection/tree/zipper.lux @@ -9,15 +9,14 @@ [data ["." maybe ("#@." monad)] [collection - ["." list ("#@." functor fold monoid)] - ["." stack (#+ Stack)]]]] + ["." list ("#@." functor fold monoid)]]]] ["." // (#+ Tree) ("#@." functor)]) (type: #export (Zipper a) {#.doc "Tree zippers, for easy navigation and editing over trees."} {#parent (Maybe (Zipper a)) - #lefts (Stack (Tree a)) - #rights (Stack (Tree a)) + #lefts (List (Tree a)) + #rights (List (Tree a)) #node (Tree a)}) (structure: #export (equivalence ,equivalence) @@ -28,10 +27,10 @@ (and (:: (//.equivalence ,equivalence) = (get@ #node reference) (get@ #node sample)) - (:: (stack.equivalence (//.equivalence ,equivalence)) = + (:: (list.equivalence (//.equivalence ,equivalence)) = (get@ #lefts reference) (get@ #lefts sample)) - (:: (stack.equivalence (//.equivalence ,equivalence)) = + (:: (list.equivalence (//.equivalence ,equivalence)) = (get@ #rights reference) (get@ #rights sample)) (:: (maybe.equivalence (equivalence ,equivalence)) = @@ -42,8 +41,8 @@ (def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) {#parent #.None - #lefts stack.empty - #rights stack.empty + #lefts #.Nil + #rights #.Nil #node tree}) (def: #export (unzip zipper) @@ -83,7 +82,7 @@ (#.Cons head tail) {#parent (#.Some zipper) - #lefts stack.empty + #lefts #.Nil #rights tail #node head})) @@ -203,8 +202,8 @@ (function (_ children) (list& (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}])) + (//.tree value {}))} + (//.tree value {})) children)) zipper)) @@ -215,8 +214,8 @@ (list@compose children (list (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}]))))) + (//.tree value {}))} + (//.tree value {}))))) zipper)) (def: #export (remove zipper) @@ -248,8 +247,8 @@ (update@ <side> (function (_ side) (#.Cons (for {@.old (: (Tree ($ 0)) - (//.tree [value {}]))} - (//.tree [value {}])) + (//.tree value {}))} + (//.tree value {})) side)))))))] [insert-left #lefts] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 98d33258b..a71498055 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -83,10 +83,10 @@ (def: re-range^ (Parser Code) - (do {@ <>.monad} - [from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume))) + (do {! <>.monad} + [from (|> regex-char^ (:: ! map (|>> (//.nth 0) maybe.assume))) _ (<t>.this "-") - to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))] + to (|> regex-char^ (:: ! map (|>> (//.nth 0) maybe.assume)))] (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re-char^ @@ -229,22 +229,22 @@ (def: (re-counted-quantified^ current-module) (-> Text (Parser Code)) - (do {@ <>.monad} + (do {! <>.monad} [base (re-simple^ current-module)] (<t>.enclosed ["{" "}"] ($_ <>.either - (do @ + (do ! [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))] (wrap (` ((~! join-text^) (<>.between (~ (code.nat from)) (~ (code.nat to)) (~ base)))))) - (do @ + (do ! [limit (<>.after (<t>.this ",") number^)] (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base)))))) - (do @ + (do ! [limit (<>.before (<t>.this ",") number^)] (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base)))))) - (do @ + (do ! [limit number^] (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b4260c691..87ec823d6 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1166,9 +1166,9 @@ (type.class "java.lang.Object" (list))) (syntax: #export (class: - {#let [@ <>.monad]} + {#let [! <>.monad]} {im inheritance-modifier^} - {[full-class-name class-vars] (:: @ map parser.declaration ..declaration^)} + {[full-class-name class-vars] (:: ! map parser.declaration ..declaration^)} {super (<>.default $Object (class^ class-vars))} {interfaces (<>.default (list) @@ -1224,8 +1224,8 @@ [(~+ (list@map (method-def$ replacer super) methods))])))))) (syntax: #export (interface: - {#let [@ <>.monad]} - {[full-class-name class-vars] (:: @ map parser.declaration ..declaration^)} + {#let [! <>.monad]} + {[full-class-name class-vars] (:: ! map parser.declaration ..declaration^)} {supers (<>.default (list) (<c>.tuple (<>.some (class^ class-vars))))} {annotations ..annotations^} @@ -1396,8 +1396,8 @@ (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] - (do {@ meta.monad} - [arg-inputs (monad.map @ + (do {! meta.monad} + [arg-inputs (monad.map ! (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) (with-gensyms [arg-name] @@ -1756,9 +1756,9 @@ (java/util/List::size [] my-list) java/lang/Character$UnicodeScript::LATIN )} - (do {@ meta.monad} + (do {! meta.monad} [kind (class-kind declaration) - =members (monad.map @ (member-import$ class-type-vars kind declaration) members)] + =members (monad.map ! (member-import$ class-type-vars kind declaration) members)] (wrap (list& (class-import$ declaration) (list@join =members))))) (syntax: #export (array {type (..type^ (list))} diff --git a/stdlib/source/lux/meta/annotation.lux b/stdlib/source/lux/meta/annotation.lux index fa412d6d0..ea47f6970 100644 --- a/stdlib/source/lux/meta/annotation.lux +++ b/stdlib/source/lux/meta/annotation.lux @@ -86,9 +86,9 @@ [(def: #export (<name> ann) (-> Annotation (List Text)) (maybe.default (list) - (do {@ maybe.monad} + (do {! maybe.monad} [args (..tuple (name-of <tag>) ann)] - (monad.map @ ..parse-text args))))] + (monad.map ! ..parse-text args))))] [function-arguments #.func-args] [type-arguments #.type-args] diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index ecfb1edb1..18457f024 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -130,7 +130,7 @@ minute (to-millis duration.minute) second (to-millis duration.second) millis (to-millis duration.milli-second)] - (do {@ <>.monad} + (do {! <>.monad} [utc-hour ..parse-hour _ (<t>.this ..separator) utc-minute ..parse-minute diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 53312a487..f38b20ccd 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -155,17 +155,23 @@ (def: parser (Parser Duration) - (let [section (: (-> Text (Parser Nat)) - (function (_ suffix) - (|> (<t>.many <t>.decimal) (<>.codec nat.decimal) (<>.before (<t>.this suffix)) (<>.default 0))))] + (let [section (: (-> Text Text (Parser Nat)) + (function (_ suffix false-suffix) + (|> (<t>.many <t>.decimal) + (<>.codec nat.decimal) + (<>.before (case false-suffix + "" (<t>.this suffix) + _ (<>.after (<>.not (<t>.this false-suffix)) + (<t>.this suffix)))) + (<>.default 0))))] (do <>.monad [sign (<>.or (<t>.this ..negative-sign) (<t>.this ..positive-sign)) - days (section ..day-suffix) - hours (section hour-suffix) - minutes (section ..minute-suffix) - seconds (section ..second-suffix) - millis (section ..milli-second-suffix) + days (section ..day-suffix "") + hours (section hour-suffix "") + minutes (section ..minute-suffix ..milli-second-suffix) + seconds (section ..second-suffix "") + millis (section ..milli-second-suffix "") #let [span (|> ..empty (..merge (..scale-up days ..day)) (..merge (..scale-up hours ..hour)) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 5f044fa71..252fccc68 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -129,10 +129,10 @@ (def: parser (Parser Instant) - (do {@ <>.monad} - [days (:: @ map date.days date.parser) + (do {! <>.monad} + [days (:: ! map date.days date.parser) _ (<t>.this ..date-suffix) - time (:: @ map //.to-millis //.parser) + time (:: ! map //.to-millis //.parser) _ (<t>.this ..time-suffix)] (wrap (|> (if (i.< +0 days) (|> duration.day diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index 43e2181ab..3be07b2ca 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -109,7 +109,7 @@ (def: #export parser (Parser Year) - (do {@ <>.monad} + (do {! <>.monad} [sign (<>.or (<t>.this "-") (wrap [])) digits (<t>.many <t>.decimal) raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))] diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index 8a6e0825d..64e66be2d 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -219,7 +219,7 @@ (def: #export (save! name code) (All [anchor expression directive] (-> Text directive (Operation anchor expression directive Any))) - (do {@ phase.monad} + (do {! phase.monad} [?buffer (extension.read (get@ #buffer))] (case ?buffer (#.Some buffer) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux index ab1cc08de..6d66678ac 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -230,7 +230,7 @@ (///////phase@wrap (_.define (..register register) ..peek-cursor)) (#/////synthesis.Bit-Fork when thenP elseP) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [then! (recur thenP) else! (.case elseP (#.Some elseP) @@ -247,9 +247,9 @@ then!)))) (#/////synthesis.I64-Fork cons) - (do {@ ///////phase.monad} - [clauses (monad.map @ (function (_ [match then]) - (do @ + (do {! ///////phase.monad} + [clauses (monad.map ! (function (_ [match then]) + (do ! [then! (recur then)] (wrap [(//runtime.i64//= (//primitive.i64 (.int match)) ..peek-cursor) @@ -259,9 +259,9 @@ (^template [<tag> <format> <type>] (<tag> cons) - (do {@ ///////phase.monad} - [cases (monad.map @ (function (_ [match then]) - (:: @ map (|>> [(list (<format> match))]) (recur then))) + (do {! ///////phase.monad} + [cases (monad.map ! (function (_ [match then]) + (:: ! map (|>> [(list (<format> match))]) (recur then))) (#.Cons cons))] (wrap (_.switch ..peek-cursor cases diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 93b400c37..0f311d61b 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -30,9 +30,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: (with-closure @self inits function-body) @@ -64,10 +64,10 @@ (def: #export (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name body!] (/////generation.with-new-context archive - (do @ - [scope (:: @ map ..@scope + (do ! + [scope (:: ! map ..@scope (/////generation.context archive))] (/////generation.with-anchor [1 scope] (statement expression archive bodyS)))) @@ -84,7 +84,7 @@ (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) initialize-self! (list.indices arity))] - environment (monad.map @ (expression archive) environment) + environment (monad.map ! (expression archive) environment) #let [[definition instantiation] (with-closure @self environment ($_ _.then (_.define @num-args (_.the "length" @@arguments)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 05ac70a6a..f73decb82 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -85,8 +85,8 @@ (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} body) - (do {@ macro.monad} - [ids (monad.seq @ (list.repeat (list.size vars) macro.count))] + (do {! macro.monad} + [ids (monad.seq ! (list.repeat (list.size vars) macro.count))] (wrap (list (` (let [(~+ (|> vars (list.zip/2 ids) (list@map (function (_ [id var]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index dee0aa051..acd36a5ba 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -23,8 +23,8 @@ (generate archive singletonS) _ - (do {@ ///////phase.monad} - [elemsT+ (monad.map @ (generate archive) elemsS+)] + (do {! ///////phase.monad} + [elemsT+ (monad.map ! (generate archive) elemsS+)] (wrap (_.array elemsT+))))) (def: #export (variant generate archive [lefts right? valueS]) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 0f440080f..8f9a4ce74 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ functionO)))) (def: #export capture @@ -45,8 +45,8 @@ (wrap (|> (_.var function-name) (_.apply/* inits)))) _ - (do {@ ///////phase.monad} - [@closure (:: @ map _.var (/////generation.gensym "closure")) + (do {! ///////phase.monad} + [@closure (:: ! map _.var (/////generation.gensym "closure")) #let [directive (_.function @closure (|> (list.enumeration inits) (list@map (|>> product.left ..capture))) @@ -62,15 +62,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.var "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 957924e8f..f65883c4c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS)) #let [directive (_.function @loop (|> initsS+ @@ -42,7 +42,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 34368c147..811ce3c93 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -216,13 +216,13 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation (Expression Any))) - (do {@ ////.monad} + (do {! ////.monad} [initG (generate valueS) pattern-matching! (pattern-matching generate pathP) @case (..gensym "case") #let [@caseG (_.global @case) @caseL (_.var @case)] - @init (:: @ map _.var (..gensym "init")) + @init (:: ! map _.var (..gensym "init")) #let [@dependencies+ (|> (case.storage pathP) (get@ #case.dependencies) set.to-list diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux index d03d4babc..58fb0a4b9 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -26,9 +26,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 (_.apply/* argsG+ functionG)))) (def: #export capture @@ -39,15 +39,15 @@ (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 Argument)) - (monad.map @ (|>> (:: //reference.system variable) - (:: @ map _.reference)) + (monad.map ! (|>> (:: //reference.system variable) + (:: ! map _.reference)) environment)) #let [@curried (_.var "curried") arityG (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 15734c737..000789484 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -22,11 +22,11 @@ (def: #export (scope generate [start initsS+ bodyS]) (-> Phase (Scope Synthesis) (Operation (Expression Any))) - (do {@ ////.monad} - [@loop (:: @ map (|>> %.nat (format "loop")) ///.next) + (do {! ////.monad} + [@loop (:: ! map (|>> %.nat (format "loop")) ///.next) #let [@loopG (_.global @loop) @loopL (_.var @loop)] - initsO+ (monad.map @ generate initsS+) + initsO+ (monad.map ! generate initsS+) bodyO (///.with-anchor @loopL (generate bodyS)) #let [directive ($_ _.then @@ -44,7 +44,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 (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux index 30f3f38fd..043941530 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* functionO argsO+)))) (def: #export capture @@ -45,8 +45,8 @@ (wrap (_.apply/* (_.var function-name) inits))) _ - (do {@ ///////phase.monad} - [@closure (:: @ map _.var (/////generation.gensym "closure")) + (do {! ///////phase.monad} + [@closure (:: ! map _.var (/////generation.gensym "closure")) #let [directive (_.def @closure (|> (list.enumeration inits) (list@map (|>> product.left ..capture))) @@ -62,15 +62,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.var function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.var "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 042cbba35..49fd86575 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS)) #let [directive (_.def @loop (|> initsS+ @@ -42,7 +42,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index 76a25d333..df8fccb33 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -27,9 +27,9 @@ (def: #export (apply generate archive [functionS argsS+]) (Generator (Application Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [functionO (generate archive functionS) - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.do "call" argsO+ functionO)))) (def: #export capture @@ -54,15 +54,15 @@ (def: #export (function generate archive [environment arity bodyS]) (Generator (Abstraction Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [[function-name bodyO] (/////generation.with-new-context - (do @ - [function-name (:: @ map ///reference.artifact-name + (do ! + [function-name (:: ! map ///reference.artifact-name /////generation.context)] (/////generation.with-anchor (_.local function-name) (generate archive bodyS)))) closureO+ (: (Operation (List (Expression Any))) - (monad.map @ (:: //reference.system variable) environment)) + (monad.map ! (:: //reference.system variable) environment)) #let [function-name (///reference.artifact-name function-name) @curried (_.local "curried") arityO (|> arity .int _.int) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index 149e67c31..c9c68139c 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -27,9 +27,9 @@ (def: #export (scope generate archive [start initsS+ bodyS]) (Generator (Scope Synthesis)) - (do {@ ///////phase.monad} - [@loop (:: @ map ..loop-name /////generation.next) - initsO+ (monad.map @ (generate archive) initsS+) + (do {! ///////phase.monad} + [@loop (:: ! map ..loop-name /////generation.next) + initsO+ (monad.map ! (generate archive) initsS+) bodyO (/////generation.with-anchor @loop (generate archive bodyS))] (wrap (|> (_.return bodyO) @@ -41,7 +41,7 @@ (def: #export (recur generate archive argsS+) (Generator (List Synthesis)) - (do {@ ///////phase.monad} + (do {! ///////phase.monad} [@scope /////generation.anchor - argsO+ (monad.map @ (generate archive) argsS+)] + argsO+ (monad.map ! (generate archive) argsS+)] (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index a413a878a..034c72a19 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -164,8 +164,8 @@ (def: #export (case generate [valueS pathP]) (-> Phase [Synthesis Path] (Operation Computation)) - (do {@ ////.monad} + (do {! ////.monad} [valueO (generate valueS)] - (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] + (<| (:: ! map (_.let (list [@cursor (_.list/* (list valueO))] [@savepoint (_.list/* (list))]))) (pattern-matching generate pathP)))) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux index d56ae6504..18a74a4a3 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux @@ -22,8 +22,8 @@ (generate singletonS) _ - (do {@ ///.monad} - [elemsT+ (monad.map @ generate elemsS+)] + (do {! ///.monad} + [elemsT+ (monad.map ! generate elemsS+)] (wrap (_.vector/* elemsT+))))) (def: #export (variant generate [lefts right? valueS]) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux index 1619794d1..f34f72acd 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux @@ -124,15 +124,15 @@ (def: #export parser (Parser Registry) (let [category (: (Parser Category) - (do {@ <>.monad} + (do {! <>.monad} [tag <b>.nat] (case tag - 0 (:: @ map (|>> #Anonymous) <b>.any) - 1 (:: @ map (|>> #Definition) <b>.text) - 2 (:: @ map (|>> #Analyser) <b>.text) - 3 (:: @ map (|>> #Synthesizer) <b>.text) - 4 (:: @ map (|>> #Generator) <b>.text) - 5 (:: @ map (|>> #Directive) <b>.text) + 0 (:: ! map (|>> #Anonymous) <b>.any) + 1 (:: ! map (|>> #Definition) <b>.text) + 2 (:: ! map (|>> #Analyser) <b>.text) + 3 (:: ! map (|>> #Synthesizer) <b>.text) + 4 (:: ! map (|>> #Generator) <b>.text) + 5 (:: ! map (|>> #Directive) <b>.text) _ (<>.fail (exception.construct ..invalid-category [tag])))))] (|> (<b>.row/64 category) (:: <>.monad map (row@fold (function (_ artifact registry) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index f4cf769eb..c807e5279 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -131,7 +131,7 @@ (def: #export (package monad file-system static archive program) (All [!] (Packager !)) - (do {@ (try.with monad)} + (do {! (try.with monad)} [cache (:share [!] {(Monad !) monad} @@ -152,7 +152,7 @@ (:: monad wrap)) #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte)) sink (java/util/jar/JarOutputStream::new buffer (..manifest program))] - sink (monad.fold @ (..write-module monad file-system static) sink order) + sink (monad.fold ! (..write-module monad file-system static) sink order) #let [_ (do-to sink (java/io/Flushable::flush) (java/io/Closeable::close))]] diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index bbbba4978..a80c28af1 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -72,7 +72,7 @@ (-> directive directive directive) (Packager !))) (function (package monad file-system static archive program) - (do {@ (try.with monad)} + (do {! (try.with monad)} [cache (!.use (:: file-system directory) [(get@ #static.target static)]) order (:: monad wrap (dependency.load-order $.key archive))] (|> order @@ -83,5 +83,5 @@ artifact.artifacts row.to-list (list@map (|>> (get@ #artifact.id))))])) - (monad.fold @ (..write-module monad file-system static sequence) header) - (:: @ map (|>> to-code encoding.to-utf8)))))) + (monad.fold ! (..write-module monad file-system static sequence) header) + (:: ! map (|>> to-code encoding.to-utf8)))))) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 0478b906e..639f58137 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -10,8 +10,7 @@ ["." name ("#@." codec)] ["." text ("#@." equivalence monoid)] [collection - ["." list ("#@." functor monoid)] - ["." stack (#+ Stack)]]] + ["." list ("#@." functor monoid)]]] ["." meta] [macro ["." code] @@ -21,6 +20,20 @@ ["csw" writer]]]] [type (#+ :cast)]]) +(type: Stack List) + +(def: peek + (All [a] (-> (Stack a) (Maybe a))) + list.head) + +(def: (push value stack) + (All [a] (-> a (Stack a) (Stack a))) + (#.Cons value stack)) + +(def: pop + (All [a] (-> (Stack a) (Maybe (Stack a)))) + list.tail) + (type: Scope {#name Text #type-vars (List Code) @@ -29,7 +42,7 @@ (def: scopes (Stack Scope) - stack.empty) + #.Nil) (template: (!peek <source> <reference> <then>) (loop [entries <source>] @@ -71,7 +84,7 @@ current-scopes) #.None - (stack.peek current-scopes)) + (..peek current-scopes)) (#.Some scope) (#.Right [compiler scope]) @@ -102,12 +115,12 @@ (#.Right [exported? scopes-type scopes-anns - (stack.push scope (:coerce (Stack Scope) scopes-value))])))) + (..push scope (:coerce (Stack Scope) scopes-value))])))) (def: (push-scope [module-reference definition-reference] scope source) (-> Name Scope (List [Text Module]) (List [Text Module])) (!push source module-reference - (|> head (update@ #.definitions (push-scope-definition definition-reference scope))))) + (update@ #.definitions (push-scope-definition definition-reference scope) head))) (def: (push! scope) (-> Scope (Meta Any)) @@ -129,7 +142,7 @@ scopes-type scopes-anns (let [current-scopes (:coerce (Stack Scope) scopes-value)] - (case (stack.pop current-scopes) + (case (..pop current-scopes) (#.Some current-scopes') current-scopes' diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 277a3018d..00b259c40 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -647,37 +647,43 @@ [(def: #export (<get> monad system path) (All [!] (-> (Monad !) (System !) Path (! (Try (<signature> !))))) (do monad - [outcome (!.use (:: system <create>) path)] + [outcome (!.use (:: system <find>) path)] (case outcome (#try.Success file) (wrap (#try.Success file)) (#try.Failure error) (if (exception.match? <exception> error) - (!.use (:: system <find>) path) + (!.use (:: system <create>) path) (wrap (#try.Failure error))))))] - [get-file File create-file file ..cannot-create-file] - [get-directory Directory create-directory directory ..cannot-create-directory] + [get-file File create-file file ..cannot-find-file] + [get-directory Directory create-directory directory ..cannot-find-directory] + ) + +(template [<predicate> <capability>] + [(def: #export (<predicate> monad system path) + (All [!] (-> (Monad !) (System !) Path (! Bit))) + (do monad + [?file (!.use (:: system <capability>) path)] + (case ?file + (#try.Success file) + (wrap true) + + (#try.Failure _) + (wrap false))))] + + [file-exists? file] + [directory-exists? directory] ) (def: #export (exists? monad system path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do monad - [?file (!.use (:: system file) path)] - (case ?file - (#try.Success file) - (wrap true) - - (#try.Failure _) - (do monad - [?directory (!.use (:: system directory) path)] - (case ?directory - (#try.Success directory) - (wrap true) - - (#try.Failure _) - (wrap false)))))) + [verdict (..file-exists? monad system path)] + (if verdict + (wrap verdict) + (..directory-exists? monad system path)))) (type: Mock-File {#mock-last-modified Instant @@ -1118,7 +1124,7 @@ (do {! stm.monad} [|store| (stm.read store)] (case (..create-mock-directory! separator path |store|) - (#try.Success _) + (#try.Success |store|) (do ! [_ (stm.write |store| store)] (wrap (#try.Success (..mock-directory separator path store)))) diff --git a/stdlib/source/lux/world/net/http/query.lux b/stdlib/source/lux/world/net/http/query.lux index 05946c427..315872b00 100644 --- a/stdlib/source/lux/world/net/http/query.lux +++ b/stdlib/source/lux/world/net/http/query.lux @@ -20,21 +20,21 @@ (Parser Text) (p.rec (function (_ component) - (do {@ p.monad} + (do {! p.monad} [head (l.some (l.none-of "+%&;"))] ($_ p.either (p.after (p.either l.end (l.this "&")) (wrap head)) - (do @ + (do ! [_ (l.this "+") tail component] (wrap (format head " " tail))) - (do @ + (do ! [_ (l.this "%") code (|> (l.exactly 2 l.hexadecimal) (p.codec nat.hex) - (:: @ map text.from-code)) + (:: ! map text.from-code)) tail component] (wrap (format head code tail)))))))) @@ -44,14 +44,14 @@ (do p.monad [_ l.end] (wrap context)) - (do {@ p.monad} + (do {! p.monad} [key (l.some (l.none-of "=&;")) key (l.local key ..component)] - (p.either (do @ + (p.either (do ! [_ (l.this "=") value ..component] (form (dictionary.put key value context))) - (do @ + (do ! [_ ($_ p.or (l.one-of "&;") l.end)] diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index 90bdac6b1..f9f214562 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -153,12 +153,12 @@ (def: #export (execute environment command arguments) (-> Context Text (List Text) (IO (Try (Console IO)))) (`` (for {(~~ (static host.old)) - (do {@ (try.with io.monad)} - [windows? (:: @ map (|>> java/lang/String::toLowerCase ..windows?) + (do {! (try.with io.monad)} + [windows? (:: ! map (|>> java/lang/String::toLowerCase ..windows?) (java/lang/System::getProperty "os.name")) #let [builder (java/lang/ProcessBuilder::new (arguments-array (list& (sanitize-command windows? command) (list;map (sanitize-argument windows?) arguments))))] - environment (:: @ map (load-environment environment) + environment (:: ! map (load-environment environment) (java/lang/ProcessBuilder::environment builder)) process (java/lang/ProcessBuilder::start builder)] (process-console process))}))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index d8d855bd0..f3f222d90 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -42,23 +42,12 @@ ["#" resolution]] ["#." command ["#/." pom] + ["#/." install] ["#/." build] ["#/." test] ["#/." auto] ["#/." deploy]]]) -(def: (install! profile) - (-> /.Profile (Promise Any)) - (do promise.monad - [outcome (/local.install (file.async file.default) profile)] - (wrap (case outcome - (#try.Success _) - (log! "Successfully installed locally!") - - (#try.Failure error) - (log! (format "Could not install locally:" text.new-line - error)))))) - (def: (fetch-dependencies! profile) (-> /.Profile (Promise Any)) (do promise.monad @@ -95,7 +84,7 @@ (wrap [])) #/cli.Install - (exec (..install! profile) + (exec (/command/install.do! (file.async file.default) profile) (wrap [])) (#/cli.Deploy repository user password) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux new file mode 100644 index 000000000..818283cc5 --- /dev/null +++ b/stdlib/source/program/aedifex/command/install.lux @@ -0,0 +1,62 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + [text + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." set]] + [format + ["." binary] + ["." tar] + ["." xml]]] + [world + ["." file (#+ Path File)]]] + [program + [compositor + ["." export]]] + ["." /// #_ + ["/" profile (#+ Profile)] + ["#." action (#+ Action)] + ["#." command (#+ Command)] + ["#." local] + ["#." pom] + ["#." artifact (#+ Artifact) + ["#/." extension]]]) + +(def: (save! system content file) + (-> (file.System Promise) Binary Path (Promise (Try Any))) + (do (try.with promise.monad) + [file (: (Promise (Try (File Promise))) + (file.get-file promise.monad system file))] + (!.use (:: file over-write) [content]))) + +(def: #export (do! system profile) + (-> (file.System Promise) (Command Any)) + (case (get@ #/.identity profile) + (#.Some identity) + (do ///action.monad + [package (export.library system (set.to-list (get@ #/.sources profile))) + repository (: (Promise (Try Path)) + (file.make-directories promise.monad system (///local.path system identity))) + #let [artifact-name (format repository (:: system separator) (///artifact.identity identity))] + _ (..save! system (binary.run tar.writer package) + (format artifact-name ///artifact/extension.lux-library)) + pom (:: promise.monad wrap (///pom.write profile)) + _ (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8) + (format artifact-name ///artifact/extension.pom)) + #let [_ (log! "Successfully installed locally!")]] + (wrap [])) + + _ + (:: promise.monad wrap (exception.throw /.no-identity [])))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 7a4cf070e..3c06f0222 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -58,24 +58,6 @@ (file.get-file promise.monad system file))] (!.use (:: file over-write) [content]))) -(def: #export (install system profile) - (-> (file.System Promise) Profile (Promise (Try Any))) - (case (get@ #/.identity profile) - (#.Some identity) - (do (try.with promise.monad) - [repository (: (Promise (Try Path)) - (file.make-directories promise.monad system (..path system identity))) - #let [artifact-name (format repository (:: system separator) (//artifact.identity identity))] - package (export.library system (set.to-list (get@ #/.sources profile))) - _ (..save! system (binary.run tar.writer package) - (format artifact-name //artifact/extension.lux-library)) - pom (:: promise.monad wrap (//pom.write profile))] - (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8) - (format artifact-name //artifact/extension.pom))) - - _ - (:: promise.monad wrap (exception.throw /.no-identity [])))) - (def: #export (cache system [artifact type] package) (-> (file.System Promise) Dependency Package (Promise (Try Any))) (do (try.with promise.monad) diff --git a/stdlib/source/program/aedifex/shell.lux b/stdlib/source/program/aedifex/shell.lux index 5ef30cf91..0215c08da 100644 --- a/stdlib/source/program/aedifex/shell.lux +++ b/stdlib/source/program/aedifex/shell.lux @@ -44,17 +44,16 @@ (#static getRuntime [] #io java/lang/Runtime) (exec [java/lang/String #? [java/lang/String] java/io/File] #io #try java/lang/Process)) -(exception: #export (failure-to-execute-command {working-directory Text} {command Text} {error Text}) - (exception.report - ["Working Directory" (%.text working-directory)] - ["Command" (%.text command)] - ["Error" (%.text error)])) +(template [<exception>] + [(exception: #export (<exception> {working-directory Text} {command Text} {error Text}) + (exception.report + ["Working directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Error" (%.text error)]))] -(exception: #export (failure-during-command-execution {working-directory Text} {command Text} {error Text}) - (exception.report - ["Working Directory" (%.text working-directory)] - ["Command" (%.text command)] - ["Error" (%.text error)])) + [failure-to-execute-command] + [failure-during-command-execution] + ) (exception: #export (abnormal-exit {working-directory Text} {command Text} {code Int}) (exception.report diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 468b1ef9d..00bdf6f19 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -62,9 +62,11 @@ (def: #export (export system [sources target]) (-> (file.System Promise) Export (Promise (Try Any))) - (let [package (format target (:: system separator) ..file)] - (do (try.with promise.monad) - [tar (..library system sources) - package (: (Promise (Try (file.File Promise))) - (file.get-file promise.monad system package))] - (!.use (:: package over-write) (binary.run tar.writer tar))))) + (do (try.with promise.monad) + [tar (..library system sources) + package (: (Promise (Try (file.File Promise))) + (file.get-file promise.monad system + (format target (:: system separator) ..file)))] + (|> tar + (binary.run tar.writer) + (!.use (:: package over-write))))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index c40939b47..dec078509 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -9,7 +9,8 @@ ["#." artifact] ["#." input] ["#." command #_ - ["#/." pom]] + ["#/." pom] + ["#/." install]] ["#." local] ["#." dependency] ["#." profile] @@ -25,6 +26,7 @@ /artifact.test /input.test /command/pom.test + /command/install.test /local.test /dependency.test /profile.test diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux new file mode 100644 index 000000000..7f8a4557f --- /dev/null +++ b/stdlib/source/test/aedifex/command/install.lux @@ -0,0 +1,101 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try) ("#@." functor)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." maybe] + ["." binary] + ["." text ("#@." equivalence) + ["%" format (#+ format)] + ["." encoding]] + [format + ["." xml]] + [collection + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)]] + [world + ["." file (#+ Path File)]]] + [/// + ["@." profile]] + {#program + ["." / + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." local] + ["#." artifact + ["#/." extension]]]]}) + +(def: (make-sources! fs sources) + (-> (file.System Promise) (Set Path) (Promise (Try Any))) + (loop [sources (set.to-list sources)] + (case sources + #.Nil + (|> [] + (:: try.monad wrap) + (:: promise.monad wrap)) + + (#.Cons head tail) + (do (try.with promise.monad) + [_ (: (Promise (Try Path)) + (file.make-directories promise.monad fs head)) + _ (: (Promise (Try (File Promise))) + (file.get-file promise.monad fs (format head (:: fs separator) head ".lux")))] + (recur tail))))) + +(def: (execute! fs sample) + (-> (file.System Promise) ///.Profile (Promise (Try Any))) + (do ///action.monad + [_ (..make-sources! fs (get@ #///.sources sample)) + _ (: (Promise (Try Path)) + (file.make-directories promise.monad fs (///local.repository fs)))] + (/.do! fs sample))) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [sample @profile.random + #let [fs (file.mock (:: file.default separator))]] + (wrap (case (get@ #///.identity sample) + (#.Some identity) + (do {@ promise.monad} + [verdict (do ///action.monad + [_ (..execute! fs sample) + #let [artifact-path (format (///local.path fs identity) + (:: fs separator) + (///artifact.identity identity)) + library-path (format artifact-path ///artifact/extension.lux-library) + pom-path (format artifact-path ///artifact/extension.pom)] + + library-exists! (:: promise.monad map + exception.return + (file.file-exists? promise.monad fs library-path)) + pom-exists! (:: promise.monad map + exception.return + (file.file-exists? promise.monad fs pom-path))] + (wrap (and library-exists! + pom-exists!)))] + (_.claim [/.do!] + (try.default false verdict))) + + #.None + (do {@ promise.monad} + [outcome (..execute! fs sample)] + (_.claim [/.do!] + (case outcome + (#try.Success _) + false + + (#try.Failure error) + true)))))))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index dcfa85e73..7aea3a1c5 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -137,9 +137,9 @@ (def: location Test - (do {@ random.monad} + (do {! random.monad} [[l m r] (|> (random.set n.hash 3 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -159,9 +159,9 @@ (def: touch Test - (do {@ random.monad} + (do {! random.monad} [[b t1 t2] (|> (random.set n.hash 3 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -185,10 +185,10 @@ (def: nested Test - (do {@ random.monad} + (do {! random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -218,10 +218,10 @@ (def: overlap Test - (do {@ random.monad} + (do {! random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (:: @ map (|>> set.to-list + (:: ! map (|>> set.to-list (list.sort n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index ab101ea76..cf7f4f074 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -31,7 +31,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [sample random.nat samples (random.list 10 random.nat) #let [equivalence (: (Equivalence (/.Predicate Nat)) @@ -46,7 +46,7 @@ (let [generator (: (Random (/.Predicate Nat)) (|> random.nat (random.filter (|>> (n.= 0) not)) - (:: @ map multiple?)))] + (:: ! map multiple?)))] ($_ _.and (_.with-cover [/.union] ($monoid.spec equivalence /.union generator)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 0b0538745..99b56cfdc 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -48,10 +48,10 @@ (n.= sample (/.run (_@wrap sample)))) (_.cover [/.call/cc] (n.= (n.* 2 sample) - (/.run (do {@ /.monad} + (/.run (do {! /.monad} [value (/.call/cc (function (_ k) - (do @ + (do ! [temp (k sample)] ## If this code where to run, ## the output would be @@ -76,9 +76,9 @@ (_@wrap #.Nil) (#.Cons x xs') - (do {@ /.monad} + (do {! /.monad} [output (/.shift (function (_ k) - (do @ + (do ! [tail (k xs')] (wrap (#.Cons x tail)))))] (visit output)))))] diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index dc341a44f..4d6a359da 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -51,10 +51,10 @@ (def: random-environment (Random (Environment Synthesis)) - (do {@ random.monad} - [size (:: @ map (n.% 5) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 5) random.nat)] (|> ..random-variable - (:: @ map (|>> synthesis.variable)) + (:: ! map (|>> synthesis.variable)) (random.list size)))) (def: valid-frac @@ -65,7 +65,7 @@ Test (`` ($_ _.and (~~ (template [<query> <check> <random> <synthesis> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random> dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] ($_ _.and @@ -81,7 +81,7 @@ (exception.match? /.cannot-parse error))))))))] [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (:: @ map .i64 random.nat) synthesis.i64 i64.equivalence] + [/.i64 /.i64! (:: ! map .i64 random.nat) synthesis.i64 i64.equivalence] [/.f64 /.f64! ..valid-frac synthesis.f64 frac.equivalence] [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] @@ -93,9 +93,9 @@ (def: complex Test ($_ _.and - (do {@ random.monad} + (do {! random.monad} [expected-bit random.bit - expected-i64 (:: @ map .i64 random.nat) + expected-i64 (:: ! map .i64 random.nat) expected-f64 ..valid-frac expected-text (random.unicode 1)] (_.cover [/.tuple] @@ -113,7 +113,7 @@ (list (synthesis.text expected-text))) (!expect (^multi (#try.Failure error) (exception.match? /.cannot-parse error))))))) - (do {@ random.monad} + (do {! random.monad} [arity random.nat expected-environment ..random-environment expected-body (random.unicode 1)] @@ -140,8 +140,8 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) ($_ _.and - (do {@ random.monad} - [expected (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [expected (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.run /.any] (|> (/.run /.any (list expected)) (!expect (^multi (#try.Success actual) @@ -150,22 +150,22 @@ (|> (/.run /.any (list)) (!expect (^multi (#try.Failure error) (exception.match? /.empty-input error))))) - (do {@ random.monad} - [expected (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [expected (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.unconsumed-input] (|> (/.run /.any (list expected expected)) (!expect (^multi (#try.Failure error) (exception.match? /.unconsumed-input error)))))) - (do {@ random.monad} - [dummy (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [dummy (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.end! /.expected-empty-input] (and (|> (/.run /.end! (list)) (!expect (#try.Success _))) (|> (/.run /.end! (list dummy)) (!expect (^multi (#try.Failure error) (exception.match? /.expected-empty-input error))))))) - (do {@ random.monad} - [dummy (:: @ map (|>> synthesis.i64) random.nat)] + (do {! random.monad} + [dummy (:: ! map (|>> synthesis.i64) random.nat)] (_.cover [/.end?] (and (|> (/.run /.end? (list)) (!expect (#try.Success #1))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 1efc39cbc..247ae8be4 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -17,10 +17,10 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [sample random.nat] ($_ _.and - (do @ + (do ! [another random.nat] (_.cover [/.new>] (n.= (inc another) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index c011df720..d3bd06b58 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -77,12 +77,12 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [#let [gen-size (|> random.nat (:: @ map (|>> (n.% 100) (n.max 8))))] + (do {! random.monad} + [#let [gen-size (|> random.nat (:: ! map (|>> (n.% 100) (n.max 8))))] size gen-size sample (..random size) value random.nat - #let [gen-idx (|> random.nat (:: @ map (n.% size)))] + #let [gen-idx (|> random.nat (:: ! map (n.% size)))] [from to] (random.and gen-idx gen-idx) #let [[from to] [(n.min from to) (n.max from to)]]] (_.with-cover [/.Binary] diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 4cd81db10..e09e502bc 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -35,7 +35,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Array]) - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size base random.nat shift random.nat @@ -109,8 +109,8 @@ _ false))) - (do @ - [occupancy (:: @ map (n.% (inc size)) random.nat)] + (do ! + [occupancy (:: ! map (n.% (inc size)) random.nat)] (_.cover [/.occupancy /.vacancy] (let [the-array (loop [output (: (Array Nat) (/.new size)) @@ -122,15 +122,15 @@ (and (n.= occupancy (/.occupancy the-array)) (n.= size (n.+ (/.occupancy the-array) (/.vacancy the-array))))))) - (do @ + (do ! [the-list (random.list size random.nat)] (_.cover [/.from-list /.to-list] (and (|> the-list /.from-list /.to-list (:: (list.equivalence n.equivalence) = the-list)) (|> the-array /.to-list /.from-list (:: (/.equivalence n.equivalence) = the-array))))) - (do @ - [amount (:: @ map (n.% (inc size)) random.nat)] + (do ! + [amount (:: ! map (n.% (inc size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.new size))] @@ -150,7 +150,7 @@ (and (n.= (list.size evens) (/.occupancy the-array)) (n.= (list.size odds) (/.vacancy the-array)) (|> the-array /.to-list (:: (list.equivalence n.equivalence) = evens)))))) - (do @ + (do ! [#let [the-array (/.clone the-array) members (|> the-array /.to-list (set.from-list n.hash))] default (random.filter (function (_ value) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index cadd2d26d..a31fec37c 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -22,12 +22,12 @@ (def: #export random (Random Bits) - (do {@ random.monad} - [size (:: @ map (n.% 1,000) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 1,000) random.nat)] (case size 0 (wrap /.empty) - _ (do {@ random.monad} - [idx (|> random.nat (:: @ map (n.% size)))] + _ (do {! random.monad} + [idx (|> random.nat (:: ! map (n.% size)))] (wrap (/.set idx /.empty)))))) (def: #export test @@ -47,9 +47,9 @@ (_.cover [/.empty] (/.empty? /.empty)) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 1,000) inc) random.nat) - idx (:: @ map (n.% size) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 1,000) inc) random.nat) + idx (:: ! map (n.% size) random.nat) sample ..random] ($_ _.and (_.cover [/.get /.set] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index f45f1d0d4..e396dd81a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -40,8 +40,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Dictionary))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 100))) keys (r.set n.hash size r.nat) values (r.set n.hash size r.nat) extra-key (|> r.nat (r.filter (|>> (set.member? keys) not))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 92cec10e8..a81de6c24 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -39,11 +39,11 @@ (def: random (Random (List Nat)) - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size] (|> random.nat (random.set n.hash size) - (:: @ map set.to-list)))) + (:: ! map set.to-list)))) (def: signatures Test @@ -61,7 +61,7 @@ (_.with-cover [/.monad] ($monad.spec /@wrap /.equivalence /.monad)) - (do {@ random.monad} + (do {! random.monad} [parameter random.nat subject random.nat] (let [lift (/.lift io.monad) @@ -81,10 +81,10 @@ (def: whole Test - (do {@ random.monad} + (do {! random.monad} [size ..bounded-size #let [(^open "/@.") (/.equivalence n.equivalence)] - sample (:: @ map set.to-list (random.set n.hash size random.nat))] + sample (:: ! map set.to-list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -127,7 +127,7 @@ Test (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor] - (do {@ random.monad} + (do {! random.monad} [sample ..random #let [size (/.size sample)]] ($_ _.and @@ -176,11 +176,11 @@ Test (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.monoid] - (do {@ random.monad} + (do {! random.monad} [sample ..random #let [size (/.size sample)] - idx (:: @ map (n.% size) random.nat) - chunk-size (:: @ map (|>> (n.% size) inc) random.nat)] + idx (:: ! map (n.% size) random.nat) + chunk-size (:: ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.filter] (let [positives (/.filter n.even? sample) @@ -223,7 +223,7 @@ (def: member Test (let [(^open "/@.") (/.equivalence n.equivalence)] - (do {@ random.monad} + (do {! random.monad} [sample ..random] (`` ($_ _.and (_.cover [/.member?] @@ -270,7 +270,7 @@ +/3 (: (-> Nat Nat Nat Nat) (function (_ left mid right) ($_ n.+ left mid right)))] - (do {@ random.monad} + (do {! random.monad} [sample/0 ..random sample/1 ..random sample/2 ..random] @@ -352,7 +352,7 @@ (if (n.even? value) (#.Some (:: n.decimal encode value)) #.None)))] - (do {@ random.monad} + (do {! random.monad} [sample ..random] ($_ _.and (_.cover [/.one] @@ -390,7 +390,7 @@ (_.with-cover [.List]) (let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor] - (do {@ random.monad} + (do {! random.monad} [sample ..random separator random.nat] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index f646fd82a..9cc7c4500 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -28,8 +28,8 @@ Test (<| (_.covering /._) (_.with-cover [/.Queue]) - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? members) not) random.nat) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 7f9b42046..555214148 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -15,10 +15,10 @@ (def: #export (queue size) (-> Nat (Random (Queue Nat))) - (do {@ r.monad} + (do {! r.monad} [inputs (r.list size r.nat)] - (monad.fold @ (function (_ head tail) - (do @ + (monad.fold ! (function (_ head tail) + (do ! [priority r.nat] (wrap (/.push priority head tail)))) /.empty @@ -27,8 +27,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 100))) sample (..queue size) non-member-priority r.nat non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not)))] diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index e096c9085..716b03168 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -28,8 +28,8 @@ (def: signatures Test - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat)] ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.row size random.nat))) @@ -47,8 +47,8 @@ (def: whole Test - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/@.") (/.equivalence n.equivalence)]] @@ -80,11 +80,11 @@ (def: index-based Test - (do {@ random.monad} - [size (:: @ map (|>> (n.% 100) inc) random.nat)] + (do {! random.monad} + [size (:: ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and - (do @ - [good-index (|> random.nat (:: @ map (n.% size))) + (do ! + [good-index (|> random.nat (:: ! map (n.% size))) #let [bad-index (n.+ size good-index)] sample (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? sample) not) @@ -133,21 +133,21 @@ Test (<| (_.covering /._) (_.with-cover [/.Row]) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 100) inc) random.nat)] + (do {! random.monad} + [size (:: ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and ..signatures ..whole ..index-based - (do @ + (do ! [sample (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? sample) not) random.nat) #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and - (do @ + (do ! [value/0 random.nat value/1 random.nat value/2 random.nat] diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 3cd41c4b2..ad1dd0448 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -36,11 +36,11 @@ (<| (_.covering /._) (_.with-cover [/.Sequence]) (let [(^open "list@.") (list.equivalence n.equivalence)]) - (do {@ random.monad} + (do {! random.monad} [repeated random.nat - index (:: @ map (n.% 100) random.nat) - size (:: @ map (|>> (n.% 10) inc) random.nat) - offset (:: @ map (n.% 100) random.nat) + index (:: ! map (n.% 100) random.nat) + size (:: ! map (|>> (n.% 10) inc) random.nat) + offset (:: ! map (n.% 100) random.nat) cycle-start random.nat cycle-next (random.list size random.nat)] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 867fa4308..335eb0226 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -46,11 +46,11 @@ ($_ _.and ($equivalence.spec /.equivalence (..set n.order r.nat size)) )) - (do {@ r.monad} + (do {! r.monad} [sizeL gen-nat sizeR gen-nat - listL (|> (r.set n.hash sizeL gen-nat) (:: @ map //.to-list)) - listR (|> (r.set n.hash sizeR gen-nat) (:: @ map //.to-list)) + listL (|> (r.set n.hash sizeL gen-nat) (:: ! map //.to-list)) + listR (|> (r.set n.hash sizeR gen-nat) (:: ! map //.to-list)) #let [(^open "/@.") /.equivalence setL (/.from-list n.order listL) setR (/.from-list n.order listR) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index a8a2ceeeb..80b7fce63 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -10,10 +9,11 @@ ["$." functor (#+ Injection)]]}] [data ["." maybe] + ["." bit ("#@." equivalence)] [number ["n" nat]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) @@ -21,48 +21,49 @@ (Injection /.Stack) (/.push value /.empty)) -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n.% 100)))) - (def: #export test Test - (<| (_.context (%.name (name-of /._))) - (do r.monad - [size gen-nat - sample (r.stack size gen-nat) - new-top gen-nat] + (<| (_.covering /._) + (_.with-cover [/.Stack]) + (do random.monad + [size (:: random.monad map (n.% 100) random.nat) + sample (random.stack size random.nat) + expected-top random.nat] ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (r.stack size r.nat)) - ($functor.spec ..injection /.equivalence /.functor) + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - (_.test (%.name (name-of /.size)) - (n.= size (/.size sample))) - (_.test (%.name (name-of /.peek)) - (case (/.peek sample) - #.None (/.empty? sample) - (#.Some _) (not (/.empty? sample)))) - (_.test (%.name (name-of /.pop)) - (case (/.size sample) - 0 (case (/.pop sample) - #.None - (/.empty? sample) - - (#.Some _) - false) - expected (case (/.pop sample) - (#.Some sample') - (and (n.= (dec expected) (/.size sample')) - (not (/.empty? sample))) - - #.None - false))) - (_.test (%.name (name-of /.push)) - (and (is? sample - (|> sample (/.push new-top) /.pop maybe.assume)) - (n.= (inc (/.size sample)) - (/.size (/.push new-top sample))) - (|> (/.push new-top sample) /.peek maybe.assume - (is? new-top)))) + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.peek] + (case (/.peek sample) + #.None + (/.empty? sample) + + (#.Some _) + (not (/.empty? sample)))) + (_.cover [/.pop] + (case (/.pop sample) + #.None + (/.empty? sample) + + (#.Some [top remaining]) + (:: (/.equivalence n.equivalence) = + sample + (/.push top remaining)))) + (_.cover [/.push] + (case (/.pop (/.push expected-top sample)) + (#.Some [actual-top actual-sample]) + (and (is? expected-top actual-top) + (is? sample actual-sample)) + + #.None + false)) )))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 37dd216b2..8ba66ef02 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -48,14 +48,14 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Tree))) - (do {@ r.monad} - [size (:: @ map (|>> (n.% 100) (n.+ 1)) r.nat)] + (do {! r.monad} + [size (:: ! map (|>> (n.% 100) (n.+ 1)) r.nat)] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat)) ($fold.spec /.leaf /.equivalence /.fold) ($functor.spec /.leaf /.equivalence /.functor) - (do @ + (do ! [sample (..tree size r.nat)] (_.test "Can flatten a tree to get all the nodes as a flat tree." (n.= size diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 74fda6cc1..7354eafed 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -23,8 +23,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Zipper))) - (do {@ r.monad} - [size (:: @ map (|>> (n.% 90) (n.+ 10)) r.nat) + (do {! r.monad} + [size (:: ! map (|>> (n.% 90) (n.+ 10)) r.nat) sample (//.tree size r.nat) mid-val r.nat new-val r.nat @@ -48,7 +48,7 @@ (|> child /.start (is? zipper) not))) (and (/.leaf? zipper) (|> zipper (/.prepend-child new-val) /.branch?))))) - (do @ + (do ! [branch-value r.nat #let [zipper (|> (/.zip (tree.branch branch-value (list (tree.leaf mid-val)))) (/.prepend-child pre-val) @@ -60,7 +60,7 @@ (|> zipper /.down /.right /.value (is? mid-val)) (and (|> zipper /.down /.right /.right /.value (is? post-val)) (|> zipper /.down /.rightmost /.value (is? post-val)))))) - (do @ + (do ! [branch-value r.nat #let [zipper (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))]] (_.test "Can insert children around a node (unless it's start)." diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 388b49d93..ca84d8b07 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -125,16 +125,16 @@ (def: palette Test (_.with-cover [/.Spread /.Palette] - (do {@ random.monad} - [eH (:: @ map (|>> f.abs (f.% +0.9) (f.+ +0.05)) + (do {! random.monad} + [eH (:: ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) random.safe-frac) #let [eS +0.5] - variations (:: @ map (|>> (n.% 3) (n.+ 2)) random.nat) + variations (:: ! map (|>> (n.% 3) (n.+ 2)) random.nat) #let [max-spread (f./ (|> variations inc .int int.frac) +1.0) min-spread (f./ +2.0 max-spread) spread-space (f.- min-spread max-spread)] - spread (:: @ map (|>> f.abs (f.% spread-space) (f.+ min-spread)) + spread (:: ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) random.safe-frac)] (`` ($_ _.and (~~ (template [<brightness> <palette>] @@ -175,7 +175,7 @@ Test (<| (_.covering /._) (_.with-cover [/.Color]) - (do {@ random.monad} + (do {! random.monad} [expected ..color] ($_ _.and (_.with-cover [/.equivalence] diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 330361792..091814105 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -34,8 +34,8 @@ (def: dimension (Random Frac) - (do {@ r.monad} - [factor (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1)))) + (do {! r.monad} + [factor (|> r.nat (:: ! map (|>> (n.% 1000) (n.max 1)))) measure (|> r.safe-frac (r.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -159,8 +159,8 @@ (def: trigonometry Test - (do {@ r.monad} - [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) + (do {! r.monad} + [angle (|> ..complex (:: ! map (|>> (update@ #/.real (f.% +1.0)) (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and (_.test "Arc-sine is the inverse of sine." @@ -183,9 +183,9 @@ (def: root Test - (do {@ r.monad} + (do {! r.monad} [sample ..complex - degree (|> r.nat (:: @ map (|>> (n.max 1) (n.% 5))))] + degree (|> r.nat (:: ! map (|>> (n.max 1) (n.% 5))))] (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/data/number/i16.lux index a00a26e9e..edfadf62d 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/data/number/i16.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i16) diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/data/number/i32.lux index d126e5b03..f5d32ba21 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/data/number/i32.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i32) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 592b5fe41..6834f6276 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -22,9 +22,9 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} + (do {! r.monad} [pattern r.nat - idx (:: @ map (//nat.% /.width) r.nat)] + idx (:: ! map (//nat.% /.width) r.nat)] ($_ _.and ($equivalence.spec /.equivalence r.i64) ($monoid.spec //nat.equivalence /.disjunction r.nat) diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/data/number/i8.lux index aac5f063a..53b196e41 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/data/number/i8.lux @@ -28,8 +28,8 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do {@ r.monad} - [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] + (do {! r.monad} + [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i8) diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index 457caee6a..e0f2a3757 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -117,9 +117,9 @@ (def: arrays Test - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) - idx (|> r.nat (:: @ map (n.% size))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 100) (n.max 1)))) + idx (|> r.nat (:: ! map (n.% size))) value r.int] ($_ _.and (_.test "Can create arrays of some length." diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 985da657c..1790c0111 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -50,9 +50,9 @@ (def: gen-record (Random Record) - (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat) - #let [gen-int (|> random.int (:: @ map (|>> i.abs (i.% +1,000,000))))]] + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat) + #let [gen-int (|> random.int (:: ! map (|>> i.abs (i.% +1,000,000))))]] ($_ random.and random.bit gen-int diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 8be02dc27..f052cdf0f 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -89,8 +89,8 @@ (def: gen-record (Random Record) - (do {@ random.monad} - [size (:: @ map (n.% 2) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 2) random.nat)] ($_ random.and random.bit random.safe-frac diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 6e90ac1bb..8dff75251 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -16,7 +16,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [left random.nat mid random.nat right random.nat] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 18bc370c2..4ade3f2f8 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -227,12 +227,12 @@ Test (<| (_.covering /._) ($_ _.and - (do {@ random.monad} + (do {! random.monad} [target (random.ascii/upper-alpha 1) version (random.ascii/upper-alpha 1) source-code (random.ascii/upper-alpha 1) expected-current-module (random.ascii/upper-alpha 1) - expected-type (:: @ map (function (_ name) + expected-type (:: ! map (function (_ name) (#.Primitive name (list))) (random.ascii/upper-alpha 1)) expected-seed random.nat diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 5900f1958..7d40750a5 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -36,10 +36,10 @@ [millis random.int] (_.test "Can convert from/to milliseconds." (|> millis /.from-millis /.to-millis (i.= millis)))) - (do {@ random.monad} - [sample (|> duration (:: @ map (/.frame /.day))) + (do {! random.monad} + [sample (|> duration (:: ! map (/.frame /.day))) frame duration - factor (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + factor (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [(^open "/@.") /.order]] ($_ _.and (_.test "Can scale a duration." diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index eef749d8f..fca611825 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -22,8 +22,8 @@ (def: short (r.Random Text) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 10)))] + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 10)))] (r.unicode size))) (def: name @@ -83,8 +83,8 @@ (:: /.equivalence = (/.un-name base) (/.un-name aliased)))))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) members (|> ..type (r.filter (function (_ type) (case type @@ -94,7 +94,7 @@ _ #1))) (list.repeat size) - (M.seq @)) + (M.seq !)) #let [(^open "/@.") /.equivalence (^open "list@.") (list.equivalence /.equivalence)]] (`` ($_ _.and @@ -109,9 +109,9 @@ ["tuple" /.tuple /.flatten-tuple Any] )) ))) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) - members (M.seq @ (list.repeat size ..type)) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) + members (M.seq ! (list.repeat size ..type)) extra (|> ..type (r.filter (function (_ type) (case type @@ -132,8 +132,8 @@ (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] (n.= (list.size members) (list.size tparams)))) )) - (do {@ r.monad} - [size (|> r.nat (:: @ map (n.% 3))) + (do {! r.monad} + [size (|> r.nat (:: ! map (n.% 3))) extra (|> ..type (r.filter (function (_ type) (case type diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 5a0942252..d4bf9ed8e 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -81,11 +81,11 @@ (def: (build-ring num-connections) (-> Nat (/.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do {@ /.monad} + (do {! /.monad} [[head-id head-type] /.var - ids+types (monad.seq @ (list.repeat num-connections /.var)) - [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type]) - (do @ + ids+types (monad.seq ! (list.repeat num-connections /.var)) + [tail-id tail-type] (monad.fold ! (function (_ [tail-id tail-type] [_head-id _head-type]) + (do ! [_ (/.check head-type tail-type)] (wrap [tail-id tail-type]))) [head-id head-type] @@ -188,8 +188,8 @@ _ (/.check var Nothing)] (/.check .Bit var)))) ) - (do {@ r.monad} - [num-connections (|> r.nat (:: @ map (n.% 100))) + (do {! r.monad} + [num-connections (|> r.nat (:: ! map (n.% 100))) boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) pick-pcg (r.and r.nat r.nat)] ($_ _.and @@ -209,14 +209,14 @@ expected-size? same-vars?)))))) (_.test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do {@ /.monad} + (type-checks? (do {! /.monad} [[[head-id headT] ids+types tailT] (build-ring num-connections) #let [ids (list@map product.left ids+types)] _ (/.check headT boundT) head-bound (/.read head-id) - tail-bound (monad.map @ /.read ids) + tail-bound (monad.map ! /.read ids) headR (/.ring head-id) - tailR+ (monad.map @ /.ring ids)] + tailR+ (monad.map ! /.ring ids)] (let [rings-were-erased? (and (set.empty? headR) (list.every? set.empty? tailR+)) same-types? (list.every? (type@= boundT) (list& (maybe.default headT head-bound) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 7c55a0d6f..4cdb9009f 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -21,8 +21,8 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do {@ random.monad} - [#let [digit (:: @ map (n.% 10) random.nat)] + (do {! random.monad} + [#let [digit (:: ! map (n.% 10) random.nat)] left digit right digit #let [start (n.min left right) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index a1146fe56..55cfe94bc 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -68,11 +68,11 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do {@ r.monad} - [file-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) + (do {! r.monad} + [file-size (|> r.nat (:: ! map (|>> (n.% 100) (n.max 10)))) dataL (_binary.random file-size) dataR (_binary.random file-size) - new-modified (|> r.int (:: @ map (|>> i.abs + new-modified (|> r.int (:: ! map (|>> i.abs (i.% +10,000,000,000,000) truncate-millis duration.from-millis |