Test imports for circular dependencies.

4 files changed, 556 insertions, 324 deletions

diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
new file mode 100644
index 000000000..7286aa50a
--- /dev/null
+++ b/stdlib/source/test/aedifex.lux
@@ -0,0 +1,21 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [control
+    [io (#+ io)]
+    [parser
+     [cli (#+ program:)]]]]
+  ["." / #_
+   ["#." parser]])
+
+(def: test
+  Test
+  ($_ _.and
+      /parser.test
+      ))
+
+(program: args
+  (<| io
+      _.run!
+      (_.times 100)
+      ..test))
diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux
new file mode 100644
index 000000000..497533fbf
--- /dev/null
+++ b/stdlib/source/test/aedifex/parser.lux
@@ -0,0 +1,212 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    [hash (#+ Hash)]]
+   [control
+    [pipe (#+ case>)]
+    ["." try]
+    [parser
+     ["<c>" code]]]
+   [data
+    ["." text
+     ["%" format (#+ format)]]
+    [number
+     ["n" nat]]
+    [collection
+     ["." set (#+ Set)]
+     ["." dictionary (#+ Dictionary)]
+     ["." list ("#@." functor)]]]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]
+   [macro
+    ["." code]]]
+  {#program
+   ["." /
+    ["/#" // #_
+     ["#" profile]
+     ["#." project (#+ Project)]
+     ["#." artifact (#+ Artifact)]
+     ["#." dependency (#+ Repository Dependency)]
+     ["#." format]]]})
+
+(def: distribution
+  (Random //.Distribution)
+  (random.or (random@wrap [])
+             (random@wrap [])))
+
+(def: license
+  (Random //.License)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      ..distribution))
+
+(def: scm
+  (Random //.SCM)
+  (random.ascii/alpha 1))
+
+(def: organization
+  (Random //.Organization)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)))
+
+(def: email
+  (Random //.Email)
+  (random.ascii/alpha 1))
+
+(def: developer
+  (Random //.Developer)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      (random.maybe organization)))
+
+(def: contributor
+  (Random //.Contributor)
+  ..developer)
+
+(def: (list-of random)
+  (All [a] (-> (Random a) (Random (List a))))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 5) random.nat)]
+    (random.list size random)))
+
+(def: (set-of hash random)
+  (All [a] (-> (Hash a) (Random a) (Random (Set a))))
+  (:: random.functor map
+      (set.from-list hash)
+      (..list-of random)))
+
+(def: (dictionary-of key-hash key-random value-random)
+  (All [k v] (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v))))
+  (:: random.functor map
+      (dictionary.from-list key-hash)
+      (..list-of (random.and key-random value-random))))
+
+(def: info
+  (Random //.Info)
+  ($_ random.and
+      (random.maybe (random.ascii/alpha 1))
+      (random.maybe ..scm)
+      (random.maybe (random.ascii/alpha 1))
+      (..list-of ..license)
+      (random.maybe ..organization)
+      (..list-of ..developer)
+      (..list-of ..contributor)
+      ))
+
+(def: name
+  (Random //.Name)
+  (random.ascii/alpha 1))
+
+(def: artifact
+  (Random Artifact)
+  ($_ random.and
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)
+      (random.ascii/alpha 1)))
+
+(def: repository
+  (Random Repository)
+  (random.ascii/alpha 1))
+
+(def: dependency
+  (Random Dependency)
+  ($_ random.and
+      ..artifact
+      (random.ascii/alpha 1)))
+
+(def: source
+  (Random //.Source)
+  (random.ascii/alpha 1))
+
+(def: target
+  (Random //.Target)
+  (random.ascii/alpha 1))
+
+(def: profile
+  (Random //.Profile)
+  ($_ random.and
+      (..list-of ..name)
+      (random.maybe ..artifact)
+      (random.maybe ..info)
+      (..set-of text.hash ..repository)
+      (..set-of //dependency.hash ..dependency)
+      (..set-of text.hash ..source)
+      (random.maybe ..target)
+      (random.maybe (random.ascii/alpha 1))
+      (random.maybe (random.ascii/alpha 1))
+      (..dictionary-of text.hash (random.ascii/alpha 1) ..repository)
+      ))
+
+(def: project
+  (Random Project)
+  (..dictionary-of text.hash ..name ..profile))
+
+(def: with-default-sources
+  (-> //.Profile //.Profile)
+  (update@ #//.sources
+           (: (-> (Set //.Source) (Set //.Source))
+              (function (_ sources)
+                (if (set.empty? sources)
+                  (set.from-list text.hash (list //.default-source))
+                  sources)))))
+
+(def: single-profile
+  Test
+  (do random.monad
+    [expected ..profile]
+    (_.test "Single profile."
+            (|> expected
+                //format.profile
+                list
+                (<c>.run /.project)
+                (case> (#try.Success actual)
+                       (|> expected
+                           ..with-default-sources
+                           [//.default]
+                           list
+                           (dictionary.from-list text.hash)
+                           (:: //project.equivalence = actual))
+                       
+                       (#try.Failure error)
+                       false)))))
+
+(def: (with-empty-profile project)
+  (-> Project Project)
+  (if (dictionary.empty? project)
+    //project.empty
+    project))
+
+(def: multiple-profiles
+  Test
+  (do random.monad
+    [expected ..project]
+    (_.test "Multiple profiles."
+            (|> expected
+                //format.project
+                list
+                (<c>.run /.project)
+                (case> (#try.Success actual)
+                       (|> expected
+                           ..with-empty-profile
+                           dictionary.entries
+                           (list@map (function (_ [name profile])
+                                       [name (..with-default-sources profile)]))
+                           (dictionary.from-list text.hash)
+                           (:: //project.equivalence = actual))
+                       
+                       (#try.Failure error)
+                       false)))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.project]
+        ($_ _.and
+            ..single-profile
+            ..multiple-profiles
+            ))))
diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux
index 65d7d1a48..cc2ccf096 100644
--- a/stdlib/source/test/lux/data/identity.lux
+++ b/stdlib/source/test/lux/data/identity.lux
@@ -10,7 +10,8 @@
      [/
       ["$." functor (#+ Injection Comparison)]
       ["$." apply]
-      ["$." monad]]}]
+      ["$." monad]
+      ["$." comonad]]}]
    [data
     ["." text ("#@." monoid equivalence)
      ["%" format (#+ format)]]]]
@@ -28,18 +29,15 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Identity)))
+  (<| (_.covering /._)
+      (_.with-cover [/.Identity])
       ($_ _.and
-          ($functor.spec ..injection ..comparison /.functor)
-          ($apply.spec ..injection ..comparison /.apply)
-          ($monad.spec ..injection ..comparison /.monad)
-          
-          (let [(^open "/@.") /.comonad]
-            (_.test "CoMonad does not affect values."
-                    (and (text@= "yololol" (/@unwrap "yololol"))
-                         (text@= "yololol" (be /.comonad
-                                             [f text@compose
-                                              a "yolo"
-                                              b "lol"]
-                                             (f a b))))))
+          (_.with-cover [/.functor]
+            ($functor.spec ..injection ..comparison /.functor))
+          (_.with-cover [/.apply]
+            ($apply.spec ..injection ..comparison /.apply))
+          (_.with-cover [/.monad]
+            ($monad.spec ..injection ..comparison /.monad))
+          (_.with-cover [/.comonad]
+            ($comonad.spec ..injection ..comparison /.comonad))
           )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 4a5672382..f2468ab4f 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -226,8 +226,8 @@
 (def: $Float::random
   (Random java/lang/Float)
   (:: random.monad map
-      (|>> (i.% +1024) i.frac (:coerce java/lang/Double) host.double-to-float)
-      random.int))
+      (|>> (:coerce java/lang/Double) host.double-to-float)
+      random.frac))
 (def: $Float::literal /.float)
 (def: $Float::primitive
   (Primitive java/lang/Float)
@@ -288,27 +288,23 @@
    #random ..$String::random
    #literal ..$String::literal})
 
-(with-expansions [<comparison> (for {@.old
-                                     "jvm leq"
-                                     @.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 {@.old
-                               (|>> (:coerce <type>) <to-long> (<comparison> expected))
-                               @.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>))))]
+(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 {@.old
+                             (|>> (:coerce <type>) <to-long> ("jvm leq" expected))
+                             @.jvm
+                             (|>> (:coerce <type>) <to-long> "jvm object cast" ("jvm long =" ("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]
-    ))
+  [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>)
@@ -341,19 +337,16 @@
 
 (def: int
   Test
-  (let [int (with-expansions [<comparison> (for {@.old "jvm ieq"
-                                                 @.jvm "jvm int ="})]
-              (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
-                 (function (_ expected bytecode)
-                   (<| (..bytecode (for {@.old
-                                         (|>> (:coerce java/lang/Integer) (<comparison> expected))
-                                         
-                                         @.jvm
-                                         (|>> (:coerce java/lang/Integer) "jvm object cast"
-                                              (<comparison> ("jvm object cast" expected)))}))
-                       (do /.monad
-                         [_ bytecode]
-                         ..$Integer::wrap)))))
+  (let [int (: (-> java/lang/Integer (Bytecode Any) (Random Bit))
+               (function (_ expected bytecode)
+                 (<| (..bytecode (for {@.old
+                                       (|>> (:coerce java/lang/Integer) ("jvm ieq" expected))
+                                       
+                                       @.jvm
+                                       (|>> (:coerce java/lang/Integer) "jvm object cast" ("jvm int =" ("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
@@ -425,290 +418,296 @@
 
 (def: long
   Test
-  (with-expansions [<comparison> (for {@.old "jvm leq"
-                                       @.jvm "jvm long ="})]
-    (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
+  (let [long (: (-> java/lang/Long (Bytecode Any) (Random Bit))
+                (function (_ expected bytecode)
+                  (<| (..bytecode (for {@.old
+                                        (|>> (:coerce Int) (i.= expected))
+                                        
+                                        @.jvm
+                                        (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))}))
+                      (do /.monad
+                        [_ 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)
+                              _ (..$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 (int+long/2 "jvm lshl" "jvm long shl") /.lshl))
+                    (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr))
+                    (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr)))
+        comparison (_.lift "LCMP"
+                           (do random.monad
+                             [reference ..$Long::random
+                              subject ..$Long::random
+                              #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long +0)
+
+                                                   (i.> (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long +1)
+
+                                                   ## (i.< (:coerce Int reference) (:coerce Int subject))
+                                                   (:coerce java/lang/Long -1))]]
+                             (<| (..bytecode (for {@.old
+                                                   (|>> (:coerce Int) (i.= expected))
+                                                   
+                                                   @.jvm
+                                                   (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" expected)))}))
+                                 (do /.monad
+                                   [_ (..$Long::literal subject)
+                                    _ (..$Long::literal reference)
+                                    _ /.lcmp
+                                    _ /.i2l]
+                                   ..$Long::wrap))))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.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 (for {@.old
+                                         (function (_ actual)
+                                           (or (|> actual (:coerce java/lang/Float) ("jvm feq" expected))
+                                               (and (f.not-a-number? (:coerce Frac (host.float-to-double expected)))
+                                                    (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce 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 (host.float-to-double expected)))
+                                                    (f.not-a-number? (:coerce Frac (host.float-to-double (:coerce java/lang/Float actual)))))))}))
+                       (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)
+                             (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 {@.old
+                                                    ("jvm feq" reference subject)
+                                                    
+                                                    @.jvm
+                                                    ("jvm float =" ("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-standard (: (-> java/lang/Float java/lang/Float Bit)
+                               (function (_ reference subject)
+                                 (for {@.old
+                                       ("jvm fgt" subject reference)
+                                       
+                                       @.jvm
+                                       ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))})))
+        comparison ($_ _.and
+                       (_.lift "FCMPL" (comparison /.fcmpl comparison-standard))
+                       (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.context "arithmetic")
+            arithmetic)
+        (<| (_.context "comparison")
+            comparison)
+        )))
+
+(def: double
+  Test
+  (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
                   (function (_ expected bytecode)
                     (<| (..bytecode (for {@.old
-                                          (|>> (:coerce Int) (i.= expected))
+                                          (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)))))
                                           
                                           @.jvm
-                                          (|>> (:coerce java/lang/Long) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
+                                          (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)))))}))
                         (do /.monad
                           [_ 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)
+                          ..$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
-                               [_ (..$Long::literal subject)]
+                               [_ (..$Double::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)
+        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
-                                [_ (..$Long::literal subject)
-                                 _ (..$Long::literal parameter)]
+                                [_ (..$Double::literal subject)
+                                 _ (..$Double::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)
-                                _ (..$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 (int+long/2 "jvm lshl" "jvm long shl") /.lshl))
-                      (_.lift "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr))
-                      (_.lift "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr)))
-          comparison (_.lift "LCMP"
-                             (do random.monad
-                               [reference ..$Long::random
-                                subject ..$Long::random
-                                #let [expected (cond (i.= (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long +0)
-
-                                                     (i.> (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long +1)
-
-                                                     ## (i.< (:coerce Int reference) (:coerce Int subject))
-                                                     (:coerce java/lang/Long -1))]]
-                               (<| (..bytecode (for {@.old
-                                                     (|>> (:coerce Int) (i.= expected))
-                                                     
-                                                     @.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
-  (with-expansions [<comparison> (for {@.old "jvm feq"
-                                       @.jvm "jvm float ="})]
-    (let [float (: (-> java/lang/Float (Bytecode Any) (Random Bit))
-                   (function (_ expected bytecode)
-                     (<| (..bytecode (for {@.old
-                                           (|>> (:coerce java/lang/Float) ("jvm feq" expected))
-                                           
-                                           @.jvm
-                                           (|>> (:coerce java/lang/Float) "jvm object cast" (<comparison> ("jvm object cast" 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)
+        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 {@.old
+                                                    ("jvm deq" reference subject)
+                                                    
+                                                    @.jvm
+                                                    ("jvm double =" ("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)]
-                                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 {@.old
-                                                      ("jvm feq" reference subject)
-                                                      
-                                                      @.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-standard (: (-> java/lang/Float java/lang/Float Bit)
-                                 (function (_ reference subject)
-                                   (for {@.old
-                                         ("jvm fgt" subject reference)
-                                         
-                                         @.jvm
-                                         ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))})))
-          comparison ($_ _.and
-                         (_.lift "FCMPL" (comparison /.fcmpl comparison-standard))
-                         (_.lift "FCMPG" (comparison /.fcmpg comparison-standard)))]
-      ($_ _.and
-          (<| (_.context "literal")
-              literal)
-          (<| (_.context "arithmetic")
-              arithmetic)
-          (<| (_.context "comparison")
-              comparison)
-          ))))
-
-(def: double
-  Test
-  (with-expansions [<comparison> (for {@.old "jvm deq"
-                                       @.jvm "jvm double ="})]
-    (let [double (: (-> java/lang/Double (Bytecode Any) (Random Bit))
-                    (function (_ expected bytecode)
-                      (<| (..bytecode (for {@.old
-                                            (|>> (:coerce java/lang/Double) ("jvm deq" expected))
-                                            
-                                            @.jvm
-                                            (|>> (:coerce java/lang/Double) "jvm object cast" (<comparison> ("jvm object cast" expected)))}))
-                          (do /.monad
-                            [_ 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 {@.old
-                                                      ("jvm deq" reference subject)
-                                                      
-                                                      @.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)))))
-          ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
-          comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
-                                 (function (_ reference subject)
-                                   (for {@.old
-                                         ("jvm dgt" subject reference)
-                                         
-                                         @.jvm
-                                         ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
-          comparison ($_ _.and
-                         (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
-                         (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
-      ($_ _.and
-          (<| (_.context "literal")
-              literal)
-          (<| (_.context "arithmetic")
-              arithmetic)
-          (<| (_.context "comparison")
-              comparison)
-          ))))
+                                [_ (..$Double::literal subject)
+                                 _ (..$Double::literal reference)
+                                 _ instruction
+                                 _ /.i2l]
+                                ..$Long::wrap)))))
+        ## https://docs.oracle.com/javase/specs/jvms/se7/html/jvms-6.html#jvms-6.5.dcmp_op
+        comparison-standard (: (-> java/lang/Double java/lang/Double Bit)
+                               (function (_ reference subject)
+                                 (for {@.old
+                                       ("jvm dgt" subject reference)
+                                       
+                                       @.jvm
+                                       ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))})))
+        comparison ($_ _.and
+                       (_.lift "DCMPL" (comparison /.dcmpl comparison-standard))
+                       (_.lift "DCMPG" (comparison /.dcmpg comparison-standard)))]
+    ($_ _.and
+        (<| (_.context "literal")
+            literal)
+        (<| (_.context "arithmetic")
+            arithmetic)
+        (<| (_.context "comparison")
+            comparison)
+        )))
 
 (def: primitive
   Test
@@ -773,7 +772,8 @@
   ($_ _.and
       (<| (_.lift "INVOKESTATIC")
           (do random.monad
-            [expected ..$Double::random])
+            [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+                                     ..$Double::random)])
           (..bytecode (for {@.old
                             (|>> (:coerce java/lang/Double) ("jvm deq" expected))
                             
@@ -793,7 +793,8 @@
             ..$Boolean::wrap))
       (<| (_.lift "INVOKESPECIAL")
           (do random.monad
-            [expected ..$Double::random])
+            [expected (random.filter (|>> (:coerce Frac) f.not-a-number? not)
+                                     ..$Double::random)])
           (..bytecode (for {@.old
                             (|>> (:coerce java/lang/Double) ("jvm deq" expected))