- Added tests for host procedures.

3 files changed, 473 insertions, 105 deletions

diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
index c8dc5a38a..c75d6efd4 100644
--- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux
@@ -11,6 +11,7 @@
                    [array #+ Array]
                    ["d" dict]))
        [macro #+ Monad<Lux>]
+       [type]
        (type ["TC" check])
        [host])
   (luxc ["&" base]
@@ -20,26 +21,32 @@
   ["@" ../common]
   )
 
-(def: Boolean Type (host java.lang.Boolean))
-(def: Byte Type (host java.lang.Byte))
-(def: Short Type (host java.lang.Short))
-(def: Integer Type (host java.lang.Integer))
-(def: Long Type (host java.lang.Long))
-(def: Float Type (host java.lang.Float))
-(def: Double Type (host java.lang.Double))
-(def: Character Type (host java.lang.Character))
-(def: String Type (host java.lang.String))
-
-(def: boolean Type (host boolean))
-(def: byte Type (host byte))
-(def: short Type (host short))
-(def: int Type (host int))
-(def: long Type (host long))
-(def: float Type (host float))
-(def: double Type (host double))
-(def: char Type (host char))
-
-(def: converter-procs
+(do-template [<name> <class>]
+  [(def: #export <name> Type (#;Host <class> (list)))]
+
+  ## Boxes
+  [Boolean   "java.lang.Boolean"]
+  [Byte      "java.lang.Byte"]
+  [Short     "java.lang.Short"]
+  [Integer   "java.lang.Integer"]
+  [Long      "java.lang.Long"]
+  [Float     "java.lang.Float"]
+  [Double    "java.lang.Double"]
+  [Character "java.lang.Character"]
+  [String    "java.lang.String"]
+
+  ## Primitives
+  [boolean   "boolean"]
+  [byte      "byte"]
+  [short     "short"]
+  [int       "int"]
+  [long      "long"]
+  [float     "float"]
+  [double    "double"]
+  [char      "char"]
+  )
+
+(def: conversion-procs
   @;Bundle
   (<| (@;prefix "convert")
       (|> (d;new text;Hash<Text>)
@@ -73,14 +80,14 @@
      @;Bundle
      (<| (@;prefix <prefix>)
          (|> (d;new text;Hash<Text>)
-             (@;install "add" (@;binary <type> <type> <type>))
-             (@;install "sub" (@;binary <type> <type> <type>))
-             (@;install "mul" (@;binary <type> <type> <type>))
-             (@;install "div" (@;binary <type> <type> <type>))
-             (@;install "rem" (@;binary <type> <type> <type>))
-             (@;install "eq" (@;binary <type> <type> Boolean))
-             (@;install "lt" (@;binary <type> <type> Boolean))
-             (@;install "gt" (@;binary <type> <type> Boolean))
+             (@;install "+" (@;binary <type> <type> <type>))
+             (@;install "-" (@;binary <type> <type> <type>))
+             (@;install "*" (@;binary <type> <type> <type>))
+             (@;install "/" (@;binary <type> <type> <type>))
+             (@;install "%" (@;binary <type> <type> <type>))
+             (@;install "=" (@;binary <type> <type> Boolean))
+             (@;install "<" (@;binary <type> <type> Boolean))
+             (@;install ">" (@;binary <type> <type> Boolean))
              (@;install "and" (@;binary <type> <type> <type>))
              (@;install "or" (@;binary <type> <type> <type>))
              (@;install "xor" (@;binary <type> <type> <type>))
@@ -98,14 +105,14 @@
      @;Bundle
      (<| (@;prefix <prefix>)
          (|> (d;new text;Hash<Text>)
-             (@;install "add" (@;binary <type> <type> <type>))
-             (@;install "sub" (@;binary <type> <type> <type>))
-             (@;install "mul" (@;binary <type> <type> <type>))
-             (@;install "div" (@;binary <type> <type> <type>))
-             (@;install "rem" (@;binary <type> <type> <type>))
-             (@;install "eq" (@;binary <type> <type> Boolean))
-             (@;install "lt" (@;binary <type> <type> Boolean))
-             (@;install "gt" (@;binary <type> <type> Boolean))
+             (@;install "+" (@;binary <type> <type> <type>))
+             (@;install "-" (@;binary <type> <type> <type>))
+             (@;install "*" (@;binary <type> <type> <type>))
+             (@;install "/" (@;binary <type> <type> <type>))
+             (@;install "%" (@;binary <type> <type> <type>))
+             (@;install "=" (@;binary <type> <type> Boolean))
+             (@;install "<" (@;binary <type> <type> Boolean))
+             (@;install ">" (@;binary <type> <type> Boolean))
              )))]
 
   [float-procs  "float"  Float]
@@ -116,12 +123,12 @@
   @;Bundle
   (<| (@;prefix "char")
       (|> (d;new text;Hash<Text>)
-          (@;install "ceq" (@;binary Character Character Boolean))
-          (@;install "clt" (@;binary Character Character Boolean))
-          (@;install "cgt" (@;binary Character Character Boolean))
+          (@;install "=" (@;binary Character Character Boolean))
+          (@;install "<" (@;binary Character Character Boolean))
+          (@;install ">" (@;binary Character Character Boolean))
           )))
 
-(def: primitive-boxes
+(def: #export boxes
   (d;Dict Text Text)
   (|> (list ["boolean" "java.lang.Boolean"]
             ["byte" "java.lang.Byte"]
@@ -133,21 +140,6 @@
             ["char" "java.lang.Character"])
       (d;from-list text;Hash<Text>)))
 
-(def: array-type
-  (l;Lexer [Type Nat Text])
-  (do p;Monad<Parser>
-    [subs (p;some (l;this "["))
-     #let [level (list;size subs)]
-     class (l;many l;any)]
-    (wrap [(list/fold (function [_ inner]
-                        (type (Array inner)))
-                      (#;Host (|> (d;get class primitive-boxes)
-                                  (default class))
-                              (list))
-                      (list;n.range +1 level))
-           level
-           class])))
-
 (def: (array-length proc)
   (-> Text @;Proc)
   (function [analyse args]
@@ -166,34 +158,77 @@
           _
           (&;fail (@;wrong-amount-error proc +1 (list;size args))))))))
 
+(def: (invalid-array-type arrayT)
+  (-> Type Text)
+  (format "Invalid type for array: " (%type arrayT)))
+
 (def: (array-new proc)
   (-> Text @;Proc)
   (function [analyse args]
     (case args
-      (^ (list classC lengthC))
-      (case classC
-        [_ (#;Text classC)]
-        (do Monad<Lux>
-          [lengthA (&;with-expected-type Nat
-                     (analyse lengthC))
-           arrayT (case (l;run classC array-type)
-                    (#R;Success [innerT level elem-class])
-                    (wrap (type (Array innerT)))
-
-                    (#R;Error error)
-                    (&;fail error))
-           expectedT macro;expected-type
-           _ (&;within-type-env
-              (TC;check expectedT arrayT))]
-          (wrap (#la;Procedure proc (list (#la;Text classC) lengthA))))
-
-        _
-        (&;fail (format "Wrong syntax for '" proc "'.")))
+      (^ (list lengthC))
+      (do Monad<Lux>
+        [lengthA (&;with-expected-type Nat
+                   (analyse lengthC))
+         expectedT macro;expected-type
+         [level elem-class] (: (Lux [Nat Text])
+                               (loop [analysisT expectedT
+                                      level +0]
+                                 (case analysisT
+                                   (#;Apply inputT funcT)
+                                   (case (type;apply (list inputT) funcT)
+                                     (#;Some outputT)
+                                     (recur outputT level)
+
+                                     #;None
+                                     (&;fail (invalid-array-type expectedT)))
+
+                                   (^ (#;Host "#Array" (list elemT)))
+                                   (recur elemT (n.inc level))
+
+                                   (#;Host class _)
+                                   (wrap [level class])
+                                   
+                                   _
+                                   (&;fail (invalid-array-type expectedT)))))
+         _ (&;assert "Must have at least 1 level of nesting in array type."
+                     (n.> +0 level))]
+        (wrap (#la;Procedure proc (list (#la;Nat level) (#la;Text elem-class) lengthA))))
 
       _
-      (&;fail (@;wrong-amount-error proc +2 (list;size args))))))
+      (&;fail (@;wrong-amount-error proc +1 (list;size args))))))
+
+(def: (check-object objectT)
+  (-> Type (Lux Text))
+  (case objectT
+    (#;Host name _)
+    (if (d;contains? name boxes)
+      (&;fail (format "Primitives are not objects: " name))
+      (:: Monad<Lux> wrap name))
 
-(def: (array-load proc)
+    _
+    (&;fail (format "Non-object type: " (%type objectT)))))
+
+(def: (box-array-element-type elemT)
+  (-> Type (Lux [Type Text]))
+  (do Monad<Lux>
+    []
+    (case elemT
+      (#;Host name #;Nil)
+      (let [boxed-name (|> (d;get name boxes)
+                           (default name))]
+        (wrap [(#;Host boxed-name #;Nil)
+               boxed-name]))
+
+      (#;Host name _)
+      (if (d;contains? name boxes)
+        (&;fail (format "Primitives cannot be parameterized: " name))
+        (:: Monad<Lux> wrap [elemT name]))
+
+      _
+      (&;fail (format "Invalid type for array element: " (%type elemT))))))
+
+(def: (array-read proc)
   (-> Text @;Proc)
   (function [analyse args]
     (&common;with-var
@@ -205,12 +240,7 @@
                       (analyse arrayC))
              elemT (&;within-type-env
                     (TC;read-var var-id))
-             elem-class (case elemT
-                          (#;Host name _)
-                          (wrap name)
-
-                          _
-                          (&;fail (format "Invalid type for array element: " (%type elemT))))
+             [elemT elem-class] (box-array-element-type elemT)
              idxA (&;with-expected-type Nat
                     (analyse idxC))
              expectedT macro;expected-type
@@ -221,7 +251,7 @@
           _
           (&;fail (@;wrong-amount-error proc +2 (list;size args))))))))
 
-(def: (array-store proc)
+(def: (array-write proc)
   (-> Text @;Proc)
   (function [analyse args]
     (&common;with-var
@@ -233,15 +263,10 @@
                       (analyse arrayC))
              elemT (&;within-type-env
                     (TC;read-var var-id))
-             elem-class (case elemT
-                          (#;Host name _)
-                          (wrap name)
-
-                          _
-                          (&;fail (format "Invalid type for array element: " (%type elemT))))
+             [valueT elem-class] (box-array-element-type elemT)
              idxA (&;with-expected-type Nat
                     (analyse idxC))
-             valueA (&;with-expected-type elemT
+             valueA (&;with-expected-type valueT
                       (analyse valueC))
              expectedT macro;expected-type
              _ (&;within-type-env
@@ -257,21 +282,10 @@
       (|> (d;new text;Hash<Text>)
           (@;install "length" array-length)
           (@;install "new" array-new)
-          (@;install "load" array-load)
-          (@;install "store" array-store)
+          (@;install "read" array-read)
+          (@;install "write" array-write)
           )))
 
-(def: (check-object objectT)
-  (-> Type (Lux Text))
-  (case objectT
-    (#;Host name _)
-    (if (d;contains? name primitive-boxes)
-      (&;fail (format "Primitives are not objects: " name))
-      (:: Monad<Lux> wrap name))
-
-    _
-    (&;fail (format "Non-object type: " (%type objectT)))))
-
 (def: (object-null proc)
   (-> Text @;Proc)
   (function [analyse args]
@@ -414,7 +428,7 @@
   @;Bundle
   (<| (@;prefix "jvm")
       (|> (d;new text;Hash<Text>)
-          (d;merge converter-procs)
+          (d;merge conversion-procs)
           (d;merge int-procs)
           (d;merge long-procs)
           (d;merge float-procs)
diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux
new file mode 100644
index 000000000..eec4ec723
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux
@@ -0,0 +1,353 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data text/format
+             [text "text/" Eq<Text>]
+             ["R" result]
+             [product]
+             (coll [array]
+                   [list "list/" Fold<List>]
+                   [dict]))
+       ["r" math/random "r/" Monad<Random>]
+       [type]
+       [macro #+ Monad<Lux>]
+       (macro [code])
+       test)
+  (luxc ["&" base]
+        ["&;" scope]
+        ["&;" module]
+        (lang ["~" analysis])
+        [analyser]
+        (analyser ["@" procedure]
+                  ["@;" common]
+                  (procedure ["@;" host]))
+        (generator ["@;" runtime]))
+  (../.. common)
+  (test/luxc common))
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (do Monad<Lux>
+           [runtime-bytecode @runtime;generate]
+           (&;with-scope
+             (&;with-expected-type output-type
+               (@;analyse-procedure analyse procedure params))))
+         (macro;run (init-compiler []))
+         (case> (#R;Success _)
+                <success>
+
+                (#R;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" @host;Float]
+                                    ["jvm convert double-to-int" "java.lang.Double" @host;Integer]
+                                    ["jvm convert double-to-long" "java.lang.Double" @host;Long]
+                                    ["jvm convert float-to-double" "java.lang.Float" @host;Double]
+                                    ["jvm convert float-to-int" "java.lang.Float" @host;Integer]
+                                    ["jvm convert float-to-long" "java.lang.Float" @host;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" @host;Byte]
+                                    ["jvm convert int-to-char" "java.lang.Integer" @host;Character]
+                                    ["jvm convert int-to-double" "java.lang.Integer" @host;Double]
+                                    ["jvm convert int-to-float" "java.lang.Integer" @host;Float]
+                                    ["jvm convert int-to-long" "java.lang.Integer" @host;Long]
+                                    ["jvm convert int-to-short" "java.lang.Integer" @host;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" @host;Double]
+                                    ["jvm convert long-to-float" "java.lang.Long" @host;Float]
+                                    ["jvm convert long-to-int" "java.lang.Long" @host;Integer]
+                                    ["jvm convert long-to-short" "java.lang.Long" @host;Short]
+                                    ["jvm convert long-to-byte" "java.lang.Long" @host;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" @host;Byte]
+                                    ["jvm convert char-to-short" "java.lang.Character" @host;Short]
+                                    ["jvm convert char-to-int" "java.lang.Character" @host;Integer]
+                                    ["jvm convert char-to-long" "java.lang.Character" @host;Long]
+                                    ["jvm convert byte-to-long" "java.lang.Byte" @host;Long]
+                                    ["jvm convert short-to-long" "java.lang.Short" @host;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> @host;Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+                                        [(format "jvm " <domain> " >") <boxed> <boxed> @host;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" @host;Integer]
+  ["long" "java.lang.Long" @host;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> @host;Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+                                        [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["float" "java.lang.Float" @host;Float]
+  ["double" "java.lang.Double" @host;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> @host;Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean]
+                                        [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["char" "java.lang.Character" @host;Character]
+  )
+
+(def: array-type
+  (r;Random [Text Text])
+  (let [entries (dict;entries @host;boxes)
+        num-entries (list;size entries)]
+    (do r;Monad<Random>
+      [choice (|> r;nat (:: @ map (n.% (n.inc num-entries))))
+       #let [[unboxed boxed] (: [Text Text]
+                                (|> entries
+                                    (list;nth choice)
+                                    (default ["java.lang.Object" "java.lang.Object"])))]]
+      (wrap [unboxed boxed]))))
+
+(context: "Array."
+  [#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 (#;Host unboxed (list))
+         arrayT (#;Host "#Array" (list unboxedT))
+         arrayC (`' (_lux_check (+0 "#Array" (+1 (+0 (~ (code;text unboxed)) (+0)) (+0)))
+                                ("jvm array new" (~ (code;nat size)))))
+         boxedT (#;Host boxed (list))
+         boxedTC (` (+0 (~ (code;text boxed)) (+0)))
+         multi-arrayT (list/fold (function [_ innerT]
+                                   (|> innerT (list) (#;Host "#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 array read"
+                     (list 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."
+  [[unboxed boxed] array-type
+   #let [boxedT (#;Host boxed (list))
+         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.% (n.inc (list;size throwables))))
+                 (:: @ map (function [idx]
+                             (|> throwables
+                                 (list;nth idx)
+                                 (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)
+                     (#;Host boxed (list))))
+      (test "jvm object null (no primitives)"
+            (or (text/= "java.lang.Object" boxed)
+                (failure "jvm object null"
+                         (list)
+                         (#;Host 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)
+                         Bottom)))
+      (test "jvm object class"
+            (success "jvm object class"
+                     (list (code;text boxed))
+                     (#;Host "java.lang.Class" (list boxedT))))
+      ))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 28ccefc42..311b6666f 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -12,7 +12,8 @@
                         ["_;A" case]
                         ["_;A" function]
                         ["_;A" type]
-                        (procedure ["_;A" common]))
+                        (procedure ["_;A" common]
+                                   ["_;A" host]))
               (synthesizer ["_;S" primitive]
                            ["_;S" structure]
                            (case ["_;S" special])