- Migrated special-form analysis to stdlib.

2 files changed, 857 insertions, 0 deletions

diff --git a/stdlib/test/test/lux/lang/analysis/procedure/common.lux b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
new file mode 100644
index 000000000..898376045
--- /dev/null
+++ b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
@@ -0,0 +1,316 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data text/format
+             ["e" error]
+             [product]
+             (coll [array]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Meta>]
+       (macro [code])
+       [lang]
+       (lang [type "type/" Eq<Type>]
+             [".L" scope]
+             [".L" init]
+             (analysis [".A" type]))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (lang.with-scope
+           (typeA.with-type output-type
+             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [check-success+ true false]
+  [check-failure+ false true]
+  )
+
+(context: "Lux procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         [antiT antiC] (|> _primitive.primitive
+                           (r.filter (|>> product.left (type/= primT) not)))]
+        ($_ seq
+            (test "Can test for reference equality."
+                  (check-success+ "lux is" (list primC primC) Bool))
+            (test "Reference equality must be done with elements of the same type."
+                  (check-failure+ "lux is" (list primC antiC) Bool))
+            (test "Can 'try' risky IO computations."
+                  (check-success+ "lux try"
+                                  (list (` ("lux function" (~' _) (~' _) (~ primC))))
+                                  (type (Either Text primT))))
+            ))))
+
+(context: "Bit procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.nat (:: @ map code.nat))
+         signedC (|> r.int (:: @ map code.int))
+         paramC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can perform bit 'and'."
+                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
+            (test "Can perform bit 'or'."
+                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
+            (test "Can perform bit 'xor'."
+                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the left."
+                  (check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the right."
+                  (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
+            (test "Can shift signed bit pattern to the right."
+                  (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
+            ))))
+
+(context: "Int procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.int (:: @ map code.int))
+         paramC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can add integers."
+                  (check-success+ "lux int +" (list subjectC paramC) Int))
+            (test "Can subtract integers."
+                  (check-success+ "lux int -" (list subjectC paramC) Int))
+            (test "Can multiply integers."
+                  (check-success+ "lux int *" (list subjectC paramC) Int))
+            (test "Can divide integers."
+                  (check-success+ "lux int /" (list subjectC paramC) Int))
+            (test "Can calculate remainder of integers."
+                  (check-success+ "lux int %" (list subjectC paramC) Int))
+            (test "Can test equality of integers."
+                  (check-success+ "lux int =" (list subjectC paramC) Bool))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum integer."
+                  (check-success+ "lux int min" (list) Int))
+            (test "Can obtain maximum integer."
+                  (check-success+ "lux int max" (list) Int))
+            (test "Can convert integer to natural number."
+                  (check-success+ "lux int to-nat" (list subjectC) Nat))
+            (test "Can convert integer to frac number."
+                  (check-success+ "lux int to-frac" (list subjectC) Frac))
+            (test "Can convert integer to text."
+                  (check-success+ "lux int char" (list subjectC) Text))
+            ))))
+
+(context: "Frac procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))
+         encodedC (|> (r.unicode +5) (:: @ map code.text))]
+        ($_ seq
+            (test "Can add frac numbers."
+                  (check-success+ "lux frac +" (list subjectC paramC) Frac))
+            (test "Can subtract frac numbers."
+                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
+            (test "Can multiply frac numbers."
+                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
+            (test "Can divide frac numbers."
+                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
+            (test "Can calculate remainder of frac numbers."
+                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
+            (test "Can test equality of frac numbers."
+                  (check-success+ "lux frac =" (list subjectC paramC) Bool))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum frac number."
+                  (check-success+ "lux frac min" (list) Frac))
+            (test "Can obtain maximum frac number."
+                  (check-success+ "lux frac max" (list) Frac))
+            (test "Can obtain smallest frac number."
+                  (check-success+ "lux frac smallest" (list) Frac))
+            (test "Can obtain not-a-number."
+                  (check-success+ "lux frac not-a-number" (list) Frac))
+            (test "Can obtain positive infinity."
+                  (check-success+ "lux frac positive-infinity" (list) Frac))
+            (test "Can obtain negative infinity."
+                  (check-success+ "lux frac negative-infinity" (list) Frac))
+            (test "Can convert frac number to integer."
+                  (check-success+ "lux frac to-int" (list subjectC) Int))
+            (test "Can convert frac number to text."
+                  (check-success+ "lux frac encode" (list subjectC) Text))
+            (test "Can convert text to frac number."
+                  (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
+            ))))
+
+(context: "Text procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> (r.unicode +5) (:: @ map code.text))
+         paramC (|> (r.unicode +5) (:: @ map code.text))
+         replacementC (|> (r.unicode +5) (:: @ map code.text))
+         fromC (|> r.nat (:: @ map code.nat))
+         toC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can test text equality."
+                  (check-success+ "lux text =" (list subjectC paramC) Bool))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) Bool))
+            (test "Can concatenate one text to another."
+                  (check-success+ "lux text concat" (list subjectC paramC) Text))
+            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
+                  (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
+            (test "Can query the size/length of a text."
+                  (check-success+ "lux text size" (list subjectC) Nat))
+            (test "Can calculate a hash code for text."
+                  (check-success+ "lux text hash" (list subjectC) Nat))
+            (test "Can replace a text inside of a larger one (once)."
+                  (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
+            (test "Can replace a text inside of a larger one (all times)."
+                  (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
+            (test "Can obtain the character code of a text at a given index."
+                  (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat))))
+            (test "Can clip a piece of text between 2 indices."
+                  (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text))))
+            ))))
+
+(context: "Array procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [arrayT (type (Array elemT))
+               g!array (code.local-symbol var-name)
+               array-operation (function (_ output-type code)
+                                 (|> (scopeL.with-scope ""
+                                       (scopeL.with-local [var-name arrayT]
+                                         (typeA.with-type output-type
+                                           (_primitive.analyse code))))
+                                     (macro.run (initL.compiler []))
+                                     (case> (#e.Success _)
+                                            true
+
+                                            (#e.Error error)
+                                            false)))]]
+        ($_ seq
+            (test "Can create arrays."
+                  (check-success+ "lux array new" (list sizeC) arrayT))
+            (test "Can get a value inside an array."
+                  (array-operation (type (Maybe elemT))
+                                   (` ("lux array get" (~ g!array) (~ idxC)))))
+            (test "Can put a value inside an array."
+                  (array-operation arrayT
+                                   (` ("lux array put" (~ g!array) (~ idxC) (~ elemC)))))
+            (test "Can remove a value from an array."
+                  (array-operation arrayT
+                                   (` ("lux array remove" (~ g!array) (~ idxC)))))
+            (test "Can query the size of an array."
+                  (array-operation Nat
+                                   (` ("lux array size" (~ g!array)))))
+            ))))
+
+(context: "Math procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))]
+        (`` ($_ seq
+                (~~ (do-template [<proc> <desc>]
+                      [(test (format "Can calculate " <desc> ".")
+                             (check-success+ <proc> (list subjectC) Frac))]
+
+                      ["lux math cos" "cosine"]
+                      ["lux math sin" "sine"]
+                      ["lux math tan" "tangent"]
+                      ["lux math acos" "inverse/arc cosine"]
+                      ["lux math asin" "inverse/arc sine"]
+                      ["lux math atan" "inverse/arc tangent"]
+                      ["lux math cosh" "hyperbolic cosine"]
+                      ["lux math sinh" "hyperbolic sine"]
+                      ["lux math tanh" "hyperbolic tangent"]
+                      ["lux math exp" "exponentiation"]
+                      ["lux math log" "logarithm"]
+                      ["lux math ceil" "ceiling"]
+                      ["lux math floor" "floor"]
+                      ["lux math round" "rounding"]))
+                (~~ (do-template [<proc> <desc>]
+                      [(test (format "Can calculate " <desc> ".")
+                             (check-success+ <proc> (list subjectC paramC) Frac))]
+
+                      ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
+                      ["lux math pow" "power"])))))))
+
+(context: "Atom procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [atomT (type (atom.Atom elemT))]]
+        ($_ seq
+            (test "Can create atomic reference."
+                  (check-success+ "lux atom new" (list elemC) atomT))
+            (test "Can read the value of an atomic reference."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type elemT
+                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            (test "Can swap the value of an atomic reference."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type Bool
+                            (_primitive.analyse (` ("lux atom compare-and-swap"
+                                                    (~ (code.symbol ["" var-name]))
+                                                    (~ elemC)
+                                                    (~ elemC)))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            ))))
+
+(context: "Process procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         timeC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can query the level of concurrency."
+                  (check-success+ "lux process parallelism-level" (list) Nat))
+            (test "Can schedule an IO computation to run concurrently at some future time."
+                  (check-success+ "lux process schedule"
+                                  (list timeC
+                                        (` ("lux function" (~' _) (~' _) (~ primC))))
+                                  Any))
+            ))))
+
+(context: "IO procedures"
+  (<| (times +100)
+      (do @
+        [logC (|> (r.unicode +5) (:: @ map code.text))
+         exitC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io log" (list logC) Any))
+            (test "Can throw a run-time error."
+                  (check-success+ "lux io error" (list logC) Nothing))
+            (test "Can exit the program."
+                  (check-success+ "lux io exit" (list exitC) Nothing))
+            (test "Can query the current time (as milliseconds since epoch)."
+                  (check-success+ "lux io current-time" (list) Int))
+            ))))
diff --git a/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
new file mode 100644
index 000000000..0a60149d5
--- /dev/null
+++ b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
@@ -0,0 +1,541 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data ["e" error]
+             [product]
+             [maybe]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]
+                   [list "list/" Fold<List>]
+                   (dictionary ["dict" unordered])))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Meta>]
+       (macro [code])
+       [lang]
+       (lang [type]
+             [".L" init]
+             (analysis [".A" type])
+             (extension (analysis [".AE" host])))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (do Monad<Meta>
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [success true false]
+  [failure false true]
+  )
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> syntax output-type)
+     (-> Code Type Bool)
+     (|> (do Monad<Meta>
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse syntax))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [success' true false]
+  [failure' false true]
+  )
+
+(context: "Conversions [double + float]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
+                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
+                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
+                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
+                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
+                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [int]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
+                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
+                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
+                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
+                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
+                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [long]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
+                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
+                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
+                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
+                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [char + byte + short]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
+                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
+                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
+                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
+                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
+                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Arithmetic " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Bitwise " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " and") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " or") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " xor") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>]
+                                        [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>]
+                                        [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["int" "java.lang.Integer" hostAE.Integer]
+  ["long" "java.lang.Long" hostAE.Long]
+  )
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Arithmetic " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["float" "java.lang.Float" hostAE.Float]
+  ["double" "java.lang.Double" hostAE.Double]
+  )
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["char" "java.lang.Character" hostAE.Character]
+  )
+
+(def: array-type
+  (r.Random [Text Text])
+  (let [entries (dict.entries hostAE.boxes)
+        num-entries (list.size entries)]
+    (do r.Monad<Random>
+      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
+       #let [[unboxed boxed] (: [Text Text]
+                                (|> entries
+                                    (list.nth choice)
+                                    (maybe.default ["java.lang.Object" "java.lang.Object"])))]]
+      (wrap [unboxed boxed]))))
+
+(context: "Array."
+  (<| (times +100)
+      (do @
+        [#let [cap (|>> (n/% +10) (n/max +1))]
+         [unboxed boxed] array-type
+         size (|> r.nat (:: @ map cap))
+         idx (|> r.nat (:: @ map (n/% size)))
+         level (|> r.nat (:: @ map cap))
+         #let [unboxedT (#.Primitive unboxed (list))
+               arrayT (#.Primitive "#Array" (list unboxedT))
+               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0)))
+                           ("jvm array new" (~ (code.nat size)))))
+               boxedT (#.Primitive boxed (list))
+               boxedTC (` (+0 (~ (code.text boxed)) (+0)))
+               multi-arrayT (list/fold (function (_ _ innerT)
+                                         (|> innerT (list) (#.Primitive "#Array")))
+                                       boxedT
+                                       (list.n/range +1 level))]]
+        ($_ seq
+            (test "jvm array new"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           arrayT))
+            (test "jvm array new (no nesting)"
+                  (failure "jvm array new"
+                           (list (code.nat size))
+                           unboxedT))
+            (test "jvm array new (nested/multi-level)"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           multi-arrayT))
+            (test "jvm array length"
+                  (success "jvm array length"
+                           (list arrayC)
+                           Nat))
+            (test "jvm array read"
+                  (success' (` ("jvm object cast"
+                                ("jvm array read" (~ arrayC) (~ (code.nat idx)))))
+                            boxedT))
+            (test "jvm array write"
+                  (success "jvm array write"
+                           (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) [])))
+                           arrayT))
+            ))))
+
+(def: throwables
+  (List Text)
+  (list "java.lang.Throwable"
+        "java.lang.Error"
+        "java.io.IOError"
+        "java.lang.VirtualMachineError"
+        "java.lang.Exception"
+        "java.io.IOException"
+        "java.lang.RuntimeException"))
+
+(context: "Object."
+  (<| (times +100)
+      (do @
+        [[unboxed boxed] array-type
+         [!unboxed !boxed] (|> array-type
+                               (r.filter (function (_ [!unboxed !boxed])
+                                           (not (text/= boxed !boxed)))))
+         #let [boxedT (#.Primitive boxed (list))
+               boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0))
+                           ("jvm object null")))
+               !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0))
+                            ("jvm object null")))
+               unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
+                             ("jvm object null")))]
+         throwable (|> r.nat
+                       (:: @ map (n/% (inc (list.size throwables))))
+                       (:: @ map (function (_ idx)
+                                   (|> throwables
+                                       (list.nth idx)
+                                       (maybe.default "java.lang.Object")))))
+         #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0))
+                               ("jvm object null")))]]
+        ($_ seq
+            (test "jvm object null"
+                  (success "jvm object null"
+                           (list)
+                           (#.Primitive boxed (list))))
+            (test "jvm object null (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object null"
+                               (list)
+                               (#.Primitive unboxed (list)))))
+            (test "jvm object null?"
+                  (success "jvm object null?"
+                           (list boxedC)
+                           Bool))
+            (test "jvm object synchronized"
+                  (success "jvm object synchronized"
+                           (list boxedC boxedC)
+                           boxedT))
+            (test "jvm object synchronized (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object synchronized"
+                               (list unboxedC boxedC)
+                               boxedT)))
+            (test "jvm object throw"
+                  (or (text/= "java.lang.Object" throwable)
+                      (success "jvm object throw"
+                               (list throwableC)
+                               Nothing)))
+            (test "jvm object class"
+                  (success "jvm object class"
+                           (list (code.text boxed))
+                           (#.Primitive "java.lang.Class" (list boxedT))))
+            (test "jvm object instance?"
+                  (success "jvm object instance?"
+                           (list (code.text boxed)
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (lineage)"
+                  (success "jvm object instance?"
+                           (list (' "java.lang.Object")
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (no lineage)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object instance?"
+                               (list (code.text boxed)
+                                     !boxedC)
+                               Bool)))
+            ))))
+
+(context: "Member [Static Field]."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.io.PrintStream" (list))))
+      (test "jvm member static get (inheritance out)"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member static put"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (final)"
+            (failure "jvm member static put"
+                     (list (code.text "java.lang.System")
+                           (code.text "out")
+                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (inheritance in)"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
+                                 ("jvm object null")))))
+                     Any))
+      ))
+
+(context: "Member [Virtual Field]."
+  ($_ seq
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.String" (list))))
+      (test "jvm member virtual get (inheritance out)"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "java.lang.String" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (primitive "org.omg.CORBA.ValueMember")))
+      (test "jvm member virtual put (final)"
+            (failure "jvm member virtual put"
+                     (list (code.text "javax.swing.text.html.parser.DTD")
+                           (code.text "applet")
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.swing.text.html.parser.DTD")))
+      (test "jvm member virtual put (inheritance in)"
+            (success "jvm member virtual put"
+                     (list (code.text "java.awt.GridBagConstraints")
+                           (code.text "insets")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
+                                ("jvm object null"))))
+                     (primitive "java.awt.GridBagConstraints")))
+      ))
+
+(context: "Boxing/Unboxing."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.util.GregorianCalendar")
+                           (code.text "AD"))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "java.lang.Integer" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.accessibility.AccessibleAttributeSequence")))
+      ))
+
+(context: "Member [Method]."
+  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
+                  +123))
+        intC (`' ("jvm convert long-to-int" (~ longC)))
+        stringC (' ("lux coerce" (+0 "java.lang.String" (+0))
+                    "YOLO"))
+        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
+                     ("jvm member invoke constructor" "java.util.ArrayList"
+                      ["int" ("jvm object cast" (~ intC))])))]
+    ($_ seq
+        (test "jvm member invoke static"
+              (success' (` ("jvm member invoke static"
+                            "java.lang.Long" "decode"
+                            ["java.lang.String" (~ stringC)]))
+                        (#.Primitive "java.lang.Long" (list))))
+        (test "jvm member invoke virtual"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke virtual"
+                             "java.lang.Object" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke special"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke special"
+                             "java.lang.Long" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke interface"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke interface"
+                             "java.util.Collection" "add"
+                             ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke constructor"
+              (success' (` ("jvm member invoke constructor"
+                            "java.util.ArrayList"
+                            ["int" ("jvm object cast" (~ intC))]))
+                        (All [a] (#.Primitive "java.util.ArrayList" (list a)))))
+        )))