aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-06-24 22:31:02 -0400
committerEduardo Julian2020-06-24 22:31:02 -0400
commitaa42fde49c66d73f41b17d4939a9226671442a8a (patch)
treec54e023d5dfbc271a632567e608087060317c2d1 /stdlib/source/test
parentc3eab65e3f107f7acdc0c0354770f9b8fbd92c4f (diff)
Last bug fixes to get the new JVM compiler to fully process the standard library and its tests.
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux5
-rw-r--r--stdlib/source/test/lux/control/parser/analysis.lux3
-rw-r--r--stdlib/source/test/lux/control/region.lux13
-rw-r--r--stdlib/source/test/lux/extension.lux89
-rw-r--r--stdlib/source/test/lux/target/jvm.lux1034
5 files changed, 648 insertions, 496 deletions
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 6b382f6de..469ff4308 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -141,7 +141,10 @@
[_ (#.Some limit)]
(and (n.> 0 raw)
- (n.= raw (refinement.un-refine limit))))))
+ (n.= raw (refinement.un-refine limit)))
+
+ _
+ false)))
(do {@ random.monad}
[limit (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1))))
#let [barrier (/.barrier (maybe.assume (/.limit limit)))
diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux
index 397b2c779..1eb314b6e 100644
--- a/stdlib/source/test/lux/control/parser/analysis.lux
+++ b/stdlib/source/test/lux/control/parser/analysis.lux
@@ -23,7 +23,8 @@
["." random (#+ Random)]]
[tool
[compiler
- [reference (#+ Constant)]
+ [reference (#+ Constant)
+ [variable (#+)]]
[language
[lux
["." analysis]]]]]]
diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux
index d911c15d5..b65590437 100644
--- a/stdlib/source/test/lux/control/region.lux
+++ b/stdlib/source/test/lux/control/region.lux
@@ -2,6 +2,7 @@
[lux #*
["_" test (#+ Test)]
[abstract
+ [equivalence (#+ Equivalence)]
[functor (#+ Functor)]
[apply (#+ Apply)]
["." monad (#+ Monad do)]
@@ -55,8 +56,16 @@
(def: comparison
(Comparison (All [a] (All [! r] (Region r (Thread !) a))))
(function (_ == left right)
- (case [(:assume (thread.run (:assume (/.run thread.monad left))))
- (:assume (thread.run (:assume (/.run thread.monad right))))]
+ (case [(:share [a]
+ {(Equivalence a)
+ ==}
+ {(Try a)
+ (thread.run (:assume (/.run thread.monad left)))})
+ (:share [a]
+ {(Equivalence a)
+ ==}
+ {(Try a)
+ (thread.run (:assume (/.run thread.monad right)))})]
[(#try.Success left) (#try.Success right)]
(== left right)
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 5efd43701..702ea2272 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -8,10 +8,13 @@
["." try]
["<>" parser
["<c>" code]
- ["<a>" analysis]]]
+ ["<a>" analysis]
+ ["<s>" synthesis]]]
[data
["." text ("#@." equivalence)
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [collection
+ ["." row]]]
[tool
[compiler
["." phase]
@@ -32,37 +35,48 @@
(def: my-generation "my generation")
(def: my-directive "my directive")
+## Generation
(`` (for {(~~ (static @.old))
- (as-is)
-
- (~~ (static @.jvm))
- (as-is (generation: (..my-generation self phase {parameters (<>.some <a>.any)})
- (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))}
- (as-is (analysis: (..my-analysis self phase {parameters (<>.some <c>.any)})
+ (as-is)}
+
+ (as-is (analysis: (..my-generation self phase archive {parameters (<>.some <c>.any)})
(do phase.monad
[_ (type.infer .Text)]
- (wrap (#analysis.Text self))))
+ (wrap (#analysis.Extension self (list)))))
- ## Synthesis
- (analysis: (..my-synthesis self phase {parameters (<>.some <c>.any)})
+ (synthesis: (..my-generation self phase archive {parameters (<>.some <a>.any)})
+ (do phase.monad
+ []
+ (wrap (#synthesis.Extension self (list)))))
+ )))
+
+(`` (for {(~~ (static @.jvm))
+ (as-is (generation: (..my-generation self phase archive {parameters (<>.some <s>.any)})
+ (do phase.monad
+ []
+ (wrap (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))))))}))
+
+(`` (for {(~~ (static @.old))
+ (as-is)}
+
+ (as-is (analysis: (..my-analysis self phase archive {parameters (<>.some <c>.any)})
(do phase.monad
[_ (type.infer .Text)]
- (wrap (#analysis.Extension self (list)))))
+ (wrap (#analysis.Primitive (#analysis.Text self)))))
- (synthesis: (..my-synthesis self phase {parameters (<>.some <a>.any)})
- (wrap (synthesis.text self)))
-
- ## Generation
- (analysis: (..my-generation self phase {parameters (<>.some <c>.any)})
+ ## Synthesis
+ (analysis: (..my-synthesis self phase archive {parameters (<>.some <c>.any)})
(do phase.monad
[_ (type.infer .Text)]
(wrap (#analysis.Extension self (list)))))
- (synthesis: (..my-generation self phase {parameters (<>.some <a>.any)})
- (wrap (#synthesis.Extension self (list))))
-
+ (synthesis: (..my-synthesis self phase archive {parameters (<>.some <a>.any)})
+ (do phase.monad
+ []
+ (wrap (synthesis.text self))))
+
## Directive
- (directive: (..my-directive self phase {parameters (<>.some <c>.any)})
+ (directive: (..my-directive self phase archive {parameters (<>.some <c>.any)})
(do phase.monad
[#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]]
(wrap directive.no-requirements)))
@@ -72,21 +86,18 @@
(def: #export test
Test
- (<| (_.context (%.name (name-of /._)))
- ($_ _.and
- (_.test "Can define and use analysis extensions."
- (`` (for {(~~ (static @.old))
- false}
- (text@= ((~~ (static ..my-analysis)))
- ..my-analysis))))
- (_.test "Can define and use synthesis extensions."
- (`` (for {(~~ (static @.old))
- false}
- (text@= ((~~ (static ..my-synthesis)))
- ..my-synthesis))))
- (_.test "Can define and use generation extensions."
- (`` (for {(~~ (static @.old))
- false}
- (text@= ((~~ (static ..my-generation)))
- ..my-generation))))
- )))
+ (<| (_.covering /._)
+ (`` ($_ _.and
+ (~~ (template [<macro> <extension>]
+ [(_.cover [<macro>]
+ (`` (for {(~~ (static @.old))
+ false}
+ (text@= ((~~ (static <extension>)))
+ <extension>))))]
+
+ [/.analysis: ..my-analysis]
+ [/.synthesis: ..my-synthesis]
+ [/.generation: ..my-generation]))
+ (_.cover [/.directive:]
+ true)
+ ))))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 0ccd4c5e3..6abfdb92d 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- Type type primitive int)
["." host (#+ import:)]
+ ["@" target]
[abstract
["." monad (#+ do)]]
[control
@@ -138,12 +139,12 @@
(/type.class "java.lang.Boolean" (list)))
(def: $Boolean::wrap
(/.invokestatic ..$Boolean "valueOf" (/type.method [(list /type.boolean) ..$Boolean (list)])))
-(def: $Boolean::random (Random java/lang/Boolean) random.bit)
+(def: $Boolean::random (:coerce (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 value
+ (if (:coerce Bit value)
..!true
..!false))
(def: $Boolean::primitive
@@ -160,10 +161,10 @@
(/.invokestatic ..$Byte "valueOf" (/type.method [(list /type.byte) ..$Byte (list)])))
(def: $Byte::random
(Random java/lang/Byte)
- (:: random.monad map (|>> host.long-to-byte) random.int))
+ (:: random.monad map (|>> (:coerce java/lang/Long) host.long-to-byte) random.int))
(def: $Byte::literal
(-> java/lang/Byte (Bytecode Any))
- (|>> host.byte-to-long .i64 i32.i32 /.int))
+ (|>> host.byte-to-long (:coerce I64) i32.i32 /.int))
(def: $Byte::primitive
(Primitive java/lang/Byte)
{#unboxed /type.byte
@@ -178,10 +179,10 @@
(/.invokestatic ..$Short "valueOf" (/type.method [(list /type.short) ..$Short (list)])))
(def: $Short::random
(Random java/lang/Short)
- (:: random.monad map (|>> host.long-to-short) random.int))
+ (:: random.monad map (|>> (:coerce java/lang/Long) host.long-to-short) random.int))
(def: $Short::literal
(-> java/lang/Short (Bytecode Any))
- (|>> host.short-to-long .i64 i32.i32 /.int))
+ (|>> host.short-to-long (:coerce I64) i32.i32 /.int))
(def: $Short::primitive
(Primitive java/lang/Short)
{#unboxed /type.short
@@ -196,10 +197,10 @@
(/.invokestatic ..$Integer "valueOf" (/type.method [(list /type.int) ..$Integer (list)])))
(def: $Integer::random
(Random java/lang/Integer)
- (:: random.monad map (|>> host.long-to-int) random.int))
+ (:: random.monad map (|>> (:coerce java/lang/Long) host.long-to-int) random.int))
(def: $Integer::literal
(-> java/lang/Integer (Bytecode Any))
- (|>> host.int-to-long .i64 i32.i32 /.int))
+ (|>> host.int-to-long (:coerce I64) i32.i32 /.int))
(def: $Integer::primitive
(Primitive java/lang/Integer)
{#unboxed /type.int
@@ -210,8 +211,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 (Random java/lang/Long) random.int)
-(def: $Long::literal (-> java/lang/Long (Bytecode Any)) /.long)
+(def: $Long::random (:coerce (Random java/lang/Long) random.int))
+(def: $Long::literal (-> java/lang/Long (Bytecode Any)) (|>> (:coerce Int) /.long))
(def: $Long::primitive
(Primitive java/lang/Long)
{#unboxed /type.long
@@ -225,7 +226,7 @@
(def: $Float::random
(Random java/lang/Float)
(:: random.monad map
- (|>> (i.% +1024) i.frac host.double-to-float)
+ (|>> (i.% +1024) i.frac (:coerce java/lang/Double) host.double-to-float)
random.int))
(def: $Float::literal /.float)
(def: $Float::primitive
@@ -238,8 +239,10 @@
(def: $Double (/type.class "java.lang.Double" (list)))
(def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))
-(def: $Double::random random.frac)
-(def: $Double::literal /.double)
+(def: $Double::random (:coerce (Random java/lang/Double) random.frac))
+(def: $Double::literal
+ (-> java/lang/Double (Bytecode Any))
+ (|>> (:coerce Frac) /.double))
(def: $Double::primitive
(Primitive java/lang/Double)
{#unboxed /type.double
@@ -254,10 +257,10 @@
(/.invokestatic ..$Character "valueOf" (/type.method [(list /type.char) ..$Character (list)])))
(def: $Character::random
(Random java/lang/Character)
- (:: random.monad map (|>> host.long-to-int host.int-to-char) random.int))
+ (:: random.monad map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-char) random.int))
(def: $Character::literal
(-> java/lang/Character (Bytecode Any))
- (|>> host.char-to-long .i64 i32.i32 /.int))
+ (|>> host.char-to-long (:coerce I64) i32.i32 /.int))
(def: $Character::primitive
(Primitive java/lang/Character)
{#unboxed /type.char
@@ -266,9 +269,17 @@
#random ..$Character::random
#literal ..$Character::literal})
-(def: $String (/type.class "java.lang.String" (list)))
-(def: $String::random (random.ascii/alpha 10))
-(def: $String::literal /.string)
+(def: $String
+ (/type.class "java.lang.String" (list)))
+
+(def: $String::random
+ (:coerce (Random java/lang/String)
+ (random.ascii/alpha 10)))
+
+(def: $String::literal
+ (-> java/lang/String (Bytecode Any))
+ (|>> (:coerce Text) /.string))
+
(def: $String::primitive
(Primitive java/lang/String)
{#unboxed ..$String
@@ -277,34 +288,71 @@
#random ..$String::random
#literal ..$String::literal})
-(template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>]
- [(def: <name>
- Test
- (do {@ random.monad}
- [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)]
- (<| (_.lift <message>)
- (..bytecode (|>> (:coerce <type>) <to-long> ("jvm leq" expected)))
- (do /.monad
- [_ (<push> (|> expected <unsigned> try.assume))]
- <wrap>))))]
+(`` (with-expansions [<comparison> (for {(~~ (static @.old))
+ "jvm leq"
+ (~~ (static @.jvm))
+ "jvm long ="})]
+ (template [<name> <bits> <type> <push> <wrap> <message> <to-long> <unsigned>]
+ [(def: <name>
+ Test
+ (do {@ random.monad}
+ [expected (:: @ map (i64.and (i64.mask <bits>)) random.nat)]
+ (<| (_.lift <message>)
+ (..bytecode (for {(~~ (static @.old))
+ (|>> (:coerce <type>) <to-long> (<comparison> expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce <type>) <to-long> "jvm object cast" (<comparison> ("jvm object cast" (:coerce java/lang/Long expected))))}))
+ (do /.monad
+ [_ (<push> (|> expected <unsigned> try.assume))]
+ <wrap>))))]
+
+ [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1]
+ [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2]
+ )))
+
+(template [<name> <type>]
+ [(`` (template: (<name> <old-extension> <new-extension>)
+ (: (-> <type> <type> <type>)
+ (function (_ parameter subject)
+ (for {(~~ (static @.old))
+ (<old-extension> subject parameter)
+ (~~ (static @.jvm))
+ ("jvm object cast"
+ (<new-extension> ("jvm object cast" subject)
+ ("jvm object cast" parameter)))})))))]
- [byte 7 java/lang/Byte /.bipush ..$Byte::wrap "BIPUSH" host.byte-to-long /unsigned.u1]
- [short 15 java/lang/Short /.sipush ..$Short::wrap "SIPUSH" host.short-to-long /unsigned.u2]
+ [int/2 java/lang/Integer]
+ [long/2 java/lang/Long]
+ [float/2 java/lang/Float]
+ [double/2 java/lang/Double]
)
-(template: (int/2 <extension>)
- (: (-> java/lang/Integer java/lang/Integer java/lang/Integer)
- (function (_ parameter subject)
- (<extension> subject parameter))))
+(`` (template: (long+int/2 <old-extension> <new-extension>)
+ (: (-> java/lang/Integer java/lang/Long java/lang/Long)
+ (function (_ parameter subject)
+ (for {(~~ (static @.old))
+ (<old-extension> subject parameter)
+ (~~ (static @.jvm))
+ ("jvm object cast"
+ (<new-extension> ("jvm object cast" subject)
+ ("jvm object cast" parameter)))})))))
(def: int
Test
- (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
- (function (_ expected bytecode)
- (<| (..bytecode (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))
- (do /.monad
- [_ bytecode]
- ..$Integer::wrap))))
+ (let [int (`` (with-expansions [<comparison> (for {(~~ (static @.old))
+ "jvm ieq"
+ (~~ (static @.jvm))
+ "jvm int ="})]
+ (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
+ (function (_ expected bytecode)
+ (<| (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Integer) (<comparison> expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Integer) "jvm object cast"
+ (<comparison> ("jvm object cast" expected)))})))
+ (do /.monad
+ [_ bytecode]
+ ..$Integer::wrap))))))
unary (: (-> (-> java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit))
(function (_ reference instruction)
(do random.monad
@@ -328,7 +376,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 host.long-to-int) random.nat)
+ [parameter (:: @ map (|>> (n.% 32) .int (:coerce java/lang/Long) host.long-to-int) random.nat)
subject ..$Integer::random]
(int (reference parameter subject)
(do /.monad
@@ -336,33 +384,35 @@
_ (..$Integer::literal parameter)]
instruction)))))
literal ($_ _.and
- (_.lift "ICONST_M1" (int (host.long-to-int -1) /.iconst-m1))
- (_.lift "ICONST_0" (int (host.long-to-int +0) /.iconst-0))
- (_.lift "ICONST_1" (int (host.long-to-int +1) /.iconst-1))
- (_.lift "ICONST_2" (int (host.long-to-int +2) /.iconst-2))
- (_.lift "ICONST_3" (int (host.long-to-int +3) /.iconst-3))
- (_.lift "ICONST_4" (int (host.long-to-int +4) /.iconst-4))
- (_.lift "ICONST_5" (int (host.long-to-int +5) /.iconst-5))
+ (_.lift "ICONST_M1" (int (host.long-to-int (:coerce java/lang/Long -1)) /.iconst-m1))
+ (_.lift "ICONST_0" (int (host.long-to-int (:coerce java/lang/Long +0)) /.iconst-0))
+ (_.lift "ICONST_1" (int (host.long-to-int (:coerce java/lang/Long +1)) /.iconst-1))
+ (_.lift "ICONST_2" (int (host.long-to-int (:coerce java/lang/Long +2)) /.iconst-2))
+ (_.lift "ICONST_3" (int (host.long-to-int (:coerce java/lang/Long +3)) /.iconst-3))
+ (_.lift "ICONST_4" (int (host.long-to-int (:coerce java/lang/Long +4)) /.iconst-4))
+ (_.lift "ICONST_5" (int (host.long-to-int (:coerce java/lang/Long +5)) /.iconst-5))
(_.lift "LDC_W/INTEGER"
(do random.monad
[expected ..$Integer::random]
(int expected (..$Integer::literal expected)))))
arithmetic ($_ _.and
- (_.lift "IADD" (binary (int/2 "jvm iadd") /.iadd))
- (_.lift "ISUB" (binary (int/2 "jvm isub") /.isub))
- (_.lift "IMUL" (binary (int/2 "jvm imul") /.imul))
- (_.lift "IDIV" (binary (int/2 "jvm idiv") /.idiv))
- (_.lift "IREM" (binary (int/2 "jvm irem") /.irem))
+ (_.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") value (host.long-to-int +0)))
+ ((int/2 "jvm isub" "jvm int -")
+ value
+ (host.long-to-int (:coerce java/lang/Long +0))))
/.ineg)))
bitwise ($_ _.and
- (_.lift "IAND" (binary (int/2 "jvm iand") /.iand))
- (_.lift "IOR" (binary (int/2 "jvm ior") /.ior))
- (_.lift "IXOR" (binary (int/2 "jvm ixor") /.ixor))
- (_.lift "ISHL" (shift (int/2 "jvm ishl") /.ishl))
- (_.lift "ISHR" (shift (int/2 "jvm ishr") /.ishr))
- (_.lift "IUSHR" (shift (int/2 "jvm iushr") /.iushr)))]
+ (_.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)))]
($_ _.and
(<| (_.context "literal")
literal)
@@ -374,244 +424,291 @@
(def: long
Test
- (let [long (: (-> Int (Bytecode Any) (Random Bit))
- (function (_ expected bytecode)
- (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
- (do /.monad
- [_ bytecode]
- ..$Long::wrap))))
- unary (: (-> (-> Int Int) (Bytecode Any) (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [subject ..$Long::random]
- (long (reference subject)
- (do /.monad
- [_ (..$Long::literal subject)]
- instruction)))))
- binary (: (-> (-> Int Int Int) (Bytecode Any) (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [parameter ..$Long::random
- subject ..$Long::random]
- (long (reference parameter subject)
+ (`` (with-expansions [<comparison> (for {(~~ (static @.old))
+ "jvm leq"
+ (~~ (static @.jvm))
+ "jvm long ="})]
+ (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
+ (function (_ expected bytecode)
+ (<| (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce Int) (i.= expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Long) "jvm object cast" (<comparison> ("jvm object cast" expected)))})))
(do /.monad
- [_ (..$Long::literal subject)
- _ (..$Long::literal parameter)]
- instruction)))))
- shift (: (-> (-> Nat Int Int) (Bytecode Any) (Random Bit))
- (function (_ reference instruction)
- (do {@ random.monad}
- [parameter (:: @ map (n.% 64) random.nat)
- subject ..$Long::random]
- (long (reference parameter subject)
- (do /.monad
- [_ (..$Long::literal subject)
- _ (..$Integer::literal (host.long-to-int parameter))]
- instruction)))))
- literal ($_ _.and
- (_.lift "LCONST_0" (long +0 /.lconst-0))
- (_.lift "LCONST_1" (long +1 /.lconst-1))
- (_.lift "LDC2_W/LONG"
- (do random.monad
- [expected ..$Long::random]
- (long expected (..$Long::literal expected)))))
- arithmetic ($_ _.and
- (_.lift "LADD" (binary i.+ /.ladd))
- (_.lift "LSUB" (binary i.- /.lsub))
- (_.lift "LMUL" (binary i.* /.lmul))
- (_.lift "LDIV" (binary i./ /.ldiv))
- (_.lift "LREM" (binary i.% /.lrem))
- (_.lift "LNEG" (unary (function (_ value) (i.- value +0)) /.lneg)))
- bitwise ($_ _.and
- (_.lift "LAND" (binary i64.and /.land))
- (_.lift "LOR" (binary i64.or /.lor))
- (_.lift "LXOR" (binary i64.xor /.lxor))
- (_.lift "LSHL" (shift i64.left-shift /.lshl))
- (_.lift "LSHR" (shift i64.arithmetic-right-shift /.lshr))
- (_.lift "LUSHR" (shift i64.logic-right-shift /.lushr)))
- comparison (_.lift "LCMP"
- (do random.monad
- [reference ..$Long::random
- subject ..$Long::random
- #let [expected (cond (i.= reference subject)
- +0
-
- (i.> reference subject)
- +1
-
- ## (i.< reference subject)
- -1)]]
- (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+ [_ bytecode]
+ ..$Long::wrap))))
+ unary (: (-> (-> java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [subject ..$Long::random]
+ (long (reference subject)
+ (do /.monad
+ [_ (..$Long::literal subject)]
+ instruction)))))
+ binary (: (-> (-> java/lang/Long java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [parameter ..$Long::random
+ subject ..$Long::random]
+ (long (reference parameter subject)
+ (do /.monad
+ [_ (..$Long::literal subject)
+ _ (..$Long::literal parameter)]
+ instruction)))))
+ 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)
+ subject ..$Long::random]
+ (long (reference (host.long-to-int parameter) subject)
(do /.monad
[_ (..$Long::literal subject)
- _ (..$Long::literal reference)
- _ /.lcmp
- _ /.i2l]
- ..$Long::wrap))))]
- ($_ _.and
- (<| (_.context "literal")
- literal)
- (<| (_.context "arithmetic")
- arithmetic)
- (<| (_.context "bitwise")
- bitwise)
- (<| (_.context "comparison")
- comparison)
- )))
+ _ (..$Integer::literal (host.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 "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
+ (:coerce 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 (long+int/2 "jvm lshl" "jvm long shl") /.lshl))
+ (_.lift "LSHR" (shift (long+int/2 "jvm lshr" "jvm long shr") /.lshr))
+ (_.lift "LUSHR" (shift (long+int/2 "jvm lushr" "jvm long ushr") /.lushr)))
+ comparison (_.lift "LCMP"
+ (do random.monad
+ [reference ..$Long::random
+ subject ..$Long::random
+ #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject))
+ (:coerce java/lang/Long +0)
+
+ (i.> (:coerce Int reference) (:coerce Int subject))
+ (:coerce java/lang/Long +1)
-(template: (float/2 <extension>)
- (: (-> java/lang/Float java/lang/Float java/lang/Float)
- (function (_ parameter subject)
- (<extension> subject parameter))))
+ ## (i.< (:coerce Int reference) (:coerce Int subject))
+ (:coerce java/lang/Long -1))]]
+ (<| (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce Int) (i.= expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Long) "jvm object cast" (<comparison> ("jvm object cast" expected)))})))
+ (do /.monad
+ [_ (..$Long::literal subject)
+ _ (..$Long::literal reference)
+ _ /.lcmp
+ _ /.i2l]
+ ..$Long::wrap))))]
+ ($_ _.and
+ (<| (_.context "literal")
+ literal)
+ (<| (_.context "arithmetic")
+ arithmetic)
+ (<| (_.context "bitwise")
+ bitwise)
+ (<| (_.context "comparison")
+ comparison)
+ )))))
(def: float
Test
- (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
- (function (_ expected bytecode)
- (<| (..bytecode (|>> (:coerce java/lang/Float) ("jvm feq" expected)))
- (do /.monad
- [_ bytecode]
- ..$Float::wrap))))
- unary (: (-> (-> java/lang/Float java/lang/Float)
- (Bytecode Any)
- (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [subject ..$Float::random]
- (float (reference subject)
- (do /.monad
- [_ (..$Float::literal subject)]
- instruction)))))
- binary (: (-> (-> java/lang/Float java/lang/Float java/lang/Float)
- (Bytecode Any)
- (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [parameter ..$Float::random
- subject ..$Float::random]
- (float (reference parameter subject)
+ (`` (with-expansions [<comparison> (for {(~~ (static @.old))
+ "jvm feq"
+ (~~ (static @.jvm))
+ "jvm float ="})]
+ (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
+ (function (_ expected bytecode)
+ (<| (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Float) ("jvm feq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Float) "jvm object cast" (<comparison> ("jvm object cast" expected)))})))
(do /.monad
- [_ (..$Float::literal subject)
- _ (..$Float::literal parameter)]
- instruction)))))
- literal ($_ _.and
- (_.lift "FCONST_0" (float (host.double-to-float +0.0) /.fconst-0))
- (_.lift "FCONST_1" (float (host.double-to-float +1.0) /.fconst-1))
- (_.lift "FCONST_2" (float (host.double-to-float +2.0) /.fconst-2))
- (_.lift "LDC_W/FLOAT"
- (do random.monad
- [expected ..$Float::random]
- (float expected (..$Float::literal expected)))))
- arithmetic ($_ _.and
- (_.lift "FADD" (binary (float/2 "jvm fadd") /.fadd))
- (_.lift "FSUB" (binary (float/2 "jvm fsub") /.fsub))
- (_.lift "FMUL" (binary (float/2 "jvm fmul") /.fmul))
- (_.lift "FDIV" (binary (float/2 "jvm fdiv") /.fdiv))
- (_.lift "FREM" (binary (float/2 "jvm frem") /.frem))
- (_.lift "FNEG" (unary (function (_ value)
- ((float/2 "jvm fsub") value (host.double-to-float +0.0)))
- /.fneg)))
- comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit))
- (function (_ instruction standard)
- (do random.monad
- [reference ..$Float::random
- subject ..$Float::random
- #let [expected (if ("jvm feq" reference subject)
- +0
- (if (standard reference subject)
- +1
- -1))]]
- (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
- (do /.monad
- [_ (..$Float::literal subject)
- _ (..$Float::literal reference)
- _ instruction
- _ /.i2l]
- ..$Long::wrap)))))
- comparison ($_ _.and
- (_.lift "FCMPL" (comparison /.fcmpl (function (_ reference subject)
- ("jvm fgt" subject reference))))
- (_.lift "FCMPG" (comparison /.fcmpg (function (_ reference subject)
- ("jvm fgt" subject reference)))))]
- ($_ _.and
- (<| (_.context "literal")
- literal)
- (<| (_.context "arithmetic")
- arithmetic)
- (<| (_.context "comparison")
- comparison)
- )))
+ [_ bytecode]
+ ..$Float::wrap))))
+ unary (: (-> (-> java/lang/Float java/lang/Float)
+ (Bytecode Any)
+ (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [subject ..$Float::random]
+ (float (reference subject)
+ (do /.monad
+ [_ (..$Float::literal subject)]
+ instruction)))))
+ binary (: (-> (-> java/lang/Float java/lang/Float java/lang/Float)
+ (Bytecode Any)
+ (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [parameter ..$Float::random
+ subject ..$Float::random]
+ (float (reference parameter subject)
+ (do /.monad
+ [_ (..$Float::literal subject)
+ _ (..$Float::literal parameter)]
+ instruction)))))
+ literal ($_ _.and
+ (_.lift "FCONST_0" (float (host.double-to-float (:coerce java/lang/Double +0.0)) /.fconst-0))
+ (_.lift "FCONST_1" (float (host.double-to-float (:coerce java/lang/Double +1.0)) /.fconst-1))
+ (_.lift "FCONST_2" (float (host.double-to-float (:coerce java/lang/Double +2.0)) /.fconst-2))
+ (_.lift "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
+ (host.double-to-float (:coerce java/lang/Double +0.0))))
+ /.fneg)))
+ comparison (: (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit))
+ (function (_ instruction standard)
+ (do random.monad
+ [reference ..$Float::random
+ subject ..$Float::random
+ #let [expected (if (`` (for {(~~ (static @.old))
+ ("jvm feq" reference subject)
+ (~~ (static @.jvm))
+ (<comparison> ("jvm object cast" reference) ("jvm object cast" subject))}))
+ +0
+ (if (standard reference subject)
+ +1
+ -1))]]
+ (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+ (do /.monad
+ [_ (..$Float::literal subject)
+ _ (..$Float::literal reference)
+ _ instruction
+ _ /.i2l]
+ ..$Long::wrap)))))
+ comparison ($_ _.and
+ (_.lift "FCMPL" (comparison /.fcmpl (function (_ reference subject)
+ (`` (for {(~~ (static @.old))
+ ("jvm fgt" subject reference)
+ (~~ (static @.jvm))
+ ("jvm float <" ("jvm object cast" reference) ("jvm object cast" subject))})))))
+ (_.lift "FCMPG" (comparison /.fcmpg (function (_ reference subject)
+ (`` (for {(~~ (static @.old))
+ ("jvm fgt" subject reference)
+ (~~ (static @.jvm))
+ ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))}))))))]
+ ($_ _.and
+ (<| (_.context "literal")
+ literal)
+ (<| (_.context "arithmetic")
+ arithmetic)
+ (<| (_.context "comparison")
+ comparison)
+ )))))
(def: double
Test
- (let [double (: (-> Frac (Bytecode Any) (Random Bit))
- (function (_ expected bytecode)
- (<| (..bytecode (|>> (:coerce Frac) (f.= expected)))
- (do /.monad
- [_ bytecode]
- ..$Double::wrap))))
- unary (: (-> (-> Frac Frac) (Bytecode Any) (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [subject ..$Double::random]
- (double (reference subject)
- (do /.monad
- [_ (..$Double::literal subject)]
- instruction)))))
- binary (: (-> (-> Frac Frac Frac) (Bytecode Any) (Random Bit))
- (function (_ reference instruction)
- (do random.monad
- [parameter ..$Double::random
- subject ..$Double::random]
- (double (reference parameter subject)
- (do /.monad
- [_ (..$Double::literal subject)
- _ (..$Double::literal parameter)]
- instruction)))))
- literal ($_ _.and
- (_.lift "DCONST_0" (double +0.0 /.dconst-0))
- (_.lift "DCONST_1" (double +1.0 /.dconst-1))
- (_.lift "LDC2_W/DOUBLE"
- (do random.monad
- [expected ..$Double::random]
- (double expected (..$Double::literal expected)))))
- arithmetic ($_ _.and
- (_.lift "DADD" (binary f.+ /.dadd))
- (_.lift "DSUB" (binary f.- /.dsub))
- (_.lift "DMUL" (binary f.* /.dmul))
- (_.lift "DDIV" (binary f./ /.ddiv))
- (_.lift "DREM" (binary f.% /.drem))
- (_.lift "DNEG" (unary (function (_ value) (f.- value +0.0)) /.dneg)))
- comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit))
- (function (_ instruction standard)
- (do random.monad
- [reference ..$Double::random
- subject ..$Double::random
- #let [expected (if ("jvm deq" reference subject)
- +0
- (if (standard reference subject)
- +1
- -1))]]
- (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+ (`` (with-expansions [<comparison> (for {(~~ (static @.old))
+ "jvm deq"
+ (~~ (static @.jvm))
+ "jvm double ="})]
+ (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
+ (function (_ expected bytecode)
+ (<| (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Double) ("jvm deq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Double) "jvm object cast" (<comparison> ("jvm object cast" expected)))})))
(do /.monad
- [_ (..$Double::literal subject)
- _ (..$Double::literal reference)
- _ instruction
- _ /.i2l]
- ..$Long::wrap)))))
- comparison ($_ _.and
- (_.lift "DCMPL" (comparison /.dcmpl (function (_ reference subject)
- ("jvm dgt" subject reference))))
- (_.lift "DCMPG" (comparison /.dcmpg (function (_ reference subject)
- ("jvm dgt" subject reference)))))]
- ($_ _.and
- (<| (_.context "literal")
- literal)
- (<| (_.context "arithmetic")
- arithmetic)
- (<| (_.context "comparison")
- comparison)
- )))
+ [_ bytecode]
+ ..$Double::wrap))))
+ unary (: (-> (-> java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [subject ..$Double::random]
+ (double (reference subject)
+ (do /.monad
+ [_ (..$Double::literal subject)]
+ instruction)))))
+ binary (: (-> (-> java/lang/Double java/lang/Double java/lang/Double) (Bytecode Any) (Random Bit))
+ (function (_ reference instruction)
+ (do random.monad
+ [parameter ..$Double::random
+ subject ..$Double::random]
+ (double (reference parameter subject)
+ (do /.monad
+ [_ (..$Double::literal subject)
+ _ (..$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 "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
+ (:coerce java/lang/Double +0.0)))
+ /.dneg)))
+ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit))
+ (function (_ instruction standard)
+ (do random.monad
+ [reference ..$Double::random
+ subject ..$Double::random
+ #let [expected (if (`` (for {(~~ (static @.old))
+ ("jvm deq" reference subject)
+ (~~ (static @.jvm))
+ (<comparison> ("jvm object cast" reference) ("jvm object cast" subject))}))
+ +0
+ (if (standard reference subject)
+ +1
+ -1))]]
+ (<| (..bytecode (|>> (:coerce Int) (i.= expected)))
+ (do /.monad
+ [_ (..$Double::literal subject)
+ _ (..$Double::literal reference)
+ _ instruction
+ _ /.i2l]
+ ..$Long::wrap)))))
+ comparison ($_ _.and
+ (_.lift "DCMPL" (comparison /.dcmpl (function (_ reference subject)
+ (`` (for {(~~ (static @.old))
+ ("jvm dlt" subject reference)
+ (~~ (static @.jvm))
+ ("jvm double <" ("jvm object cast" reference) ("jvm object cast" subject))})))))
+ (_.lift "DCMPG" (comparison /.dcmpg (function (_ reference subject)
+ (`` (for {(~~ (static @.old))
+ ("jvm dgt" subject reference)
+ (~~ (static @.jvm))
+ ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))}))))))]
+ ($_ _.and
+ (<| (_.context "literal")
+ literal)
+ (<| (_.context "arithmetic")
+ arithmetic)
+ (<| (_.context "comparison")
+ comparison)
+ )))))
(def: primitive
Test
@@ -649,7 +746,7 @@
[value ..$String::random])
(..bytecode (|>> (:coerce Bit)))
(do /.monad
- [_ (/.string value)
+ [_ (/.string (:coerce Text value))
_ (/.instanceof ..$String)]
..$Boolean::wrap))
(<| (_.lift "NEW & CHECKCAST")
@@ -664,7 +761,7 @@
[value ..$String::random])
(..bytecode (|>> (:coerce Bit)))
(do /.monad
- [_ (/.string value)
+ [_ (/.string (:coerce Text value))
_ /.dup _ /.monitorenter
_ /.dup _ /.monitorexit
_ (/.instanceof ..$String)]
@@ -677,35 +774,40 @@
(<| (_.lift "INVOKESTATIC")
(do random.monad
[expected ..$Double::random])
- (..bytecode (|>> (:coerce java/lang/Double) ("jvm deq" expected)))
+ (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Double) ("jvm deq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})))
(do /.monad
- [_ (/.double expected)]
+ [_ (/.double (:coerce Frac expected))]
(/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))))
(<| (_.lift "INVOKEVIRTUAL")
(do random.monad
[expected ..$Double::random])
- (..bytecode (|>> (:coerce java/lang/Boolean) (bit@= (f.not-a-number? expected))))
+ (..bytecode (|>> (:coerce Bit) (bit@= (f.not-a-number? (:coerce Frac expected)))))
(do /.monad
- [_ (/.double expected)
+ [_ (/.double (:coerce Frac expected))
_ ..$Double::wrap
_ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) /type.boolean (list)]))]
..$Boolean::wrap))
(<| (_.lift "INVOKESPECIAL")
(do random.monad
[expected ..$Double::random])
- (..bytecode (|>> (:coerce java/lang/Double) ("jvm deq" expected)))
+ (..bytecode (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Double) ("jvm deq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected)))})))
(do /.monad
[_ (/.new ..$Double)
_ /.dup
- _ (/.double expected)]
+ _ (/.double (:coerce Frac expected))]
(/.invokespecial ..$Double "<init>" (/type.method [(list /type.double) /type.void (list)]))))
(<| (_.lift "INVOKEINTERFACE")
(do random.monad
[subject ..$String::random])
- (..bytecode (|>> (:coerce java/lang/Long)
- ("jvm leq" (text.size subject))))
+ (..bytecode (|>> (:coerce Nat) (n.= (text.size (:coerce Text subject)))))
(do /.monad
- [_ (/.string subject)
+ [_ (/.string (:coerce Text subject))
_ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)]))
_ /.i2l]
..$Long::wrap))
@@ -717,7 +819,12 @@
[class-name ..class-name
part0 ..$Long::random
part1 ..$Long::random
- #let [expected (i.+ part0 part1)
+ #let [expected (: java/lang/Long
+ (`` (for {(~~ (static @.old))
+ ("jvm ladd" part0 part1)
+ (~~ (static @.jvm))
+ ("jvm object cast"
+ ("jvm long +" ("jvm object cast" part0) ("jvm object cast" part1)))})))
$Self (/type.class class-name (list))
class-field "class_field"
object-field "object_field"
@@ -771,8 +878,8 @@
output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)]
(wrap (:coerce Int output)))
(#try.Success actual)
- (i.= expected actual)
-
+ (i.= (:coerce Int expected) (:coerce Int actual))
+
(#try.Failure error)
false))))
@@ -781,7 +888,7 @@
(let [!length (: (-> Nat (Bytecode Any))
(function (_ size)
(do /.monad
- [_ ($Long::literal (.int size))]
+ [_ ($Long::literal (:coerce java/lang/Long size))]
/.l2i)))
?length (: (Bytecode Any)
(do /.monad
@@ -802,7 +909,7 @@
(-> a Any Bit)
(Random Bit)))
(function (_ size constructor value literal [*store *load *wrap] test)
- (let [!index ($Integer::literal (host.long-to-int +0))]
+ (let [!index ($Integer::literal (host.long-to-int (:coerce java/lang/Long +0)))]
(<| (..bytecode (test value))
(do /.monad
[_ (!length size)
@@ -827,31 +934,59 @@
($_ _.and
(_.context "boolean"
(array (/.newarray /instruction.t-boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap]
- (function (_ expected) (|>> (:coerce Bit) (bit@= expected)))))
+ (function (_ expected) (|>> (:coerce Bit) (bit@= (:coerce Bit expected))))))
(_.context "byte"
(array (/.newarray /instruction.t-byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected))))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected)))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Byte) host.byte-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte-to-long (:coerce java/lang/Byte expected)))))})))))
(_.context "short"
(array (/.newarray /instruction.t-short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected))))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected)))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Short) host.short-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short-to-long (:coerce java/lang/Short expected)))))})))))
(_.context "int"
(array (/.newarray /instruction.t-int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Integer) ("jvm ieq" (host.int-to-long expected)))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (:coerce java/lang/Integer expected))))})))))
(_.context "long"
(array (/.newarray /instruction.t-long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Long) ("jvm leq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})))))
(_.context "float"
(array (/.newarray /instruction.t-float) $Float::random $Float::literal [/.fastore /.faload $Float::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Float) ("jvm feq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))})))))
(_.context "double"
(array (/.newarray /instruction.t-double) $Double::random $Double::literal [/.dastore /.daload $Double::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Double) ("jvm deq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (:coerce java/lang/Double expected))))})))))
(_.context "char"
(array (/.newarray /instruction.t-char) $Character::random $Character::literal [/.castore /.caload $Character::wrap]
- (function (_ expected) (|>> (:coerce java/lang/Character) ("jvm ceq" expected)))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Character) ("jvm ceq" expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (:coerce java/lang/Character expected))))})))))
(_.context "object"
(array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop]
- (function (_ expected) (|>> (:coerce Text) (text@= expected)))))
+ (function (_ expected) (|>> (:coerce Text) (text@= (:coerce Text expected))))))
(<| (_.context "multi")
(do {@ random.monad}
[#let [size (:: @ map (|>> (n.% 10) (n.+ 1))
@@ -866,15 +1001,23 @@
0 type
_ (recur (dec dimensions) (/type.array type))))]]
(<| (_.lift "MULTIANEWARRAY")
- (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" (.int sizesH))))
+ (..bytecode (|>> (:coerce Nat) (n.= sizesH)))
(do {@ /.monad}
- [_ (monad.map @ (|>> host.long-to-int ..$Integer::literal)
+ [_ (monad.map @ (|>> (:coerce java/lang/Long) host.long-to-int ..$Integer::literal)
(#.Cons sizesH sizesT))
_ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume))
_ ?length]
$Long::wrap))))
)))
+(template: (!::= <type> <old> <new>)
+ (: (-> <type> Any Bit)
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce <type>) (<old> expected))
+ (~~ (static @.jvm))
+ (|>> (:coerce <type>) "jvm object cast" (<new> ("jvm object cast" (:coerce <type> expected))))})))))
+
(def: conversion
Test
(let [conversion (: (All [a z]
@@ -887,46 +1030,46 @@
(do /.monad
[_ ((get@ #literal from) input)
_ instruction]
- (get@ #wrap to))))))]
+ (get@ #wrap to))))))
+ int::= (!::= java/lang/Integer "jvm ieq" "jvm int =")
+ long::= (!::= java/lang/Long "jvm leq" "jvm long =")
+ float::= (!::= java/lang/Float "jvm feq" "jvm float =")
+ double::= (!::= java/lang/Double "jvm deq" "jvm double =")]
($_ _.and
(<| (_.context "int")
($_ _.and
- (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> host.int-to-long)
- (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
- (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> host.int-to-float)
- (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))
- (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> host.int-to-double)
- (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))
+ (_.lift "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> host.int-to-long) long::=))
+ (_.lift "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> host.int-to-float) float::=))
+ (_.lift "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> host.int-to-double) double::=))
(_.lift "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> host.int-to-byte)
- (function (_ expected) (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected))))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Byte) host.byte-to-long ("jvm leq" (host.byte-to-long expected)))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Byte) host.byte-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.byte-to-long (:coerce java/lang/Byte expected)))))})))))
(_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> host.int-to-char)
- (function (_ expected) (|>> (:coerce java/lang/Character) ("jvm ceq" expected)))))
+ (!::= java/lang/Character "jvm ceq" "jvm char =")))
(_.lift "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> host.int-to-short)
- (function (_ expected) (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected))))))))
+ (function (_ expected)
+ (`` (for {(~~ (static @.old))
+ (|>> (:coerce java/lang/Short) host.short-to-long ("jvm leq" (host.short-to-long expected)))
+ (~~ (static @.jvm))
+ (|>> (:coerce java/lang/Short) host.short-to-long "jvm object cast" ("jvm long =" ("jvm object cast" (host.short-to-long (:coerce java/lang/Short expected)))))})))))))
(<| (_.context "long")
($_ _.and
- (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> host.long-to-int)
- (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
- (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> host.long-to-float)
- (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))
- (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> host.long-to-double)
- (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))))
+ (_.lift "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> host.long-to-int) int::=))
+ (_.lift "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> host.long-to-float) float::=))
+ (_.lift "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> host.long-to-double) double::=))))
(<| (_.context "float")
($_ _.and
- (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> host.float-to-int)
- (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
- (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> host.float-to-long)
- (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
- (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> host.float-to-double)
- (function (_ expected) (|>> (:coerce java/lang/Double) ("jvm deq" expected)))))))
+ (_.lift "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> host.float-to-int) int::=))
+ (_.lift "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> host.float-to-long) long::=))
+ (_.lift "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> host.float-to-double) double::=))))
(<| (_.context "double")
($_ _.and
- (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> host.double-to-int)
- (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" expected)))))
- (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> host.double-to-long)
- (function (_ expected) (|>> (:coerce java/lang/Long) ("jvm leq" expected)))))
- (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> host.double-to-float)
- (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" expected)))))))
+ (_.lift "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> host.double-to-int) int::=))
+ (_.lift "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> host.double-to-long) long::=))
+ (_.lift "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> host.double-to-float) float::=))))
)))
(def: value
@@ -948,27 +1091,7 @@
(def: registry
Test
- (let [add-registers (: (All [a]
- (-> (Random a) (-> a (Bytecode Any)) (Bytecode Any) (Bytecode Any)
- (-> a a (-> Any Bit))
- [(Bytecode Any) (Bytecode Any)]
- [(Bytecode Any) (Bytecode Any)]
- (Random Bit)))
- (function (_ random-value literal *add *wrap test [!parameter ?parameter] [!subject ?subject])
- (do random.monad
- [subject random-value
- parameter random-value]
- (<| (..bytecode (test parameter subject))
- (do /.monad
- [_ (literal subject)
- _ !subject
- _ (literal parameter)
- _ !parameter
- _ ?subject
- _ ?parameter
- _ *add]
- *wrap)))))
- store-and-load (: (All [a]
+ (let [store-and-load (: (All [a]
(-> (Random a) (-> a (Bytecode Any)) (Bytecode Any)
[(-> Nat (Bytecode Any)) (-> Nat (Bytecode Any))]
(-> a (-> Any Bit))
@@ -985,28 +1108,34 @@
*wrap)))))]
($_ _.and
(<| (_.context "int")
- (let [test-int (: (-> java/lang/Integer java/lang/Integer (-> Any Bit))
- (function (_ parameter subject)
- (|>> (:coerce java/lang/Integer) ("jvm ieq" ("jvm iadd" parameter subject)))))
- add-int-registers (add-registers ..$Integer::random ..$Integer::literal /.iadd ..$Integer::wrap test-int)]
+ (let [test (!::= java/lang/Integer "jvm ieq" "jvm int =")]
($_ _.and
- (_.lift "ISTORE_0/ILOAD_0 & ISTORE_2/ILOAD_2"
- (add-int-registers [/.istore-2 /.iload-2] [/.istore-0 /.iload-0]))
- (_.lift "ISTORE_1/ILOAD_1 & ISTORE_3/ILOAD_3"
- (add-int-registers [/.istore-3 /.iload-3] [/.istore-1 /.iload-1]))
+ (_.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]
- (function (_ expected actual)
- (|> actual (:coerce java/lang/Integer) ("jvm ieq" expected)))))
+ (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.assume)
random.nat)
- #let [expected ("jvm ladd"
- (host.byte-to-long base)
- (.int (/unsigned.value increment)))]]
- (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected))
+ #let [expected (: java/lang/Long
+ (`` (for {(~~ (static @.old))
+ ("jvm ladd"
+ (host.byte-to-long base)
+ (.int (/unsigned.value increment)))
+ (~~ (static @.jvm))
+ ("jvm object cast"
+ ("jvm long +"
+ ("jvm object cast" (host.byte-to-long base))
+ ("jvm object cast" (:coerce java/lang/Long (/unsigned.value increment)))))})))]]
+ (..bytecode (|>> (:coerce Int) (i.= (:coerce Int expected)))
(do /.monad
[_ (..$Byte::literal base)
_ /.istore-0
@@ -1015,89 +1144,84 @@
_ /.i2l]
..$Long::wrap)))))))
(<| (_.context "long")
- (let [test-long (: (-> Int Int (-> Any Bit))
- (function (_ parameter subject)
- (|>> (:coerce Int) (i.= (i.+ parameter subject)))))
- add-long-registers (add-registers ..$Long::random ..$Long::literal /.ladd ..$Long::wrap test-long)]
+ (let [test (!::= java/lang/Long "jvm leq" "jvm long =")]
($_ _.and
- (_.lift "LSTORE_0/LLOAD_0 & LSTORE_2/LLOAD_2"
- (add-long-registers [/.lstore-2 /.lload-2] [/.lstore-0 /.lload-0]))
- (_.lift "LSTORE_1/LLOAD_1 & LSTORE_3/LLOAD_3"
- (add-long-registers [/.lstore-3 /.lload-3] [/.lstore-1 /.lload-1]))
+ (_.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]
- (function (_ expected actual)
- (|> actual (:coerce java/lang/Long) ("jvm leq" expected))))))))
+ (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test)))))
(<| (_.context "float")
- (let [test-float (: (-> java/lang/Float java/lang/Float (-> Any Bit))
- (function (_ parameter subject)
- (|>> (:coerce java/lang/Float) ("jvm feq" ("jvm fadd" parameter subject)))))
- add-float-registers (add-registers ..$Float::random ..$Float::literal /.fadd ..$Float::wrap test-float)]
+ (let [test (!::= java/lang/Float "jvm feq" "jvm float =")]
($_ _.and
- (_.lift "FSTORE_0/FLOAD_0 & FSTORE_2/FLOAD_2"
- (add-float-registers [/.fstore-2 /.fload-2] [/.fstore-0 /.fload-0]))
- (_.lift "FSTORE_1/FLOAD_1 & FSTORE_3/FLOAD_3"
- (add-float-registers [/.fstore-3 /.fload-3] [/.fstore-1 /.fload-1]))
+ (_.lift "FSTORE_0/FLOAD_0"
+ (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test))
+ (_.lift "FSTORE_1/FLOAD_1"
+ (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test))
+ (_.lift "FSTORE_2/FLOAD_2"
+ (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test))
+ (_.lift "FSTORE_3/FLOAD_3"
+ (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test))
(_.lift "FSTORE/FLOAD"
- (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload]
- (function (_ expected actual)
- (|> actual (:coerce java/lang/Float) ("jvm feq" expected))))))))
+ (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload] test)))))
(<| (_.context "double")
- (let [test-double (: (-> Frac Frac (-> Any Bit))
- (function (_ parameter subject)
- (|>> (:coerce Frac) (f.= (f.+ parameter subject)))))
- add-double-registers (add-registers ..$Double::random ..$Double::literal /.dadd ..$Double::wrap test-double)]
+ (let [test (!::= java/lang/Double "jvm deq" "jvm double =")]
($_ _.and
- (_.lift "DSTORE_0/DLOAD_0 & DSTORE_2/DLOAD_2"
- (add-double-registers [/.dstore-2 /.dload-2] [/.dstore-0 /.dload-0]))
- (_.lift "DSTORE_1/DLOAD_1 & DSTORE_3/DLOAD_3"
- (add-double-registers [/.dstore-3 /.dload-3] [/.dstore-1 /.dload-1]))
+ (_.lift "DSTORE_0/DLOAD_0"
+ (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-0) (function.constant /.dload-0)] test))
+ (_.lift "DSTORE_1/DLOAD_1"
+ (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-1) (function.constant /.dload-1)] test))
+ (_.lift "DSTORE_2/DLOAD_2"
+ (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-2) (function.constant /.dload-2)] test))
+ (_.lift "DSTORE_3/DLOAD_3"
+ (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [(function.constant /.dstore-3) (function.constant /.dload-3)] test))
(_.lift "DSTORE/DLOAD"
- (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [/.dstore /.dload]
- (function (_ expected actual)
- (|> actual (:coerce java/lang/Double) ("jvm deq" expected))))))))
+ (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [/.dstore /.dload] test)))))
(<| (_.context "object")
- (let [test (function (_ expected actual)
- (|> actual (:coerce Text) (text@= expected)))]
+ (let [test (: (-> java/lang/String Any Bit)
+ (function (_ expected actual)
+ (|> actual (:coerce Text) (text@= (:coerce 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))
+ (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))
+ (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))
+ (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))
+ (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)))))
+ (store-and-load ..$String::random ..$String::literal /.nop [/.astore /.aload] test)))))
)))
(def: stack
Test
(do random.monad
[expected/1 $String::random
+ #let [object-test (: (-> Any Bit)
+ (|>> (:coerce Text) (text@= (:coerce Text expected/1))))]
dummy/1 $String::random
#let [single ($_ _.and
(<| (_.lift "DUP & POP")
- (..bytecode (|>> (:coerce Text) (text@= expected/1)))
+ (..bytecode object-test)
(do /.monad
[_ ($String::literal expected/1)
_ /.dup]
/.pop))
(<| (_.lift "DUP_X1 & POP2")
- (..bytecode (|>> (:coerce Text) (text@= expected/1)))
+ (..bytecode object-test)
(do /.monad
[_ ($String::literal dummy/1)
_ ($String::literal expected/1)
_ /.dup-x1]
/.pop2))
(<| (_.lift "DUP_X2")
- (..bytecode (|>> (:coerce Text) (text@= expected/1)))
+ (..bytecode object-test)
(do /.monad
[_ ($String::literal dummy/1)
_ ($String::literal dummy/1)
@@ -1106,7 +1230,7 @@
_ /.pop2]
/.pop))
(<| (_.lift "SWAP")
- (..bytecode (|>> (:coerce Text) (text@= expected/1)))
+ (..bytecode object-test)
(do /.monad
[_ ($String::literal dummy/1)
_ ($String::literal expected/1)
@@ -1114,17 +1238,19 @@
/.pop))
)]
expected/2 $Long::random
+ #let [long-test (: (-> Any Bit)
+ (|>> (:coerce Int) (i.= (:coerce Int expected/2))))]
dummy/2 $Long::random
#let [double ($_ _.and
(<| (_.lift "DUP2")
- (..bytecode (|>> (:coerce Int) (i.= expected/2)))
+ (..bytecode long-test)
(do /.monad
[_ ($Long::literal expected/2)
_ /.dup2
_ /.pop2]
..$Long::wrap))
(<| (_.lift "DUP2_X1")
- (..bytecode (|>> (:coerce Int) (i.= expected/2)))
+ (..bytecode long-test)
(do /.monad
[_ ($String::literal dummy/1)
_ ($Long::literal expected/2)
@@ -1133,7 +1259,7 @@
_ /.pop]
..$Long::wrap))
(<| (_.lift "DUP2_X2")
- (..bytecode (|>> (:coerce Int) (i.= expected/2)))
+ (..bytecode long-test)
(do /.monad
[_ ($Long::literal dummy/2)
_ ($Long::literal expected/2)
@@ -1206,16 +1332,16 @@
(java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method))
(#try.Success actual)
(test expected actual)
-
+
(#try.Failure error)
false)
))))]
($_ _.and
- (_.lift "IRETURN" (primitive-return ..$Integer::primitive /.ireturn #.None (function (_ expected actual) ("jvm ieq" expected (:coerce java/lang/Integer actual)))))
- (_.lift "LRETURN" (primitive-return ..$Long::primitive /.lreturn #.None (function (_ expected actual) ("jvm leq" expected (:coerce java/lang/Long actual)))))
- (_.lift "FRETURN" (primitive-return ..$Float::primitive /.freturn #.None (function (_ expected actual) ("jvm feq" expected (:coerce java/lang/Float actual)))))
- (_.lift "DRETURN" (primitive-return ..$Double::primitive /.dreturn #.None (function (_ expected actual) ("jvm deq" expected (:coerce java/lang/Double actual)))))
- (_.lift "ARETURN" (primitive-return ..$String::primitive /.areturn #.None (function (_ expected actual) (text@= expected (:coerce java/lang/String actual)))))
+ (_.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@= (:coerce Text expected) (:coerce Text actual)))))
(_.lift "RETURN" (primitive-return (: (Primitive java/lang/String)
{#unboxed /type.void
#boxed ..$String
@@ -1224,7 +1350,7 @@
#literal (function.constant /.nop)})
/.return
(#.Some ..$String::literal)
- (function (_ expected actual) (text@= expected (:coerce java/lang/String actual)))))
+ (function (_ expected actual) (text@= (:coerce Text expected) (:coerce Text actual)))))
)))
(def: branching
@@ -1234,7 +1360,7 @@
dummy ..$Long::random
#let [if! (: (-> (-> Label (Bytecode Any)) (Bytecode Any) (Random Bit))
(function (_ instruction prelude)
- (<| (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
+ (<| (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected))
(do /.monad
[@then /.new-label
@end /.new-label
@@ -1258,8 +1384,11 @@
(_.lift "IFNONNULL" (if! /.ifnonnull (/.string ""))))]
reference ..$Integer::random
subject (|> ..$Integer::random
- (random.filter (|>> ("jvm ieq" reference) not)))
- #let [[lesser greater] (if ("jvm ilt" reference subject)
+ (random.filter (|>> ((!::= java/lang/Integer "jvm ieq" "jvm int =") reference) not)))
+ #let [[lesser greater] (if (`` (for {(~~ (static @.old))
+ ("jvm ilt" reference subject)
+ (~~ (static @.jvm))
+ ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))}))
[reference subject]
[subject reference])
int-comparison ($_ _.and
@@ -1292,7 +1421,7 @@
dummy ..$Long::random
#let [jump (: (-> (-> Label (Bytecode Any)) (Random Bit))
(function (_ goto)
- (<| (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
+ (<| (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected))
(do /.monad
[@skipped /.new-label
@value /.new-label
@@ -1319,7 +1448,7 @@
minimum (:: @ map (|>> (n.% 100) .int /signed.s4 try.assume)
random.nat)
afterwards (:: @ map (n.% 10) random.nat)])
- (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
+ (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected))
(do /.monad
[@right /.new-label
@wrong /.new-label
@@ -1339,18 +1468,18 @@
random.nat)
choice (:: @ map (n.% options) random.nat)
options (|> random.int
- (:: @ map (|>> host.long-to-int host.int-to-long))
+ (:: @ map (|>> (:coerce java/lang/Long) host.long-to-int host.int-to-long (:coerce Int)))
(random.set i.hash options)
(:: @ map set.to-list))
#let [choice (maybe.assume (list.nth choice options))]
expected ..$Long::random
dummy ..$Long::random])
- (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
+ (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected))
(do /.monad
[@right /.new-label
@wrong /.new-label
@return /.new-label
- _ (..$Integer::literal (host.long-to-int choice))
+ _ (..$Integer::literal (host.long-to-int (:coerce java/lang/Long choice)))
_ (/.lookupswitch @wrong (list@map (function (_ option)
[(|> option /signed.s4 try.assume)
(if (i.= choice option) @right @wrong)])
@@ -1371,7 +1500,7 @@
dummy ..$Long::random
exception ..$String::random]
(<| (_.lift "ATHROW")
- (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" expected)))
+ (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected))
(do /.monad
[#let [$Exception (/type.class "java.lang.Exception" (list))]
@skipped /.new-label
@@ -1437,12 +1566,11 @@
part3 ..$Long::random
part4 ..$Long::random
#let [expected ($_ i.+
- part0
- part1
- part2
- part3
- part4
- )
+ (:coerce Int part0)
+ (:coerce Int part1)
+ (:coerce Int part2)
+ (:coerce Int part3)
+ (:coerce Int part4))
$Concrete (/type.class concrete-class (list))
$Abstract (/type.class abstract-class (list))
$Interface (/type.class interface-class (list))
@@ -1555,8 +1683,8 @@
output (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method)]
(wrap (:coerce Int output)))
(#try.Success actual)
- (i.= expected actual)
-
+ (i.= (:coerce Int expected) (:coerce Int actual))
+
(#try.Failure error)
false))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 19:47:51 +0000