Improvements and fixes for JVM extensions.

5 files changed, 347 insertions, 357 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index a9df2710c..d5a7bd3f5 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -53,13 +53,9 @@
   [(def: (<name> inputI)
      (Unary Inst)
      (if (is? _.NOP <conversion>)
+       inputI
        (|>> inputI
-            (_.unwrap <unwrap>)
-            (_.wrap <wrap>))
-       (|>> inputI
-            (_.unwrap <unwrap>)
-            <conversion>
-            (_.wrap <wrap>))))]
+            <conversion>)))]
   
   [conversion::double-to-float #$.Double _.D2F #$.Float]
   [conversion::double-to-int #$.Double _.D2I #$.Int]
@@ -117,61 +113,61 @@
           (bundle.install "short-to-long" (unary conversion::short-to-long))
           )))
 
-(template [<name> <op> <unwrapX> <unwrapY> <wrap>]
+(template [<name> <op>]
   [(def: (<name> [xI yI])
      (Binary Inst)
-     (|>> xI (_.unwrap <unwrapX>)
-          yI (_.unwrap <unwrapY>)
-          <op> (_.wrap <wrap>)))]
-
-  [int::+ _.IADD #$.Int #$.Int #$.Int]
-  [int::- _.ISUB #$.Int #$.Int #$.Int]
-  [int::* _.IMUL #$.Int #$.Int #$.Int]
-  [int::/ _.IDIV #$.Int #$.Int #$.Int]
-  [int::% _.IREM #$.Int #$.Int #$.Int]
-  [int::and _.IAND #$.Int #$.Int #$.Int]
-  [int::or _.IOR #$.Int #$.Int #$.Int]
-  [int::xor _.IXOR #$.Int #$.Int #$.Int]
-  [int::shl _.ISHL #$.Int #$.Int #$.Int]
-  [int::shr _.ISHR #$.Int #$.Int #$.Int]
-  [int::ushr _.IUSHR #$.Int #$.Int #$.Int]
+     (|>> xI
+          yI
+          <op>))]
+
+  [int::+ _.IADD]
+  [int::- _.ISUB]
+  [int::* _.IMUL]
+  [int::/ _.IDIV]
+  [int::% _.IREM]
+  [int::and _.IAND]
+  [int::or _.IOR]
+  [int::xor _.IXOR]
+  [int::shl _.ISHL]
+  [int::shr _.ISHR]
+  [int::ushr _.IUSHR]
   
-  [long::+ _.LADD #$.Long #$.Long #$.Long]
-  [long::- _.LSUB #$.Long #$.Long #$.Long]
-  [long::* _.LMUL #$.Long #$.Long #$.Long]
-  [long::/ _.LDIV #$.Long #$.Long #$.Long]
-  [long::% _.LREM #$.Long #$.Long #$.Long]
-  [long::and _.LAND #$.Long #$.Long #$.Long]
-  [long::or _.LOR #$.Long #$.Long #$.Long]
-  [long::xor _.LXOR #$.Long #$.Long #$.Long]
-  [long::shl _.LSHL #$.Long #$.Int #$.Long]
-  [long::shr _.LSHR #$.Long #$.Int #$.Long]
-  [long::ushr _.LUSHR #$.Long #$.Int #$.Long]
-
-  [float::+ _.FADD #$.Float #$.Float #$.Float]
-  [float::- _.FSUB #$.Float #$.Float #$.Float]
-  [float::* _.FMUL #$.Float #$.Float #$.Float]
-  [float::/ _.FDIV #$.Float #$.Float #$.Float]
-  [float::% _.FREM #$.Float #$.Float #$.Float]
+  [long::+ _.LADD]
+  [long::- _.LSUB]
+  [long::* _.LMUL]
+  [long::/ _.LDIV]
+  [long::% _.LREM]
+  [long::and _.LAND]
+  [long::or _.LOR]
+  [long::xor _.LXOR]
+  [long::shl _.LSHL]
+  [long::shr _.LSHR]
+  [long::ushr _.LUSHR]
+
+  [float::+ _.FADD]
+  [float::- _.FSUB]
+  [float::* _.FMUL]
+  [float::/ _.FDIV]
+  [float::% _.FREM]
   
-  [double::+ _.DADD #$.Double #$.Double #$.Double]
-  [double::- _.DSUB #$.Double #$.Double #$.Double]
-  [double::* _.DMUL #$.Double #$.Double #$.Double]
-  [double::/ _.DDIV #$.Double #$.Double #$.Double]
-  [double::% _.DREM #$.Double #$.Double #$.Double]
+  [double::+ _.DADD]
+  [double::- _.DSUB]
+  [double::* _.DMUL]
+  [double::/ _.DDIV]
+  [double::% _.DREM]
   )
 
 (def: boolean-class (_t.class "java.lang.Boolean" (list)))
 (def: falseI (_.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class))
 (def: trueI (_.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class))
 
-(template [<name> <op> <unwrap>]
+(template [<name> <op>]
   [(def: (<name> [xI yI])
      (Binary Inst)
      (<| _.with-label (function (_ @then))
          _.with-label (function (_ @end))
-         (|>> xI (_.unwrap <unwrap>)
-              yI (_.unwrap <unwrap>)
+         (|>> xI
+              yI
               (<op> @then)
               falseI
               (_.GOTO @end)
@@ -179,20 +175,20 @@
               trueI
               (_.label @end))))]
 
-  [int::= _.IF_ICMPEQ #$.Int]
-  [int::< _.IF_ICMPLT #$.Int]
+  [int::= _.IF_ICMPEQ]
+  [int::< _.IF_ICMPLT]
 
-  [char::= _.IF_ICMPEQ #$.Char]
-  [char::< _.IF_ICMPLT #$.Char]
+  [char::= _.IF_ICMPEQ]
+  [char::< _.IF_ICMPLT]
   )
 
-(template [<name> <op> <reference> <unwrap>]
+(template [<name> <op> <reference>]
   [(def: (<name> [xI yI])
      (Binary Inst)
      (<| _.with-label (function (_ @then))
          _.with-label (function (_ @end))
-         (|>> xI (_.unwrap <unwrap>)
-              yI (_.unwrap <unwrap>)
+         (|>> xI
+              yI
               <op>
               (_.int <reference>)
               (_.IF_ICMPEQ @then)
@@ -202,14 +198,14 @@
               trueI
               (_.label @end))))]
 
-  [long::= _.LCMP +0 #$.Long]
-  [long::< _.LCMP -1 #$.Long]
+  [long::= _.LCMP +0]
+  [long::< _.LCMP -1]
   
-  [float::= _.FCMPG +0 #$.Float]
-  [float::< _.FCMPG -1 #$.Float]
+  [float::= _.FCMPG +0]
+  [float::< _.FCMPG -1]
 
-  [double::= _.DCMPG +0 #$.Double]
-  [double::< _.DCMPG -1 #$.Double]
+  [double::= _.DCMPG +0]
+  [double::< _.DCMPG -1]
   )
 
 (def: int
@@ -308,9 +304,7 @@
       [arrayI (generate arrayS)]
       (wrap (|>> arrayI
                  (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
-                 _.ARRAYLENGTH
-                 _.I2L
-                 (_.wrap #$.Long))))
+                 _.ARRAYLENGTH)))
 
     _
     (phase.throw extension.invalid-syntax [proc %synthesis inputs])))
@@ -324,8 +318,6 @@
     (do phase.monad
       [lengthI (generate lengthS)]
       (wrap (|>> lengthI
-                 (_.unwrap #$.Long)
-                 _.L2I
                  (_.array (array-java-type (.nat nesting) elem-class)))))
 
     _
@@ -342,20 +334,18 @@
       [arrayI (generate arrayS)
        idxI (generate idxS)
        #let [loadI (case elem-class
-                     "boolean" (|>> _.BALOAD (_.wrap #$.Boolean))
-                     "byte" (|>> _.BALOAD (_.wrap #$.Byte))
-                     "short" (|>> _.SALOAD (_.wrap #$.Short))
-                     "int" (|>> _.IALOAD (_.wrap #$.Int))
-                     "long" (|>> _.LALOAD (_.wrap #$.Long))
-                     "float" (|>> _.FALOAD (_.wrap #$.Float))
-                     "double" (|>> _.DALOAD (_.wrap #$.Double))
-                     "char" (|>> _.CALOAD (_.wrap #$.Char))
+                     "boolean" _.BALOAD
+                     "byte" _.BALOAD
+                     "short" _.SALOAD
+                     "int" _.IALOAD
+                     "long" _.LALOAD
+                     "float" _.FALOAD
+                     "double" _.DALOAD
+                     "char" _.CALOAD
                      _ _.AALOAD)]]
       (wrap (|>> arrayI
                  (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
                  idxI
-                 (_.unwrap #$.Long)
-                 _.L2I
                  loadI)))
 
     _
@@ -374,21 +364,19 @@
        idxI (generate idxS)
        valueI (generate valueS)
        #let [storeI (case elem-class
-                      "boolean" (|>> (_.unwrap #$.Boolean) _.BASTORE)
-                      "byte" (|>> (_.unwrap #$.Byte) _.BASTORE)
-                      "short" (|>> (_.unwrap #$.Short) _.SASTORE)
-                      "int" (|>> (_.unwrap #$.Int) _.IASTORE)
-                      "long" (|>> (_.unwrap #$.Long) _.LASTORE)
-                      "float" (|>> (_.unwrap #$.Float) _.FASTORE)
-                      "double" (|>> (_.unwrap #$.Double) _.DASTORE)
-                      "char" (|>> (_.unwrap #$.Char) _.CASTORE)
+                      "boolean" _.BASTORE
+                      "byte" _.BASTORE
+                      "short" _.SASTORE
+                      "int" _.IASTORE
+                      "long" _.LASTORE
+                      "float" _.FASTORE
+                      "double" _.DASTORE
+                      "char" _.CASTORE
                       _ _.AASTORE)]]
       (wrap (|>> arrayI
                  (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
                  _.DUP
                  idxI
-                 (_.unwrap #$.Long)
-                 _.L2I
                  valueI
                  storeI)))
 
@@ -528,8 +516,7 @@
       []
       (case (dictionary.get unboxed primitives)
         (#.Some primitive)
-        (wrap (|>> (_.GETSTATIC class field (#$.Primitive primitive))
-                   (_.wrap primitive)))
+        (wrap (_.GETSTATIC class field (#$.Primitive primitive)))
         
         #.None
         (wrap (_.GETSTATIC class field (_t.class unboxed (list))))))
@@ -549,7 +536,6 @@
       (case (dictionary.get unboxed primitives)
         (#.Some primitive)
         (wrap (|>> valueI
-                   (_.unwrap primitive)
                    (_.PUTSTATIC class field (#$.Primitive primitive))
                    (_.string synthesis.unit)))
         
@@ -575,8 +561,7 @@
         (#.Some primitive)
         (wrap (|>> objectI
                    (_.CHECKCAST class)
-                   (_.GETFIELD class field (#$.Primitive primitive))
-                   (_.wrap primitive)))
+                   (_.GETFIELD class field (#$.Primitive primitive))))
         
         #.None
         (wrap (|>> objectI
@@ -603,7 +588,6 @@
                    (_.CHECKCAST class)
                    _.DUP
                    valueI
-                   (_.unwrap primitive)
                    (_.PUTFIELD class field (#$.Primitive primitive))))
         
         #.None
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index 4cb89c71b..d73ca2e7f 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -21,17 +21,28 @@
   {#.doc "Mutable arrays."}
   (#.Primitive ..type-name (#.Cons a #.Nil)))
 
-(with-expansions [<elem-type> (primitive "java.lang.Object")
+(with-expansions [<index-type> (primitive "java.lang.Long")
+                  <elem-type> (primitive "java.lang.Object")
                   <array-type> (type (Array <elem-type>))]
+  (`` (for {(~~ (static host.jvm))
+            (template: (!int value)
+              (|> value
+                  (:coerce <index-type>)
+                  "jvm object cast"
+                  "jvm conversion long-to-int"))}
+           (as-is)))
+  
   (def: #export (new size)
     (All [a] (-> Nat (Array a)))
     (`` (for {(~~ (static host.old))
               (:assume ("jvm anewarray" "(java.lang.Object )" size))
 
               (~~ (static host.jvm))
-              (:assume
-               (: (Array (primitive "java.lang.Object"))
-                  ("jvm array new" size)))})))
+              (|> size
+                  !int
+                  "jvm array new"
+                  (: <array-type>)
+                  :assume)})))
 
   (def: #export (size array)
     (All [a] (-> (Array a) Nat))
@@ -39,7 +50,13 @@
               ("jvm arraylength" array)
 
               (~~ (static host.jvm))
-              ("jvm array length" (:coerce <array-type> array))})))
+              (|> array
+                  (:coerce <array-type>)
+                  "jvm array length"
+                  "jvm conversion int-to-long"
+                  "jvm object cast"
+                  (: <index-type>)
+                  (:coerce Nat))})))
 
   (def: #export (read index array)
     (All [a]
@@ -52,7 +69,9 @@
                     (#.Some value)))
 
                 (~~ (static host.jvm))
-                (let [value ("jvm array read" index (:coerce <array-type> array))]
+                (let [value (|> array
+                                (:coerce <array-type>)
+                                ("jvm array read" (!int index)))]
                   (if ("jvm object null?" value)
                     #.None
                     (#.Some (:assume value))))}))
@@ -65,9 +84,10 @@
               ("jvm aastore" array index value)
 
               (~~ (static host.jvm))
-              (:assume
-               ("jvm array write" index (:coerce <elem-type> value)
-                (:coerce <array-type> array)))})))
+              (|> array
+                  (:coerce <array-type>)
+                  ("jvm array write" (!int index) (:coerce <elem-type> value))
+                  :assume)})))
 
   (def: #export (delete index array)
     (All [a]
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index a91beccef..42b8170b9 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -199,8 +199,9 @@
               (|> input
                   (:coerce (primitive "java.lang.String"))
                   ("jvm member invoke virtual" "java.lang.String" "hashCode")
-                  "jvm object cast"
                   "jvm conversion int-to-long"
+                  "jvm object cast"
+                  (: (primitive "java.lang.Long"))
                   (:coerce Nat))}
              ## Platform-independent default.
              (let [length ("lux text size" input)]
diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux
index d9cf0d701..9d9563eba 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension.lux
@@ -51,9 +51,7 @@
 (exception: #export [a] (invalid-syntax {name Name} {%format (Format a)} {inputs (List a)})
   (exception.report
    ["Extension" (%t name)]
-   ["Inputs" (|> inputs
-                 (list@map %format)
-                 (text.join-with text.new-line))]))
+   ["Inputs" (exception.enumerate %format inputs)]))
 
 (exception: #export [s i o] (unknown {name Name} {bundle (Bundle s i o)})
   (exception.report
@@ -61,8 +59,7 @@
    ["Available" (|> bundle
                     dictionary.keys
                     (list.sort text@<)
-                    (list@map %t)
-                    (text.join-with text.new-line))]))
+                    (exception.enumerate %t))]))
 
 (def: #export (install name handler)
   (All [s i o]
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
index fe9a63f09..998590d1c 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.old.lux
@@ -4,7 +4,7 @@
     ["." monad (#+ do)]]
    [control
     ["p" parser]
-    ["ex" exception (#+ exception:)]
+    ["." exception (#+ exception:)]
     pipe]
    [data
     ["." error (#+ Error)]
@@ -30,9 +30,30 @@
       [".A" type]
       [".A" inference]]
      ["#/" // #_
-      ["#." analysis (#+ Analysis Operation Handler Bundle)]
+      ["#." analysis (#+ Analysis Operation Phase Handler Bundle)]
       ["#." synthesis]]]]])
 
+(def: (custom [syntax handler])
+  (All [s]
+    (-> [(Syntax s)
+         (-> Text Phase s (Operation Analysis))]
+        Handler))
+  (function (_ extension-name analyse args)
+    (case (s.run args syntax)
+      (#error.Success inputs)
+      (handler extension-name analyse inputs)
+
+      (#error.Failure error)
+      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+
+(type: Member
+  {#class Text
+   #member Text})
+
+(def: member
+  (Syntax Member)
+  ($_ p.and s.text s.text))
+
 (type: Method-Signature
   {#method Type
    #exceptions (List Type)})
@@ -42,7 +63,8 @@
 
 (template [<name>]
   [(exception: #export (<name> {jvm-type java/lang/reflect/Type})
-     (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))]
+     (exception.report
+      ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))]
 
   [jvm-type-is-not-a-class]
   [cannot-convert-to-a-class]
@@ -52,7 +74,8 @@
 
 (template [<name>]
   [(exception: #export (<name> {type Type})
-     (%type type))]
+     (exception.report
+      ["Type" (%type type)]))]
 
   [non-object]
   [non-array]
@@ -60,26 +83,50 @@
   )
 
 (template [<name>]
-  [(exception: #export (<name> {name Text})
-     name)]
+  [(exception: #export (<name> {class Text})
+     (exception.report
+      ["Class" (%t class)]))]
 
+  [unknown-class]
   [non-interface]
   [non-throwable]
   )
 
 (template [<name>]
+  [(exception: #export (<name> {class Text} {field Text})
+     (exception.report
+      ["Class" (%t class)]
+      ["Field" (%t field)]))]
+
+  [unknown-field]
+  [not-a-static-field]
+  [not-a-virtual-field]
+  [cannot-set-a-final-field]
+  )
+
+(template [<name>]
+  [(exception: #export (<name> {class Text}
+                               {method Text}
+                               {hints (List Method-Signature)})
+     (exception.report
+      ["Class" class]
+      ["Method" method]
+      ["Hints" (|> hints
+                   (list@map (|>> product.left %type (format text.new-line text.tab)))
+                   (text.join-with ""))]))]
+
+  [no-candidates]
+  [too-many-candidates]
+  )
+
+(template [<name>]
   [(exception: #export (<name> {message Text})
      message)]
 
-  [unknown-class]
   [primitives-cannot-have-type-parameters]
   [primitives-are-not-objects]
 
-  [unknown-field]
   [mistaken-field-owner]
-  [not-a-virtual-field]
-  [not-a-static-field]
-  [cannot-set-a-final-field]
 
   [cannot-cast]
 
@@ -90,22 +137,10 @@
   [cannot-correspond-type-with-a-class]
   )
 
-(template [<name>]
-  [(exception: #export (<name> {class Text}
-                               {method Text}
-                               {hints (List Method-Signature)})
-     (ex.report ["Class" class]
-                ["Method" method]
-                ["Hints" (|> hints
-                             (list@map (|>> product.left %type (format text.new-line text.tab)))
-                             (text.join-with ""))]))]
-
-  [no-candidates]
-  [too-many-candidates]
-  )
-
+## TODO: Get rid of this template block and use the definition in
+## lux/host.jvm.lux ASAP
 (template [<name> <class>]
-  [(def: #export <name> Type (#.Primitive <class> (list)))]
+  [(type: #export <name> (primitive <class>))]
 
   ## Boxes
   [Boolean   "java.lang.Boolean"]
@@ -133,29 +168,29 @@
   Bundle
   (<| (///bundle.prefix "conversion")
       (|> ///bundle.empty
-          (///bundle.install "double-to-float" (//common.unary Double Float))
-          (///bundle.install "double-to-int" (//common.unary Double Integer))
-          (///bundle.install "double-to-long" (//common.unary Double Long))
-          (///bundle.install "float-to-double" (//common.unary Float Double))
-          (///bundle.install "float-to-int" (//common.unary Float Integer))
-          (///bundle.install "float-to-long" (//common.unary Float Long))
-          (///bundle.install "int-to-byte" (//common.unary Integer Byte))
-          (///bundle.install "int-to-char" (//common.unary Integer Character))
-          (///bundle.install "int-to-double" (//common.unary Integer Double))
-          (///bundle.install "int-to-float" (//common.unary Integer Float))
-          (///bundle.install "int-to-long" (//common.unary Integer Long))
-          (///bundle.install "int-to-short" (//common.unary Integer Short))
-          (///bundle.install "long-to-double" (//common.unary Long Double))
-          (///bundle.install "long-to-float" (//common.unary Long Float))
-          (///bundle.install "long-to-int" (//common.unary Long Integer))
-          (///bundle.install "long-to-short" (//common.unary Long Short))
-          (///bundle.install "long-to-byte" (//common.unary Long Byte))
-          (///bundle.install "char-to-byte" (//common.unary Character Byte))
-          (///bundle.install "char-to-short" (//common.unary Character Short))
-          (///bundle.install "char-to-int" (//common.unary Character Integer))
-          (///bundle.install "char-to-long" (//common.unary Character Long))
-          (///bundle.install "byte-to-long" (//common.unary Byte Long))
-          (///bundle.install "short-to-long" (//common.unary Short Long))
+          (///bundle.install "double-to-float" (//common.unary ..double ..float))
+          (///bundle.install "double-to-int" (//common.unary ..double ..int))
+          (///bundle.install "double-to-long" (//common.unary ..double ..long))
+          (///bundle.install "float-to-double" (//common.unary ..float ..double))
+          (///bundle.install "float-to-int" (//common.unary ..float ..int))
+          (///bundle.install "float-to-long" (//common.unary ..float ..long))
+          (///bundle.install "int-to-byte" (//common.unary ..int ..byte))
+          (///bundle.install "int-to-char" (//common.unary ..int ..char))
+          (///bundle.install "int-to-double" (//common.unary ..int ..double))
+          (///bundle.install "int-to-float" (//common.unary ..int ..float))
+          (///bundle.install "int-to-long" (//common.unary ..int ..long))
+          (///bundle.install "int-to-short" (//common.unary ..int ..short))
+          (///bundle.install "long-to-double" (//common.unary ..long ..double))
+          (///bundle.install "long-to-float" (//common.unary ..long ..float))
+          (///bundle.install "long-to-int" (//common.unary ..long ..int))
+          (///bundle.install "long-to-short" (//common.unary ..long ..short))
+          (///bundle.install "long-to-byte" (//common.unary ..long ..byte))
+          (///bundle.install "char-to-byte" (//common.unary ..char ..byte))
+          (///bundle.install "char-to-short" (//common.unary ..char ..short))
+          (///bundle.install "char-to-int" (//common.unary ..char ..int))
+          (///bundle.install "char-to-long" (//common.unary ..char ..long))
+          (///bundle.install "byte-to-long" (//common.unary ..byte ..long))
+          (///bundle.install "short-to-long" (//common.unary ..short ..long))
           )))
 
 (template [<name> <prefix> <type>]
@@ -178,8 +213,8 @@
              (///bundle.install "ushr" (//common.binary <type> Integer <type>))
              )))]
 
-  [bundle::int  "int"  Integer]
-  [bundle::long "long" Long]
+  [bundle::int  "int"  ..long]
+  [bundle::long "long" ..long]
   )
 
 (template [<name> <prefix> <type>]
@@ -196,16 +231,16 @@
              (///bundle.install "<" (//common.binary <type> <type> Bit))
              )))]
 
-  [bundle::float  "float"  Float]
-  [bundle::double "double" Double]
+  [bundle::float  "float"  ..float]
+  [bundle::double "double" ..double]
   )
 
 (def: bundle::char
   Bundle
   (<| (///bundle.prefix "char")
       (|> ///bundle.empty
-          (///bundle.install "=" (//common.binary Character Character Bit))
-          (///bundle.install "<" (//common.binary Character Character Bit))
+          (///bundle.install "=" (//common.binary ..char ..char Bit))
+          (///bundle.install "<" (//common.binary ..char ..char Bit))
           )))
 
 (def: #export boxes
@@ -253,7 +288,7 @@
     (case args
       (^ (list arrayC))
       (do ////.monad
-        [_ (typeA.infer Nat)
+        [_ (typeA.infer ..int)
          [var-id varT] (typeA.with-env check.var)
          arrayA (typeA.with-type (type (Array varT))
                   (analyse arrayC))
@@ -272,7 +307,7 @@
     (case args
       (^ (list lengthC))
       (do ////.monad
-        [lengthA (typeA.with-type Nat
+        [lengthA (typeA.with-type ..int
                    (analyse lengthC))
          expectedT (///.lift macro.expected-type)
          [level elem-class] (array-type-info expectedT)
@@ -336,7 +371,7 @@
          varT (typeA.with-env
                 (check.clean varT))
          [nesting elem-class] (array-type-info varT)
-         idxA (typeA.with-type Nat
+         idxA (typeA.with-type ..int
                 (analyse idxC))]
         (wrap (#/////analysis.Extension extension-name (list (/////analysis.nat (inc nesting))
                                                              (/////analysis.text elem-class)
@@ -359,7 +394,7 @@
          varT (typeA.with-env
                 (check.clean varT))
          [nesting elem-class] (array-type-info varT)
-         idxA (typeA.with-type Nat
+         idxA (typeA.with-type ..int
                 (analyse idxC))
          valueA (typeA.with-type varT
                   (analyse valueC))]
@@ -788,19 +823,54 @@
                                        "Target Class: " class-name text.new-line))))
 
       (#error.Failure _)
-      (/////analysis.throw unknown-field (format class-name "#" field-name)))))
+      (/////analysis.throw unknown-field [class-name field-name]))))
 
 (def: (static-field class-name field-name)
-  (-> Text Text (Operation [Type Bit]))
+  (-> Text Text (Operation [Type Text Bit]))
   (do ////.monad
     [[class fieldJ] (find-field class-name field-name)
      #let [modifiers (Field::getModifiers fieldJ)]]
     (if (Modifier::isStatic modifiers)
       (let [fieldJT (Field::getGenericType fieldJ)]
         (do @
-          [fieldT (java-type-to-lux-type fresh-mappings fieldJT)]
-          (wrap [fieldT (Modifier::isFinal modifiers)])))
-      (/////analysis.throw not-a-static-field (format class-name "#" field-name)))))
+          [fieldT (java-type-to-lux-type fresh-mappings fieldJT)
+           unboxed (java-type-to-class fieldJT)]
+          (wrap [fieldT unboxed (Modifier::isFinal modifiers)])))
+      (/////analysis.throw ..not-a-static-field [class-name field-name]))))
+
+(def: static::get
+  Handler
+  (..custom [..member
+             (function (_ extension-name analyse [class field])
+               (do ////.monad
+                 [[fieldT unboxed final?] (static-field class field)
+                  _ (typeA.infer fieldT)]
+                 (wrap (<| (#/////analysis.Extension extension-name)
+                           (list (/////analysis.text class)
+                                 (/////analysis.text field)
+                                 (/////analysis.text unboxed))))))]))
+
+(def: static::put
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC fieldC valueC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do ////.monad
+          [_ (typeA.infer Any)
+           [fieldT unboxed final?] (static-field class field)
+           _ (////.assert cannot-set-a-final-field [class field]
+                          (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA))))
+
+        _
+        (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
+
+      _
+      (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
 
 (def: (virtual-field class-name field-name objectT)
   (-> Text Text Type (Operation [Type Bit]))
@@ -833,46 +903,7 @@
                        (/////analysis.throw non-object objectT)))
          fieldT (java-type-to-lux-type mappings fieldJT)]
         (wrap [fieldT (Modifier::isFinal modifiers)]))
-      (/////analysis.throw not-a-virtual-field (format class-name "#" field-name)))))
-
-(def: static::get
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.monad
-          [[fieldT final?] (static-field class field)]
-          (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field)))))
-
-        _
-        (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
-
-      _
-      (/////analysis.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
-
-(def: static::put
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC valueC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.monad
-          [_ (typeA.infer Any)
-           [fieldT final?] (static-field class field)
-           _ (////.assert cannot-set-a-final-field (format class "#" field)
-                          (not final?))
-           valueA (typeA.with-type fieldT
-                    (analyse valueC))]
-          (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) valueA))))
-
-        _
-        (/////analysis.throw ///.invalid-syntax [extension-name %code args]))
-
-      _
-      (/////analysis.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
+      (/////analysis.throw not-a-virtual-field [class-name field-name]))))
 
 (def: virtual::get
   Handler
@@ -884,7 +915,8 @@
         (do ////.monad
           [[objectT objectA] (typeA.with-inference
                                (analyse objectC))
-           [fieldT final?] (virtual-field class field objectT)]
+           [fieldT final?] (virtual-field class field objectT)
+           _ (typeA.infer fieldT)]
           (wrap (#/////analysis.Extension extension-name (list (/////analysis.text class) (/////analysis.text field) objectA))))
 
         _
@@ -905,7 +937,7 @@
                                (analyse objectC))
            _ (typeA.infer objectT)
            [fieldT final?] (virtual-field class field objectT)
-           _ (////.assert cannot-set-a-final-field (format class "#" field)
+           _ (////.assert cannot-set-a-final-field [class field]
                           (not final?))
            valueA (typeA.with-type fieldT
                     (analyse valueC))]
@@ -1004,17 +1036,23 @@
   (-> Nat Type)
   (|>> (n/* 2) inc #.Parameter))
 
-(def: (type-vars amount offset)
-  (-> Nat Nat (List Type))
-  (if (n/= 0 amount)
-    (list)
-    (|> (list.indices amount)
-        (list@map (|>> (n/+ offset) idx-to-parameter)))))
+(def: (jvm-type-var-mappings owner-tvars method-tvars)
+  (-> (List Text) (List Text) [(List Type) Mappings])
+  (let [jvm-tvars (list@compose owner-tvars method-tvars)
+        lux-tvars (|> jvm-tvars
+                      list.reverse
+                      list.enumerate
+                      (list@map (function (_ [idx name])
+                                  [name (idx-to-parameter idx)]))
+                      list.reverse)
+        num-owner-tvars (list.size owner-tvars)
+        owner-tvarsT (|> lux-tvars (list.take num-owner-tvars) (list@map product.right))
+        mappings (dictionary.from-list text.hash lux-tvars)]
+    [owner-tvarsT mappings]))
 
 (def: (method-signature method-style method)
   (-> Method-Style Method (Operation Method-Signature))
   (let [owner (Method::getDeclaringClass method)
-        owner-name (Class::getName owner)
         owner-tvars (case method-style
                       #Static
                       (list)
@@ -1026,19 +1064,7 @@
         method-tvars (|> (Method::getTypeParameters method)
                          array.to-list
                          (list@map (|>> TypeVariable::getName)))
-        num-owner-tvars (list.size owner-tvars)
-        num-method-tvars (list.size method-tvars)
-        all-tvars (list@compose owner-tvars method-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars 0)
-        method-tvarsT (type-vars num-method-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list@compose owner-tvarsT method-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dictionary.from-list text.hash))))]
+        [owner-tvarsT mappings] (jvm-type-var-mappings owner-tvars method-tvars)]
     (do ////.monad
       [inputsT (|> (Method::getGenericParameterTypes method)
                    array.to-list
@@ -1047,17 +1073,40 @@
        exceptionsT (|> (Method::getGenericExceptionTypes method)
                        array.to-list
                        (monad.map @ (java-type-to-lux-type mappings)))
-       #let [methodT (<| (type.univ-q num-all-tvars)
+       #let [methodT (<| (type.univ-q (dictionary.size mappings))
                          (type.function (case method-style
                                           #Static
                                           inputsT
 
                                           _
-                                          (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
+                                          (list& (#.Primitive (Class::getName owner) owner-tvarsT)
                                                  inputsT)))
                          outputT)]]
       (wrap [methodT exceptionsT]))))
 
+(def: (constructor-signature constructor)
+  (-> (Constructor Object) (Operation Method-Signature))
+  (let [owner (Constructor::getDeclaringClass constructor)
+        owner-tvars (|> (Class::getTypeParameters owner)
+                        array.to-list
+                        (list@map (|>> TypeVariable::getName)))
+        method-tvars (|> (Constructor::getTypeParameters constructor)
+                         array.to-list
+                         (list@map (|>> TypeVariable::getName)))
+        [owner-tvarsT mappings] (jvm-type-var-mappings owner-tvars method-tvars)]
+    (do ////.monad
+      [inputsT (|> (Constructor::getGenericParameterTypes constructor)
+                   array.to-list
+                   (monad.map @ (java-type-to-lux-type mappings)))
+       exceptionsT (|> (Constructor::getGenericExceptionTypes constructor)
+                       array.to-list
+                       (monad.map @ (java-type-to-lux-type mappings)))
+       #let [objectT (#.Primitive (Class::getName owner) owner-tvarsT)
+             constructorT (<| (type.univ-q (dictionary.size mappings))
+                              (type.function inputsT)
+                              objectT)]]
+      (wrap [constructorT exceptionsT]))))
+
 (type: Evaluation
   (#Pass Method-Signature)
   (#Hint Method-Signature)
@@ -1105,41 +1154,6 @@
       candidates
       (/////analysis.throw too-many-candidates [class-name method-name candidates]))))
 
-(def: (constructor-signature constructor)
-  (-> (Constructor Object) (Operation Method-Signature))
-  (let [owner (Constructor::getDeclaringClass constructor)
-        owner-name (Class::getName owner)
-        owner-tvars (|> (Class::getTypeParameters owner)
-                        array.to-list
-                        (list@map (|>> TypeVariable::getName)))
-        constructor-tvars (|> (Constructor::getTypeParameters constructor)
-                              array.to-list
-                              (list@map (|>> TypeVariable::getName)))
-        num-owner-tvars (list.size owner-tvars)
-        all-tvars (list@compose owner-tvars constructor-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars 0)
-        constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list@compose owner-tvarsT constructor-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dictionary.from-list text.hash))))]
-    (do ////.monad
-      [inputsT (|> (Constructor::getGenericParameterTypes constructor)
-                   array.to-list
-                   (monad.map @ (java-type-to-lux-type mappings)))
-       exceptionsT (|> (Constructor::getGenericExceptionTypes constructor)
-                       array.to-list
-                       (monad.map @ (java-type-to-lux-type mappings)))
-       #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT))
-             constructorT (<| (type.univ-q num-all-tvars)
-                              (type.function inputsT)
-                              objectT)]]
-      (wrap [constructorT exceptionsT]))))
-
 (def: constructor-method "<init>")
 
 (def: (constructor-candidate class-name arg-classes)
@@ -1178,106 +1192,80 @@
 
 (def: invoke::static
   Handler
-  (function (_ extension-name analyse args)
-    (case (: (Error [Text Text (List [Text Code])])
-             (s.run args ($_ p.and s.text s.text (p.some ..typed-input))))
-      (#error.Success [class method argsTC])
-      (do ////.monad
-        [#let [argsT (list@map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Static argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))
-         outputJC (check-jvm outputT)]
-        (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
-                                                              (/////analysis.text method)
-                                                              (/////analysis.text outputJC)
-                                                              (decorate-inputs argsT argsA)))))
-
-      _
-      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+  (..custom [($_ p.and ..member (p.some ..typed-input))
+             (function (_ extension-name analyse [[class method] argsTC])
+               (do ////.monad
+                 [#let [argsT (list@map product.left argsTC)]
+                  [methodT exceptionsT] (method-candidate class method #Static argsT)
+                  [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))
+                  outputJC (check-jvm outputT)]
+                 (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+                                                                       (/////analysis.text method)
+                                                                       (/////analysis.text outputJC)
+                                                                       (decorate-inputs argsT argsA))))))]))
 
 (def: invoke::virtual
   Handler
-  (function (_ extension-name analyse args)
-    (case (: (Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
-      (#error.Success [class method objectC argsTC])
-      (do ////.monad
-        [#let [argsT (list@map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Virtual argsT)
-         [outputT allA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
-         #let [[objectA argsA] (case allA
-                                 (#.Cons objectA argsA)
-                                 [objectA argsA]
-
-                                 _
-                                 (undefined))]
-         outputJC (check-jvm outputT)]
-        (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
-                                                              (/////analysis.text method)
-                                                              (/////analysis.text outputJC)
-                                                              objectA
-                                                              (decorate-inputs argsT argsA)))))
+  (..custom [($_ p.and ..member s.any (p.some ..typed-input))
+             (function (_ extension-name analyse [[class method] objectC argsTC])
+               (do ////.monad
+                 [#let [argsT (list@map product.left argsTC)]
+                  [methodT exceptionsT] (method-candidate class method #Virtual argsT)
+                  [outputT allA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
+                  #let [[objectA argsA] (case allA
+                                          (#.Cons objectA argsA)
+                                          [objectA argsA]
 
-      _
-      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+                                          _
+                                          (undefined))]
+                  outputJC (check-jvm outputT)]
+                 (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+                                                                       (/////analysis.text method)
+                                                                       (/////analysis.text outputJC)
+                                                                       objectA
+                                                                       (decorate-inputs argsT argsA))))))]))
 
 (def: invoke::special
   Handler
-  (function (_ extension-name analyse args)
-    (case (: (Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
-      (#error.Success [class method objectC argsTC])
-      (do ////.monad
-        [#let [argsT (list@map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Special argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
-         outputJC (check-jvm outputT)]
-        (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
-                                                              (/////analysis.text method)
-                                                              (/////analysis.text outputJC)
-                                                              (decorate-inputs argsT argsA)))))
-
-      _
-      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+  (..custom [($_ p.and ..member s.any (p.some ..typed-input))
+             (function (_ extension-name analyse [[class method] objectC argsTC])
+               (do ////.monad
+                 [#let [argsT (list@map product.left argsTC)]
+                  [methodT exceptionsT] (method-candidate class method #Special argsT)
+                  [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
+                  outputJC (check-jvm outputT)]
+                 (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+                                                                       (/////analysis.text method)
+                                                                       (/////analysis.text outputJC)
+                                                                       (decorate-inputs argsT argsA))))))]))
 
 (def: invoke::interface
   Handler
-  (function (_ extension-name analyse args)
-    (case (: (Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.and s.text s.text s.any (p.some ..typed-input))))
-      (#error.Success [class-name method objectC argsTC])
-      (do ////.monad
-        [#let [argsT (list@map product.left argsTC)]
-         class (load-class class-name)
-         _ (////.assert non-interface class-name
-                        (Modifier::isInterface (Class::getModifiers class)))
-         [methodT exceptionsT] (method-candidate class-name method #Interface argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
-         outputJC (check-jvm outputT)]
-        (wrap (#/////analysis.Extension extension-name
-                                        (list& (/////analysis.text class-name)
-                                               (/////analysis.text method)
-                                               (/////analysis.text outputJC)
-                                               (decorate-inputs argsT argsA)))))
-
-      _
-      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+  (..custom [($_ p.and ..member s.any (p.some ..typed-input))
+             (function (_ extension-name analyse [[class-name method] objectC argsTC])
+               (do ////.monad
+                 [#let [argsT (list@map product.left argsTC)]
+                  class (load-class class-name)
+                  _ (////.assert non-interface class-name
+                                 (Modifier::isInterface (Class::getModifiers class)))
+                  [methodT exceptionsT] (method-candidate class-name method #Interface argsT)
+                  [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
+                  outputJC (check-jvm outputT)]
+                 (wrap (#/////analysis.Extension extension-name
+                                                 (list& (/////analysis.text class-name)
+                                                        (/////analysis.text method)
+                                                        (/////analysis.text outputJC)
+                                                        (decorate-inputs argsT argsA))))))]))
 
 (def: invoke::constructor
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (Error [Text (List [Text Code])])
-             (s.run args ($_ p.and s.text (p.some ..typed-input))))
-      (#error.Success [class argsTC])
-      (do ////.monad
-        [#let [argsT (list@map product.left argsTC)]
-         [methodT exceptionsT] (constructor-candidate class argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))]
-        (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
-                                                              (decorate-inputs argsT argsA)))))
-
-      _
-      (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
+  (..custom [($_ p.and s.text (p.some ..typed-input))
+             (function (_ extension-name analyse [class argsTC])
+               (do ////.monad
+                 [#let [argsT (list@map product.left argsTC)]
+                  [methodT exceptionsT] (constructor-candidate class argsT)
+                  [outputT argsA] (inferenceA.general analyse methodT (list@map product.right argsTC))]
+                 (wrap (#/////analysis.Extension extension-name (list& (/////analysis.text class)
+                                                                       (decorate-inputs argsT argsA))))))]))
 
 (def: bundle::member
   Bundle