diff options
Diffstat (limited to 'stdlib/source/test')
36 files changed, 437 insertions, 261 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 708834481..4947dcf18 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -25,7 +25,8 @@ ["#." hash] ["#." parser] ["#." pom] - ["#." repository]]) + ["#." repository] + ["#." runtime]]) (def: test Test @@ -49,6 +50,7 @@ /parser.test /pom.test /repository.test + /runtime.test )) (program: args diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index c0617188d..ce85a2206 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -82,7 +82,7 @@ (/.do! fs (list (///repository.mock ($///dependency/resolution.single depender-artifact depender-package) []))))] (wrap (and (and (set.member? pre dependee-artifact) (not (set.member? pre depender-artifact))) - (and (not (set.member? post dependee-artifact)) - (set.member? post depender-artifact)))))] + (and (dictionary.contains? dependee post) + (dictionary.contains? depender post)))))] (_.claim [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index c25d6fe36..c7f6a4282 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -12,8 +12,10 @@ [data ["." binary] ["." text - ["%" format] - ["." encoding]]] + ["%" format (#+ format)] + ["." encoding]] + [collection + ["." set (#+ Set)]]] [math ["." random (#+ Random)]] [world @@ -28,6 +30,12 @@ ["#." action] ["#." format]]]}) +(def: (with-default-source sources) + (-> (Set //.Source) (Set //.Source)) + (if (set.empty? sources) + (set.add //.default-source sources) + sources)) + (def: #export test Test (<| (_.covering /._) @@ -46,6 +54,8 @@ (!.use (:: file over-write))) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] - (wrap (:: //.equivalence = expected actual)))] + (wrap (:: //.equivalence = + (update@ #//.sources ..with-default-source expected) + actual)))] (_.claim [/.read] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux new file mode 100644 index 000000000..e1c0a77c1 --- /dev/null +++ b/stdlib/source/test/aedifex/runtime.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text]] + [math + ["." random]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [path (random.ascii/alpha 5)] + (`` ($_ _.and + (~~ (template [<command>] + [(_.cover [<command>] + (let [command (<command> path)] + (and (text.starts-with? (<command> "") command) + (text.ends-with? path command))))] + + [/.java] + [/.node] + )) + ))))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 14d75527f..37ae36572 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -18,17 +18,7 @@ ["#/." memo] ["#/." mixin]] ["#." io] - ["#." parser - ["#/." analysis] - ["#/." binary] - ["#/." cli] - ["#/." code] - ["#/." json] - ["#/." synthesis] - ["#/." text] - ["#/." tree] - ["#/." type] - ["#/." xml]] + ["#." parser] ["#." pipe] ["#." reader] ["#." region] @@ -62,22 +52,6 @@ /function/mixin.test )) -(def: parser - Test - ($_ _.and - /parser.test - /parser/analysis.test - /parser/binary.test - /parser/cli.test - /parser/code.test - /parser/json.test - /parser/synthesis.test - /parser/text.test - /parser/tree.test - /parser/type.test - /parser/xml.test - )) - (def: security Test ($_ _.and @@ -94,7 +68,7 @@ /exception.test ..function /io.test - ..parser + /parser.test /pipe.test /reader.test /region.test diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 52cd5d214..f346ff568 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -6,7 +6,7 @@ [data ["." sum] ["." name] - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["n" nat] ["i" int] @@ -111,7 +111,7 @@ <arithmetic>')) (~~ (template [<concatenative> <functional>] [(_.cover [<concatenative>] - (bit@= (<functional> parameter subject) + (bit\= (<functional> parameter subject) (||> (/.push subject) (/.push parameter) <concatenative>)))] diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 7ab561360..c25d7b07f 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -21,7 +21,7 @@ ["." / (#+ actor: message:) [// ["." atom (#+ Atom)] - ["." promise (#+ Promise Resolver) ("#@." monad)] + ["." promise (#+ Promise Resolver) ("#\." monad)] ["." frp]]]}) (exception: got-wrecked) @@ -33,11 +33,11 @@ (message state self)) ((on-stop cause state) - (promise@wrap [])) + (promise\wrap [])) (message: (count! {increment Nat} state self Nat) (let [state' (n.+ increment state)] - (promise@wrap (#try.Success [state' state'])))) + (promise\wrap (#try.Success [state' state'])))) ) (def: (mailed? outcome) @@ -53,7 +53,7 @@ #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a))) (function (_ transform) (function (_ state actor) - (|> state transform #try.Success promise@wrap)))) + (|> state transform #try.Success promise\wrap)))) inc! (: (/.Mail Nat) (as-mail inc)) dec! (: (/.Mail Nat) (as-mail dec))]] (<| (_.covering /._) @@ -129,7 +129,7 @@ (let [die! (: (/.Mail Nat) (function (_ state actor) - (promise@wrap (exception.throw ..got-wrecked []))))] + (promise\wrap (exception.throw ..got-wrecked []))))] (wrap (do promise.monad [result (promise.future (do io.monad [actor (/.spawn! /.default initial-state) @@ -175,7 +175,7 @@ (message (inc state) self)) ((on-stop cause state) - (promise@wrap (exec (%.nat state) + (promise\wrap (exec (%.nat state) [])))) sent/inc? (/.mail! inc! anonymous) sent/dec? (/.mail! dec! anonymous) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index e7d418bf7..c9b19f1c7 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -16,14 +16,14 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." fold monoid)] ["." row (#+ Row)]]] [math ["." random]]] {1 ["." / [// - ["." promise ("#@." monad)] + ["." promise ("#\." monad)] ["." atom (#+ Atom atom)]]]}) (def: injection @@ -49,7 +49,7 @@ (def: #export test Test (<| (_.covering /._) - (let [(^open "list@.") (list.equivalence n.equivalence)] + (let [(^open "list\.") (list.equivalence n.equivalence)] (do random.monad [inputs (random.list 5 random.nat) sample random.nat @@ -104,14 +104,14 @@ /.from-promise /.consume)] (_.claim [/.from-promise /.consume] - (list@= (list sample) + (list\= (list sample) output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) /.consume)] (_.claim [/.sequential] - (list@= inputs + (list\= inputs output)))) (wrap (do promise.monad [output (|> inputs @@ -119,12 +119,12 @@ (/.filter n.even?) /.consume)] (_.claim [/.filter] - (list@= (list.filter n.even? inputs) + (list\= (list.filter n.even? inputs) output)))) (wrap (do {! promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) - channel (/.sequential 0 (list@compose inputs inputs))] + channel (/.sequential 0 (list\compose inputs inputs))] _ (promise.future (/.subscribe (function (_ value) (do {! io.monad} [current (atom.read sink)] @@ -141,9 +141,9 @@ promise.future (:: ! map row.to-list))] (_.claim [/.Subscriber /.subscribe] - (and (list@= inputs + (and (list\= inputs output) - (list@= output + (list\= output listened))))) (wrap (do promise.monad [actual (/.fold (function (_ input total) @@ -151,7 +151,7 @@ 0 (/.sequential 0 inputs))] (_.claim [/.fold] - (n.= (list@fold n.+ 0 inputs) + (n.= (list\fold n.+ 0 inputs) actual)))) (wrap (do promise.monad [actual (|> inputs @@ -161,7 +161,7 @@ 0) /.consume)] (_.claim [/.folds] - (list@= (list.folds n.+ 0 inputs) + (list\= (list.folds n.+ 0 inputs) actual)))) (wrap (do promise.monad [actual (|> (list distint/0 distint/0 distint/0 @@ -171,7 +171,7 @@ (/.distinct n.equivalence) /.consume)] (_.claim [/.distinct] - (list@= (list distint/0 distint/1 distint/2) + (list\= (list distint/0 distint/1 distint/2) actual)))) (let [polling-delay 10 wiggle-room (n.* 5 polling-delay) @@ -207,6 +207,6 @@ /.consume)] (_.claim [/.iterate] (and (n.= max-iterations (list.size actual)) - (list@= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 763ae41f8..fa81183cd 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -15,10 +15,10 @@ ["." maybe] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [type ["." refinement]] [math @@ -116,9 +116,9 @@ _ processB #let [outcome (io.run (atom.read resource))]] (_.claim [/.mutex /.synchronize] - (or (text@= (format expected-As expected-Bs) + (or (text\= (format expected-As expected-Bs) outcome) - (text@= (format expected-Bs expected-As) + (text\= (format expected-Bs expected-As) outcome)))))) ))) @@ -155,7 +155,7 @@ (list.repeat limit) (text.join-with "")) ids (enum.range n.enum 0 (dec limit)) - waiters (list@map (function (_ id) + waiters (list\map (function (_ id) (exec (io.run (atom.update (|>> (format "_")) resource)) (waiter resource barrier id))) ids)] diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index fd3cd53d9..ca2a0eb92 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["." random]]] {1 @@ -94,7 +94,7 @@ (wrap (let [var (/.var 0)] (do {! promise.monad} [_ (|> (list.repeat iterations-per-process []) - (list@map (function (_ _) (/.commit (/.update inc var)))) + (list\map (function (_ _) (/.commit (/.update inc var)))) (monad.seq !)) cummulative (/.commit (/.read var))] (_.claim [/.STM] diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 90a2064af..a19b9e6f9 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -5,7 +5,7 @@ [monad (#+ do)]] [control ["." io (#+ IO)] - ["." state (#+ State) ("#@." monad)]] + ["." state (#+ State) ("#\." monad)]] [math ["." random]] [data @@ -14,7 +14,7 @@ ["n" nat]] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [time ["." instant] ["." duration (#+ Duration)]]] @@ -26,8 +26,8 @@ (def: (fibonacci recur input) (/.Memo Nat Nat) (case input - 0 (state@wrap 0) - 1 (state@wrap 1) + 0 (state\wrap 0) + 1 (state\wrap 1) _ (do state.monad [output-1 (recur (n.- 1 input)) output-2 (recur (n.- 2 input))] @@ -90,8 +90,8 @@ [output' (recur (dec input))] (wrap (n.* input output'))))))) expected (|> (list.indices input) - (list@map inc) - (list@fold n.* 1)) + (list\map inc) + (list\fold n.* 1)) actual (|> (memo input) (state.run (dictionary.new n.hash)) product.right)] diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index accf7659d..c4d6040cd 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [math ["." random (#+ Random)]]] {1 @@ -39,8 +39,8 @@ (wrap (function (_ delegate recur input) output)))) expected (|> (list.indices input) - (list@map inc) - (list@fold n.* 1))]]) + (list\map inc) + (list\fold n.* 1))]]) ($_ _.and (_.with-cover [/.Mixin] ($_ _.and diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 9acf45684..569e32621 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -26,7 +26,19 @@ ["." code] [syntax (#+ syntax:)]]] {1 - ["." / (#+ Parser)]}) + ["." / (#+ Parser)]} + ["." / #_ + ["#." analysis] + ["#." binary] + ["#." cli] + ["#." code] + ["#." environment] + ["#." json] + ["#." synthesis] + ["#." text] + ["#." tree] + ["#." type] + ["#." xml]]) (def: (should-fail expected input) (All [a] (-> Text (Try a) Bit)) @@ -371,4 +383,16 @@ ..combinators-0 ..combinators-1 ..combinators-2 + + /analysis.test + /binary.test + /cli.test + /code.test + /environment.test + /json.test + /synthesis.test + /text.test + /tree.test + /type.test + /xml.test )))) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux new file mode 100644 index 000000000..89b174b47 --- /dev/null +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -0,0 +1,52 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception]] + [data + ["." text ("#\." equivalence)] + [number + ["n" nat]] + [collection + ["." dictionary]]] + [math + ["." random]]] + {1 + ["." / + ["/#" // ("#\." monad)]]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + ($_ _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (do random.monad + [expected random.nat] + (_.cover [/.run] + (|> (/.run (//\wrap expected) /.empty) + (:: try.functor map (n.= expected)) + (try.default false)))) + (do random.monad + [property (random.ascii/alpha 1) + expected (random.ascii/alpha 1)] + (_.cover [/.property] + (|> /.empty + (dictionary.put property expected) + (/.run (/.property property)) + (:: try.functor map (text\= expected)) + (try.default false)))) + (do random.monad + [property (random.ascii/alpha 1)] + (_.cover [/.unknown] + (case (/.run (/.property property) /.empty) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.unknown error)))) + ))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 247ae8be4..6a9809c8b 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -7,7 +7,7 @@ ["." identity] [number ["n" nat]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]]] [math ["." random]]] @@ -33,7 +33,7 @@ (|> sample (/.let> x [(n.+ x x)])))) (_.cover [/.cond>] - (text@= (cond (n.= 0 sample) "zero" + (text\= (cond (n.= 0 sample) "zero" (n.even? sample) "even" "odd") (|> sample @@ -41,7 +41,7 @@ [n.even?] [(/.new> "even" [])] [(/.new> "odd" [])])))) (_.cover [/.if>] - (text@= (if (n.even? sample) + (text\= (if (n.even? sample) "even" "odd") (|> sample @@ -79,9 +79,9 @@ [%.nat]))] (and (n.= (inc sample) left) (n.= (dec sample) middle) - (text@= (%.nat sample) right)))) + (text\= (%.nat sample) right)))) (_.cover [/.case>] - (text@= (case (n.% 10 sample) + (text\= (case (n.% 10 sample) 0 "zero" 1 "one" 2 "two" diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 4885b52eb..13ad42f3f 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -14,7 +14,7 @@ [security ["!" capability]]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] [math @@ -50,20 +50,20 @@ (Ex [%] (-> Any (Policy %))) (/.with-policy (: (Context Privacy Policy) - (function (_ (^@ privilege (^open "%@."))) + (function (_ (^@ privilege (^open "%\."))) (structure (def: &hash (structure (def: &equivalence (structure (def: (= reference sample) - (text@= (!.use %@can-downgrade reference) - (!.use %@can-downgrade sample))))) + (text\= (!.use %\can-downgrade reference) + (!.use %\can-downgrade sample))))) (def: hash - (|>> (!.use %@can-downgrade) + (|>> (!.use %\can-downgrade) (:: text.hash hash))))) (def: password - (!.use %@can-upgrade)) + (!.use %\can-upgrade)) (def: privilege privilege)))))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 246beeeab..f4eaec656 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -13,7 +13,7 @@ pipe ["." io]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] [math @@ -44,7 +44,7 @@ [expected random.nat alternative (|> random.nat (random.filter (|>> (n.= expected) not))) error (random.unicode 1) - #let [(^open "io@.") io.monad]]) + #let [(^open "io\.") io.monad]]) ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..try random.nat))) @@ -65,7 +65,7 @@ (_.cover [/.fail] (case (/.fail error) (#/.Failure message) - (text@= error message) + (text\= error message) _ false)) @@ -97,7 +97,7 @@ (_.cover [/.with /.lift] (let [lift (/.lift io.monad)] (|> (do (/.with io.monad) - [a (lift (io@wrap expected)) + [a (lift (io\wrap expected)) b (wrap alternative)] (wrap (n.+ a b))) io.run diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index 1bb81e06a..9ffff2f1f 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -10,7 +10,7 @@ ["n" nat]] [collection ["." set (#+ Set)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [macro ["." template]] [math @@ -32,8 +32,8 @@ languages (: (List /.Language) (`` (list (~~ (template.splice <languages>)))))] {#count count - #names (|> languages (list@map /.name) (set.from-list text.hash)) - #codes (|> languages (list@map /.code) (set.from-list text.hash)) + #names (|> languages (list\map /.name) (set.from-list text.hash)) + #codes (|> languages (list\map /.code) (set.from-list text.hash)) #languages (|> languages (set.from-list /.hash)) #test (_.cover <languages> true)}))] @@ -181,7 +181,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list@fold (function (_ bundle [count set]) + (list\fold (function (_ bundle [count set]) [(n.+ count (get@ #count bundle)) (set.union set (lens bundle))]) [0 (set.new hash)] @@ -191,8 +191,8 @@ Test (|> ..languages list.reverse - (list@map (get@ #test)) - (list@fold _.and + (list\map (get@ #test)) + (list\fold _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[count set] (..aggregate (get@ <tag>) <hash> ..languages)] diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 43d4401ec..12fa402af 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -10,7 +10,7 @@ ["n" nat]] [collection ["." set (#+ Set)] - ["." list ("#@." functor fold)]]] + ["." list ("#\." functor fold)]]] [macro ["." template]] [math @@ -33,10 +33,10 @@ (let [count (template.count <territories>) territories (`` (list (~~ (template.splice <territories>))))] {#count count - #names (|> territories (list@map /.name) (set.from-list text.hash)) - #shorts (|> territories (list@map /.short-code) (set.from-list text.hash)) - #longs (|> territories (list@map /.long-code) (set.from-list text.hash)) - #numbers (|> territories (list@map /.numeric-code) (set.from-list n.hash)) + #names (|> territories (list\map /.name) (set.from-list text.hash)) + #shorts (|> territories (list\map /.short-code) (set.from-list text.hash)) + #longs (|> territories (list\map /.long-code) (set.from-list text.hash)) + #numbers (|> territories (list\map /.numeric-code) (set.from-list n.hash)) #territories (|> territories (set.from-list /.hash)) #test (_.cover <territories> true)}))] @@ -138,7 +138,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list@fold (function (_ bundle [count set]) + (list\fold (function (_ bundle [count set]) [(n.+ count (get@ #count bundle)) (set.union set (lens bundle))]) [0 (set.new hash)] @@ -148,8 +148,8 @@ Test (|> ..territories list.reverse - (list@map (get@ #test)) - (list@fold _.and + (list\map (get@ #test)) + (list\fold _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[count set] (..aggregate (get@ <tag>) <hash> ..territories)] diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 673099c34..2c34e8ed5 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -5,7 +5,6 @@ ["r" math/random (#+ Random)] [abstract/monad (#+ Monad do)] [data - ["." bit ("#@." equivalence)] [number ["n" nat] ["." int] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 4ade3f2f8..0f6b13629 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -11,7 +11,7 @@ [control ["." try]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat]]] @@ -42,7 +42,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) expected-gensym (random.ascii/upper-alpha 1) #let [expected-lux {#.info {#.target target @@ -114,7 +114,7 @@ (: (Meta Any)) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error))))) + (text\= expected-error actual-error))))) (_.cover [/.assert] (and (|> (/.assert expected-error true) (: (Meta Any)) @@ -123,7 +123,7 @@ (|> (/.assert expected-error false) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error)))))) + (text\= expected-error actual-error)))))) (_.cover [/.either] (and (|> (/.either (:: /.monad wrap expected) (: (Meta Nat) @@ -143,7 +143,7 @@ (/.fail expected-error))) (/.run expected-lux) (!expect (^multi (#try.Failure actual-error) - (text@= expected-error actual-error)))) + (text\= expected-error actual-error)))) (|> (/.either (:: /.monad wrap expected) (:: /.monad wrap dummy)) (/.run expected-lux) @@ -164,7 +164,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) #let [expected-lux {#.info {#.target target #.version version @@ -187,17 +187,17 @@ (|> /.current-module-name (/.run expected-lux) (!expect (^multi (#try.Success actual-current-module) - (text@= expected-current-module actual-current-module))))) + (text\= expected-current-module actual-current-module))))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected-short]) (/.run expected-lux) (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text@= expected-current-module actual-module) + (and (text\= expected-current-module actual-module) (is? expected-short actual-short))))) (|> (/.normalize [dummy-module expected-short]) (/.run expected-lux) (!expect (^multi (#try.Success [actual-module actual-short]) - (and (text@= dummy-module actual-module) + (and (text\= dummy-module actual-module) (is? expected-short actual-short))))))) ))) @@ -240,7 +240,7 @@ dummy (random.filter (|>> (n.= expected) not) random.nat) expected-error (random.ascii/upper-alpha 1) expected-short (random.ascii/upper-alpha 1) - dummy-module (random.filter (|>> (text@= expected-current-module) not) + dummy-module (random.filter (|>> (text\= expected-current-module) not) (random.ascii/upper-alpha 1)) expected-gensym (random.ascii/upper-alpha 1) expected-location ..random-location diff --git a/stdlib/source/test/lux/meta/annotation.lux b/stdlib/source/test/lux/meta/annotation.lux index a3c2dae7f..8acce1930 100644 --- a/stdlib/source/test/lux/meta/annotation.lux +++ b/stdlib/source/test/lux/meta/annotation.lux @@ -19,9 +19,9 @@ ["." rev] ["." frac]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [macro - ["." code ("#@." equivalence)]]] + ["." code ("#\." equivalence)]]] {1 ["." /]} [/// @@ -127,11 +127,11 @@ [(do ! [expected (random.list 5 (random.ascii/alpha 1))] (_.cover [<definition>] - (and (|> expected (list@map code.text) code.tuple + (and (|> expected (list\map code.text) code.tuple (..annotation (name-of <tag>)) <definition> (:: (list.equivalence text.equivalence) = expected)) - (|> expected (list@map code.text) code.tuple + (|> expected (list\map code.text) code.tuple (..annotation key) <definition> (:: (list.equivalence text.equivalence) = (list))))))] @@ -155,7 +155,7 @@ (..annotation key) (/.value key) (!expect (^multi (#.Some actual) - (code@= expected actual)))))) + (code\= expected actual)))))) ..typed-value diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 2f3e7e8ba..c866acf41 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -3,19 +3,19 @@ [abstract ["." monad (#+ do)]] [data ["%" text/format (#+ format)] - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name]] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control pipe] [data ["." product] ["." maybe] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." monad)] + ["." list ("#\." monad)] ["." set]]] ["." type ["." check]] @@ -44,7 +44,7 @@ #.Nil (#.Cons head+ #.Nil) - (list@map (|>> list) head+) + (list\map (|>> list) head+) (#.Cons head+ tail++) (do list.monad @@ -56,7 +56,7 @@ (-> Bit (List [Code Code]) Code (Random (List Code))) (case inputC [_ (#.Bit _)] - (r@wrap (list (' #0) (' #1))) + (r\wrap (list (' #0) (' #1))) (^template [<tag> <gen> <wrapper>] [[_ (<tag> _)] @@ -71,7 +71,7 @@ #.None (wrap (list (' _))))) - (r@wrap (list (' _))))]) + (r\wrap (list (' _))))]) ([#.Nat r.nat code.nat] [#.Int r.int code.int] [#.Rev r.rev code.rev] @@ -79,26 +79,26 @@ [#.Text (r.unicode 5) code.text]) (^ [_ (#.Tuple (list))]) - (r@wrap (list (' []))) + (r\wrap (list (' []))) [_ (#.Tuple members)] (do {! r.monad} [member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving - (list@map code.tuple)))) + (list\map code.tuple)))) (^ [_ (#.Record (list))]) - (r@wrap (list (' {}))) + (r\wrap (list (' {}))) [_ (#.Record kvs)] (do {! r.monad} - [#let [ks (list@map product.left kvs) - vs (list@map product.right kvs)] + [#let [ks (list\map product.left kvs) + vs (list\map product.right kvs)] member-wise-patterns (monad.map ! (exhaustive-branches allow-literals? variantTC) vs)] (wrap (|> member-wise-patterns exhaustive-weaving - (list@map (|>> (list.zip/2 ks) code.record))))) + (list\map (|>> (list.zip/2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) (do {! r.monad} @@ -106,13 +106,13 @@ (function (_ [_tag _code]) (do ! [v-branches (exhaustive-branches allow-literals? variantTC _code)] - (wrap (list@map (function (_ pattern) (` ((~ _tag) (~ pattern)))) + (wrap (list\map (function (_ pattern) (` ((~ _tag) (~ pattern)))) v-branches)))) variantTC)] - (wrap (list@join bundles))) + (wrap (list\join bundles))) _ - (r@wrap (list)) + (r\wrap (list)) )) (def: #export (input variant-tags record-tags primitivesC) @@ -120,7 +120,7 @@ (r.rec (function (_ input) ($_ r.either - (r@map product.right _primitive.primitive) + (r\map product.right _primitive.primitive) (do {! r.monad} [choice (|> r.nat (:: ! map (n.% (list.size variant-tags)))) #let [choiceT (maybe.assume (list.nth choice variant-tags)) @@ -130,7 +130,7 @@ [size (|> r.nat (:: ! map (n.% 3))) elems (r.list size input)] (wrap (code.tuple elems))) - (r@wrap (code.record (list.zip/2 record-tags primitivesC))) + (r\wrap (code.record (list.zip/2 record-tags primitivesC))) )))) (def: (branch body pattern) @@ -142,16 +142,16 @@ (do {! r.monad} [module-name (r.unicode 5) variant-name (r.unicode 5) - record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not))) + record-name (|> (r.unicode 5) (r.filter (|>> (text\= variant-name) not))) size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) record-tags (|> (r.set text.hash size (r.unicode 5)) (:: ! map set.to-list)) primitivesTC (r.list size _primitive.primitive) - #let [primitivesT (list@map product.left primitivesTC) - primitivesC (list@map product.right primitivesTC) + #let [primitivesT (list\map product.left primitivesTC) + primitivesC (list\map product.right primitivesTC) code-tag (|>> [module-name] code.tag) - variant-tags+ (list@map code-tag variant-tags) - record-tags+ (list@map code-tag record-tags) + variant-tags+ (list\map code-tag variant-tags) + record-tags+ (list\map code-tag record-tags) variantTC (list.zip/2 variant-tags+ primitivesC)] inputC (input variant-tags+ record-tags+ primitivesC) [outputT outputC] (r.filter (|>> product.left (is? Any) not) @@ -169,7 +169,7 @@ (type.tuple primitivesT)))]) (//module.with-module 0 module-name)))] exhaustive-patterns (exhaustive-branches true variantTC inputC) - #let [exhaustive-branchesC (list@map (branch outputC) + #let [exhaustive-branchesC (list\map (branch outputC) exhaustive-patterns)]] ($_ _.and (_.test "Will reject empty pattern-matching (no branches)." diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 4fa365850..67c02f142 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -4,8 +4,8 @@ ["." monad (#+ do)]] [data ["%" text/format (#+ format)] - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name]] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe @@ -13,11 +13,11 @@ [data ["." maybe] ["." product] - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] ["." type] ["." macro ["." code]]] @@ -53,7 +53,7 @@ (def: abstraction (do r.monad [func-name (r.unicode 5) - arg-name (|> (r.unicode 5) (r.filter (|>> (text@= func-name) not))) + arg-name (|> (r.unicode 5) (r.filter (|>> (text\= func-name) not))) [outputT outputC] _primitive.primitive [inputT _] _primitive.primitive #let [g!arg (code.local-identifier arg-name)]] @@ -85,8 +85,8 @@ partial-args (|> r.nat (:: ! map (n.% full-args))) var-idx (|> r.nat (:: ! map (|>> (n.% full-args) (n.max 1)))) inputsTC (r.list full-args _primitive.primitive) - #let [inputsT (list@map product.left inputsTC) - inputsC (list@map product.right inputsTC)] + #let [inputsT (list\map product.left inputsTC) + inputsC (list\map product.right inputsTC)] [outputT outputC] _primitive.primitive #let [funcT (type.function inputsT outputT) partialT (type.function (list.drop partial-args inputsT) outputT) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index d2864e6a1..c26e16a6f 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -6,13 +6,12 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control pipe ["." try (#+ Try)] ["." exception (#+ exception:)]] - ["." type ("#@." equivalence)] [macro ["." code]]] {1 @@ -55,9 +54,9 @@ (Random [Type Code]) (`` ($_ r.either (~~ (template [<type> <code-wrapper> <value-gen>] - [(r.and (r@wrap <type>) (r@map <code-wrapper> <value-gen>))] + [(r.and (r\wrap <type>) (r\map <code-wrapper> <value-gen>))] - [Any code.tuple (r.list 0 (r@wrap (' [])))] + [Any code.tuple (r.list 0 (r\wrap (' [])))] [Bit code.bit r.bit] [Nat code.nat r.nat] [Int code.int r.int] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index b67193533..ec5ef8ae0 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -2,17 +2,17 @@ [lux #* [abstract ["." monad (#+ do)]] [data - ["." name ("#@." equivalence)]] - ["r" math/random (#+ Random) ("#@." monad)] + ["." name ("#\." equivalence)]] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try (#+ Try)]] [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [number ["n" nat]]] - ["." type ("#@." equivalence)] + ["." type ("#\." equivalence)] [macro ["." code]]] [// @@ -70,7 +70,7 @@ scope-name (r.unicode 5) var-name (r.unicode 5) dependent-module (|> (r.unicode 5) - (r.filter (|>> (text@= def-module) not)))] + (r.filter (|>> (text\= def-module) not)))] ($_ _.and (_.test "Can analyse variable." (|> (//scope.with-scope scope-name @@ -79,7 +79,7 @@ (_primitive.phase archive.empty (code.local-identifier var-name))))) (phase.run _primitive.state) (case> (^ (#try.Success [inferredT (#////analysis.Reference (////reference.local var))])) - (and (type@= expectedT inferredT) + (and (type\= expectedT inferredT) (n.= 0 var)) _ @@ -93,8 +93,8 @@ (//module.with-module 0 def-module) (phase.run _primitive.state) (case> (^ (#try.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))])) - (and (type@= expectedT inferredT) - (name@= def-name constant-name)) + (and (type\= expectedT inferredT) + (name\= def-name constant-name)) _ false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index fc6d49b3d..5ef40f052 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -4,20 +4,20 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." product] ["." maybe] ["." text] [number ["n" nat]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set]]] ["." type ["." check]] @@ -62,7 +62,7 @@ actual//lefts (get@ #////analysis.lefts variant)] (and (n.= expected//lefts actual//lefts) - (bit@= expected//right? + (bit\= expected//right? actual//right?)))) (def: (check-sum type tag size analysis) @@ -123,14 +123,14 @@ primitives (r.list size _primitive.primitive) +choice (|> r.nat (:: ! map (n.% (inc size)))) [_ +valueC] _primitive.primitive - #let [variantT (type.variant (list@map product.left primitives)) + #let [variantT (type.variant (list\map product.left primitives)) [valueT valueC] (maybe.assume (list.nth choice primitives)) +size (inc size) +primitives (list.concat (list (list.take choice primitives) (list [(#.Parameter 1) +valueC]) (list.drop choice primitives))) [+valueT +valueC] (maybe.assume (list.nth +choice +primitives)) - +variantT (type.variant (list@map product.left +primitives))]] + +variantT (type.variant (list\map product.left +primitives))]] (<| (_.context (%.name (name-of /.sum))) ($_ _.and (_.test "Can analyse." @@ -174,17 +174,17 @@ primitives (r.list size _primitive.primitive) choice (|> r.nat (:: ! map (n.% size))) [_ +valueC] _primitive.primitive - #let [tupleT (type.tuple (list@map product.left primitives)) + #let [tupleT (type.tuple (list\map product.left primitives)) [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume) +primitives (list.concat (list (list.take choice primitives) (list [(#.Parameter 1) +valueC]) (list.drop choice primitives))) - +tupleT (type.tuple (list@map product.left +primitives))]] + +tupleT (type.tuple (list\map product.left +primitives))]] (<| (_.context (%.name (name-of /.product))) ($_ _.and (_.test "Can analyse." (|> (//type.with-type tupleT - (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (/.product archive.empty _primitive.phase (list\map product.right primitives))) (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -193,7 +193,7 @@ false))) (_.test "Can infer." (|> (//type.with-inference - (/.product archive.empty _primitive.phase (list@map product.right primitives))) + (/.product archive.empty _primitive.phase (list\map product.right primitives))) (phase.run _primitive.state) (case> (#try.Success [_type tupleA]) (and (check.checks? tupleT _type) @@ -209,9 +209,9 @@ (|> (do phase.monad [[_ varT] (//type.with-env check.var) _ (//type.with-env - (check.check varT (type.tuple (list@map product.left primitives))))] + (check.check varT (type.tuple (list\map product.left primitives))))] (//type.with-type varT - (/.product archive.empty _primitive.phase (list@map product.right primitives)))) + (/.product archive.empty _primitive.phase (list\map product.right primitives)))) (phase.run _primitive.state) (case> (#try.Success tupleA) (correct-size? size tupleA) @@ -220,11 +220,11 @@ false))) (_.test "Can analyse through existential quantification." (|> (//type.with-type (type.ex-q 1 +tupleT) - (/.product archive.empty _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list\map product.right +primitives))) check-succeeds)) (_.test "Cannot analyse through universal quantification." (|> (//type.with-type (type.univ-q 1 +tupleT) - (/.product archive.empty _primitive.phase (list@map product.right +primitives))) + (/.product archive.empty _primitive.phase (list\map product.right +primitives))) check-fails)) )))) @@ -239,7 +239,7 @@ type-name (r.unicode 5) #let [with-name (|>> (#.Named [module-name type-name])) varT (#.Parameter 1) - primitivesT (list@map product.left primitives) + primitivesT (list\map product.left primitives) [choiceT choiceC] (maybe.assume (list.nth choice primitives)) [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives)) monoT (type.variant primitivesT) @@ -283,9 +283,9 @@ type-name (r.unicode 5) choice (|> r.nat (:: ! map (n.% size))) #let [varT (#.Parameter 1) - tagsC (list@map (|>> [module-name] code.tag) tags) - primitivesT (list@map product.left primitives) - primitivesC (list@map product.right primitives) + tagsC (list\map (|>> [module-name] code.tag) tags) + primitivesT (list\map product.left primitives) + primitivesC (list\map product.right primitives) monoT (#.Named [module-name type-name] (type.tuple primitivesT)) recordC (list.zip/2 tagsC primitivesC) polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 0c0a2d467..b479b523a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -5,7 +5,7 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe @@ -15,7 +15,7 @@ ["." atom]]] [data ["." product]] - ["." type ("#@." equivalence)] + ["." type ("#\." equivalence)] [macro ["." code]]] [//// @@ -58,7 +58,7 @@ (do r.monad [[primT primC] ..primitive [antiT antiC] (|> ..primitive - (r.filter (|>> product.left (type@= primT) not)))] + (r.filter (|>> product.left (type\= primT) not)))] ($_ _.and (_.test "Can test for reference equality." (check-success+ "lux is" (list primC primC) Bit)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 0a59b5534..16ef89258 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -6,7 +6,7 @@ ["." monad (#+ do)]] [control [pipe (#+ case>)] - ["." try ("#@." functor)]] + ["." try ("#\." functor)]] [data ["." sum] ["." text @@ -17,10 +17,10 @@ ["." rev] ["." frac]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] ["." set]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random)]]] ["." // #_ ["#." primitive]] {1 @@ -53,7 +53,7 @@ (|> maskA (//.phase archive.empty) (phase.run [///bundle.empty synthesis.init]) - (try@map (//primitive.corresponds? maskedA)) + (try\map (//primitive.corresponds? maskedA)) (try.default false))))) (def: let-test @@ -127,16 +127,16 @@ (Random [analysis.Pattern Register])) (do random.monad [@member random.nat] - (wrap [(list@fold (function (_ member inner) + (wrap [(list\fold (function (_ member inner) (case member (#.Left lefts) (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (list inner (analysis.pattern/unit)))) (#.Right lefts) (analysis.pattern/tuple - (list@compose (list.repeat (inc lefts) (analysis.pattern/unit)) + (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) (list inner))))) (#analysis.Bind @member) (list.reverse path)) @@ -290,26 +290,26 @@ branch (: (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) {#analysis.when (if right? - (analysis.pattern/tuple (list@compose (list.repeat (inc lefts) (analysis.pattern/unit)) + (analysis.pattern/tuple (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list@compose + (analysis.pattern/tuple ($_ list\compose (list.repeat lefts (analysis.pattern/unit)) (list (analysis.pattern/text value) (analysis.pattern/unit))))) #analysis.then (analysis.frac body)}))]] - (wrap [(list@fold (function (_ left right) + (wrap [(list\fold (function (_ left right) (#synthesis.Alt left right)) (path (inc mid-size) true value/last body/last) (|> (list.zip/2 value/mid body/mid) (#.Cons [value/first body/first]) list.enumeration - (list@map (function (_ [lefts' [value body]]) + (list\map (function (_ [lefts' [value body]]) (path lefts' false value body))) list.reverse)) [(branch 0 false value/first body/first) - (list@compose (|> (list.zip/2 value/mid body/mid) + (list\compose (|> (list.zip/2 value/mid body/mid) list.enumeration - (list@map (function (_ [lefts' [value body]]) + (list\map (function (_ [lefts' [value body]]) (branch (inc lefts') false value body)))) (list (branch (inc mid-size) true value/last body/last)))]]))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 4d92094d3..ffb04e31b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -13,7 +13,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold monoid)] + ["." list ("#\." functor fold monoid)] ["." dictionary (#+ Dictionary)] ["." set]]] [math @@ -32,7 +32,7 @@ [/// [arity (#+ Arity)] ["." reference - ["." variable (#+ Variable) ("#@." equivalence)]] + ["." variable (#+ Variable)]] ["." phase] [meta ["." archive]]]]]]]}) @@ -51,11 +51,11 @@ (def: (n-abstraction arity body) (-> Arity Analysis Analysis) - (list@fold (function (_ arity-1 body) + (list\fold (function (_ arity-1 body) (case arity-1 0 (#analysis.Function (list) body) - _ (#analysis.Function ($_ list@compose - (list@map (|>> #variable.Foreign) + _ (#analysis.Function ($_ list\compose + (list\map (|>> #variable.Foreign) (list.indices arity-1)) (list (#variable.Local 1))) body))) @@ -230,7 +230,7 @@ #analysis.value (#analysis.Bind 2)}) #analysis.then actual-output} {#analysis.when (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) (#analysis.Bind 2)) (list (#analysis.Bind 2) (analysis.pattern/unit))))) @@ -289,7 +289,7 @@ expected-record]) (#analysis.Case actual-record [{#analysis.when (analysis.pattern/tuple - (list@compose (list.repeat lefts (analysis.pattern/unit)) + (list\compose (list.repeat lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) (#analysis.Bind 2)) (list (#analysis.Bind 2) (analysis.pattern/unit))))) @@ -308,27 +308,27 @@ (do {! random.monad} [resets (random.list arity (random-value false))] (wrap [true - (synthesis.loop/recur (list@map (|>> product.right product.left) resets)) + (synthesis.loop/recur (list\map (|>> product.right product.left) resets)) (analysis.apply [(#analysis.Reference (case arity 1 (reference.local 0) _ (reference.foreign 0))) - (list@map (|>> product.right product.right) resets)])]))) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-scope arity output?) (-> Arity Scenario) (do {! random.monad} [resets (random.list arity (..random-variable arity output?)) [_ expected-output actual-output] (..random-nat output?)] - (wrap [(list@fold (function (_ new old) + (wrap [(list\fold (function (_ new old) (and new old)) true - (list@map product.left resets)) + (list\map product.left resets)) (synthesis.loop/scope {#synthesis.start (inc arity) - #synthesis.inits (list@map (|>> product.right product.left) resets) + #synthesis.inits (list\map (|>> product.right product.left) resets) #synthesis.iteration expected-output}) (analysis.apply [(..n-abstraction arity actual-output) - (list@map (|>> product.right product.right) resets)])]))) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-loop arity random-value output?) (-> Arity Scenario Scenario) @@ -344,8 +344,8 @@ (do {! random.monad} [[loop?-output expected-output actual-output] (..random-nat output?) arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) - #let [environment ($_ list@compose - (list@map (|>> #variable.Foreign) + #let [environment ($_ list\compose + (list\map (|>> #variable.Foreign) (list.indices arity)) (list (#variable.Local 1)))]] (wrap [true @@ -365,14 +365,14 @@ [[loop?-abstraction expected-abstraction actual-abstraction] (..random-nat output?) arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) inputs (random.list arity (random-value false))] - (wrap [(list@fold (function (_ new old) + (wrap [(list\fold (function (_ new old) (and new old)) loop?-abstraction - (list@map product.left inputs)) + (list\map product.left inputs)) (synthesis.function/apply [expected-abstraction - (list@map (|>> product.right product.left) inputs)]) + (list\map (|>> product.right product.left) inputs)]) (analysis.apply [actual-abstraction - (list@map (|>> product.right product.right) inputs)])]))) + (list\map (|>> product.right product.right) inputs)])]))) (def: (random-function random-value output?) (-> Scenario Scenario) 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 2667eedac..05a6095bb 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 @@ -10,9 +10,9 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["." random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 ["." / [//// @@ -112,7 +112,7 @@ (let [pattern (: (Scenario Path) (.function (recur offset arity next) (`` ($_ random.either - (random@wrap [next + (random\wrap [next [//.path/pop //.path/pop]]) (~~ (template [<path> <random>] @@ -139,7 +139,7 @@ [//.path/side] [//.path/member] )) - (random@wrap [(inc next) + (random\wrap [(inc next) [(//.path/bind (/.register-optimization offset next)) (//.path/bind next)]]) )))) @@ -276,7 +276,7 @@ (case (/.optimization true expected-offset expected-inits {#//.environment (|> expected-offset list.indices - (list@map (|>> #variable.Local))) + (list\map (|>> #variable.Local))) #//.arity arity #//.body iteration}) (^ (#.Some (//.loop/scope [actual-offset actual-inits diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 1a215fb3b..69f087de7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -11,7 +11,7 @@ ["n" nat]] [collection ["." list]]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)]] {1 ["." / #_ @@ -87,10 +87,10 @@ _ false))))] - [#////analysis.Unit #////synthesis.Text (r@wrap ////synthesis.unit)] + [#////analysis.Unit #////synthesis.Text (r\wrap ////synthesis.unit)] [#////analysis.Bit #////synthesis.Bit r.bit] - [#////analysis.Nat #////synthesis.I64 (r@map .i64 r.nat)] - [#////analysis.Int #////synthesis.I64 (r@map .i64 r.int)] - [#////analysis.Rev #////synthesis.I64 (r@map .i64 r.rev)] + [#////analysis.Nat #////synthesis.I64 (r\map .i64 r.nat)] + [#////analysis.Int #////synthesis.I64 (r\map .i64 r.int)] + [#////analysis.Rev #////synthesis.I64 (r\map .i64 r.rev)] [#////analysis.Frac #////synthesis.F64 r.frac] [#////analysis.Text #////synthesis.Text (r.unicode 5)])))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index d759ff213..b51a196f0 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -4,13 +4,13 @@ [data ["%" text/format (#+ format)] ["." name]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random)] ["_" test (#+ Test)] [control pipe ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] ["." product] [number ["n" nat]] @@ -49,7 +49,7 @@ (case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] (and (n.= tagA tagS) - (|> tagS (n.= (dec size)) (bit@= right?S)) + (|> tagS (n.= (dec size)) (bit\= right?S)) (//primitive.corresponds? memberA valueS))) _ diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 45706256b..437d721cd 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)] + ["." list ("#\." functor fold)] ["." dictionary (#+ Dictionary)]]]] {1 ["." / @@ -97,8 +97,8 @@ (Scenario Synthesis) (let [registers (dictionary.entries (get@ #necessary context))] (:: random.monad wrap - [(synthesis.tuple (list@map (|>> product.left synthesis.variable/local) registers)) - (synthesis.tuple (list@map (|>> product.right synthesis.variable/local) registers))]))) + [(synthesis.tuple (list\map (|>> product.left synthesis.variable/local) registers)) + (synthesis.tuple (list\map (|>> product.right synthesis.variable/local) registers))]))) (def: (structure-scenario context) (Scenario Synthesis) @@ -244,23 +244,23 @@ inits (random.list ..scope-arity (scenario context)) [expected-iteration actual-iteration] (scenario (update@ #necessary (function (_ necessary) - (list@fold (function (_ [idx _] context) + (list\fold (function (_ [idx _] context) (dictionary.put (n.+ real-start idx) (n.+ fake-start idx) context)) necessary (list.enumeration inits))) context))] - (wrap [(synthesis.loop/scope [real-start (list@map product.left inits) expected-iteration]) - (synthesis.loop/scope [fake-start (list@map product.right inits) actual-iteration])]))) + (wrap [(synthesis.loop/scope [real-start (list\map product.left inits) expected-iteration]) + (synthesis.loop/scope [fake-start (list\map product.right inits) actual-iteration])]))) (def: (recur-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} [_ (wrap []) resets (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.loop/recur (list@map product.left resets)) - (synthesis.loop/recur (list@map product.right resets))]))) + (wrap [(synthesis.loop/recur (list\map product.left resets)) + (synthesis.loop/recur (list\map product.right resets))]))) (def: (loop-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -274,8 +274,8 @@ (do {! random.monad} [_ (wrap []) #let [registers (dictionary.entries (get@ #necessary context)) - expected-environment (list@map (|>> product.left #variable.Local) registers) - actual-environment (list@map (|>> product.right #variable.Local) registers)] + expected-environment (list\map (|>> product.left #variable.Local) registers) + actual-environment (list\map (|>> product.right #variable.Local) registers)] [expected-body actual-body] (..primitive-scenario context)] (wrap [(synthesis.function/abstraction [expected-environment 1 expected-body]) (synthesis.function/abstraction [actual-environment 1 actual-body])]))) @@ -287,8 +287,8 @@ (random.and (random.unicode 1) (random.unicode 1))) inputs (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.function/apply [abstraction (list@map product.left inputs)]) - (synthesis.function/apply [abstraction (list@map product.right inputs)])]))) + (wrap [(synthesis.function/apply [abstraction (list\map product.left inputs)]) + (synthesis.function/apply [abstraction (list\map product.right inputs)])]))) (def: (function-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 7c2ece82e..c93eae5f9 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -6,7 +6,7 @@ ["." name] [number ["n" nat]]] - ["r" math/random (#+ Random) ("#@." monad)] + ["r" math/random (#+ Random) ("#\." monad)] ["_" test (#+ Test)] [control ["." try] @@ -38,18 +38,18 @@ (Random Code) (let [numeric^ (: (Random Code) ($_ r.either - (|> r.bit (r@map code.bit)) - (|> r.nat (r@map code.nat)) - (|> r.int (r@map code.int)) - (|> r.rev (r@map code.rev)) - (|> r.safe-frac (r@map code.frac)))) + (|> r.bit (r\map code.bit)) + (|> r.nat (r\map code.nat)) + (|> r.int (r\map code.int)) + (|> r.rev (r\map code.rev)) + (|> r.safe-frac (r\map code.frac)))) textual^ (: (Random Code) ($_ r.either (do r.monad - [size (|> r.nat (r@map (n.% 20)))] - (|> (r.ascii/upper-alpha size) (r@map code.text))) - (|> name^ (r@map code.identifier)) - (|> name^ (r@map code.tag)))) + [size (|> r.nat (r\map (n.% 20)))] + (|> (r.ascii/upper-alpha size) (r\map code.text))) + (|> name^ (r\map code.identifier)) + (|> name^ (r\map code.tag)))) simple^ (: (Random Code) ($_ r.either numeric^ @@ -57,16 +57,16 @@ (r.rec (function (_ code^) (let [multi^ (do r.monad - [size (|> r.nat (r@map (n.% 3)))] + [size (|> r.nat (r\map (n.% 3)))] (r.list size code^)) composite^ (: (Random Code) ($_ r.either - (|> multi^ (r@map code.form)) - (|> multi^ (r@map code.tuple)) + (|> multi^ (r\map code.form)) + (|> multi^ (r\map code.tuple)) (do r.monad - [size (|> r.nat (r@map (n.% 3)))] + [size (|> r.nat (r\map (n.% 3)))] (|> (r.list size (r.and code^ code^)) - (r@map code.record)))))] + (r\map code.record)))))] ($_ r.either simple^ composite^)))))) @@ -110,7 +110,7 @@ (Random Text) (let [char-gen (|> r.nat (r.filter (|>> (n.= (`` (char (~~ (static text.new-line))))) not)))] (do r.monad - [size (|> r.nat (r@map (n.% 20)))] + [size (|> r.nat (r\map (n.% 20)))] (r.text char-gen size)))) (def: comment^ diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index f98fc6a17..094b32420 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -5,22 +5,39 @@ [monad (#+ do)]] [control ["." try (#+ Try)] - ["." exception (#+ exception:)]] + ["." exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]] + [parser + ["." environment]]] [data + ["." text ("#\." equivalence)] [number ["n" nat] ["i" int]] [collection - ["." list]]]] + ["." list]]] + [math + ["." random]]] {1 - ["." /]} + ["." / + [// + [environment (#+ Environment)]]]} {[1 #spec] ["$." /]}) +(macro: (|private| definition+ compiler) + (let [[module _] (name-of /._)] + (#.Right [compiler (list (` ("lux in-module" (~ [["" 0 0] (#.Text module)]) + (~+ definition+))))]))) + (exception: dead) (def: (simulation [environment command arguments]) - (-> [/.Environment /.Command (List /.Argument)] + (-> [Environment /.Command (List /.Argument)] (/.Simulation Bit)) (structure (def: (on-read dead?) @@ -50,9 +67,80 @@ (exception.throw ..dead []) (#try.Success [true /.normal]))))) +(def: (io-shell command oops input destruction exit) + (-> /.Command Text Text Text /.Exit (/.Shell IO)) + (structure + (def: execute + ((|private| /.can-execute) + (function (_ [environment command arguments]) + (io.io + (#try.Success + (: (/.Process IO) + (structure + (def: read + ((|private| /.can-read) + (function (_ _) + (io.io (#try.Success command))))) + (def: error + ((|private| /.can-read) + (function (_ _) + (io.io (#try.Success oops))))) + (def: write + ((|private| /.can-write) + (function (_ message) + (io.io (#try.Failure message))))) + (def: destroy + ((|private| /.can-destroy) + (function (_ _) + (io.io (#try.Failure destruction))))) + (def: await + ((|private| /.can-wait) + (function (_ _) + (io.io (#try.Success exit)))))))))))))) + (def: #export test Test (<| (_.covering /._) - (_.with-cover [/.mock /.Simulation] - ($/.spec (/.mock (|>> ..simulation #try.Success) - false))))) + ($_ _.and + (_.with-cover [/.mock /.Simulation] + ($/.spec (/.mock (|>> ..simulation #try.Success) + false))) + (_.cover [/.error] + (not (i.= /.normal /.error))) + (do random.monad + [command (random.ascii/alpha 5) + oops (random.ascii/alpha 5) + input (random.ascii/alpha 5) + destruction (random.ascii/alpha 5) + exit random.int + #let [shell (/.async (..io-shell command oops input destruction exit))]] + (wrap (do {! promise.monad} + [verdict (do (try.with !) + [process (!.use (:: shell execute) [environment.empty command (list)]) + read (!.use (:: process read) []) + error (!.use (:: process error) []) + write? (do ! + [write (!.use (:: process write) [input])] + (wrap (#try.Success (case write + (#try.Success _) + false + + (#try.Failure write) + (text\= input write))))) + destroy? (do ! + [destroy (!.use (:: process destroy) [])] + (wrap (#try.Success (case destroy + (#try.Success _) + false + + (#try.Failure destroy) + (text\= destruction destroy))))) + await (!.use (:: process await) [])] + (wrap (and (text\= command read) + (text\= oops error) + write? + destroy? + (i.= exit await))))] + (_.claim [/.async /.Can-Write] + (try.default false verdict))))) + ))) |