From 3289b9dcf9d5d1c1e5c380e3185065c8fd32535f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Aug 2021 01:12:01 -0400 Subject: Made extension-definition macros specify their bindings the same way as syntax:. --- stdlib/source/test/aedifex/command/deps.lux | 4 +- .../source/test/aedifex/dependency/deployment.lux | 2 +- .../source/test/aedifex/dependency/resolution.lux | 6 +- stdlib/source/test/aedifex/metadata/artifact.lux | 2 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 2 +- stdlib/source/test/lux.lux | 2 +- stdlib/source/test/lux/abstract/apply.lux | 4 +- stdlib/source/test/lux/abstract/codec.lux | 4 +- stdlib/source/test/lux/abstract/functor.lux | 4 +- stdlib/source/test/lux/abstract/monoid.lux | 4 +- .../test/lux/control/concurrency/semaphore.lux | 8 +- stdlib/source/test/lux/control/continuation.lux | 34 +- stdlib/source/test/lux/control/function.lux | 4 +- stdlib/source/test/lux/control/maybe.lux | 10 +- stdlib/source/test/lux/control/parser.lux | 6 +- stdlib/source/test/lux/control/parser/text.lux | 8 +- stdlib/source/test/lux/control/reader.lux | 4 +- stdlib/source/test/lux/control/region.lux | 4 +- stdlib/source/test/lux/control/state.lux | 4 +- stdlib/source/test/lux/control/try.lux | 4 +- stdlib/source/test/lux/control/writer.lux | 6 +- stdlib/source/test/lux/data/binary.lux | 4 +- .../source/test/lux/data/collection/dictionary.lux | 8 +- stdlib/source/test/lux/data/collection/list.lux | 6 +- stdlib/source/test/lux/data/collection/row.lux | 8 +- .../source/test/lux/data/collection/sequence.lux | 43 +- stdlib/source/test/lux/data/format/tar.lux | 2 +- stdlib/source/test/lux/data/format/xml.lux | 2 +- stdlib/source/test/lux/data/text.lux | 6 +- stdlib/source/test/lux/data/text/encoding.lux | 2 +- stdlib/source/test/lux/data/text/format.lux | 2 +- stdlib/source/test/lux/data/text/unicode/set.lux | 6 +- stdlib/source/test/lux/debug.lux | 2 +- stdlib/source/test/lux/documentation.lux | 131 ++--- stdlib/source/test/lux/extension.lux | 20 +- stdlib/source/test/lux/ffi.jvm.lux | 6 +- stdlib/source/test/lux/locale/language.lux | 2 +- stdlib/source/test/lux/locale/territory.lux | 2 +- stdlib/source/test/lux/macro.lux | 2 - stdlib/source/test/lux/macro/poly.lux | 20 - stdlib/source/test/lux/macro/poly/equivalence.lux | 84 ---- stdlib/source/test/lux/macro/poly/functor.lux | 28 -- stdlib/source/test/lux/macro/poly/json.lux | 119 ----- stdlib/source/test/lux/meta.lux | 6 +- stdlib/source/test/lux/target/jvm.lux | 546 ++++++++++----------- stdlib/source/test/lux/test.lux | 6 +- stdlib/source/test/lux/time/year.lux | 6 +- .../compiler/language/lux/phase/analysis/case.lux | 8 +- .../language/lux/phase/analysis/function.lux | 2 +- .../language/lux/phase/analysis/structure.lux | 14 +- stdlib/source/test/lux/type.lux | 8 +- stdlib/source/test/lux/type/poly.lux | 20 + stdlib/source/test/lux/type/poly/equivalence.lux | 83 ++++ stdlib/source/test/lux/type/poly/functor.lux | 27 + stdlib/source/test/lux/type/poly/json.lux | 117 +++++ stdlib/source/test/lux/type/refinement.lux | 6 +- stdlib/source/test/lux/world/input/keyboard.lux | 2 +- .../test/lux/world/output/video/resolution.lux | 2 +- 58 files changed, 752 insertions(+), 732 deletions(-) delete mode 100644 stdlib/source/test/lux/macro/poly.lux delete mode 100644 stdlib/source/test/lux/macro/poly/equivalence.lux delete mode 100644 stdlib/source/test/lux/macro/poly/functor.lux delete mode 100644 stdlib/source/test/lux/macro/poly/json.lux create mode 100644 stdlib/source/test/lux/type/poly.lux create mode 100644 stdlib/source/test/lux/type/poly/equivalence.lux create mode 100644 stdlib/source/test/lux/type/poly/functor.lux create mode 100644 stdlib/source/test/lux/type/poly/json.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index c4311fc2c..0c6676488 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -75,12 +75,12 @@ dependee_pom (|> (\ ///.monoid identity) (set@ #///.identity (#.Some dependee_artifact)) ///pom.write - try.assumed) + try.trusted) depender_pom (|> (\ ///.monoid identity) (set@ #///.identity (#.Some depender_artifact)) (set@ #///.dependencies (set.of_list ///dependency.hash (list dependee))) ///pom.write - try.assumed) + try.trusted) dependee_package (|> dependee_package (set@ #///package.origin (#///repository/origin.Remote "")) diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux index 9ddabee88..ae97a70ca 100644 --- a/stdlib/source/test/aedifex/dependency/deployment.lux +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -137,7 +137,7 @@ [[profile package] $///package.random .let [artifact (|> profile (get@ #profile.identity) - maybe.assume) + maybe.trusted) dependency (: Dependency [artifact artifact/type.lux_library])]] diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index da101dfa2..c7f7d6d40 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -368,16 +368,16 @@ dependee_pom (|> (\ ///.monoid identity) (set@ #///.identity (#.Some dependee_artifact)) ///pom.write - try.assumed) + try.trusted) depender_pom (|> (\ ///.monoid identity) (set@ #///.identity (#.Some depender_artifact)) (set@ #///.dependencies (set.of_list ///dependency.hash (list dependee))) ///pom.write - try.assumed) + try.trusted) ignored_pom (|> (\ ///.monoid identity) (set@ #///.identity (#.Some ignored_artifact)) ///pom.write - try.assumed) + try.trusted) dependee_package (set@ #///package.pom [dependee_pom diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 7bcb0bd91..46ebf4eae 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -54,7 +54,7 @@ hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] - (in (try.assumed + (in (try.trusted (do try.monad [year (year.year year) month (month.by_number month) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index 5683178c4..d5dc8595e 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -58,7 +58,7 @@ hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] - (in (try.assumed + (in (try.trusted (do try.monad [year (year.year year) month (month.by_number month) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index b2c6790ee..a0e00fdd4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -748,7 +748,7 @@ [left (random.ascii/lower 1) mid (random.ascii/lower 1) right (random.ascii/lower 1) - .let [expected (text.join_with "" (list left mid right))]] + .let [expected (text.interposed "" (list left mid right))]] (_.cover [/.$_ /._$] (with_expansions [ (/._$ format left diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index 26bb2cc7e..fcdf5d793 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -23,9 +23,9 @@ right random.nat] (<| (_.covering /._) ($_ _.and - (_.cover [/.compose] + (_.cover [/.composite] (let [expected (n.+ left right)] - (case (\ (/.compose maybe.monad maybe.apply list.apply) apply + (case (\ (/.composite maybe.monad maybe.apply list.apply) apply (#.Some (list (n.+ left))) (#.Some (list right))) (^ (#.Some (list actual))) diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index fe3a58e71..e3fd09626 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -31,14 +31,14 @@ (def: codec (Codec Text Bit) - (/.compose json.codec ..json)) + (/.composite json.codec ..json)) (def: .public test Test (do random.monad [expected random.bit] (<| (_.covering /._) - (_.cover [/.compose] + (_.cover [/.composite] (case (|> expected (\ ..codec encode) (\ ..codec decode)) (#try.Success actual) (bit\= expected actual) diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 252e9b999..522707615 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -51,8 +51,8 @@ _ false)) - (_.cover [/.Then /.compose] - (case (\ (/.compose maybe.functor list.functor) map + (_.cover [/.Then /.composite] + (case (\ (/.composite maybe.functor list.functor) map (n.+ shift) (#.Some (list left))) (^ (#.Some (list actual))) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index 98c33068a..75eee67c6 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -23,8 +23,8 @@ intR random.int] (<| (_.covering /._) ($_ _.and - (_.cover [/.compose] - (let [[natLR intLR] (\ (/.compose nat.addition int.multiplication) compose + (_.cover [/.composite] + (let [[natLR intLR] (\ (/.composite nat.addition int.multiplication) compose [natL intL] [natR intR])] (and (nat.= (\ nat.addition compose natL natR) natLR) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 40cc7d703..a57e3bcd6 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -100,8 +100,8 @@ (do {! random.monad} [repetitions (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) .let [resource (atom.atom "") - expected_As (text.join_with "" (list.repeated repetitions "A")) - expected_Bs (text.join_with "" (list.repeated repetitions "B")) + expected_As (text.joined (list.repeated repetitions "A")) + expected_Bs (text.joined (list.repeated repetitions "B")) mutex (/.mutex []) processA (<| (/.synchronize! mutex) io.io @@ -156,13 +156,13 @@ false))) (do {! random.monad} [limit (\ ! map (|>> (n.% 9) inc) random.nat) - .let [barrier (/.barrier (maybe.assume (/.limit limit))) + .let [barrier (/.barrier (maybe.trusted (/.limit limit))) resource (atom.atom "")]] (in (do {! async.monad} [.let [suffix "_" expected_ending (|> suffix (list.repeated limit) - (text.join_with "")) + text.joined) expected_ids (enum.range n.enum 0 (dec limit))] _ (|> expected_ids (list\map (function (_ id) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 03f3ae2c3..4844e521f 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -46,17 +46,17 @@ (_.cover [/.result] (n.= sample (/.result (_\in sample)))) - (_.cover [/.call/cc] + (_.cover [/.with_current] (n.= (n.* 2 sample) (/.result (do {! /.monad} - [value (/.call/cc - (function (_ k) - (do ! - [temp (k sample)] - ... If this code where to run, - ... the output would be - ... (n.* 4 sample) - (k temp))))] + [value (/.with_current + (function (_ k) + (do ! + [temp (k sample)] + ... If this code where to run, + ... the output would be + ... (n.* 4 sample) + (k temp))))] (in (n.* 2 value)))))) (_.cover [/.portal] (n.= (n.+ 100 sample) @@ -84,13 +84,13 @@ (visit output)))))] (list\= elems (/.result (/.reset (visit elems)))))) - (_.cover [/.continue] - (/.continue (same? sample) - (: (/.Cont Nat Bit) - (function (_ next) - (next sample))))) + (_.cover [/.continued] + (/.continued (same? sample) + (: (/.Cont Nat Bit) + (function (_ next) + (next sample))))) (_.cover [/.pending] - (/.continue (same? sample) - (: (/.Cont Nat Bit) - (/.pending sample)))) + (/.continued (same? sample) + (: (/.Cont Nat Bit) + (/.pending sample)))) ))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index 01da979e6..369a018e0 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -44,9 +44,9 @@ (_.cover [/.identity] (n.= expected (/.identity expected))) - (_.cover [/.compose] + (_.cover [/.composite] (n.= (f0 (f1 expected)) - ((/.compose f0 f1) expected))) + ((/.composite f0 f1) expected))) (_.cover [/.constant] (n.= expected ((/.constant expected) dummy))) diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index 5d9a04a0b..6f4213268 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -49,10 +49,10 @@ [left random.nat right random.nat .let [expected (n.+ left right)]] - (let [lift (/.lift io.monad)] - (_.cover [/.with /.lift] + (let [lifted (/.lifted io.monad)] + (_.cover [/.with /.lifted] (|> (io.run! (do (/.with io.monad) - [a (lift (io\in left)) + [a (lifted (io\in left)) b (in right)] (in (n.+ a b)))) (case> (#.Some actual) @@ -71,8 +71,8 @@ (#.Some value)))))) (do random.monad [value random.nat] - (_.cover [/.assume] - (same? value (/.assume (#.Some value))))) + (_.cover [/.trusted] + (same? value (/.trusted (#.Some value))))) (do random.monad [value random.nat] (_.cover [/.list] diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index bb81f4383..f45ba2111 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -368,12 +368,12 @@ (|> (list) (/.result (/.failure failure)) (should_fail failure))) - (_.cover [/.lift] + (_.cover [/.lifted] (and (|> (list) - (/.result (/.lift (#try.Success expected))) + (/.result (/.lifted (#try.Success expected))) (match actual (n.= expected actual))) (|> (list) - (/.result (/.lift (#try.Failure failure))) + (/.result (/.lifted (#try.Failure failure))) (should_fail failure)))) (_.cover [/.assertion] (and (|> (list (code.bit #1) (code.int +123)) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 35c509e00..7be2416d0 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -157,11 +157,11 @@ (random.set n.hash num_options) (\ ! map (|>> set.list (list\map text.of_char) - (text.join_with "")))) + text.joined))) expected (\ ! map (function (_ value) (|> options (text.char (n.% num_options value)) - maybe.assume)) + maybe.trusted)) random.nat) invalid (random.only (function (_ char) (not (text.contains? (text.of_char char) options))) @@ -183,11 +183,11 @@ (random.set n.hash num_options) (\ ! map (|>> set.list (list\map text.of_char) - (text.join_with "")))) + text.joined))) invalid (\ ! map (function (_ value) (|> options (text.char (n.% num_options value)) - maybe.assume)) + maybe.trusted)) random.nat) expected (random.only (function (_ char) (not (text.contains? (text.of_char char) options))) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 9b17a19fa..78ea0d961 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -49,10 +49,10 @@ (n.= (n.* factor sample) (/.result sample (/.local (n.* factor) /.read)))) (let [(^open "io\.") io.monad] - (_.cover [/.with /.lift] + (_.cover [/.with /.lifted] (|> (: (/.Reader Any (IO Nat)) (do (/.with io.monad) - [a (/.lift (io\in sample)) + [a (/.lifted (io\in sample)) b (in factor)] (in (n.* b a)))) (/.result []) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 4f135a57d..caabbadf6 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -172,14 +172,14 @@ (..throws? /.clean_up_error outcome)) (n.= expected_clean_ups actual_clean_ups)))))) - (_.cover [/.lift] + (_.cover [/.lifted] (thread.result (do {! thread.monad} [clean_up_counter (thread.box 0) .let [//@ !] outcome (/.run! ! (do (/.monad !) - [_ (/.lift //@ (thread.write! expected_clean_ups clean_up_counter))] + [_ (/.lifted //@ (thread.write! expected_clean_ups clean_up_counter))] (in []))) actual_clean_ups (thread.read! clean_up_counter)] (in (and (..success? outcome) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 3f2123211..864c16bd9 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -108,10 +108,10 @@ left random.nat right random.nat] (let [(^open "io\.") io.monad] - (_.cover [/.+State /.with /.lift /.result'] + (_.cover [/.+State /.with /.lifted /.result'] (|> (: (/.+State io.IO Nat Nat) (do (/.with io.monad) - [a (/.lift io.monad (io\in left)) + [a (/.lifted io.monad (io\in left)) b (in right)] (in (n.+ a b)))) (/.result' state) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 3c030bdcc..55bcc0b4f 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -55,9 +55,9 @@ (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.assumed] + (_.cover [/.trusted] (n.= expected - (/.assumed (#/.Success expected)))) + (/.trusted (#/.Success expected)))) (_.cover [/.of_maybe] (case [(/.of_maybe (#.Some expected)) (/.of_maybe #.None)] diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 9d43ef5f8..5ef2c76c4 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -50,11 +50,11 @@ (_.cover [/.write] (text\= log (product.left (/.write log)))) - (_.cover [/.with /.lift] - (let [lift (/.lift text.monoid io.monad) + (_.cover [/.with /.lifted] + (let [lifted (/.lifted text.monoid io.monad) (^open "io\.") io.monad] (|> (do (/.with text.monoid io.monad) - [a (lift (io\in left)) + [a (lifted (io\in left)) b (in right)] (in (n.+ a b))) io.run! diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index aab56834f..372aed7de 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -38,7 +38,7 @@ (if (n.< size idx) (do random.monad [byte random.nat] - (exec (try.assumed (/.write/8! idx byte output)) + (exec (try.trusted (/.write/8! idx byte output)) (recur (inc idx)))) (\ random.monad in output))))) @@ -113,7 +113,7 @@ (_.cover [/.read/64! /.write/64!] (..binary_io 3 /.read/64! /.write/64! value)))) (_.cover [/.slice] - (let [random_slice (try.assumed (/.slice offset length sample)) + (let [random_slice (try.trusted (/.slice offset length sample)) idxs (: (List Nat) (case length 0 (list) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 82e421d28..080e09001 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -174,7 +174,7 @@ cannot_put_old_keys! (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.assume)] + (let [first_key (|> dict /.keys list.head maybe.trusted)] (case (/.has' first_key test_val dict) (#try.Success _) false @@ -239,13 +239,13 @@ (_.cover [/.re_bound] (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.assume) + (let [first_key (|> dict /.keys list.head maybe.trusted) rebound (/.re_bound first_key non_key dict)] (and (n.= (/.size dict) (/.size rebound)) (/.key? rebound non_key) (not (/.key? rebound first_key)) - (n.= (maybe.assume (/.value first_key dict)) - (maybe.assume (/.value non_key rebound))))))) + (n.= (maybe.trusted (/.value first_key dict)) + (maybe.trusted (/.value non_key rebound))))))) ))) (def: .public test diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index ce86a80c7..8ba430845 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -68,12 +68,12 @@ (do {! random.monad} [parameter random.nat subject random.nat] - (let [lift (/.lift io.monad) + (let [lifted (/.lifted io.monad) (^open "io\.") io.monad expected (n.+ parameter subject)] - (_.cover [/.with /.lift] + (_.cover [/.with /.lifted] (|> (io.run! (do (/.with io.monad) - [a (lift (io\in parameter)) + [a (lifted (io\in parameter)) b (in subject)] (in (n.+ a b)))) (case> (^ (list actual)) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 3ae89efba..2515f284f 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -98,16 +98,16 @@ (#try.Failure error) false)) - (_.cover [/.put] + (_.cover [/.has] (<| (try.else false) (do try.monad - [sample (/.put good_index non_member sample) + [sample (/.has good_index non_member sample) actual (/.item good_index sample)] (in (same? non_member actual))))) (_.cover [/.revised] (<| (try.else false) (do try.monad - [sample (/.put good_index non_member sample) + [sample (/.has good_index non_member sample) sample (/.revised good_index inc sample) actual (/.item good_index sample)] (in (n.= (inc non_member) actual))))) @@ -124,7 +124,7 @@ (#try.Failure error) (exception.match? /.index_out_of_bounds error))))] (and (fails! (/.item bad_index sample)) - (fails! (/.put bad_index non_member sample)) + (fails! (/.has bad_index non_member sample)) (fails! (/.revised bad_index inc sample))))) )) ))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 19183f1b1..ebac1772b 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -29,6 +29,15 @@ (/.first 100 reference) (/.first 100 subject)))) +(def: (iterations step) + (All [a] + (-> (-> a a) + (-> a (/.Sequence a)))) + (/.iterations + (function (_ state) + (let [state' (step state)] + [state' state])))) + (def: .public test Test (<| (_.covering /._) @@ -47,67 +56,67 @@ (_.for [/.comonad] ($comonad.spec /.repeated ..equivalence /.comonad)) - (_.cover [/.iterations /.item] + (_.cover [/.item] (n.= (n.+ offset index) - (/.item index (/.iterations inc offset)))) + (/.item index (..iterations inc offset)))) (_.cover [/.repeated] (n.= repeated (/.item index (/.repeated repeated)))) (_.cover [/.first] (list\= (enum.range n.enum offset (dec (n.+ size offset))) - (/.first size (/.iterations inc offset)))) + (/.first size (..iterations inc offset)))) (_.cover [/.after] (list\= (enum.range n.enum offset (dec (n.+ size offset))) - (/.first size (/.after offset (/.iterations inc 0))))) + (/.first size (/.after offset (..iterations inc 0))))) (_.cover [/.split_at] - (let [[drops takes] (/.split_at size (/.iterations inc 0))] + (let [[drops takes] (/.split_at size (..iterations inc 0))] (and (list\= (enum.range n.enum 0 (dec size)) drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.first size takes))))) (_.cover [/.while] (list\= (enum.range n.enum 0 (dec size)) - (/.while (n.< size) (/.iterations inc 0)))) + (/.while (n.< size) (..iterations inc 0)))) (_.cover [/.until] (list\= (enum.range n.enum offset (dec (n.+ size offset))) (/.while (n.< (n.+ size offset)) - (/.until (n.< offset) (/.iterations inc 0))))) + (/.until (n.< offset) (..iterations inc 0))))) (_.cover [/.split_when] - (let [[drops takes] (/.split_when (n.= size) (/.iterations inc 0))] + (let [[drops takes] (/.split_when (n.= size) (..iterations inc 0))] (and (list\= (enum.range n.enum 0 (dec size)) drops) (list\= (enum.range n.enum size (dec (n.* 2 size))) (/.while (n.< (n.* 2 size)) takes))))) (_.cover [/.head] (n.= offset - (/.head (/.iterations inc offset)))) + (/.head (..iterations inc offset)))) (_.cover [/.tail] (list\= (enum.range n.enum (inc offset) (n.+ size offset)) - (/.first size (/.tail (/.iterations inc offset))))) + (/.first size (/.tail (..iterations inc offset))))) (_.cover [/.only] (list\= (list\map (n.* 2) (enum.range n.enum 0 (dec size))) - (/.first size (/.only n.even? (/.iterations inc 0))))) + (/.first size (/.only n.even? (..iterations inc 0))))) (_.cover [/.partition] - (let [[evens odds] (/.partition n.even? (/.iterations inc 0))] + (let [[evens odds] (/.partition n.even? (..iterations inc 0))] (and (n.= (n.* 2 offset) (/.item offset evens)) (n.= (inc (n.* 2 offset)) (/.item offset odds))))) - (_.cover [/.unfold] + (_.cover [/.iterations] (let [(^open "/\.") /.functor (^open "list\.") (list.equivalence text.equivalence)] (list\= (/.first size - (/\map %.nat (/.iterations inc offset))) + (/\map %.nat (..iterations inc offset))) (/.first size - (/.unfold (function (_ n) [(inc n) (%.nat n)]) - offset))))) + (/.iterations (function (_ n) [(inc n) (%.nat n)]) + offset))))) (_.cover [/.cycle] (let [cycle (list& cycle_start cycle_next)] (list\= (list.joined (list.repeated size cycle)) (/.first (n.* size (list.size cycle)) (/.cycle [cycle_start cycle_next]))))) (_.cover [/.^sequence&] - (let [(/.^sequence& first second third next) (/.iterations inc offset)] + (let [(/.^sequence& first second third next) (..iterations inc offset)] (and (n.= offset first) (n.= (n.+ 1 offset) second) (n.= (n.+ 2 offset) third)))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 0c43ada46..fe0083c95 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -164,7 +164,7 @@ chunks (\ ! map (n.% 100) random.nat) .let [content (|> chunk (list.repeated chunks) - (text.join_with "") + text.joined (\ utf8.codec encode))]] (`` ($_ _.and (~~ (template [ ] diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 4fef01a10..0ce833e92 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -37,7 +37,7 @@ (Random Nat) (do {! random.monad} [idx (|> random.nat (\ ! map (n.% (text.size char_range))))] - (in (maybe.assume (text.char idx char_range))))) + (in (maybe.trusted (text.char idx char_range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 1efa4ebfe..aa012a5ae 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -195,15 +195,15 @@ (_.cover [/.joined] (n.= (set.size characters) (/.size (/.joined (set.list characters))))) - (_.cover [/.join_with /.all_split_by] + (_.cover [/.interposed /.all_split_by] (and (|> (set.list characters) - (/.join_with separator) + (/.interposed separator) (/.all_split_by separator) (set.of_list /.hash) (\ set.equivalence = characters)) (\ /.equivalence = (/.joined (set.list characters)) - (/.join_with "" (set.list characters))))) + (/.interposed "" (set.list characters))))) (_.cover [/.replaced/1] (\ /.equivalence = (\ /.monoid compose post static) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 34d6ee08d..46dba6ded 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -215,7 +215,7 @@ (let [options (list.size ..all_encodings)] (do {! random.monad} [choice (\ ! map (n.% options) random.nat)] - (in (maybe.assume (list.item choice ..all_encodings)))))) + (in (maybe.trusted (list.item choice ..all_encodings)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index f2887f530..24746c45d 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -160,7 +160,7 @@ (text\= (/.list /.nat members) (|> members (list\map /.nat) - (text.join_with " ") + (text.interposed " ") list (/.list (|>>)))))) (do random.monad diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 6efe6cb14..84ebef798 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -64,9 +64,9 @@ (_.cover [/.member?] (bit\= (block.within? block inside) (/.member? (/.set [block (list)]) inside))) - (_.cover [/.compose] - (let [composed (/.compose (/.set [left (list)]) - (/.set [right (list)]))] + (_.cover [/.composite] + (let [composed (/.composite (/.set [left (list)]) + (/.set [right (list)]))] (and (n.= (n.min (block.start left) (block.start right)) (/.start composed)) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 2f94947a5..151dd34c2 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -211,7 +211,7 @@ (text\= (|> (list sample_bit sample_int sample_frac sample_text) (: (List Any)) (list\map /.inspection) - (text.join_with " ") + (text.interposed " ") (text.enclosed ["[" "]"])) (/.inspection [sample_bit sample_int sample_frac sample_text])) ))))) diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index b8a34a752..72417f5c5 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -2,13 +2,15 @@ [library [lux #* ["_" test (#+ Test)] + ["." meta] [control ["." try] ["." exception] [parser ["<.>" code]]] [data - ["." text ("#\." equivalence)] + ["." text ("#\." equivalence) + ["%" format]] [format ["md" markdown]]] ["." macro @@ -27,67 +29,80 @@ (#try.Success _) (#try.Failure "OOPS!")))) -(template.with_locals [g!default - g!description] - (as_is (def: g!default - Nat - 123) +(syntax: (description []) + (\ meta.monad map + (|>> %.nat code.text list) + meta.seed)) - (`` (/.documentation: /.documentation: - (~~ (template.text [g!description])))) +(template.with_locals [g!default] + (with_expansions ['definition_description' (..description) + 'sub_description' (..description) + 'super_description' (..description)] + (as_is (def: g!default + Nat + 123) - (def: .public test - Test - (<| (_.covering /._) - ($_ _.and - (_.for [/.Definition] - ($_ _.and - (_.cover [/.default] - (let [definition (`` (/.default (~~ (template.identifier [.._] [g!default]))))] - (and (|> definition + (/.documentation: /.documentation: + 'definition_description') + + (def: .public test + Test + (<| (_.covering /._) + ($_ _.and + (_.for [/.Definition] + ($_ _.and + (_.cover [/.default] + (let [definition (`` (/.default (~~ (template.identifier [.._] [g!default]))))] + (and (|> definition + (get@ #/.definition) + (text\= (template.text [g!default]))) + (|> definition + (get@ #/.documentation) + md.markdown + (text\= "") + not)))) + (_.cover [/.documentation:] + (and (|> ..documentation: (get@ #/.definition) - (text\= (template.text [g!default]))) - (|> definition + (text\= (template.text [/.documentation:]))) + (|> ..documentation: (get@ #/.documentation) md.markdown - (text\= "") - not)))) - (_.cover [/.documentation:] - (and (|> ..documentation: - (get@ #/.definition) - (text\= (template.text [/.documentation:]))) - (|> ..documentation: - (get@ #/.documentation) - md.markdown - (text.contains? (template.text [g!description])) - not))) - )) - (_.for [/.Module] - ($_ _.and - (_.cover [/.module /.documentation] - (let [sub (/.module /._ - [] - []) - super (/.module .._ - [..documentation:] - [sub])] - (and (text.contains? (/.documentation sub) - (/.documentation super)) - (text.contains? (md.markdown (get@ #/.documentation ..documentation:)) - (/.documentation super))))) - )) - (_.cover [/.unqualified_identifier] - (`` (and (~~ (template [] - [(<| (text.contains? (get@ #exception.label /.unqualified_identifier)) - macro_error - )] + (text.contains? 'definition_description')))) + )) + (_.for [/.Module] + ($_ _.and + (_.cover [/.module /.documentation] + (let [sub (`` (/.module /._ + (~~ (template.text ['sub_description'])) + [] + [])) + super (`` (/.module .._ + (~~ (template.text ['super_description'])) + [..documentation:] + [sub]))] + (and (text.contains? (template.text ['sub_description']) + (/.documentation sub)) + (text.contains? (/.documentation sub) + (/.documentation super)) + (text.contains? (template.text ['super_description']) + (/.documentation super)) + (text.contains? (md.markdown (get@ #/.documentation ..documentation:)) + (/.documentation super))))) + )) + (_.cover [/.unqualified_identifier] + (`` (and (~~ (template [] + [(<| (text.contains? (get@ #exception.label /.unqualified_identifier)) + macro_error + )] - [(/.default g!default)] - [(/.documentation: g!default - (~~ (template.text [g!description])))] - [(/.module g!default - [..documentation:] - [sub])] - ))))) - )))) + [(/.default g!default)] + [(/.documentation: g!default + (~~ (template.text ['definition_description'])))] + [(/.module g!default + "" + [..documentation:] + [sub])] + ))))) + ))))) ) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index e28e013cc..68a945f9c 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -56,45 +56,45 @@ (as_is ... Analysis - (analysis: (..my_analysis self phase archive {pass_through .any}) + (analysis: (..my_analysis self phase archive [pass_through .any]) (phase archive pass_through)) ... Synthesis - (analysis: (..my_synthesis self phase archive {parameters (<>.some .any)}) + (analysis: (..my_synthesis self phase archive [parameters (<>.some .any)]) (let [! phase.monad] (|> parameters (monad.map ! (phase archive)) (\ ! map (|>> (#analysis.Extension self)))))) - (synthesis: (..my_synthesis self phase archive {pass_through .any}) + (synthesis: (..my_synthesis self phase archive [pass_through .any]) (phase archive pass_through)) ... Generation - (analysis: (..my_generation self phase archive {parameters (<>.some .any)}) + (analysis: (..my_generation self phase archive [parameters (<>.some .any)]) (let [! phase.monad] (|> parameters (monad.map ! (phase archive)) (\ ! map (|>> (#analysis.Extension self)))))) - (synthesis: (..my_generation self phase archive {parameters (<>.some .any)}) + (synthesis: (..my_generation self phase archive [parameters (<>.some .any)]) (let [! phase.monad] (|> parameters (monad.map ! (phase archive)) (\ ! map (|>> (#synthesis.Extension self)))))) - (generation: (..my_generation self phase archive {pass_through .any}) + (generation: (..my_generation self phase archive [pass_through .any]) (for {@.jvm (\ phase.monad map (|>> #jvm.Embedded row.row) (phase archive pass_through))} (phase archive pass_through))) - (analysis: (..dummy_generation self phase archive) + (analysis: (..dummy_generation self phase archive []) (\ phase.monad in (#analysis.Extension self (list)))) - (synthesis: (..dummy_generation self phase archive) + (synthesis: (..dummy_generation self phase archive []) (\ phase.monad in (#synthesis.Extension self (list)))) - (generation: (..dummy_generation self phase archive) + (generation: (..dummy_generation self phase archive []) (\ phase.monad in (for {@.jvm (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) @@ -107,7 +107,7 @@ @.scheme (scheme.string self)}))) ... Directive - (directive: (..my_directive self phase archive {parameters (<>.some .any)}) + (directive: (..my_directive self phase archive [parameters (<>.some .any)]) (do phase.monad [.let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] (in directive.no_requirements))) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 24c4c6f11..55c812d72 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -199,10 +199,10 @@ )) (_.cover [/.cannot_cast_to_non_object] (text.contains? (get@ #exception.label /.cannot_cast_to_non_object) - (macro_error (/.:cast boolean (: /.Boolean boolean))))) - (_.cover [/.:cast] + (macro_error (/.:as boolean (: /.Boolean boolean))))) + (_.cover [/.:as] (|> string - (/.:cast java/lang/Object) + (/.:as java/lang/Object) (same? (:as java/lang/Object string)))) (_.cover [/.type] (and (and (type\= /.Boolean (/.type java/lang/Boolean)) diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index 9c272f1bc..29389ae9f 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -283,7 +283,7 @@ (do {! random.monad} [choice (\ ! map (n.% (list.size options)) random.nat)] - (in (maybe.assume (list.item choice options)))))) + (in (maybe.trusted (list.item choice options)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 2388bdecf..fa7aff326 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -209,7 +209,7 @@ (do {! random.monad} [choice (\ ! map (n.% (list.size options)) random.nat)] - (in (maybe.assume (list.item choice options)))))) + (in (maybe.trusted (list.item choice options)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 3ac184b75..93f2f8530 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -29,7 +29,6 @@ ["." / #_ ["#." code] ["#." local] - ["#." poly] ["#." syntax] ["#." template]]) @@ -184,6 +183,5 @@ /code.test /local.test /syntax.test - /poly.test /template.test ))) diff --git a/stdlib/source/test/lux/macro/poly.lux b/stdlib/source/test/lux/macro/poly.lux deleted file mode 100644 index 1ffe2cf61..000000000 --- a/stdlib/source/test/lux/macro/poly.lux +++ /dev/null @@ -1,20 +0,0 @@ -(.module: - [library - [lux #* - ["_" test (#+ Test)]]] - [\\library - ["." /]] - ["." / #_ - ["#." equivalence] - ["#." functor] - ["#." json]]) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.poly: /.derived: /.code]) - ($_ _.and - /equivalence.test - /functor.test - /json.test - ))) diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux deleted file mode 100644 index 6de4e4019..000000000 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ /dev/null @@ -1,84 +0,0 @@ -(.module: - [library - [lux (#- Variant) - ["%" data/text/format (#+ format)] - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - [equivalence (#+ Equivalence) - [\\poly - ["." /]]] - [\\specification - ["$." equivalence]]] - [control - ["." maybe]] - [data - ["." bit] - ["." text] - [collection - ["." list]]] - [macro - [poly (#+ derived:)]] - [math - ["." random (#+ Random)] - [number - ["n" nat] - ["i" int]]]]]) - -(type: Variant - (#Case0 Bit) - (#Case1 Int) - (#Case2 Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#bit Bit - #int Int - #frac Frac - #text Text - #maybe (Maybe Int) - #list (List Int) - #variant Variant - #tuple [Int Frac Text] - #recursive Recursive}) - -(def: gen_recursive - (Random Recursive) - (random.rec (function (_ gen_recursive) - (random.or random.safe_frac - (random.and random.safe_frac - gen_recursive))))) - -(def: random - (Random Record) - (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 - random.safe_frac - (random.unicode size) - (random.maybe gen_int) - (random.list size gen_int) - ($_ random.or - random.bit - gen_int - random.safe_frac) - ($_ random.and - gen_int - random.safe_frac - (random.unicode size)) - gen_recursive))) - -(derived: equivalence - (/.equivalence Record)) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.equivalence] - ($equivalence.spec ..equivalence ..random)))) diff --git a/stdlib/source/test/lux/macro/poly/functor.lux b/stdlib/source/test/lux/macro/poly/functor.lux deleted file mode 100644 index b98541232..000000000 --- a/stdlib/source/test/lux/macro/poly/functor.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [library - [lux #* - ["%" data/text/format (#+ format)] - [abstract - [monad (#+ do)] - [functor - [\\poly - ["." /]]]] - ["r" math/random (#+ Random)] - ["_" test (#+ Test)] - [control - ["." state]] - [data - ["." identity]] - [macro - [poly (#+ derived:)]]]]) - -(derived: maybe_functor (/.functor .Maybe)) -(derived: list_functor (/.functor .List)) -(derived: state_functor (/.functor state.State)) -(derived: identity_functor (/.functor identity.Identity)) - -(def: .public test - Test - (<| (_.covering /._) - (_.cover [/.functor] - true))) diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux deleted file mode 100644 index d99b3364e..000000000 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ /dev/null @@ -1,119 +0,0 @@ -(.module: - [library - [lux (#- Variant) - ["_" test (#+ Test)] - ["." debug] - [abstract - codec - [monad (#+ do)] - ["." equivalence (#+ Equivalence) - ["poly/#" \\poly]] - [\\specification - ["$." equivalence] - ["$." codec]]] - [control - pipe - ["." try] - ["p" parser - ... TODO: Get rid of this import ASAP - [json (#+)]]] - [data - ["." bit] - ["." text - ["%" format (#+ format)]] - [format - [json (#+) - [\\poly - ["." /]]]] - [collection - [row (#+ row)] - ["d" dictionary] - ["." list]]] - [macro - [poly (#+ derived:)]] - [type - ["." unit]] - [math - ["." random (#+ Random)] - [number - ["n" nat] - ["." frac]]] - [time - ["ti" instant] - ["tda" date] - ... ["tdu" duration] - ]]] - [test - [lux - [time - ["_." instant] - ... ["_." duration] - ]]]) - -(type: Variant - (#Bit Bit) - (#Text Text) - (#Frac Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#bit Bit - #frac Frac - #text Text - #maybe (Maybe Frac) - #list (List Frac) - #dictionary (d.Dictionary Text Frac) - #variant Variant - #tuple [Bit Text Frac] - #recursive Recursive - ... #instant ti.Instant - ... #duration tdu.Duration - #date tda.Date - #grams (unit.Qty unit.Gram)}) - -(def: gen_recursive - (Random Recursive) - (random.rec - (function (_ gen_recursive) - (random.or random.safe_frac - (random.and random.safe_frac - gen_recursive))))) - -(def: qty - (All [unit] (Random (unit.Qty unit))) - (\ random.monad map (debug.private unit.in) random.int)) - -(def: gen_record - (Random Record) - (do {! random.monad} - [size (\ ! map (n.% 2) random.nat)] - ($_ random.and - random.bit - random.safe_frac - (random.unicode size) - (random.maybe random.safe_frac) - (random.list size random.safe_frac) - (random.dictionary text.hash size (random.unicode size) random.safe_frac) - ($_ random.or random.bit (random.unicode size) random.safe_frac) - ($_ random.and random.bit (random.unicode size) random.safe_frac) - ..gen_recursive - ... _instant.instant - ... _duration.duration - random.date - ..qty - ))) - -(derived: equivalence - (poly/equivalence.equivalence Record)) - -(derived: codec - (/.codec Record)) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.codec] - ($codec.spec ..equivalence ..codec ..gen_record)))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 1403d6ee8..5c84f9c38 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -930,11 +930,11 @@ (do random.monad [expected_value random.nat expected_error (random.ascii/upper 1)] - (_.cover [/.lift] + (_.cover [/.lifted] (and (|> expected_error #try.Failure (: (Try Nat)) - /.lift + /.lifted (/.result expected_lux) (!expect (^multi (#try.Failure actual) (text\= (location.with expected_location expected_error) @@ -942,7 +942,7 @@ (|> expected_value #try.Success (: (Try Nat)) - /.lift + /.lifted (/.result expected_lux) (!expect (^multi (#try.Success actual) (same? expected_value actual))))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index f503c8779..ae4685790 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -306,13 +306,13 @@ Test (do {! random.monad} [expected (\ ! map (i64.and (i64.mask )) random.nat)] - (<| (_.lift ) + (<| (_.lifted ) (..bytecode (for {@.old (|>> (:as ) ("jvm leq" expected)) @.jvm (|>> (:as ) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})) (do /.monad - [_ ( (|> expected .int try.assumed))] + [_ ( (|> expected .int try.trusted))] ))))] [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" ffi.byte_to_long /signed.s1] @@ -391,35 +391,35 @@ _ (..$Integer::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "ICONST_M1" (int (ffi.long_to_int (:as java/lang/Long -1)) /.iconst_m1)) - (_.lift "ICONST_0" (int (ffi.long_to_int (:as java/lang/Long +0)) /.iconst_0)) - (_.lift "ICONST_1" (int (ffi.long_to_int (:as java/lang/Long +1)) /.iconst_1)) - (_.lift "ICONST_2" (int (ffi.long_to_int (:as java/lang/Long +2)) /.iconst_2)) - (_.lift "ICONST_3" (int (ffi.long_to_int (:as java/lang/Long +3)) /.iconst_3)) - (_.lift "ICONST_4" (int (ffi.long_to_int (:as java/lang/Long +4)) /.iconst_4)) - (_.lift "ICONST_5" (int (ffi.long_to_int (:as java/lang/Long +5)) /.iconst_5)) - (_.lift "LDC_W/INTEGER" - (do random.monad - [expected ..$Integer::random] - (int expected (..$Integer::literal expected))))) + (_.lifted "ICONST_M1" (int (ffi.long_to_int (:as java/lang/Long -1)) /.iconst_m1)) + (_.lifted "ICONST_0" (int (ffi.long_to_int (:as java/lang/Long +0)) /.iconst_0)) + (_.lifted "ICONST_1" (int (ffi.long_to_int (:as java/lang/Long +1)) /.iconst_1)) + (_.lifted "ICONST_2" (int (ffi.long_to_int (:as java/lang/Long +2)) /.iconst_2)) + (_.lifted "ICONST_3" (int (ffi.long_to_int (:as java/lang/Long +3)) /.iconst_3)) + (_.lifted "ICONST_4" (int (ffi.long_to_int (:as java/lang/Long +4)) /.iconst_4)) + (_.lifted "ICONST_5" (int (ffi.long_to_int (:as java/lang/Long +5)) /.iconst_5)) + (_.lifted "LDC_W/INTEGER" + (do random.monad + [expected ..$Integer::random] + (int expected (..$Integer::literal expected))))) arithmetic ($_ _.and - (_.lift "IADD" (binary (int/2 "jvm iadd" "jvm int +") /.iadd)) - (_.lift "ISUB" (binary (int/2 "jvm isub" "jvm int -") /.isub)) - (_.lift "IMUL" (binary (int/2 "jvm imul" "jvm int *") /.imul)) - (_.lift "IDIV" (binary (int/2 "jvm idiv" "jvm int /") /.idiv)) - (_.lift "IREM" (binary (int/2 "jvm irem" "jvm int %") /.irem)) - (_.lift "INEG" (unary (function (_ value) - ((int/2 "jvm isub" "jvm int -") - value - (ffi.long_to_int (:as java/lang/Long +0)))) - /.ineg))) + (_.lifted "IADD" (binary (int/2 "jvm iadd" "jvm int +") /.iadd)) + (_.lifted "ISUB" (binary (int/2 "jvm isub" "jvm int -") /.isub)) + (_.lifted "IMUL" (binary (int/2 "jvm imul" "jvm int *") /.imul)) + (_.lifted "IDIV" (binary (int/2 "jvm idiv" "jvm int /") /.idiv)) + (_.lifted "IREM" (binary (int/2 "jvm irem" "jvm int %") /.irem)) + (_.lifted "INEG" (unary (function (_ value) + ((int/2 "jvm isub" "jvm int -") + value + (ffi.long_to_int (:as java/lang/Long +0)))) + /.ineg))) bitwise ($_ _.and - (_.lift "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) - (_.lift "IOR" (binary (int/2 "jvm ior" "jvm int or") /.ior)) - (_.lift "IXOR" (binary (int/2 "jvm ixor" "jvm int xor") /.ixor)) - (_.lift "ISHL" (shift (int/2 "jvm ishl" "jvm int shl") /.ishl)) - (_.lift "ISHR" (shift (int/2 "jvm ishr" "jvm int shr") /.ishr)) - (_.lift "IUSHR" (shift (int/2 "jvm iushr" "jvm int ushr") /.iushr)))] + (_.lifted "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) + (_.lifted "IOR" (binary (int/2 "jvm ior" "jvm int or") /.ior)) + (_.lifted "IXOR" (binary (int/2 "jvm ixor" "jvm int xor") /.ixor)) + (_.lifted "ISHL" (shift (int/2 "jvm ishl" "jvm int shl") /.ishl)) + (_.lifted "ISHR" (shift (int/2 "jvm ishr" "jvm int shr") /.ishr)) + (_.lifted "IUSHR" (shift (int/2 "jvm iushr" "jvm int ushr") /.iushr)))] ($_ _.and (<| (_.context "literal") literal) @@ -470,53 +470,53 @@ _ (..$Integer::literal (ffi.long_to_int parameter))] instruction))))) literal ($_ _.and - (_.lift "LCONST_0" (long (:as java/lang/Long +0) /.lconst_0)) - (_.lift "LCONST_1" (long (:as java/lang/Long +1) /.lconst_1)) - (_.lift "LDC2_W/LONG" - (do random.monad - [expected ..$Long::random] - (long expected (..$Long::literal expected))))) + (_.lifted "LCONST_0" (long (:as java/lang/Long +0) /.lconst_0)) + (_.lifted "LCONST_1" (long (:as java/lang/Long +1) /.lconst_1)) + (_.lifted "LDC2_W/LONG" + (do random.monad + [expected ..$Long::random] + (long expected (..$Long::literal expected))))) arithmetic ($_ _.and - (_.lift "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) - (_.lift "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) - (_.lift "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) - (_.lift "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) - (_.lift "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) - (_.lift "LNEG" (unary (function (_ value) - ((long/2 "jvm lsub" "jvm long -") - value - (:as java/lang/Long +0))) - /.lneg))) + (_.lifted "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) + (_.lifted "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) + (_.lifted "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) + (_.lifted "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) + (_.lifted "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) + (_.lifted "LNEG" (unary (function (_ value) + ((long/2 "jvm lsub" "jvm long -") + value + (:as java/lang/Long +0))) + /.lneg))) bitwise ($_ _.and - (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) - (_.lift "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) - (_.lift "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) - (_.lift "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) - (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) - (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) - comparison (_.lift "LCMP" - (do random.monad - [reference ..$Long::random - subject ..$Long::random - .let [expected (cond (i.= (:as Int reference) (:as Int subject)) - (:as java/lang/Long +0) + (_.lifted "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) + (_.lifted "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) + (_.lifted "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) + (_.lifted "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) + (_.lifted "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) + (_.lifted "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) + comparison (_.lifted "LCMP" + (do random.monad + [reference ..$Long::random + subject ..$Long::random + .let [expected (cond (i.= (:as Int reference) (:as Int subject)) + (:as java/lang/Long +0) - (i.> (:as Int reference) (:as Int subject)) - (:as java/lang/Long +1) + (i.> (:as Int reference) (:as Int subject)) + (:as java/lang/Long +1) - ... (i.< (:as Int reference) (:as Int subject)) - (:as java/lang/Long -1))]] - (<| (..bytecode (for {@.old - (|>> (:as Int) (i.= expected)) - - @.jvm - (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) - (do /.monad - [_ (..$Long::literal subject) - _ (..$Long::literal reference) - _ /.lcmp - _ /.i2l] - ..$Long::wrap))))] + ... (i.< (:as Int reference) (:as Int subject)) + (:as java/lang/Long -1))]] + (<| (..bytecode (for {@.old + (|>> (:as Int) (i.= expected)) + + @.jvm + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (do /.monad + [_ (..$Long::literal subject) + _ (..$Long::literal reference) + _ /.lcmp + _ /.i2l] + ..$Long::wrap))))] ($_ _.and (<| (_.context "literal") literal) @@ -569,24 +569,24 @@ _ (..$Float::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "FCONST_0" (float (ffi.double_to_float (:as java/lang/Double +0.0)) /.fconst_0)) - (_.lift "FCONST_1" (float (ffi.double_to_float (:as java/lang/Double +1.0)) /.fconst_1)) - (_.lift "FCONST_2" (float (ffi.double_to_float (:as java/lang/Double +2.0)) /.fconst_2)) - (_.lift "LDC_W/FLOAT" - (do random.monad - [expected ..$Float::random] - (float expected (..$Float::literal expected))))) + (_.lifted "FCONST_0" (float (ffi.double_to_float (:as java/lang/Double +0.0)) /.fconst_0)) + (_.lifted "FCONST_1" (float (ffi.double_to_float (:as java/lang/Double +1.0)) /.fconst_1)) + (_.lifted "FCONST_2" (float (ffi.double_to_float (:as java/lang/Double +2.0)) /.fconst_2)) + (_.lifted "LDC_W/FLOAT" + (do random.monad + [expected ..$Float::random] + (float expected (..$Float::literal expected))))) arithmetic ($_ _.and - (_.lift "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) - (_.lift "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) - (_.lift "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) - (_.lift "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) - (_.lift "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) - (_.lift "FNEG" (unary (function (_ value) - ((float/2 "jvm fsub" "jvm float -") - value - (ffi.double_to_float (:as java/lang/Double +0.0)))) - /.fneg))) + (_.lifted "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) + (_.lifted "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) + (_.lifted "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) + (_.lifted "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) + (_.lifted "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) + (_.lifted "FNEG" (unary (function (_ value) + ((float/2 "jvm fsub" "jvm float -") + value + (ffi.double_to_float (:as java/lang/Double +0.0)))) + /.fneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) (function (_ instruction standard) (do random.monad @@ -618,8 +618,8 @@ @.jvm ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))}))) comparison ($_ _.and - (_.lift "FCMPL" (comparison /.fcmpl comparison_standard)) - (_.lift "FCMPG" (comparison /.fcmpg comparison_standard)))] + (_.lifted "FCMPL" (comparison /.fcmpl comparison_standard)) + (_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))] ($_ _.and (<| (_.context "literal") literal) @@ -666,23 +666,23 @@ _ (..$Double::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "DCONST_0" (double (:as java/lang/Double +0.0) /.dconst_0)) - (_.lift "DCONST_1" (double (:as java/lang/Double +1.0) /.dconst_1)) - (_.lift "LDC2_W/DOUBLE" - (do random.monad - [expected ..$Double::random] - (double expected (..$Double::literal expected))))) + (_.lifted "DCONST_0" (double (:as java/lang/Double +0.0) /.dconst_0)) + (_.lifted "DCONST_1" (double (:as java/lang/Double +1.0) /.dconst_1)) + (_.lifted "LDC2_W/DOUBLE" + (do random.monad + [expected ..$Double::random] + (double expected (..$Double::literal expected))))) arithmetic ($_ _.and - (_.lift "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) - (_.lift "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) - (_.lift "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) - (_.lift "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) - (_.lift "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) - (_.lift "DNEG" (unary (function (_ value) - ((double/2 "jvm dsub" "jvm double -") - value - (:as java/lang/Double +0.0))) - /.dneg))) + (_.lifted "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) + (_.lifted "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) + (_.lifted "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) + (_.lifted "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) + (_.lifted "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) + (_.lifted "DNEG" (unary (function (_ value) + ((double/2 "jvm dsub" "jvm double -") + value + (:as java/lang/Double +0.0))) + /.dneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad @@ -713,8 +713,8 @@ @.jvm ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))}))) comparison ($_ _.and - (_.lift "DCMPL" (comparison /.dcmpl comparison_standard)) - (_.lift "DCMPG" (comparison /.dcmpg comparison_standard)))] + (_.lifted "DCMPL" (comparison /.dcmpl comparison_standard)) + (_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))] ($_ _.and (<| (_.context "literal") literal) @@ -749,13 +749,13 @@ _ /.dup] (/.invokespecial ..$Object "" (/type.method [(list) (list) /type.void (list)]))))] ($_ _.and - (<| (_.lift "ACONST_NULL") + (<| (_.lifted "ACONST_NULL") (..bytecode (|>> (:as Bit) not)) (do /.monad [_ /.aconst_null _ (/.instanceof ..$String)] ..$Boolean::wrap)) - (<| (_.lift "INSTANCEOF") + (<| (_.lifted "INSTANCEOF") (do random.monad [value ..$String::random]) (..bytecode (|>> (:as Bit))) @@ -763,14 +763,14 @@ [_ (/.string (:as Text value)) _ (/.instanceof ..$String)] ..$Boolean::wrap)) - (<| (_.lift "NEW & CHECKCAST") + (<| (_.lifted "NEW & CHECKCAST") (..bytecode (|>> (:as Bit))) (do /.monad [_ !object _ (/.checkcast ..$Object) _ (/.instanceof ..$Object)] ..$Boolean::wrap)) - (<| (_.lift "MONITORENTER & MONITOREXIT") + (<| (_.lifted "MONITORENTER & MONITOREXIT") (do random.monad [value ..$String::random]) (..bytecode (|>> (:as Bit))) @@ -785,7 +785,7 @@ (def: method Test ($_ _.and - (<| (_.lift "INVOKESTATIC") + (<| (_.lifted "INVOKESTATIC") (do random.monad [expected (random.only (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) @@ -797,7 +797,7 @@ (do /.monad [_ (/.double expected)] (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) - (<| (_.lift "INVOKEVIRTUAL") + (<| (_.lifted "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) (..bytecode (|>> (:as Bit) (bit\= (f.not_a_number? (:as Frac expected))))) @@ -806,7 +806,7 @@ _ ..$Double::wrap _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) (list) /type.boolean (list)]))] ..$Boolean::wrap)) - (<| (_.lift "INVOKESPECIAL") + (<| (_.lifted "INVOKESPECIAL") (do random.monad [expected (random.only (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) @@ -820,7 +820,7 @@ _ /.dup _ (/.double expected)] (/.invokespecial ..$Double "" (/type.method [(list) (list /type.double) /type.void (list)])))) - (<| (_.lift "INVOKEINTERFACE") + (<| (_.lifted "INVOKEINTERFACE") (do random.monad [subject ..$String::random]) (..bytecode (|>> (:as Nat) (n.= (text.size (:as Text subject))))) @@ -886,7 +886,7 @@ _ ..$Long::wrap] /.areturn)))) (row.row)) - try.assumed + try.trusted (format.result /class.writer)) loader (/loader.memory (/loader.new_library []))]] (_.test "PUTSTATIC & PUTFIELD & GETFIELD & GETSTATIC" @@ -946,9 +946,9 @@ [size (\ ! map (|>> (n.% 1024) (n.max 1)) random.nat) value random] ($_ _.and - (<| (_.lift "length") + (<| (_.lifted "length") (length size constructor)) - (<| (_.lift "write and read") + (<| (_.lifted "write and read") (write_and_read size constructor value literal [*store *load *wrap] test))))))] ($_ _.and (_.context "boolean" @@ -1026,12 +1026,12 @@ (case dimensions 0 type _ (recur (dec dimensions) (/type.array type))))]] - (<| (_.lift "MULTIANEWARRAY") + (<| (_.lifted "MULTIANEWARRAY") (..bytecode (|>> (:as Nat) (n.= sizesH))) (do {! /.monad} [_ (monad.map ! (|>> (:as java/lang/Long) ffi.long_to_int ..$Integer::literal) (#.Item sizesH sizesT)) - _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assumed)) + _ (/.multianewarray type (|> dimensions /unsigned.u1 try.trusted)) _ ?length] $Long::wrap)))) ))) @@ -1065,40 +1065,40 @@ ($_ _.and (<| (_.context "int") ($_ _.and - (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> ffi.int_to_long) long::=)) - (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> ffi.int_to_float) float::=)) - (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) - (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) - (function (_ expected) - (for {@.old - (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) - - @.jvm - (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) - (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) - (!::= java/lang/Character "jvm ceq" "jvm char ="))) - (_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) - (function (_ expected) - (for {@.old - (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) - - @.jvm - (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))))) + (_.lifted "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> ffi.int_to_long) long::=)) + (_.lifted "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> ffi.int_to_float) float::=)) + (_.lifted "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) + (_.lifted "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) + (function (_ expected) + (for {@.old + (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + + @.jvm + (|>> (:as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:as java/lang/Byte expected)))))})))) + (_.lifted "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) + (!::= java/lang/Character "jvm ceq" "jvm char ="))) + (_.lifted "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) + (function (_ expected) + (for {@.old + (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + + @.jvm + (|>> (:as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:as java/lang/Short expected)))))})))))) (<| (_.context "long") ($_ _.and - (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) - (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> ffi.long_to_float) float::=)) - (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> ffi.long_to_double) double::=)))) + (_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) + (_.lifted "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> ffi.long_to_float) float::=)) + (_.lifted "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> ffi.long_to_double) double::=)))) (<| (_.context "float") ($_ _.and - (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> ffi.float_to_int) int::=)) - (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> ffi.float_to_long) long::=)) - (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> ffi.float_to_double) double::=)))) + (_.lifted "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> ffi.float_to_int) int::=)) + (_.lifted "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> ffi.float_to_long) long::=)) + (_.lifted "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> ffi.float_to_double) double::=)))) (<| (_.context "double") ($_ _.and - (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> ffi.double_to_int) int::=)) - (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> ffi.double_to_long) long::=)) - (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> ffi.double_to_float) float::=)))) + (_.lifted "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> ffi.double_to_int) int::=)) + (_.lifted "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> ffi.double_to_long) long::=)) + (_.lifted "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> ffi.double_to_float) float::=)))) ))) (def: value @@ -1139,94 +1139,94 @@ (<| (_.context "int") (let [test (!::= java/lang/Integer "jvm ieq" "jvm int =")] ($_ _.and - (_.lift "ISTORE_0/ILOAD_0" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) - (_.lift "ISTORE_1/ILOAD_1" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) - (_.lift "ISTORE_2/ILOAD_2" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) - (_.lift "ISTORE_3/ILOAD_3" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) - (_.lift "ISTORE/ILOAD" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) - (_.lift "IINC" - (do {! random.monad} - [base ..$Byte::random - increment (\ ! map (|>> (n.% 100) /unsigned.u1 try.assumed) - random.nat) - .let [expected (: java/lang/Long - (for {@.old - ("jvm ladd" - (ffi.byte_to_long base) - (.int (/unsigned.value increment))) - - @.jvm - ("jvm object cast" - ("jvm long +" - ("jvm object cast" (ffi.byte_to_long base)) - ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))}))]] - (..bytecode (|>> (:as Int) (i.= (:as Int expected))) - (do /.monad - [_ (..$Byte::literal base) - _ /.istore_0 - _ (/.iinc 0 increment) - _ /.iload_0 - _ /.i2l] - ..$Long::wrap))))))) + (_.lifted "ISTORE_0/ILOAD_0" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) + (_.lifted "ISTORE_1/ILOAD_1" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) + (_.lifted "ISTORE_2/ILOAD_2" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) + (_.lifted "ISTORE_3/ILOAD_3" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) + (_.lifted "ISTORE/ILOAD" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) + (_.lifted "IINC" + (do {! random.monad} + [base ..$Byte::random + increment (\ ! map (|>> (n.% 100) /unsigned.u1 try.trusted) + random.nat) + .let [expected (: java/lang/Long + (for {@.old + ("jvm ladd" + (ffi.byte_to_long base) + (.int (/unsigned.value increment))) + + @.jvm + ("jvm object cast" + ("jvm long +" + ("jvm object cast" (ffi.byte_to_long base)) + ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))}))]] + (..bytecode (|>> (:as Int) (i.= (:as Int expected))) + (do /.monad + [_ (..$Byte::literal base) + _ /.istore_0 + _ (/.iinc 0 increment) + _ /.iload_0 + _ /.i2l] + ..$Long::wrap))))))) (<| (_.context "long") (let [test (!::= java/lang/Long "jvm leq" "jvm long =")] ($_ _.and - (_.lift "LSTORE_0/LLOAD_0" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) - (_.lift "LSTORE_1/LLOAD_1" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) - (_.lift "LSTORE_2/LLOAD_2" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) - (_.lift "LSTORE_3/LLOAD_3" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) - (_.lift "LSTORE/LLOAD" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) + (_.lifted "LSTORE_0/LLOAD_0" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) + (_.lifted "LSTORE_1/LLOAD_1" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) + (_.lifted "LSTORE_2/LLOAD_2" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) + (_.lifted "LSTORE_3/LLOAD_3" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) + (_.lifted "LSTORE/LLOAD" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) (<| (_.context "float") (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] ($_ _.and - (_.lift "FSTORE_0/FLOAD_0" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) - (_.lift "FSTORE_1/FLOAD_1" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) - (_.lift "FSTORE_2/FLOAD_2" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) - (_.lift "FSTORE_3/FLOAD_3" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) - (_.lift "FSTORE/FLOAD" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (_.lifted "FSTORE_0/FLOAD_0" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) + (_.lifted "FSTORE_1/FLOAD_1" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) + (_.lifted "FSTORE_2/FLOAD_2" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) + (_.lifted "FSTORE_3/FLOAD_3" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) + (_.lifted "FSTORE/FLOAD" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) (<| (_.context "double") (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and - (_.lift "DSTORE_0/DLOAD_0" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) - (_.lift "DSTORE_1/DLOAD_1" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) - (_.lift "DSTORE_2/DLOAD_2" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) - (_.lift "DSTORE_3/DLOAD_3" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) - (_.lift "DSTORE/DLOAD" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) + (_.lifted "DSTORE_0/DLOAD_0" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) + (_.lifted "DSTORE_1/DLOAD_1" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) + (_.lifted "DSTORE_2/DLOAD_2" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) + (_.lifted "DSTORE_3/DLOAD_3" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) + (_.lifted "DSTORE/DLOAD" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) (|> actual (:as Text) (text\= (:as Text expected)))))] ($_ _.and - (_.lift "ASTORE_0/ALOAD_0" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) - (_.lift "ASTORE_1/ALOAD_1" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) - (_.lift "ASTORE_2/ALOAD_2" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) - (_.lift "ASTORE_3/ALOAD_3" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) - (_.lift "ASTORE/ALOAD" - (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) + (_.lifted "ASTORE_0/ALOAD_0" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) + (_.lifted "ASTORE_1/ALOAD_1" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) + (_.lifted "ASTORE_2/ALOAD_2" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) + (_.lifted "ASTORE_3/ALOAD_3" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) + (_.lifted "ASTORE/ALOAD" + (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) ))) (def: stack @@ -1237,20 +1237,20 @@ (|>> (:as Text) (text\= (:as Text expected/1))))] dummy/1 $String::random .let [single ($_ _.and - (<| (_.lift "DUP & POP") + (<| (_.lifted "DUP & POP") (..bytecode object_test) (do /.monad [_ ($String::literal expected/1) _ /.dup] /.pop)) - (<| (_.lift "DUP_X1 & POP2") + (<| (_.lifted "DUP_X1 & POP2") (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) _ ($String::literal expected/1) _ /.dup_x1] /.pop2)) - (<| (_.lift "DUP_X2") + (<| (_.lifted "DUP_X2") (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) @@ -1259,7 +1259,7 @@ _ /.dup_x2 _ /.pop2] /.pop)) - (<| (_.lift "SWAP") + (<| (_.lifted "SWAP") (..bytecode object_test) (do /.monad [_ ($String::literal dummy/1) @@ -1272,14 +1272,14 @@ (|>> (:as Int) (i.= (:as Int expected/2))))] dummy/2 $Long::random .let [double ($_ _.and - (<| (_.lift "DUP2") + (<| (_.lifted "DUP2") (..bytecode long_test) (do /.monad [_ ($Long::literal expected/2) _ /.dup2 _ /.pop2] ..$Long::wrap)) - (<| (_.lift "DUP2_X1") + (<| (_.lifted "DUP2_X1") (..bytecode long_test) (do /.monad [_ ($String::literal dummy/1) @@ -1288,7 +1288,7 @@ _ /.pop2 _ /.pop] ..$Long::wrap)) - (<| (_.lift "DUP2_X2") + (<| (_.lifted "DUP2_X2") (..bytecode long_test) (do /.monad [_ ($Long::literal dummy/2) @@ -1367,20 +1367,20 @@ false) ))))] ($_ _.and - (_.lift "IRETURN" (primitive_return ..$Integer::primitive /.ireturn #.None (!::= java/lang/Integer "jvm ieq" "jvm int ="))) - (_.lift "LRETURN" (primitive_return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) - (_.lift "FRETURN" (primitive_return ..$Float::primitive /.freturn #.None (!::= java/lang/Float "jvm feq" "jvm float ="))) - (_.lift "DRETURN" (primitive_return ..$Double::primitive /.dreturn #.None (!::= java/lang/Double "jvm deq" "jvm double ="))) - (_.lift "ARETURN" (primitive_return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) - (_.lift "RETURN" (primitive_return (: (Primitive java/lang/String) - {#unboxed /type.void - #boxed ..$String - #wrap /.nop - #random ..$String::random - #literal (function.constant /.nop)}) - /.return - (#.Some ..$String::literal) - (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) + (_.lifted "IRETURN" (primitive_return ..$Integer::primitive /.ireturn #.None (!::= java/lang/Integer "jvm ieq" "jvm int ="))) + (_.lifted "LRETURN" (primitive_return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) + (_.lifted "FRETURN" (primitive_return ..$Float::primitive /.freturn #.None (!::= java/lang/Float "jvm feq" "jvm float ="))) + (_.lifted "DRETURN" (primitive_return ..$Double::primitive /.dreturn #.None (!::= java/lang/Double "jvm deq" "jvm double ="))) + (_.lifted "ARETURN" (primitive_return ..$String::primitive /.areturn #.None (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) + (_.lifted "RETURN" (primitive_return (: (Primitive java/lang/String) + {#unboxed /type.void + #boxed ..$String + #wrap /.nop + #random ..$String::random + #literal (function.constant /.nop)}) + /.return + (#.Some ..$String::literal) + (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) ))) (def: branching @@ -1403,15 +1403,15 @@ _ (/.set_label @end)] ..$Long::wrap)))) comparison_against_zero ($_ _.and - (_.lift "IFEQ" (if! /.ifeq /.iconst_0)) - (_.lift "IFNE" (if! /.ifne /.iconst_1)) - (_.lift "IFLT" (if! /.iflt /.iconst_m1)) - (_.lift "IFLE" (if! /.ifle /.iconst_0)) - (_.lift "IFGT" (if! /.ifgt /.iconst_1)) - (_.lift "IFGE" (if! /.ifge /.iconst_0))) + (_.lifted "IFEQ" (if! /.ifeq /.iconst_0)) + (_.lifted "IFNE" (if! /.ifne /.iconst_1)) + (_.lifted "IFLT" (if! /.iflt /.iconst_m1)) + (_.lifted "IFLE" (if! /.ifle /.iconst_0)) + (_.lifted "IFGT" (if! /.ifgt /.iconst_1)) + (_.lifted "IFGE" (if! /.ifge /.iconst_0))) null_test ($_ _.and - (_.lift "IFNULL" (if! /.ifnull /.aconst_null)) - (_.lift "IFNONNULL" (if! /.ifnonnull (/.string ""))))] + (_.lifted "IFNULL" (if! /.ifnull /.aconst_null)) + (_.lifted "IFNONNULL" (if! /.ifnonnull (/.string ""))))] reference ..$Integer::random subject (|> ..$Integer::random (random.only (|>> ((!::= java/lang/Integer "jvm ieq" "jvm int =") reference) not))) @@ -1423,20 +1423,20 @@ [reference subject] [subject reference]) int_comparison ($_ _.and - (_.lift "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) - (_.lift "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) - (_.lift "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lift "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lift "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) - (_.lift "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) + (_.lifted "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) + (_.lifted "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) + (_.lifted "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) + (_.lifted "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) new_object (: (Bytecode Any) (do /.monad [_ (/.new ..$Object) _ /.dup] (/.invokespecial ..$Object "" (/type.method [(list) (list) /type.void (list)])))) reference_comparison ($_ _.and - (_.lift "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) - (_.lift "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) + (_.lifted "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) + (_.lifted "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) )]] ($_ _.and comparison_against_zero @@ -1466,17 +1466,17 @@ _ (/.set_label @end)] ..$Long::wrap))))]] ($_ _.and - (_.lift "GOTO" (jump /.goto)) - (_.lift "GOTO_W" (jump /.goto_w))))) + (_.lifted "GOTO" (jump /.goto)) + (_.lifted "GOTO_W" (jump /.goto_w))))) (def: switch Test ($_ _.and - (<| (_.lift "TABLESWITCH") + (<| (_.lifted "TABLESWITCH") (do {! random.monad} [expected ..$Long::random dummy ..$Long::random - minimum (\ ! map (|>> (n.% 100) .int /signed.s4 try.assumed) + minimum (\ ! map (|>> (n.% 100) .int /signed.s4 try.trusted) random.nat) afterwards (\ ! map (n.% 10) random.nat)]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) @@ -1484,7 +1484,7 @@ [@right /.new_label @wrong /.new_label @return /.new_label - _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.assumed)) + _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.trusted)) _ (/.tableswitch minimum @wrong [@right (list.repeated afterwards @wrong)]) _ (/.set_label @wrong) _ (..$Long::literal dummy) @@ -1493,7 +1493,7 @@ _ (..$Long::literal expected) _ (/.set_label @return)] ..$Long::wrap)) - (<| (_.lift "LOOKUPSWITCH") + (<| (_.lifted "LOOKUPSWITCH") (do {! random.monad} [options (\ ! map (|>> (n.% 10) (n.+ 1)) random.nat) @@ -1502,7 +1502,7 @@ (\ ! map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_long (:as Int))) (random.set i.hash options) (\ ! map set.list)) - .let [choice (maybe.assume (list.item choice options))] + .let [choice (maybe.trusted (list.item choice options))] expected ..$Long::random dummy ..$Long::random]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) @@ -1512,7 +1512,7 @@ @return /.new_label _ (..$Integer::literal (ffi.long_to_int (:as java/lang/Long choice))) _ (/.lookupswitch @wrong (list\map (function (_ option) - [(|> option /signed.s4 try.assumed) + [(|> option /signed.s4 try.trusted) (if (i.= choice option) @right @wrong)]) options)) _ (/.set_label @wrong) @@ -1530,7 +1530,7 @@ [expected ..$Long::random dummy ..$Long::random exception ..$String::random] - (<| (_.lift "ATHROW") + (<| (_.lifted "ATHROW") (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad [.let [$Exception (/type.class "java.lang.Exception" (list))] @@ -1634,7 +1634,7 @@ (list (/method.method ($_ /modifier\compose /method.public /method.abstract) interface_method method::type (list) #.None)) (row.row)) - try.assumed + try.trusted (format.result /class.writer)) abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier\compose /class.public /class.abstract) (/name.internal abstract_class) @@ -1654,7 +1654,7 @@ (/method.method ($_ /modifier\compose /method.public /method.abstract) abstract_method method::type (list) #.None)) (row.row)) - try.assumed + try.trusted (format.result /class.writer)) invoke (: (-> (Type Class) Text (Bytecode Any)) (function (_ class method) @@ -1701,7 +1701,7 @@ _ ..$Long::wrap] /.areturn)))) (row.row)) - try.assumed + try.trusted (format.result /class.writer)) loader (/loader.memory (/loader.new_library []))]] (_.test "Class & interface inheritance" diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index fe60e832c..eef7b91e7 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -286,12 +286,12 @@ (and (n.= 0 (get@ #/.successes failure_tally)) (n.= 1 (get@ #/.failures failure_tally)))))))) (do ! - [success_assertion (/.lift expected_message/0 (in true)) - failure_assertion (/.lift expected_message/0 (in false))] + [success_assertion (/.lifted expected_message/0 (in true)) + failure_assertion (/.lifted expected_message/0 (in false))] (in (do async.monad [[success_tally success_message] success_assertion [failure_tally failure_message] failure_assertion] - (/.cover' [/.lift] + (/.cover' [/.lifted] (and (text.contains? expected_message/0 success_message) (text.contains? expected_message/0 failure_message) (and (n.= 1 (get@ #/.successes success_tally)) diff --git a/stdlib/source/test/lux/time/year.lux b/stdlib/source/test/lux/time/year.lux index 82cdbf713..513b1b92d 100644 --- a/stdlib/source/test/lux/time/year.lux +++ b/stdlib/source/test/lux/time/year.lux @@ -79,9 +79,9 @@ (_.for [/.Period] (_.cover [/.leap /.century /.era] (n.= /.leap (n./ /.century /.era)))) - (let [leap (try.assumed (/.year (.int /.leap))) - century (try.assumed (/.year (.int /.century))) - era (try.assumed (/.year (.int /.era)))] + (let [leap (try.trusted (/.year (.int /.leap))) + century (try.trusted (/.year (.int /.century))) + era (try.trusted (/.year (.int /.era)))] ($_ _.and (_.cover [/.leap?] (and (/.leap? leap) 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 f694d0629..aa4443cdb 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 @@ -124,8 +124,8 @@ (r\map product.right _primitive.primitive) (do {! r.monad} [choice (|> r.nat (\ ! map (n.% (list.size variant_tags)))) - .let [choiceT (maybe.assume (list.item choice variant_tags)) - choiceC (maybe.assume (list.item choice primitivesC))]] + .let [choiceT (maybe.trusted (list.item choice variant_tags)) + choiceC (maybe.trusted (list.item choice primitivesC))]] (in (` ((~ choiceT) (~ choiceC))))) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) @@ -190,7 +190,7 @@ .let [redundant_branchesC (<| (list!map (branch outputC)) list.joined (list (list.first redundancy_idx redundant_patterns) - (list (maybe.assume (list.item redundancy_idx redundant_patterns))) + (list (maybe.trusted (list.item redundancy_idx redundant_patterns))) (list.after redundancy_idx redundant_patterns)))]] (_.test "Will reject redundant pattern-matching." (|> (analyse_pm redundant_branchesC) @@ -200,7 +200,7 @@ _primitive.primitive) heterogeneous_idx (|> r.nat (\ ! map (n.% (list.size exhaustive_patterns)))) .let [heterogeneous_branchesC (list.joined (list (list.first heterogeneous_idx exhaustive_branchesC) - (list (let [[_pattern _body] (maybe.assume (list.item heterogeneous_idx exhaustive_branchesC))] + (list (let [[_pattern _body] (maybe.trusted (list.item heterogeneous_idx exhaustive_branchesC))] [_pattern heterogeneousC])) (list.after (inc heterogeneous_idx) exhaustive_branchesC)))]] (_.test "Will reject pattern-matching if the bodies of the branches do not all have the same type." 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 b0027b15d..42b1e366c 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 @@ -96,7 +96,7 @@ (list varT) (list.after (inc var_idx) inputsT)))) varT) - poly_inputT (maybe.assume (list.item var_idx inputsT)) + poly_inputT (maybe.trusted (list.item var_idx inputsT)) partial_poly_inputsT (list.after (inc var_idx) inputsT) partial_polyT1 (<| (type.function partial_poly_inputsT) poly_inputT) 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 bc4890efe..d27b85baf 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 @@ -124,12 +124,12 @@ +choice (|> r.nat (\ ! map (n.% (inc size)))) [_ +valueC] _primitive.primitive .let [variantT (type.variant (list\map product.left primitives)) - [valueT valueC] (maybe.assume (list.item choice primitives)) + [valueT valueC] (maybe.trusted (list.item choice primitives)) +size (inc size) +primitives (list.joined (list (list.first choice primitives) (list [(#.Parameter 1) +valueC]) (list.after choice primitives))) - [+valueT +valueC] (maybe.assume (list.item +choice +primitives)) + [+valueT +valueC] (maybe.trusted (list.item +choice +primitives)) +variantT (type.variant (list\map product.left +primitives))]] (<| (_.context (%.name (name_of /.sum))) ($_ _.and @@ -175,7 +175,7 @@ choice (|> r.nat (\ ! map (n.% size))) [_ +valueC] _primitive.primitive .let [tupleT (type.tuple (list\map product.left primitives)) - [singletonT singletonC] (|> primitives (list.item choice) maybe.assume) + [singletonT singletonC] (|> primitives (list.item choice) maybe.trusted) +primitives (list.joined (list (list.first choice primitives) (list [(#.Parameter 1) +valueC]) (list.after choice primitives))) @@ -240,15 +240,15 @@ .let [with_name (|>> (#.Named [module_name type_name])) varT (#.Parameter 1) primitivesT (list\map product.left primitives) - [choiceT choiceC] (maybe.assume (list.item choice primitives)) - [other_choiceT other_choiceC] (maybe.assume (list.item other_choice primitives)) + [choiceT choiceC] (maybe.trusted (list.item choice primitives)) + [other_choiceT other_choiceC] (maybe.trusted (list.item other_choice primitives)) monoT (type.variant primitivesT) polyT (|> (type.variant (list.joined (list (list.first choice primitivesT) (list varT) (list.after (inc choice) primitivesT)))) (type.univ_q 1)) - choice_tag (maybe.assume (list.item choice tags)) - other_choice_tag (maybe.assume (list.item other_choice tags))]] + choice_tag (maybe.trusted (list.item choice tags)) + other_choice_tag (maybe.trusted (list.item other_choice tags))]] (<| (_.context (%.name (name_of /.tagged_sum))) ($_ _.and (_.test "Can infer." diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 078aef4e2..8c135b590 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -28,6 +28,7 @@ ["#." check] ["#." dynamic] ["#." implicit] + ["#." poly] ["#." quotient] ["#." refinement] ["#." resource] @@ -207,10 +208,10 @@ [left random.nat right (random.ascii/lower 1) .let [left,right [left right]]] - (_.cover [/.:cast] + (_.cover [/.:as] (|> left,right - (/.:cast [l r] (And l r) (Or l r)) - (/.:cast [l r] (Or l r) (And l r)) + (/.:as [l r] (And l r) (Or l r)) + (/.:as [l r] (Or l r) (And l r)) (same? left,right)))) (do random.monad [expected random.nat] @@ -239,6 +240,7 @@ /check.test /dynamic.test /implicit.test + /poly.test /quotient.test /refinement.test /resource.test diff --git a/stdlib/source/test/lux/type/poly.lux b/stdlib/source/test/lux/type/poly.lux new file mode 100644 index 000000000..1ffe2cf61 --- /dev/null +++ b/stdlib/source/test/lux/type/poly.lux @@ -0,0 +1,20 @@ +(.module: + [library + [lux #* + ["_" test (#+ Test)]]] + [\\library + ["." /]] + ["." / #_ + ["#." equivalence] + ["#." functor] + ["#." json]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.poly: /.derived: /.code]) + ($_ _.and + /equivalence.test + /functor.test + /json.test + ))) diff --git a/stdlib/source/test/lux/type/poly/equivalence.lux b/stdlib/source/test/lux/type/poly/equivalence.lux new file mode 100644 index 000000000..14c763226 --- /dev/null +++ b/stdlib/source/test/lux/type/poly/equivalence.lux @@ -0,0 +1,83 @@ +(.module: + [library + [lux (#- Variant) + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence) + [\\poly + ["." /]]] + [\\specification + ["$." equivalence]]] + [control + ["." maybe]] + [data + ["." bit] + ["." text] + [collection + ["." list]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]] + [type + [poly (#+ derived:)]]]]) + +(type: Variant + (#Case0 Bit) + (#Case1 Int) + (#Case2 Frac)) + +(type: #rec Recursive + (#Number Frac) + (#Addition Frac Recursive)) + +(type: Record + {#bit Bit + #int Int + #frac Frac + #text Text + #maybe (Maybe Int) + #list (List Int) + #variant Variant + #tuple [Int Frac Text] + #recursive Recursive}) + +(def: gen_recursive + (Random Recursive) + (random.rec (function (_ gen_recursive) + (random.or random.safe_frac + (random.and random.safe_frac + gen_recursive))))) + +(def: random + (Random Record) + (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 + random.safe_frac + (random.unicode size) + (random.maybe gen_int) + (random.list size gen_int) + ($_ random.or + random.bit + gen_int + random.safe_frac) + ($_ random.and + gen_int + random.safe_frac + (random.unicode size)) + gen_recursive))) + +(derived: equivalence + (/.equivalence Record)) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.equivalence] + ($equivalence.spec ..equivalence ..random)))) diff --git a/stdlib/source/test/lux/type/poly/functor.lux b/stdlib/source/test/lux/type/poly/functor.lux new file mode 100644 index 000000000..da5b00391 --- /dev/null +++ b/stdlib/source/test/lux/type/poly/functor.lux @@ -0,0 +1,27 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)] + [functor + [\\poly + ["." /]]]] + ["r" math/random (#+ Random)] + ["_" test (#+ Test)] + [control + ["." state]] + [data + ["." identity]] + [type + [poly (#+ derived:)]]]]) + +(derived: maybe_functor (/.functor .Maybe)) +(derived: list_functor (/.functor .List)) +(derived: state_functor (/.functor state.State)) +(derived: identity_functor (/.functor identity.Identity)) + +(def: .public test + Test + (<| (_.covering /._) + (_.cover [/.functor] + true))) diff --git a/stdlib/source/test/lux/type/poly/json.lux b/stdlib/source/test/lux/type/poly/json.lux new file mode 100644 index 000000000..16a466ed5 --- /dev/null +++ b/stdlib/source/test/lux/type/poly/json.lux @@ -0,0 +1,117 @@ +(.module: + [library + [lux (#- Variant) + ["_" test (#+ Test)] + ["." debug] + [abstract + codec + [monad (#+ do)] + ["." equivalence (#+ Equivalence) + ["poly/#" \\poly]] + [\\specification + ["$." equivalence] + ["$." codec]]] + [control + pipe + ["." try] + ["p" parser + ... TODO: Get rid of this import ASAP + [json (#+)]]] + [data + ["." bit] + ["." text] + [format + [json (#+) + [\\poly + ["." /]]]] + [collection + [row (#+ row)] + ["d" dictionary] + ["." list]]] + [type + [poly (#+ derived:)] + ["." unit]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["." frac]]] + [time + ["ti" instant] + ["tda" date] + ... ["tdu" duration] + ]]] + [test + [lux + [time + ["_." instant] + ... ["_." duration] + ]]]) + +(type: Variant + (#Bit Bit) + (#Text Text) + (#Frac Frac)) + +(type: #rec Recursive + (#Number Frac) + (#Addition Frac Recursive)) + +(type: Record + {#bit Bit + #frac Frac + #text Text + #maybe (Maybe Frac) + #list (List Frac) + #dictionary (d.Dictionary Text Frac) + #variant Variant + #tuple [Bit Text Frac] + #recursive Recursive + ... #instant ti.Instant + ... #duration tdu.Duration + #date tda.Date + #grams (unit.Qty unit.Gram)}) + +(def: gen_recursive + (Random Recursive) + (random.rec + (function (_ gen_recursive) + (random.or random.safe_frac + (random.and random.safe_frac + gen_recursive))))) + +(def: qty + (All [unit] (Random (unit.Qty unit))) + (\ random.monad map (debug.private unit.in) random.int)) + +(def: gen_record + (Random Record) + (do {! random.monad} + [size (\ ! map (n.% 2) random.nat)] + ($_ random.and + random.bit + random.safe_frac + (random.unicode size) + (random.maybe random.safe_frac) + (random.list size random.safe_frac) + (random.dictionary text.hash size (random.unicode size) random.safe_frac) + ($_ random.or random.bit (random.unicode size) random.safe_frac) + ($_ random.and random.bit (random.unicode size) random.safe_frac) + ..gen_recursive + ... _instant.instant + ... _duration.duration + random.date + ..qty + ))) + +(derived: equivalence + (poly/equivalence.equivalence Record)) + +(derived: codec + (/.codec Record)) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.codec] + ($codec.spec ..equivalence ..codec ..gen_record)))) diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux index 64a0b60bd..cf69e9243 100644 --- a/stdlib/source/test/lux/type/refinement.lux +++ b/stdlib/source/test/lux/type/refinement.lux @@ -53,14 +53,14 @@ (|> (/.refiner predicate modulus) (maybe\map (|>> /.value (n.= modulus))) (maybe.else false))) - (_.cover [/.lift] + (_.cover [/.lifted] (and (|> (/.refiner predicate modulus) - (maybe\map (/.lift (n.+ modulus))) + (maybe\map (/.lifted (n.+ modulus))) maybe\join (maybe\map (|>> /.value (n.= (n.+ modulus modulus)))) (maybe.else false)) (|> (/.refiner predicate modulus) - (maybe\map (/.lift (n.+ (inc modulus)))) + (maybe\map (/.lifted (n.+ (inc modulus)))) maybe\join (maybe\map (|>> /.value (n.= (n.+ modulus (inc modulus))))) (maybe.else false) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux index 0060dc9a4..67ce892fe 100644 --- a/stdlib/source/test/lux/world/input/keyboard.lux +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -141,7 +141,7 @@ (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (in (maybe.assume (list.item choice ..listing)))))) + (in (maybe.trusted (list.item choice ..listing)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index 543dcb3f7..b6b18505a 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -48,7 +48,7 @@ (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (in (maybe.assume (list.item choice ..listing)))))) + (in (maybe.trusted (list.item choice ..listing)))))) (def: .public test Test -- cgit v1.2.3