From abe24425ced15fd784ef6c62d6f186af72b491db Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 11 Jul 2021 01:51:04 -0400 Subject: Re-named ":coerce" to ":as" since it technically doesn't do coercions. --- stdlib/source/test/aedifex/command/install.lux | 9 +- stdlib/source/test/aedifex/profile.lux | 1 + stdlib/source/test/aedifex/repository.lux | 2 + stdlib/source/test/aedifex/repository/local.lux | 51 ++++ stdlib/source/test/lux.lux | 5 +- stdlib/source/test/lux/ffi.js.lux | 4 +- stdlib/source/test/lux/ffi.jvm.lux | 14 +- stdlib/source/test/lux/meta.lux | 6 +- stdlib/source/test/lux/program.lux | 4 +- stdlib/source/test/lux/target/jvm.lux | 256 ++++++++++----------- .../language/lux/phase/synthesis/primitive.lux | 2 +- stdlib/source/test/lux/type.lux | 213 +++++++++-------- 12 files changed, 327 insertions(+), 240 deletions(-) create mode 100644 stdlib/source/test/aedifex/repository/local.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 5800bca6d..0e8a95526 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -67,10 +67,11 @@ sample (\ ! map (set@ #///.identity (#.Some identity)) $profile.random) home (random.ascii/alpha 5) - working_directory (random.ascii/alpha 5)] + working_directory (random.ascii/alpha 5) + #let [/ (\ file.default separator)]] ($_ _.and (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator)) + [#let [fs (file.mock /) program (program.async (program.mock environment.empty home working_directory)) artifact_path (///local.uri (get@ #///artifact.version identity) identity) @@ -80,9 +81,11 @@ [succeeded! (\ ! map (text\= /.success) (..execute! program fs sample)) library_exists! (|> library_path + (format home /) (\ fs file?) (\ promise.monad map exception.return)) pom_exists! (|> pom_path + (format home /) (\ fs file?) (\ promise.monad map exception.return))] (wrap (and succeeded! @@ -91,7 +94,7 @@ (_.cover' [/.do! /.success] (try.default false verdict)))) (wrap (do {! promise.monad} - [#let [fs (file.mock (\ file.default separator)) + [#let [fs (file.mock /) program (program.async (program.mock environment.empty home working_directory))] logging (..execute! program fs (set@ #///.identity #.None sample))] (_.cover' [/.failure] diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 3410255f5..0a0ba8642 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -124,6 +124,7 @@ (random.maybe ..info) (..set_of text.hash ..repository) (..set_of //dependency.hash @dependency.random) + @dependency.random (..set_of text.hash ..source) ..target (random.maybe (random.ascii/alpha 1)) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index d16734a60..f9a4eeda6 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -24,6 +24,7 @@ ["." / #_ ["#." identity] ["#." origin] + ["#." local] ["#." remote] [// ["@." artifact]]] @@ -100,5 +101,6 @@ /identity.test /origin.test + /local.test /remote.test ))) diff --git a/stdlib/source/test/aedifex/repository/local.lux b/stdlib/source/test/aedifex/repository/local.lux new file mode 100644 index 000000000..946494437 --- /dev/null +++ b/stdlib/source/test/aedifex/repository/local.lux @@ -0,0 +1,51 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["." environment]] + [concurrency + ["." promise]]] + [data + ["." binary ("#\." equivalence)] + [text + [encoding + ["." utf8]]]] + [math + ["." random]] + [world + ["." file] + ["." program]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [/ (random.ascii/upper 1) + home (random.ascii/lower 10) + working_directory (random.ascii/lower 10) + #let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory)) + repo (/.repository program fs)] + + uri (random.ascii/lower 10) + expected (\ ! map (\ utf8.codec encode) + (random.ascii/lower 10))] + ($_ _.and + (wrap (do promise.monad + [before_upload (\ repo download uri) + _ (\ repo upload uri expected) + actual (\ repo download uri)] + (_.cover' [/.repository] + (and (case before_upload + (#try.Success _) false + (#try.Failure _) true) + (|> actual + (try\map (binary\= expected)) + (try.default false)))))) + )))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index b320841c5..415bb3500 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -58,8 +58,9 @@ (def: identity Test (do {! random.monad} - [#let [object (: (Random (Atom Text)) - (\ ! map atom.atom (random.unicode 1)))] + [value random.nat + #let [object (: (Random (Atom Nat)) + (\ ! map atom.atom (wrap value)))] self object] ($_ _.and (_.test "Every value is identical to itself." diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 9835e52e4..8af4be0fd 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -68,9 +68,9 @@ (let [encoding "utf8"] (text\= string (cond /.on_nashorn? - (let [binary (java/lang/String::getBytes [encoding] (:coerce java/lang/String string))] + (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] (|> (java/lang/String::new [binary encoding]) - (:coerce Text))) + (:as Text))) /.on_node_js? (|> (Buffer::from [string encoding]) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index d2686f3ba..0c618bfac 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -81,9 +81,9 @@ (`` ($_ _.and (~~ (template [ ] [(_.test - (or (|> sample (:coerce java/lang/Long) (:coerce Int) (i.= sample)) - (let [capped_sample (|> sample (:coerce java/lang/Long) )] - (|> capped_sample (:coerce Int) (i.= (:coerce Int capped_sample))))))] + (or (|> sample (:as java/lang/Long) (:as Int) (i.= sample)) + (let [capped_sample (|> sample (:as java/lang/Long) )] + (|> capped_sample (:as Int) (i.= (:as Int capped_sample))))))] [/.long_to_byte /.byte_to_long "Can succesfully convert to/from byte."] [/.long_to_short /.short_to_long "Can succesfully convert to/from short."] @@ -97,7 +97,7 @@ (def: miscellaneous Test (do {! r.monad} - [sample (\ ! map (|>> (:coerce java/lang/Object)) + [sample (\ ! map (|>> (:as java/lang/Object)) (r.ascii 1))] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -130,7 +130,7 @@ (do {! r.monad} [size (|> r.nat (\ ! map (|>> (n.% 100) (n.max 1)))) idx (|> r.nat (\ ! map (n.% size))) - value (\ ! map (|>> (:coerce java/lang/Long)) r.int)] + value (\ ! map (|>> (:as java/lang/Long)) r.int)] ($_ _.and (_.test "Can create arrays of some length." (n.= size (/.array_length (/.array java/lang/Long size)))) @@ -138,8 +138,8 @@ (_.test "Can set and get array values." (let [arr (/.array java/lang/Long size)] (exec (/.array_write idx value arr) - (i.= (:coerce Int value) - (:coerce Int (/.array_read idx arr))))))))) + (i.= (:as Int value) + (:as Int (/.array_read idx arr))))))))) (def: #export test ($_ _.and diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index c3d984854..e02b1197a 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -590,7 +590,7 @@ (and (bit\= expected_exported? actual_exported?) (is? expected_type actual_type) (is? expected_annotations actual_annotations) - (is? (:coerce Any expected_value) actual_value))))) + (is? (:as Any expected_value) actual_value))))) alias! (|> (/.find_def [expected_current_module expected_short]) @@ -625,13 +625,13 @@ (|> (/.find_type_def [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) - (is? (:coerce .Type expected_value) actual_value)))) + (is? (:as .Type expected_value) actual_value)))) alias! (|> (/.find_type_def [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) - (is? (:coerce .Type expected_value) actual_value))))] + (is? (:as .Type expected_value) actual_value))))] (and definition! alias!))) ))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 973216d84..e7d4a4767 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -44,14 +44,14 @@ (..actual_program )) inputs)] (list\= (list.reverse inputs) - (:coerce (List Text) (io.run outcome))))) + (:as (List Text) (io.run outcome))))) (with_expansions [ (/.program: [{all_arguments (<>.many .any)}] (io.io all_arguments))] (let [outcome ((: (-> (List Text) (io.IO Any)) (..actual_program )) inputs)] (list\= inputs - (:coerce (List Text) (io.run outcome))))) + (:as (List Text) (io.run outcome))))) (with_expansions [ (/.program: [arg/0 arg/1 arg/2 arg/3] (io.io []))] (case (try ((: (-> (List Text) (io.IO Any)) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index acdeaf653..173e9624f 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -143,12 +143,12 @@ (/type.class "java.lang.Boolean" (list))) (def: $Boolean::wrap (/.invokestatic ..$Boolean "valueOf" (/type.method [(list /type.boolean) ..$Boolean (list)]))) -(def: $Boolean::random (:coerce (Random java/lang/Boolean) random.bit)) +(def: $Boolean::random (:as (Random java/lang/Boolean) random.bit)) (def: !false (|> 0 .i64 i32.i32 /.int)) (def: !true (|> 1 .i64 i32.i32 /.int)) (def: ($Boolean::literal value) (-> java/lang/Boolean (Bytecode Any)) - (if (:coerce Bit value) + (if (:as Bit value) ..!true ..!false)) (def: $Boolean::primitive @@ -165,10 +165,10 @@ (/.invokestatic ..$Byte "valueOf" (/type.method [(list /type.byte) ..$Byte (list)]))) (def: $Byte::random (Random java/lang/Byte) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_byte) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_byte) random.int)) (def: $Byte::literal (-> java/lang/Byte (Bytecode Any)) - (|>> ffi.byte_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.byte_to_long (:as I64) i32.i32 /.int)) (def: $Byte::primitive (Primitive java/lang/Byte) {#unboxed /type.byte @@ -183,10 +183,10 @@ (/.invokestatic ..$Short "valueOf" (/type.method [(list /type.short) ..$Short (list)]))) (def: $Short::random (Random java/lang/Short) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_short) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_short) random.int)) (def: $Short::literal (-> java/lang/Short (Bytecode Any)) - (|>> ffi.short_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.short_to_long (:as I64) i32.i32 /.int)) (def: $Short::primitive (Primitive java/lang/Short) {#unboxed /type.short @@ -201,10 +201,10 @@ (/.invokestatic ..$Integer "valueOf" (/type.method [(list /type.int) ..$Integer (list)]))) (def: $Integer::random (Random java/lang/Integer) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_int) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int) random.int)) (def: $Integer::literal (-> java/lang/Integer (Bytecode Any)) - (|>> ffi.int_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.int_to_long (:as I64) i32.i32 /.int)) (def: $Integer::primitive (Primitive java/lang/Integer) {#unboxed /type.int @@ -215,8 +215,8 @@ (def: $Long (/type.class "java.lang.Long" (list))) (def: $Long::wrap (/.invokestatic ..$Long "valueOf" (/type.method [(list /type.long) ..$Long (list)]))) -(def: $Long::random (:coerce (Random java/lang/Long) random.int)) -(def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:coerce Int) /.long)) +(def: $Long::random (:as (Random java/lang/Long) random.int)) +(def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:as Int) /.long)) (def: $Long::primitive (Primitive java/lang/Long) {#unboxed /type.long @@ -230,12 +230,12 @@ (def: $Float::random (Random java/lang/Float) (\ random.monad map - (|>> (:coerce java/lang/Double) ffi.double_to_float) + (|>> (:as java/lang/Double) ffi.double_to_float) random.frac)) (def: $Float::literal /.float) (def: valid_float (Random java/lang/Float) - (random.filter (|>> ffi.float_to_double (:coerce Frac) f.not_a_number? not) + (random.filter (|>> ffi.float_to_double (:as Frac) f.not_a_number? not) ..$Float::random)) (def: $Float::primitive (Primitive java/lang/Float) @@ -247,13 +247,13 @@ (def: $Double (/type.class "java.lang.Double" (list))) (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) -(def: $Double::random (:coerce (Random java/lang/Double) random.frac)) +(def: $Double::random (:as (Random java/lang/Double) random.frac)) (def: $Double::literal (-> java/lang/Double (Bytecode Any)) /.double) (def: valid_double (Random java/lang/Double) - (random.filter (|>> (:coerce Frac) f.not_a_number? not) + (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)) (def: $Double::primitive (Primitive java/lang/Double) @@ -269,10 +269,10 @@ (/.invokestatic ..$Character "valueOf" (/type.method [(list /type.char) ..$Character (list)]))) (def: $Character::random (Random java/lang/Character) - (\ random.monad map (|>> (:coerce java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) + (\ random.monad map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) (def: $Character::literal (-> java/lang/Character (Bytecode Any)) - (|>> ffi.char_to_long (:coerce I64) i32.i32 /.int)) + (|>> ffi.char_to_long (:as I64) i32.i32 /.int)) (def: $Character::primitive (Primitive java/lang/Character) {#unboxed /type.char @@ -285,12 +285,12 @@ (/type.class "java.lang.String" (list))) (def: $String::random - (:coerce (Random java/lang/String) - (random.ascii/alpha 10))) + (:as (Random java/lang/String) + (random.ascii/alpha 10))) (def: $String::literal (-> java/lang/String (Bytecode Any)) - (|>> (:coerce Text) /.string)) + (|>> (:as Text) /.string)) (def: $String::primitive (Primitive java/lang/String) @@ -307,9 +307,9 @@ [expected (\ ! map (i64.and (i64.mask )) random.nat)] (<| (_.lift ) (..bytecode (for {@.old - (|>> (:coerce ) ("jvm leq" expected)) + (|>> (:as ) ("jvm leq" expected)) @.jvm - (|>> (:coerce ) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})) + (|>> (:as ) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})) (do /.monad [_ ( (|> expected .int try.assume))] ))))] @@ -352,10 +352,10 @@ (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit)) (function (_ expected bytecode) (<| (..bytecode (for {@.old - (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)) + (|>> (:as java/lang/Integer) ("jvm ieq" expected)) @.jvm - (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" expected)))})) (do /.monad [_ bytecode] ..$Integer::wrap)))) @@ -382,7 +382,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do {! random.monad} - [parameter (\ ! map (|>> (n.% 32) .int (:coerce java/lang/Long) ffi.long_to_int) random.nat) + [parameter (\ ! map (|>> (n.% 32) .int (:as java/lang/Long) ffi.long_to_int) random.nat) subject ..$Integer::random] (int (reference parameter subject) (do /.monad @@ -390,13 +390,13 @@ _ (..$Integer::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "ICONST_M1" (int (ffi.long_to_int (:coerce java/lang/Long -1)) /.iconst_m1)) - (_.lift "ICONST_0" (int (ffi.long_to_int (:coerce java/lang/Long +0)) /.iconst_0)) - (_.lift "ICONST_1" (int (ffi.long_to_int (:coerce java/lang/Long +1)) /.iconst_1)) - (_.lift "ICONST_2" (int (ffi.long_to_int (:coerce java/lang/Long +2)) /.iconst_2)) - (_.lift "ICONST_3" (int (ffi.long_to_int (:coerce java/lang/Long +3)) /.iconst_3)) - (_.lift "ICONST_4" (int (ffi.long_to_int (:coerce java/lang/Long +4)) /.iconst_4)) - (_.lift "ICONST_5" (int (ffi.long_to_int (:coerce java/lang/Long +5)) /.iconst_5)) + (_.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] @@ -410,7 +410,7 @@ (_.lift "INEG" (unary (function (_ value) ((int/2 "jvm isub" "jvm int -") value - (ffi.long_to_int (:coerce java/lang/Long +0)))) + (ffi.long_to_int (:as java/lang/Long +0)))) /.ineg))) bitwise ($_ _.and (_.lift "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) @@ -433,10 +433,10 @@ (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit)) (function (_ expected bytecode) (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) + (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) (do /.monad [_ bytecode] ..$Long::wrap)))) @@ -461,7 +461,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do {! random.monad} - [parameter (\ ! map (|>> (n.% 64) (:coerce java/lang/Long)) random.nat) + [parameter (\ ! map (|>> (n.% 64) (:as java/lang/Long)) random.nat) subject ..$Long::random] (long (reference (ffi.long_to_int parameter) subject) (do /.monad @@ -469,8 +469,8 @@ _ (..$Integer::literal (ffi.long_to_int parameter))] instruction))))) literal ($_ _.and - (_.lift "LCONST_0" (long (:coerce java/lang/Long +0) /.lconst_0)) - (_.lift "LCONST_1" (long (:coerce java/lang/Long +1) /.lconst_1)) + (_.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] @@ -484,7 +484,7 @@ (_.lift "LNEG" (unary (function (_ value) ((long/2 "jvm lsub" "jvm long -") value - (:coerce java/lang/Long +0))) + (:as java/lang/Long +0))) /.lneg))) bitwise ($_ _.and (_.lift "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) @@ -497,19 +497,19 @@ (do random.monad [reference ..$Long::random subject ..$Long::random - #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +0) + #let [expected (cond (i.= (:as Int reference) (:as Int subject)) + (:as java/lang/Long +0) - (i.> (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long +1) + (i.> (:as Int reference) (:as Int subject)) + (:as java/lang/Long +1) - ## (i.< (:coerce Int reference) (:coerce Int subject)) - (:coerce java/lang/Long -1))]] + ## (i.< (:as Int reference) (:as Int subject)) + (:as java/lang/Long -1))]] (<| (..bytecode (for {@.old - (|>> (:coerce Int) (i.= expected)) + (|>> (:as Int) (i.= expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))})) (do /.monad [_ (..$Long::literal subject) _ (..$Long::literal reference) @@ -533,15 +533,15 @@ (function (_ expected bytecode) (<| (..bytecode (for {@.old (function (_ actual) - (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected)) - (and (f.not_a_number? (:coerce Frac (ffi.float_to_double expected))) - (f.not_a_number? (:coerce Frac (ffi.float_to_double (:coerce java/lang/Float actual))))))) + (or (|> actual (:as java/lang/Float) ("jvm feq" expected)) + (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) + (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual))))))) @.jvm (function (_ actual) - (or (|> actual (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) - (and (f.not_a_number? (:coerce Frac (ffi.float_to_double expected))) - (f.not_a_number? (:coerce Frac (ffi.float_to_double (:coerce java/lang/Float actual)))))))})) + (or (|> actual (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" expected))) + (and (f.not_a_number? (:as Frac (ffi.float_to_double expected))) + (f.not_a_number? (:as Frac (ffi.float_to_double (:as java/lang/Float actual)))))))})) (do /.monad [_ bytecode] ..$Float::wrap)))) @@ -568,9 +568,9 @@ _ (..$Float::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "FCONST_0" (float (ffi.double_to_float (:coerce java/lang/Double +0.0)) /.fconst_0)) - (_.lift "FCONST_1" (float (ffi.double_to_float (:coerce java/lang/Double +1.0)) /.fconst_1)) - (_.lift "FCONST_2" (float (ffi.double_to_float (:coerce java/lang/Double +2.0)) /.fconst_2)) + (_.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] @@ -584,12 +584,12 @@ (_.lift "FNEG" (unary (function (_ value) ((float/2 "jvm fsub" "jvm float -") value - (ffi.double_to_float (:coerce java/lang/Double +0.0)))) + (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 - [#let [valid_float (random.filter (|>> ffi.float_to_double (:coerce Frac) f.not_a_number? not) + [#let [valid_float (random.filter (|>> ffi.float_to_double (:as Frac) f.not_a_number? not) ..$Float::random)] reference valid_float subject valid_float @@ -602,7 +602,7 @@ (if (standard reference subject) +1 -1))]] - (<| (..bytecode (|>> (:coerce Int) (i.= expected))) + (<| (..bytecode (|>> (:as Int) (i.= expected))) (do /.monad [_ (..$Float::literal subject) _ (..$Float::literal reference) @@ -634,15 +634,15 @@ (function (_ expected bytecode) (<| (..bytecode (for {@.old (function (_ actual) - (or (|> actual (:coerce java/lang/Double) ("jvm deq" expected)) - (and (f.not_a_number? (:coerce Frac expected)) - (f.not_a_number? (:coerce Frac actual))))) + (or (|> actual (:as java/lang/Double) ("jvm deq" expected)) + (and (f.not_a_number? (:as Frac expected)) + (f.not_a_number? (:as Frac actual))))) @.jvm (function (_ actual) - (or (|> actual (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) - (and (f.not_a_number? (:coerce Frac expected)) - (f.not_a_number? (:coerce Frac actual)))))})) + (or (|> actual (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))) + (and (f.not_a_number? (:as Frac expected)) + (f.not_a_number? (:as Frac actual)))))})) (do /.monad [_ bytecode] ..$Double::wrap)))) @@ -665,8 +665,8 @@ _ (..$Double::literal parameter)] instruction))))) literal ($_ _.and - (_.lift "DCONST_0" (double (:coerce java/lang/Double +0.0) /.dconst_0)) - (_.lift "DCONST_1" (double (:coerce java/lang/Double +1.0) /.dconst_1)) + (_.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] @@ -680,7 +680,7 @@ (_.lift "DNEG" (unary (function (_ value) ((double/2 "jvm dsub" "jvm double -") value - (:coerce java/lang/Double +0.0))) + (:as java/lang/Double +0.0))) /.dneg))) comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) @@ -696,7 +696,7 @@ (if (standard reference subject) +1 -1))]] - (<| (..bytecode (|>> (:coerce Int) (i.= expected))) + (<| (..bytecode (|>> (:as Int) (i.= expected))) (do /.monad [_ (..$Double::literal subject) _ (..$Double::literal reference) @@ -749,7 +749,7 @@ (/.invokespecial ..$Object "" (/type.method [(list) /type.void (list)]))))] ($_ _.and (<| (_.lift "ACONST_NULL") - (..bytecode (|>> (:coerce Bit) not)) + (..bytecode (|>> (:as Bit) not)) (do /.monad [_ /.aconst_null _ (/.instanceof ..$String)] @@ -757,13 +757,13 @@ (<| (_.lift "INSTANCEOF") (do random.monad [value ..$String::random]) - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad - [_ (/.string (:coerce Text value)) + [_ (/.string (:as Text value)) _ (/.instanceof ..$String)] ..$Boolean::wrap)) (<| (_.lift "NEW & CHECKCAST") - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad [_ !object _ (/.checkcast ..$Object) @@ -772,9 +772,9 @@ (<| (_.lift "MONITORENTER & MONITOREXIT") (do random.monad [value ..$String::random]) - (..bytecode (|>> (:coerce Bit))) + (..bytecode (|>> (:as Bit))) (do /.monad - [_ (/.string (:coerce Text value)) + [_ (/.string (:as Text value)) _ /.dup _ /.monitorenter _ /.dup _ /.monitorexit _ (/.instanceof ..$String)] @@ -786,20 +786,20 @@ ($_ _.and (<| (_.lift "INVOKESTATIC") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) + [expected (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) (do /.monad [_ (/.double expected)] (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))) (<| (_.lift "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) - (..bytecode (|>> (:coerce Bit) (bit\= (f.not_a_number? (:coerce Frac expected))))) + (..bytecode (|>> (:as Bit) (bit\= (f.not_a_number? (:as Frac expected))))) (do /.monad [_ (/.double expected) _ ..$Double::wrap @@ -807,13 +807,13 @@ ..$Boolean::wrap)) (<| (_.lift "INVOKESPECIAL") (do random.monad - [expected (random.filter (|>> (:coerce Frac) f.not_a_number? not) + [expected (random.filter (|>> (:as Frac) f.not_a_number? not) ..$Double::random)]) (..bytecode (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})) (do /.monad [_ (/.new ..$Double) _ /.dup @@ -822,9 +822,9 @@ (<| (_.lift "INVOKEINTERFACE") (do random.monad [subject ..$String::random]) - (..bytecode (|>> (:coerce Nat) (n.= (text.size (:coerce Text subject))))) + (..bytecode (|>> (:as Nat) (n.= (text.size (:as Text subject))))) (do /.monad - [_ (/.string (:coerce Text subject)) + [_ (/.string (:as Text subject)) _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)])) _ /.i2l] ..$Long::wrap)) @@ -894,9 +894,9 @@ class (io.run (/loader.load class_name loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:coerce Int output))) + (wrap (:as Int output))) (#try.Success actual) - (i.= (:coerce Int expected) (:coerce Int actual)) + (i.= (:as Int expected) (:as Int actual)) (#try.Failure error) false)))) @@ -906,7 +906,7 @@ (let [!length (: (-> Nat (Bytecode Any)) (function (_ size) (do /.monad - [_ ($Long::literal (:coerce java/lang/Long size))] + [_ ($Long::literal (:as java/lang/Long size))] /.l2i))) ?length (: (Bytecode Any) (do /.monad @@ -914,7 +914,7 @@ /.i2l)) length (: (-> Nat (Bytecode Any) (Random Bit)) (function (_ size constructor) - (<| (..bytecode (|>> (:coerce Nat) (n.= size))) + (<| (..bytecode (|>> (:as Nat) (n.= size))) (do /.monad [_ (!length size) _ constructor @@ -927,7 +927,7 @@ (-> a Any Bit) (Random Bit))) (function (_ size constructor value literal [*store *load *wrap] test) - (let [!index ($Integer::literal (ffi.long_to_int (:coerce java/lang/Long +0)))] + (let [!index ($Integer::literal (ffi.long_to_int (:as java/lang/Long +0)))] (<| (..bytecode (test value)) (do /.monad [_ (!length size) @@ -952,66 +952,66 @@ ($_ _.and (_.context "boolean" (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] - (function (_ expected) (|>> (:coerce Bit) (bit\= (:coerce Bit expected)))))) + (function (_ expected) (|>> (:as Bit) (bit\= (:as Bit expected)))))) (_.context "byte" (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:coerce java/lang/Byte expected)))))})))) + (|>> (: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)))))})))) (_.context "short" (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:coerce java/lang/Short expected)))))})))) + (|>> (: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 "int" (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Integer) ("jvm ieq" (:coerce java/lang/Integer expected))) + (|>> (:as java/lang/Integer) ("jvm ieq" (:as java/lang/Integer expected))) @.jvm - (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:coerce java/lang/Integer expected))))})))) + (|>> (:as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:as java/lang/Integer expected))))})))) (_.context "long" (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Long) ("jvm leq" expected)) + (|>> (:as java/lang/Long) ("jvm leq" expected)) @.jvm - (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})))) + (|>> (:as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:as java/lang/Long expected))))})))) (_.context "float" (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Float) ("jvm feq" expected)) + (|>> (:as java/lang/Float) ("jvm feq" expected)) @.jvm - (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))})))) + (|>> (:as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:as java/lang/Float expected))))})))) (_.context "double" (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Double) ("jvm deq" expected)) + (|>> (:as java/lang/Double) ("jvm deq" expected)) @.jvm - (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:coerce java/lang/Double expected))))})))) + (|>> (:as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:as java/lang/Double expected))))})))) (_.context "char" (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Character) ("jvm ceq" expected)) + (|>> (:as java/lang/Character) ("jvm ceq" expected)) @.jvm - (|>> (:coerce java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:coerce java/lang/Character expected))))})))) + (|>> (:as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:as java/lang/Character expected))))})))) (_.context "object" (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] - (function (_ expected) (|>> (:coerce Text) (text\= (:coerce Text expected)))))) + (function (_ expected) (|>> (:as Text) (text\= (:as Text expected)))))) (<| (_.context "multi") (do {! random.monad} [#let [size (\ ! map (|>> (n.% 5) (n.+ 1)) @@ -1026,9 +1026,9 @@ 0 type _ (recur (dec dimensions) (/type.array type))))]] (<| (_.lift "MULTIANEWARRAY") - (..bytecode (|>> (:coerce Nat) (n.= sizesH))) + (..bytecode (|>> (:as Nat) (n.= sizesH))) (do {! /.monad} - [_ (monad.map ! (|>> (:coerce java/lang/Long) ffi.long_to_int ..$Integer::literal) + [_ (monad.map ! (|>> (:as java/lang/Long) ffi.long_to_int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) _ ?length] @@ -1039,10 +1039,10 @@ (: (-> Any Bit) (function (_ expected) (for {@.old - (|>> (:coerce ) ( expected)) + (|>> (:as ) ( expected)) @.jvm - (|>> (:coerce ) "jvm object cast" ( ("jvm object cast" (:coerce expected))))})))) + (|>> (:as ) "jvm object cast" ( ("jvm object cast" (:as expected))))})))) (def: conversion Test @@ -1070,19 +1070,19 @@ (_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) (function (_ expected) (for {@.old - (|>> (:coerce java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + (|>> (:as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) @.jvm - (|>> (:coerce java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (:coerce java/lang/Byte expected)))))})))) + (|>> (: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 - (|>> (:coerce java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + (|>> (:as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) @.jvm - (|>> (:coerce java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (:coerce java/lang/Short expected)))))})))))) + (|>> (: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::=)) @@ -1163,8 +1163,8 @@ ("jvm object cast" ("jvm long +" ("jvm object cast" (ffi.byte_to_long base)) - ("jvm object cast" (:coerce java/lang/Long (/unsigned.value increment)))))}))]] - (..bytecode (|>> (:coerce Int) (i.= (:coerce Int expected))) + ("jvm object cast" (:as java/lang/Long (/unsigned.value increment)))))}))]] + (..bytecode (|>> (:as Int) (i.= (:as Int expected))) (do /.monad [_ (..$Byte::literal base) _ /.istore_0 @@ -1214,7 +1214,7 @@ (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) - (|> actual (:coerce Text) (text\= (:coerce Text expected)))))] + (|> 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)) @@ -1233,7 +1233,7 @@ (do random.monad [expected/1 $String::random #let [object_test (: (-> Any Bit) - (|>> (:coerce Text) (text\= (:coerce Text expected/1))))] + (|>> (:as Text) (text\= (:as Text expected/1))))] dummy/1 $String::random #let [single ($_ _.and (<| (_.lift "DUP & POP") @@ -1268,7 +1268,7 @@ )] expected/2 $Long::random #let [long_test (: (-> Any Bit) - (|>> (:coerce Int) (i.= (:coerce Int expected/2))))] + (|>> (:as Int) (i.= (:as Int expected/2))))] dummy/2 $Long::random #let [double ($_ _.and (<| (_.lift "DUP2") @@ -1370,7 +1370,7 @@ (_.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\= (:coerce Text expected) (:coerce Text actual))))) + (_.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 @@ -1379,7 +1379,7 @@ #literal (function.constant /.nop)}) /.return (#.Some ..$String::literal) - (function (_ expected actual) (text\= (:coerce Text expected) (:coerce Text actual))))) + (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) ))) (def: branching @@ -1498,7 +1498,7 @@ random.nat) choice (\ ! map (n.% options) random.nat) options (|> random.int - (\ ! map (|>> (:coerce java/lang/Long) ffi.long_to_int ffi.int_to_long (:coerce Int))) + (\ ! map (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_long (:as Int))) (random.set i.hash options) (\ ! map set.to_list)) #let [choice (maybe.assume (list.nth choice options))] @@ -1509,7 +1509,7 @@ [@right /.new_label @wrong /.new_label @return /.new_label - _ (..$Integer::literal (ffi.long_to_int (:coerce java/lang/Long choice))) + _ (..$Integer::literal (ffi.long_to_int (:as java/lang/Long choice))) _ (/.lookupswitch @wrong (list\map (function (_ option) [(|> option /signed.s4 try.assume) (if (i.= choice option) @right @wrong)]) @@ -1596,11 +1596,11 @@ part3 ..$Long::random part4 ..$Long::random #let [expected ($_ i.+ - (:coerce Int part0) - (:coerce Int part1) - (:coerce Int part2) - (:coerce Int part3) - (:coerce Int part4)) + (:as Int part0) + (:as Int part1) + (:as Int part2) + (:as Int part3) + (:as Int part4)) $Concrete (/type.class concrete_class (list)) $Abstract (/type.class abstract_class (list)) $Interface (/type.class interface_class (list)) @@ -1711,9 +1711,9 @@ class (io.run (/loader.load concrete_class loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:coerce Int output))) + (wrap (:as Int output))) (#try.Success actual) - (i.= (:coerce Int expected) (:coerce Int actual)) + (i.= (:as Int expected) (:as Int actual)) (#try.Failure error) false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 69f087de7..be4542936 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -50,7 +50,7 @@ (is? (|> expected ) (|> actual ))] - [#////analysis.Unit (:coerce Text) #////synthesis.Text (|>)] + [#////analysis.Unit (:as Text) #////synthesis.Text (|>)] [#////analysis.Bit (|>) #////synthesis.Bit (|>)] [#////analysis.Nat .i64 #////synthesis.I64 .i64] [#////analysis.Int .i64 #////synthesis.I64 .i64] diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 86e7a63e5..933edbfa3 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -1,17 +1,21 @@ (.module: - [lux (#- type) - ["%" data/text/format (#+ format)] + [lux #* ["_" test (#+ Test)] [abstract - ["." monad (#+ do)]] + ["." monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] [control - pipe] + [pipe (#+ case>)]] [data ["." maybe] + ["." text ("#\." equivalence)] [collection - ["." list]]] + ["." list] + ["." array]]] [math - ["." random (#+ Random)] + ["." random (#+ Random) ("#\." monad)] [number ["n" nat]]]] {1 @@ -39,57 +43,45 @@ (def: #export random (Random Type) - (let [(^open "random\.") random.monad] - (random.rec (function (_ recur) - (let [pairG (random.and recur recur) - idG random.nat - quantifiedG (random.and (random\wrap (list)) recur)] - ($_ random.or - (random.and ..short (random\wrap (list))) - pairG - pairG - pairG - idG - idG - idG - quantifiedG - quantifiedG - pairG - (random.and ..name recur) - )))))) + (random.rec + (function (_ recur) + (let [pairG (random.and recur recur) + idG random.nat + quantifiedG (random.and (random\wrap (list)) recur)] + ($_ random.or + (random.and ..short (random\wrap (list))) + pairG + pairG + pairG + idG + idG + idG + quantifiedG + quantifiedG + pairG + (random.and ..name recur) + ))))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) ($_ _.and - (do random.monad - [sample ..random] - (_.test "Every type is equal to itself." - (\ /.equivalence = sample sample))) - (_.test "Can apply quantified types (universal and existential quantification)." - (and (maybe.default #0 - (do maybe.monad - [partial (/.apply (list Bit) Ann) - full (/.apply (list Int) partial)] - (wrap (\ /.equivalence = full (#.Product Bit Int))))) - (|> (/.apply (list Bit) Text) - (case> #.None #1 _ #0)))) - (let [base (#.Named ["" "a"] (#.Product Bit Int)) - aliased (#.Named ["" "c"] - (#.Named ["" "b"] - base))] + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do {! random.monad} + [anonymousT (random.filter (|>> (case> (#.Named _ _) false + _ true)) + ..random) + name/0 ..name + name/1 ..name + #let [namedT (#.Named name/0 anonymousT) + aliasedT (#.Named name/1 namedT)]] ($_ _.and - (_.test "Can remove aliases from an already-named type." - (\ /.equivalence = - base - (/.un_alias aliased))) - (_.test "Can remove all names from a type." - (and (not (\ /.equivalence = - base - (/.un_name aliased))) - (\ /.equivalence = - (/.un_name base) - (/.un_name aliased)))))) + (_.cover [/.un_alias] + (\ /.equivalence = namedT (/.un_alias aliasedT))) + (_.cover [/.un_name] + (\ /.equivalence = anonymousT (/.un_name aliasedT))))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3))) members (|> ..random @@ -105,17 +97,25 @@ #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] (`` ($_ _.and - (~~ (template [ ] - [(_.test (format "Can build and tear-down " " types.") - (let [flat (|> members )] - (or (list\= members flat) - (and (list\= (list) members) - (list\= (list ) flat)))))] + (~~ (template [ ] + [(_.cover [ ] + (let [flat (|> members )] + (or (list\= members flat) + (and (list\= (list) members) + (list\= (list ) flat)))))] - ["variant" /.variant /.flatten_variant Nothing] - ["tuple" /.tuple /.flatten_tuple Any] + [/.variant /.flatten_variant Nothing] + [/.tuple /.flatten_tuple Any] )) ))) + (_.cover [/.apply] + (and (<| (maybe.default #0) + (do maybe.monad + [partial (/.apply (list Bit) Ann) + full (/.apply (list Int) partial)] + (wrap (\ /.equivalence = full (#.Product Bit Int))))) + (|> (/.apply (list Bit) Text) + (case> #.None #1 _ #0)))) (do {! random.monad} [size (|> random.nat (\ ! map (n.% 3))) members (monad.seq ! (list.repeat size ..random)) @@ -130,46 +130,75 @@ #let [(^open "/\.") /.equivalence (^open "list\.") (list.equivalence /.equivalence)]] ($_ _.and - (_.test "Can build and tear-down function types." - (let [[inputs output] (|> (/.function members extra) /.flatten_function)] - (and (list\= members inputs) - (/\= extra output)))) - - (_.test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] - (n.= (list.size members) (list.size tparams)))) + (_.cover [/.function /.flatten_function] + (let [[inputs output] (|> (/.function members extra) /.flatten_function)] + (and (list\= members inputs) + (/\= extra output)))) + (_.cover [/.application /.flatten_application] + (let [[tfunc tparams] (|> extra (/.application members) /.flatten_application)] + (n.= (list.size members) (list.size tparams)))) )) (do {! random.monad} - [size (|> random.nat (\ ! map (n.% 3))) - extra (|> ..random - (random.filter (function (_ type) - (case type - (^or (#.UnivQ _) (#.ExQ _)) - #0 + [size (|> random.nat (\ ! map (|>> (n.% 3) inc))) + body_type (|> ..random + (random.filter (function (_ type) + (case type + (^or (#.UnivQ _) (#.ExQ _)) + #0 - _ - #1)))) + _ + #1)))) #let [(^open "/\.") /.equivalence]] (`` ($_ _.and - (~~ (template [ ] - [(_.test (format "Can build and tear-down " " types.") - (let [[flat_size flat_body] (|> extra ( size) )] - (and (n.= size flat_size) - (/\= extra flat_body))))] + (~~ (template [ ] + [(_.cover [ ] + (let [[flat_size flat_body] (|> body_type ( size) )] + (and (n.= size flat_size) + (/\= body_type flat_body))))] - ["universally-quantified" /.univ_q /.flatten_univ_q] - ["existentially-quantified" /.ex_q /.flatten_ex_q] + [/.univ_q /.flatten_univ_q] + [/.ex_q /.flatten_ex_q] )) + (_.cover [/.quantified?] + (and (not (/.quantified? body_type)) + (|> body_type (/.univ_q size) /.quantified?) + (|> body_type (/.ex_q size) /.quantified?))) ))) - (_.test (%.name (name_of /.:by_example)) - (let [example (: (Maybe Nat) - #.None)] - (/\= (.type (List Nat)) - (/.:by_example [a] - (Maybe a) - example - - (List a))))) + (do {! random.monad} + [depth (|> random.nat (\ ! map (|>> (n.% 3) inc))) + element_type (|> ..random + (random.filter (function (_ type) + (case type + (^ (#.Primitive name (list element_type))) + (not (text\= array.type_name name)) + + _ + #1)))) + #let [(^open "/\.") /.equivalence]] + ($_ _.and + (_.cover [/.array /.flatten_array] + (let [[flat_depth flat_element] (|> element_type (/.array depth) /.flatten_array)] + (and (n.= depth flat_depth) + (/\= element_type flat_element)))) + (_.cover [/.array?] + (and (not (/.array? element_type)) + (/.array? (/.array depth element_type)))) + )) + (_.cover [/.:by_example] + (let [example (: (Maybe Nat) + #.None)] + (/\= (.type (List Nat)) + (/.:by_example [a] + (Maybe a) + example + + (List a))))) + (do {! random.monad} + [sample random.nat] + (_.cover [/.:log!] + (exec + (/.:log! sample) + true))) /abstract.test /check.test -- cgit v1.2.3