Some type casting/coercion automation.

3 files changed, 96 insertions, 98 deletions

diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 495d8a7ce..c8d413421 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -22,8 +22,9 @@
      ["." list ("#@." monad fold monoid)]
      ["." dictionary (#+ Dictionary)]]]
    ["." macro (#+ with-gensyms)
+    [syntax (#+ syntax:)]
     ["." code]
-    [syntax (#+ syntax:)]]
+    ["." template]]
    [target
     ["." jvm #_
      ["#" type (#+ Primitive Var Bound Class Generic Type Argument Return Typed)]]]])
@@ -1490,80 +1491,64 @@
   (-> Var Code)
   code.local-identifier)
 
-(template [<name> <unbox/box>
-           <byte> <for-byte>
-           <short> <for-short>
-           <int> <for-int>
-           <float> <for-float>]
+(template [<input?> <name> <unbox/box> <special+>]
   [(def: (<name> mode [unboxed raw])
      (-> Primitive-Mode [Text Code] Code)
-     (let [[unboxed refined] (case mode
-                               #ManualPrM
-                               [unboxed raw]
-                               
-                               #AutoPrM
-                               (case unboxed
-                                 (^ (static jvm.byte-descriptor))
-                                 [<byte> (` (<for-byte> (~ raw)))]
-                                 
-                                 (^ (static jvm.short-descriptor))
-                                 [<short> (` (<for-short> (~ raw)))]
-                                 
-                                 (^ (static jvm.int-descriptor))
-                                 [<int> (` (<for-int> (~ raw)))]
-                                 
-                                 (^ (static jvm.float-descriptor))
-                                 [<float> (` (<for-float> (~ raw)))]
-                                 
-                                 _
-                                 [unboxed raw]))]
-       (case (dictionary.get unboxed boxes)
-         (#.Some boxed)
-         (<unbox/box> unboxed boxed refined)
-         
-         #.None
-         refined)))]
-
-  [auto-convert-input ..unbox
-   jvm.byte-descriptor ..long-to-byte
-   jvm.short-descriptor ..long-to-short
-   jvm.int-descriptor ..long-to-int
-   jvm.float-descriptor ..double-to-float]
-  [auto-convert-output ..box
-   jvm.long-descriptor "jvm conversion byte-to-long"
-   jvm.long-descriptor "jvm conversion short-to-long"
-   jvm.long-descriptor "jvm conversion int-to-long"
-   jvm.double-descriptor "jvm conversion float-to-double"]
+     (let [[unboxed refined post] (: [Text Code (List Code)]
+                                     (case mode
+                                       #ManualPrM
+                                       [unboxed raw (list)]
+                                       
+                                       #AutoPrM
+                                       (`` (case unboxed
+                                             (^template [<old> <new> <pre> <post>]
+                                               (^ (static <old>))
+                                               (with-expansions [<post>' (template.splice <post>)]
+                                                 [<new>
+                                                  (` (.|> (~ raw) (~+ <pre>)))
+                                                  (list <post>')]))
+                                             ((~~ (template.splice <special+>)))
+                                             
+                                             _
+                                             [unboxed
+                                              (if <input?>
+                                                (` ("jvm object cast" (~ raw)))
+                                                raw)
+                                              (list)]))))
+           unboxed/boxed (case (dictionary.get unboxed boxes)
+                           (#.Some boxed)
+                           (<unbox/box> unboxed boxed refined)
+                           
+                           #.None
+                           refined)
+           post-processed (case post
+                            #.Nil
+                            unboxed/boxed
+
+                            _
+                            (` (.|> (~ unboxed/boxed) (~+ post))))]
+       post-processed))]
+
+  [#1 auto-convert-input ..unbox
+   [[jvm.byte-descriptor jvm.byte-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-byte)) []]
+    [jvm.short-descriptor jvm.short-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-short)) []]
+    [jvm.int-descriptor jvm.int-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long"))) (` ..long-to-int)) []]
+    [jvm.long-descriptor jvm.long-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive "java.lang.Long")))) []]
+    [jvm.float-descriptor jvm.float-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double"))) (` ..double-to-float)) []]
+    [jvm.double-descriptor jvm.double-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive "java.lang.Double")))) []]]]
+  [#0 auto-convert-output ..box
+   [[jvm.byte-descriptor jvm.long-descriptor (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]]
+    [jvm.short-descriptor jvm.long-descriptor (list (` "jvm conversion short-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]]
+    [jvm.int-descriptor jvm.long-descriptor (list (` "jvm conversion int-to-long")) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]]
+    [jvm.long-descriptor jvm.long-descriptor (list) [(` (.: (.primitive "java.lang.Long"))) (` (.:coerce .Int))]]
+    [jvm.float-descriptor jvm.double-descriptor (list (` "jvm conversion float-to-double")) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]]
+    [jvm.double-descriptor jvm.double-descriptor (list) [(` (.: (.primitive "java.lang.Double"))) (` (.:coerce .Frac))]]]]
   )
 
 (def: (un-quote quoted)
   (-> Code Code)
   (` ((~' ~) (~ quoted))))
 
-(def: (jvm-input [unboxed raw])
-  (-> [Text Code] [Text Code])
-  [unboxed (case unboxed
-             (^ (static jvm.byte-descriptor))
-             (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
-             
-             (^ (static jvm.short-descriptor))
-             (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
-             
-             (^ (static jvm.int-descriptor))
-             (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
-             
-             (^ (static jvm.long-descriptor))
-             (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
-             
-             (^ (static jvm.float-descriptor))
-             (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
-             
-             (^ (static jvm.double-descriptor))
-             (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
-             
-             _
-             (` ("jvm object cast" (~ raw))))])
-
 (def: (jvm-invoke-inputs mode classes inputs)
   (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code))
   (|> inputs
@@ -1572,7 +1557,7 @@
                     (` ((~! !!!) (~ (un-quote input))))
                     (un-quote input))))
       (list.zip2 classes)
-      (list@map (|>> jvm-input (auto-convert-input mode)))))
+      (list@map (auto-convert-input mode))))
 
 (def: (with-class-type class expression)
   (-> Text Code Code)
@@ -1695,7 +1680,6 @@
                                                    (` ((~ setter-name) (~ g!value)))
                                                    (` ((~ setter-name) (~ g!value) (~ g!obj))))
                                      setter-value (|> [(jvm.signature import-field-type) (un-quote g!value)]
-                                                      ..jvm-input
                                                       (auto-convert-input import-field-mode))
                                      setter-value (if import-field-maybe?
                                                     (` ((~! !!!) (~ setter-value)))
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index d8851d978..6e3269df5 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -39,6 +39,19 @@
   [char-reflection "char"]
   )
 
+(template [<name> <box>]
+  [(def: #export <name> <box>)]
+
+  [boolean-box "java.lang.Boolean"]
+  [byte-box    "java.lang.Byte"]
+  [short-box   "java.lang.Short"]
+  [int-box     "java.lang.Integer"]
+  [long-box    "java.lang.Long"]
+  [float-box   "java.lang.Float"]
+  [double-box  "java.lang.Double"]
+  [char-box    "java.lang.Character"]
+  )
+
 (def: #export array-prefix "[")
 (def: object-prefix "L")
 (def: var-prefix "T")
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 947bbc69f..358c666c7 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -60,14 +60,14 @@
   [(def: #export <name> .Type (#.Primitive <class> #.Nil))]
 
   ## 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"]
+  [Boolean   jvm.boolean-box]
+  [Byte      jvm.byte-box]
+  [Short     jvm.short-box]
+  [Integer   jvm.int-box]
+  [Long      jvm.long-box]
+  [Float     jvm.float-box]
+  [Double    jvm.double-box]
+  [Character jvm.char-box]
   [String    "java.lang.String"]
 
   ## Primitives
@@ -354,14 +354,14 @@
 
 (def: #export boxes
   (Dictionary Text Text)
-  (|> (list [jvm.boolean-reflection "java.lang.Boolean"]
-            [jvm.byte-reflection    "java.lang.Byte"]
-            [jvm.short-reflection   "java.lang.Short"]
-            [jvm.int-reflection     "java.lang.Integer"]
-            [jvm.long-reflection    "java.lang.Long"]
-            [jvm.float-reflection   "java.lang.Float"]
-            [jvm.double-reflection  "java.lang.Double"]
-            [jvm.char-reflection    "java.lang.Character"])
+  (|> (list [jvm.boolean-reflection jvm.boolean-box]
+            [jvm.byte-reflection    jvm.byte-box]
+            [jvm.short-reflection   jvm.short-box]
+            [jvm.int-reflection     jvm.int-box]
+            [jvm.long-reflection    jvm.long-box]
+            [jvm.float-reflection   jvm.float-box]
+            [jvm.double-reflection  jvm.double-box]
+            [jvm.char-reflection    jvm.char-box])
       (dictionary.from-list text.hash)))
 
 (def: (array-type-info allow-primitives? arrayT)
@@ -518,10 +518,10 @@
       (check-jvm outputT)
 
       #.None
-      (/////analysis.throw non-object objectT))
+      (/////analysis.throw ..non-object objectT))
 
     _
-    (/////analysis.throw non-object objectT)))
+    (/////analysis.throw ..non-object objectT)))
 
 (def: (check-object objectT)
   (-> .Type (Operation Text))
@@ -1032,17 +1032,18 @@
          can-cast? (: (Operation Bit)
                       (case [from-name to-name]
                         (^template [<primitive> <object>]
-                          (^or (^ [(static <primitive>) <object>])
-                               (^ [<object> (static <primitive>)]))
+                          (^or (^ [(static <primitive>) (static <object>)])
+                               (^ [(static <object>) (static <primitive>)])
+                               (^ [(static <primitive>) (static <primitive>)]))
                           (wrap #1))
-                        ([jvm.boolean-reflection "java.lang.Boolean"]
-                         [jvm.byte-reflection    "java.lang.Byte"]
-                         [jvm.short-reflection   "java.lang.Short"]
-                         [jvm.int-reflection     "java.lang.Integer"]
-                         [jvm.long-reflection    "java.lang.Long"]
-                         [jvm.float-reflection   "java.lang.Float"]
-                         [jvm.double-reflection  "java.lang.Double"]
-                         [jvm.char-reflection    "java.lang.Character"])
+                        ([jvm.boolean-reflection jvm.boolean-box]
+                         [jvm.byte-reflection    jvm.byte-box]
+                         [jvm.short-reflection   jvm.short-box]
+                         [jvm.int-reflection     jvm.int-box]
+                         [jvm.long-reflection    jvm.long-box]
+                         [jvm.float-reflection   jvm.float-box]
+                         [jvm.double-reflection  jvm.double-box]
+                         [jvm.char-reflection    jvm.char-box])
 
                         _
                         (do @
@@ -1188,7 +1189,7 @@
                                   (dictionary.from-list text.hash))))
 
                       _
-                      (/////analysis.throw non-object objectT)))
+                      (/////analysis.throw ..non-object objectT)))
          fieldT (java-type-to-lux-type mapping fieldJT)]
         (wrap [fieldT (Modifier::isFinal modifiers)]))
       (/////analysis.throw not-a-virtual-field [class-name field-name]))))