(.module:
  [lux (#- Type type primitive int)
   ["." host (#+ import:)]
   [abstract
    [monad (#+ do)]]
   [control
    ["." function]
    ["." io (#+ IO)]
    ["." try (#+ Try)]
    [concurrency
     ["." atom]]
    [security
     ["!" capability]]]
   [data
    [binary (#+ Binary)]
    ["." bit ("#@." equivalence)]
    [number
     ["." i32 (#+ I32)]
     ["." i64]
     ["n" nat]
     ["i" int]
     ["f" frac]]
    ["." text ("#@." equivalence)
     ["%" format (#+ format)]]
    ["." format #_
     ["#" binary]]
    [collection
     ["." array]
     ["." dictionary]
     ["." row]]]
   [world
    ["." file (#+ File)]]
   [math
    ["." random (#+ Random) ("#@." monad)]]
   ["_" test (#+ Test)]]
  {1
   ["." / #_
    ["#." loader (#+ Library)]
    ["#." version]
    ["#." modifier ("#@." monoid)]
    ["#." field]
    ["#." method]
    ["#." class]
    ["#." attribute
     ["#/." code]]
    ["#." constant
     ["#/." pool]]
    [encoding
     ["#." name]
     ["#." unsigned]]
    ["#" bytecode (#+ Bytecode)
     ["#." instruction]
     [environment
      [limit
       [registry (#+ Register)]]]]
    ["#." type (#+ Type)
     ["." category (#+ Value)]]]})

## (def: (write-class! name bytecode)
##   (-> Text Binary (IO Text))
##   (let [file-path (format name ".class")]
##     (do io.monad
##       [outcome (do (try.with @)
##                  [file (: (IO (Try (File IO)))
##                           (file.get-file io.monad file.system file-path))]
##                  (!.use (:: file over-write) bytecode))]
##       (wrap (case outcome
##               (#try.Success definition)
##               (format "Wrote: " (%.text file-path))

##               (#try.Failure error)
##               error)))))

(def: method-modifier
  ($_ /modifier@compose
      /method.public
      /method.static))

(import: #long java/lang/Boolean)
(import: #long java/lang/Byte)
(import: #long java/lang/Short)
(import: #long java/lang/Integer)
(import: #long java/lang/Long)
(import: #long java/lang/Float)
(import: #long java/lang/Double
  (#static compare [double double] int))
(import: #long java/lang/Character)
(import: #long java/lang/String)

(import: #long java/lang/reflect/Method
  (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))

(import: #long (java/lang/Class c)
  (getDeclaredMethod [java/lang/String [(java/lang/Class [? < java/lang/Object])]] java/lang/reflect/Method))

(import: #long java/lang/Object
  (getClass [] (java/lang/Class java/lang/Object))
  (toString [] java/lang/String))

(def: class-name
  (Random Text)
  (do random.monad
    [super-package (random.ascii/lower-alpha 10)
     package (random.ascii/lower-alpha 10)
     name (random.ascii/upper-alpha 10)]
    (wrap (format super-package
                  /name.external-separator package
                  /name.external-separator name))))

(def: type
  (Random (Type Value))
  (random.rec
   (function (_ type)
     ($_ random.either
         (random@wrap /type.boolean)
         (random@wrap /type.byte)
         (random@wrap /type.short)
         (random@wrap /type.int)
         (random@wrap /type.long)
         (random@wrap /type.float)
         (random@wrap /type.double)
         (random@wrap /type.char)
         (random@map (function (_ name) (/type.class name (list))) ..class-name)
         (random@map /type.array type)
         ))))

(def: field
  (Random [Text (Type Value)])
  ($_ random.and
      (random.ascii/lower-alpha 10)
      ..type
      ))

(def: (get-method name class)
  (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method)
  (java/lang/Class::getDeclaredMethod name
                                      (host.array (java/lang/Class java/lang/Object) 0)
                                      class))

(def: $Object (/type.class "java.lang.Object" (list)))

(def: (bytecode test bytecode)
  (-> (-> Any Bit) (Bytecode Any) (Random Bit))
  (do random.monad
    [class-name ..class-name
     method-name (random.ascii/upper-alpha 10)]
    (wrap (case (do try.monad
                  [class (/class.class /version.v6_0 /class.public
                                       (/name.internal class-name)
                                       (/name.internal "java.lang.Object")
                                       (list)
                                       (list)
                                       (list (/method.method ..method-modifier
                                                             method-name
                                                             (/type.method [(list) ..$Object (list)])
                                                             (list)
                                                             (do /.monad
                                                               [_ bytecode]
                                                               /.areturn)))
                                       (row.row))
                   #let [bytecode (format.run /class.writer class)
                         loader (/loader.memory (/loader.new-library []))]
                   _ (/loader.define class-name bytecode loader)
                   class (io.run (/loader.load class-name loader))
                   method (host.try (get-method method-name class))]
                  (java/lang/reflect/Method::invoke (host.null) (host.array java/lang/Object 0) method))
            (#try.Success actual)
            (test actual)
            
            (#try.Failure error)
            false))))

(type: (Primitive a)
  {#unboxed (Type category.Return)
   #boxed (Type category.Class)
   #wrap (Bytecode Any)
   #random (Random a)
   #literal (-> a (Bytecode Any))})

(def: $Boolean
  (/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: !false (|> 0 .i64 i32.i32 /.int))
(def: !true (|> 1 .i64 i32.i32 /.int))
(def: ($Boolean::literal value)
  (-> java/lang/Boolean (Bytecode Any))
  (if value
    ..!true
    ..!false))
(def: $Boolean::primitive
  (Primitive java/lang/Boolean)
  {#unboxed /type.boolean
   #boxed ..$Boolean
   #wrap ..$Boolean::wrap
   #random ..$Boolean::random
   #literal ..$Boolean::literal})

(def: $Byte
  (/type.class "java.lang.Byte" (list)))
(def: $Byte::wrap
  (/.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))
(def: $Byte::literal
  (-> java/lang/Byte (Bytecode Any))
  (|>> host.byte-to-long .i64 i32.i32 /.int))
(def: $Byte::primitive
  (Primitive java/lang/Byte)
  {#unboxed /type.byte
   #boxed ..$Byte
   #wrap ..$Byte::wrap
   #random ..$Byte::random
   #literal ..$Byte::literal})

(def: $Short
  (/type.class "java.lang.Short" (list)))
(def: $Short::wrap
  (/.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))
(def: $Short::literal
  (-> java/lang/Short (Bytecode Any))
  (|>> host.short-to-long .i64 i32.i32 /.int))
(def: $Short::primitive
  (Primitive java/lang/Short)
  {#unboxed /type.short
   #boxed ..$Short
   #wrap ..$Short::wrap
   #random ..$Short::random
   #literal ..$Short::literal})

(def: $Integer
  (/type.class "java.lang.Integer" (list)))
(def: $Integer::wrap
  (/.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))
(def: $Integer::literal
  (-> java/lang/Integer (Bytecode Any))
  (|>> host.int-to-long .i64 i32.i32 /.int))
(def: $Integer::primitive
  (Primitive java/lang/Integer)
  {#unboxed /type.int
   #boxed ..$Integer
   #wrap ..$Integer::wrap
   #random ..$Integer::random
   #literal ..$Integer::literal})

(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::primitive
  (Primitive java/lang/Long)
  {#unboxed /type.long
   #boxed ..$Long
   #wrap ..$Long::wrap
   #random ..$Long::random
   #literal ..$Long::literal})

(def: $Float (/type.class "java.lang.Float" (list)))
(def: $Float::wrap (/.invokestatic ..$Float "valueOf" (/type.method [(list /type.float) ..$Float (list)])))
(def: $Float::random
  (Random java/lang/Float)
  (:: random.monad map
      (|>> (i.% +1024) i.frac host.double-to-float)
      random.int))
(def: $Float::literal /.float)
(def: $Float::primitive
  (Primitive java/lang/Float)
  {#unboxed /type.float
   #boxed ..$Float
   #wrap ..$Float::wrap
   #random ..$Float::random
   #literal ..$Float::literal})

(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::primitive
  (Primitive java/lang/Double)
  {#unboxed /type.double
   #boxed ..$Double
   #wrap ..$Double::wrap
   #random ..$Double::random
   #literal ..$Double::literal})

(def: $Character
  (/type.class "java.lang.Character" (list)))
(def: $Character::wrap
  (/.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))
(def: $Character::literal
  (-> java/lang/Character (Bytecode Any))
  (|>> host.char-to-long .i64 i32.i32 /.int))
(def: $Character::primitive
  (Primitive java/lang/Character)
  {#unboxed /type.char
   #boxed ..$Character
   #wrap ..$Character::wrap
   #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::primitive
  (Primitive java/lang/String)
  {#unboxed ..$String
   #boxed ..$String
   #wrap /.nop
   #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>))))]

  [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: (int/2 <extension>)
  (: (-> java/lang/Integer java/lang/Integer java/lang/Integer)
     (function (_ parameter subject)
       (<extension> subject 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))))
        unary (: (-> (-> java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit))
                 (function (_ reference instruction)
                   (do random.monad
                     [subject ..$Integer::random]
                     (int (reference subject)
                          (do /.monad
                            [_ (..$Integer::literal subject)]
                            instruction)))))
        binary (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer)
                      (Bytecode Any)
                      (Random Bit))
                  (function (_ reference instruction)
                    (do random.monad
                      [parameter ..$Integer::random
                       subject ..$Integer::random]
                      (int (reference parameter subject)
                           (do /.monad
                             [_ (..$Integer::literal subject)
                              _ (..$Integer::literal parameter)]
                             instruction)))))
        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)
                      subject ..$Integer::random]
                     (int (reference parameter subject)
                          (do /.monad
                            [_ (..$Integer::literal subject)
                             _ (..$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 "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 "INEG" (unary (function (_ value)
                                               ((int/2 "jvm isub") value (host.long-to-int +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)))]
    ($_ _.and
        (<| (_.context "literal")
            literal)
        (<| (_.context "arithmetic")
            arithmetic)
        (<| (_.context "bitwise")
            bitwise)
        )))

(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)
                            (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)))
                                 (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)
        )))

(template: (float/2 <extension>)
  (: (-> java/lang/Float java/lang/Float java/lang/Float)
     (function (_ parameter subject)
       (<extension> subject parameter))))

(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)
                             (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)
        )))

(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)))
                              (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)
        )))

(def: primitive
  Test
  ($_ _.and
      (<| (_.context "byte")
          ..byte)
      (<| (_.context "short")
          ..short)
      (<| (_.context "int")
          ..int)
      (<| (_.context "long")
          ..long)
      (<| (_.context "float")
          ..float)
      (<| (_.context "double")
          ..double)
      ))

(def: object
  Test
  (let [!object (: (Bytecode Any)
                   (do /.monad
                     [_ (/.new ..$Object)
                      _ /.dup]
                     (/.invokespecial ..$Object "<init>" (/type.method [(list) /type.void (list)]))))]
    ($_ _.and
        (<| (_.lift "ACONST_NULL")
            (..bytecode (|>> (:coerce Bit) not))
            (do /.monad
              [_ /.aconst-null
               _ (/.instanceof ..$String)]
              ..$Boolean::wrap))
        (<| (_.lift "INSTANCEOF")
            (do random.monad
              [value ..$String::random])
            (..bytecode (|>> (:coerce Bit)))
            (do /.monad
              [_ (/.string value)
               _ (/.instanceof ..$String)]
              ..$Boolean::wrap))
        (<| (_.lift "NEW & CHECKCAST")
            (..bytecode (|>> (:coerce Bit)))
            (do /.monad
              [_ !object
               _ (/.checkcast ..$Object)
               _ (/.instanceof ..$Object)]
              ..$Boolean::wrap))
        (<| (_.lift "MONITORENTER & MONITOREXIT")
            (do random.monad
              [value ..$String::random])
            (..bytecode (|>> (:coerce Bit)))
            (do /.monad
              [_ (/.string value)
               _ /.dup _ /.monitorenter
               _ /.dup _ /.monitorexit
               _ (/.instanceof ..$String)]
              ..$Boolean::wrap))
        (<| (_.lift "INVOKESTATIC")
            (do random.monad
              [expected ..$Double::random])
            (..bytecode (|>> (:coerce java/lang/Double) ("jvm deq" expected)))
            (do /.monad
              [_ (/.double expected)]
              (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))))
        (<| (_.lift "INVOKEVIRTUAL")
            (do random.monad
              [expected ..$Double::random])
            (..bytecode (|>> (:coerce java/lang/Boolean) (bit@= (f.not-a-number? expected))))
            (do /.monad
              [_ (/.double 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)))
            (do /.monad
              [_ (/.new ..$Double)
               _ /.dup
               _ (/.double 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))))
            (do /.monad
              [_ (/.string subject)
               _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) /type.int (list)]))
               _ /.i2l]
              ..$Long::wrap))
        )))

(def: array
  Test
  (let [!length (: (-> Nat (Bytecode Any))
                   (function (_ size)
                     (do /.monad
                       [_ ($Long::literal (.int size))]
                       /.l2i)))
        ?length (: (Bytecode Any)
                   (do /.monad
                     [_ /.arraylength]
                     /.i2l))
        length (: (-> Nat (Bytecode Any) (Random Bit))
                  (function (_ size constructor)
                    (<| (..bytecode (|>> (:coerce Nat) (n.= size)))
                        (do /.monad
                          [_ (!length size)
                           _ constructor
                           _ ?length]
                          $Long::wrap))))
        write-and-read (: (All [a]
                            (-> Nat (Bytecode Any)
                                a (-> a (Bytecode Any))
                                [(Bytecode Any) (Bytecode Any) (Bytecode Any)]
                                (-> a Any Bit)
                                (Random Bit)))
                          (function (_ size constructor value literal [*store *load *wrap] test)
                            (let [!index ($Integer::literal (host.long-to-int +0))]
                              (<| (..bytecode (test value))
                                  (do /.monad
                                    [_ (!length size)
                                     _ constructor
                                     _ /.dup _ !index _ (literal value) _ *store
                                     _ /.dup _ !index _ *load]
                                    *wrap)))))
        array (: (All [a]
                   (-> (Bytecode Any) (Random a) (-> a (Bytecode Any))
                       [(Bytecode Any) (Bytecode Any) (Bytecode Any)]
                       (-> a Any Bit)
                       Test))
                 (function (_ constructor random literal [*store *load *wrap] test)
                   (do random.monad
                     [size (:: @ map (|>> (n.% 1024) (n.max 1)) random.nat)
                      value random]
                     ($_ _.and
                         (<| (_.lift "length")
                             (length size constructor))
                         (<| (_.lift "write and read")
                             (write-and-read size constructor value literal [*store *load *wrap] test))))))]
    ($_ _.and
        (_.context "boolean"
                   (array (/.newarray /instruction.t-boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap]
                          (function (_ expected) (|>> (:coerce Bit) (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))))))
        (_.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))))))
        (_.context "int"
                   (array (/.newarray /instruction.t-int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap]
                          (function (_ expected) (|>> (:coerce java/lang/Integer) ("jvm ieq" 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)))))
        (_.context "float"
                   (array (/.newarray /instruction.t-float) $Float::random $Float::literal [/.fastore /.faload $Float::wrap]
                          (function (_ expected) (|>> (:coerce java/lang/Float) ("jvm feq" 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)))))
        (_.context "char"
                   (array (/.newarray /instruction.t-char) $Character::random $Character::literal [/.castore /.caload $Character::wrap]
                          (function (_ expected) (|>> (:coerce java/lang/Character) ("jvm ceq" expected)))))
        (_.context "object"
                   (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop]
                          (function (_ expected) (|>> (:coerce Text) (text@= expected)))))
        )))

(def: conversion
  Test
  (let [conversion (: (All [a z]
                        (-> (Primitive a) (Primitive z) (Bytecode Any) (-> a z) (-> z Any Bit) (Random Bit)))
                      (function (_ from to instruction convert test)
                        (do random.monad
                          [input (get@ #random from)
                           #let [expected (convert input)]]
                          (..bytecode (test expected)
                                      (do /.monad
                                        [_ ((get@ #literal from) input)
                                         _ instruction]
                                        (get@ #wrap to))))))]
    ($_ _.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 "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))))))
                (_.lift "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> host.int-to-char)
                                          (function (_ expected) (|>> (:coerce java/lang/Character) ("jvm ceq" expected)))))
                (_.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))))))))
        (<| (_.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)))))))
        (<| (_.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)))))))
        (<| (_.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)))))))
        )))

(def: value
  Test
  ($_ _.and
      (<| (_.context "primitive")
          ..primitive)
      (<| (_.context "object")
          ..object)
      (<| (_.context "array")
          ..array)
      (<| (_.context "conversion")
          ..conversion)
      ))

(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]
                            (-> (Random a) (-> a (Bytecode Any)) (Bytecode Any)
                                [(-> Register (Bytecode Any)) (-> Register (Bytecode Any))]
                                (-> a (-> Any Bit))
                                (Random Bit)))
                          (function (_ random-value literal *wrap [store load] test)
                            (do random.monad
                              [expected random-value
                               register (:: @ map (|>> (n.% 128) /unsigned.u1 try.assume) random.nat)]
                              (<| (..bytecode (test expected))
                                  (do /.monad
                                    [_ (literal expected)
                                     _ (store register)
                                     _ (load register)]
                                    *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)]
              ($_ _.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/ILOAD"
                          (store-and-load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload]
                                          (function (_ expected actual)
                                            (|> actual (:coerce java/lang/Integer) ("jvm ieq" expected))))))))
        (<| (_.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)]
              ($_ _.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/LLOAD"
                          (store-and-load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload]
                                          (function (_ expected actual)
                                            (|> actual (:coerce java/lang/Long) ("jvm leq" expected))))))))
        (<| (_.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)]
              ($_ _.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/FLOAD"
                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload]
                                          (function (_ expected actual)
                                            (|> actual (:coerce java/lang/Float) ("jvm feq" expected))))))))
        (<| (_.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)]
              ($_ _.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/DLOAD"
                          (store-and-load ..$Double::random ..$Double::literal ..$Double::wrap [/.dstore /.dload]
                                          (function (_ expected actual)
                                            (|> actual (:coerce java/lang/Double) ("jvm deq" expected))))))))
        (<| (_.context "object")
            (let [test (function (_ expected actual)
                         (|> actual (:coerce Text) (text@= expected)))]
              ($_ _.and
                  (_.lift "ASTORE_0/ALOAD_0"
                          (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-0) (function.constant /.aload-0)]
                                          test))
                  (_.lift "ASTORE_1/ALOAD_1"
                          (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-1) (function.constant /.aload-1)]
                                          test))
                  (_.lift "ASTORE_2/ALOAD_2"
                          (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-2) (function.constant /.aload-2)]
                                          test))
                  (_.lift "ASTORE_3/ALOAD_3"
                          (store-and-load ..$String::random ..$String::literal /.nop [(function.constant /.astore-3) (function.constant /.aload-3)]
                                          test))
                  (_.lift "ASTORE/ALOAD"
                          (store-and-load ..$String::random ..$String::literal /.nop [/.astore /.aload]
                                          test)))))
        )))

(def: stack
  Test
  (do random.monad
    [expected/1 $String::random
     dummy/1 $String::random
     #let [single ($_ _.and
                      (<| (_.lift "DUP & POP")
                          (..bytecode (|>> (:coerce Text) (text@= expected/1)))
                          (do /.monad
                            [_ ($String::literal expected/1)
                             _ /.dup]
                            /.pop))
                      (<| (_.lift "DUP_X1 & POP2")
                          (..bytecode (|>> (:coerce Text) (text@= expected/1)))
                          (do /.monad
                            [_ ($String::literal dummy/1)
                             _ ($String::literal expected/1)
                             _ /.dup-x1]
                            /.pop2))
                      (<| (_.lift "DUP_X2")
                          (..bytecode (|>> (:coerce Text) (text@= expected/1)))
                          (do /.monad
                            [_ ($String::literal dummy/1)
                             _ ($String::literal dummy/1)
                             _ ($String::literal expected/1)
                             _ /.dup-x2
                             _ /.pop2]
                            /.pop))
                      (<| (_.lift "SWAP")
                          (..bytecode (|>> (:coerce Text) (text@= expected/1)))
                          (do /.monad
                            [_ ($String::literal dummy/1)
                             _ ($String::literal expected/1)
                             _ /.swap]
                            /.pop))
                      )]
     expected/2 $Long::random
     dummy/2 $Long::random
     #let [double ($_ _.and
                      (<| (_.lift "DUP2")
                          (..bytecode (|>> (:coerce Int) (i.= expected/2)))
                          (do /.monad
                            [_ ($Long::literal expected/2)
                             _ /.dup2
                             _ /.pop2]
                            ..$Long::wrap))
                      (<| (_.lift "DUP2_X1")
                          (..bytecode (|>> (:coerce Int) (i.= expected/2)))
                          (do /.monad
                            [_ ($String::literal dummy/1)
                             _ ($Long::literal expected/2)
                             _ /.dup2-x1
                             _ /.pop2
                             _ /.pop]
                            ..$Long::wrap))
                      (<| (_.lift "DUP2_X2")
                          (..bytecode (|>> (:coerce Int) (i.= expected/2)))
                          (do /.monad
                            [_ ($Long::literal dummy/2)
                             _ ($Long::literal expected/2)
                             _ /.dup2-x2
                             _ /.pop2
                             _ /.pop2]
                            ..$Long::wrap))
                      )]]
    ($_ _.and
        (<| (_.context "single")
            single)
        (<| (_.context "double")
            double)
        )))

(def: resource
  Test
  ($_ _.and
      (<| (_.context "registry")
          ..registry)
      (<| (_.context "stack")
          ..stack)
      ))

(def: return
  Test
  (let [primitive-return (: (All [a] (-> (Primitive a) (Bytecode Any) (Maybe (-> a (Bytecode Any))) (-> a Any Bit) (Random Bit)))
                            (function (_ primitive return substitute test)
                              (do random.monad
                                [class-name ..class-name
                                 primitive-method-name (random.ascii/upper-alpha 10)
                                 #let [primitive-method-type (/type.method [(list) (get@ #unboxed primitive) (list)])]
                                 object-method-name (|> (random.ascii/upper-alpha 10)
                                                        (random.filter (|>> (text@= primitive-method-name) not)))
                                 expected (get@ #random primitive)
                                 #let [$Self (/type.class class-name (list))]]
                                (wrap (case (do try.monad
                                              [class (/class.class /version.v6_0 /class.public
                                                                   (/name.internal class-name)
                                                                   (/name.internal "java.lang.Object")
                                                                   (list)
                                                                   (list)
                                                                   (list (/method.method ..method-modifier
                                                                                         primitive-method-name
                                                                                         primitive-method-type
                                                                                         (list)
                                                                                         (do /.monad
                                                                                           [_ ((get@ #literal primitive) expected)]
                                                                                           return))
                                                                         (/method.method ..method-modifier
                                                                                         object-method-name
                                                                                         (/type.method [(list) (get@ #boxed primitive) (list)])
                                                                                         (list)
                                                                                         (do /.monad
                                                                                           [_ (/.invokestatic $Self primitive-method-name primitive-method-type)
                                                                                            _ (case substitute
                                                                                                #.None
                                                                                                (wrap [])

                                                                                                (#.Some substitute)
                                                                                                (substitute expected))
                                                                                            _ (get@ #wrap primitive)]
                                                                                           /.areturn)))
                                                                   (row.row))
                                               #let [bytecode (format.run /class.writer class)
                                                     loader (/loader.memory (/loader.new-library []))]
                                               _ (/loader.define class-name bytecode loader)
                                               class (io.run (/loader.load class-name loader))
                                               method (host.try (get-method object-method-name class))]
                                              (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 "RETURN" (primitive-return (: (Primitive java/lang/String)
                                              {#unboxed /type.void
                                               #boxed ..$String
                                               #wrap /.nop
                                               #random ..$String::random
                                               #literal (function.constant /.nop)})
                                           /.return
                                           (#.Some ..$String::literal)
                                           (function (_ expected actual) (text@= expected (:coerce java/lang/String actual)))))
        )))

(def: code
  Test
  ($_ _.and
      (<| (_.context "return")
          ..return)
      ))

(def: instruction
  Test
  ($_ _.and
      (<| (_.context "value")
          ..value)
      (<| (_.context "resource")
          ..resource)
      (<| (_.context "code")
          ..code)
      ))

(def: method
  Test
  (do random.monad
    [class-name ..class-name
     method-name (random.ascii/upper-alpha 10)
     expected ..$Long::random
     #let [inputsJT (list)
           outputJT ..$Object]]
    (_.test "Can compile a method."
            (let [bytecode (|> (/class.class /version.v6_0 /class.public
                                             (/name.internal class-name)
                                             (/name.internal "java.lang.Object")
                                             (list)
                                             (list)
                                             (list (/method.method ($_ /modifier@compose
                                                                       /method.public
                                                                       /method.static)
                                                                   method-name
                                                                   (/type.method [inputsJT outputJT (list)])
                                                                   (list)
                                                                   (do /.monad
                                                                     [_ (..$Long::literal expected)
                                                                      _ ..$Long::wrap]
                                                                     /.areturn)))
                                             (row.row))
                               try.assume
                               (format.run /class.writer))
                  loader (/loader.memory (/loader.new-library []))]
              (case (do try.monad
                      [_ (/loader.define class-name bytecode loader)
                       class (io.run (/loader.load class-name loader))
                       method (host.try (get-method method-name class))
                       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)
                
                (#try.Failure error)
                false)))))

(def: class
  Test
  (do random.monad
    [class-name ..class-name
     [field0 type0] ..field
     [field1 type1] ..field
     #let [bytecode (|> (/class.class /version.v6_0 /class.public
                                      (/name.internal class-name)
                                      (/name.internal "java.lang.Object")
                                      (list (/name.internal "java.io.Serializable")
                                            (/name.internal "java.lang.Runnable"))
                                      (list (/field.field /field.public field0 type0 (row.row))
                                            (/field.field /field.public field1 type1 (row.row)))
                                      (list)
                                      (row.row))
                        try.assume
                        (format.run /class.writer))
           loader (/loader.memory (/loader.new-library []))]]
    ($_ _.and
        (_.test "Can generate a class."
                (case (do try.monad
                        [_ (/loader.define class-name bytecode loader)]
                        (io.run (/loader.load class-name loader)))
                  (#try.Success definition)
                  true
                  
                  (#try.Failure error)
                  false))
        )))

(def: #export test
  Test
  (<| (_.context (%.name (name-of .._)))
      ($_ _.and
          ..instruction
          ..method
          ..class
          )))