From 79aa92dfd81d569fe6120b8e5c00d41528801153 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 7 Oct 2020 23:03:33 -0400
Subject: Optimized generation of I64, F64 and variants on JVM.

---
 .../source/luxc/lang/translation/jvm/primitive.lux | 77 +++++++++++++++++++---
 .../source/luxc/lang/translation/jvm/structure.lux | 16 +++--
 2 files changed, 80 insertions(+), 13 deletions(-)

(limited to 'lux-jvm')

diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
index 873c363bd..469e730de 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux
@@ -1,5 +1,9 @@
 (.module:
   [lux (#- i64)
+   ["." host (#+ import:)]
+   [data
+    [number
+     ["i" int]]]
    [target
     [jvm
      ["." type]]]
@@ -18,13 +22,68 @@
     (function (_ value)
       (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
 
-(template [<name> <type> <load> <wrap>]
-  [(def: #export (<name> value)
-     (-> <type> (Operation Inst))
-     (let [loadI (|> value <load>)]
-       (operation@wrap (|>> loadI <wrap>))))]
+(def: #export (i64 value)
+  (-> (I64 Any) (Operation Inst))
+  (case (.int value)
+    (^template [<int> <instruction>]
+      <int>
+      (operation@wrap (|>> <instruction> (_.wrap type.long))))
+    ([+0 _.LCONST_0]
+     [+1 _.LCONST_1])
 
-  [i64  (I64 Any) (<| _.long .int) (_.wrap type.long)]
-  [f64  Frac      _.double         (_.wrap type.double)]
-  [text Text      _.string         (<|)]
-  )
+    (^template [<int> <instruction>]
+      <int>
+      (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long))))
+    ([-1 _.ICONST_M1]
+     ## [+0 _.ICONST_0]
+     ## [+1 _.ICONST_1]
+     [+2 _.ICONST_2]
+     [+3 _.ICONST_3]
+     [+4 _.ICONST_4]
+     [+5 _.ICONST_5])
+
+    _
+    (let [loadI (|> value .int _.long)]
+      (operation@wrap (|>> loadI (_.wrap type.long))))))
+
+(import: #long java/lang/Double
+  (#static doubleToRawLongBits #manual [double] int))
+
+(def: d0-bits
+  Int
+  (java/lang/Double::doubleToRawLongBits +0.0))
+
+(def: #export (f64 value)
+  (-> Frac (Operation Inst))
+  (case value
+    (^template [<int> <instruction>]
+      <int>
+      (operation@wrap (|>> <instruction> (_.wrap type.double))))
+    ([+1.0 _.DCONST_1])
+
+    (^template [<int> <instruction>]
+      <int>
+      (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double))))
+    ([+2.0 _.FCONST_2])
+
+    (^template [<int> <instruction>]
+      <int>
+      (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double))))
+    ([-1.0 _.ICONST_M1]
+     ## [+0.0 _.ICONST_0]
+     ## [+1.0 _.ICONST_1]
+     [+2.0 _.ICONST_2]
+     [+3.0 _.ICONST_3]
+     [+4.0 _.ICONST_4]
+     [+5.0 _.ICONST_5])
+    
+    _
+    (let [loadI (if (i.= ..d0-bits
+                         (java/lang/Double::doubleToRawLongBits (:coerce java/lang/Double value)))
+                  _.DCONST_0
+                  (_.double value))]
+      (operation@wrap (|>> loadI (_.wrap type.double))))))
+
+(def: #export (text value)
+  (-> Text (Operation Inst))
+  (operation@wrap (_.string value)))
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
index 46f87142a..049c1549a 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux
@@ -66,10 +66,18 @@
 (def: #export (variant generate archive [lefts right? member])
   (Generator [Nat Bit Synthesis])
   (do phase.monad
-    [memberI (generate archive member)]
-    (wrap (|>> (_.int (.int (if right?
-                              (.inc lefts)
-                              lefts)))
+    [memberI (generate archive member)
+     #let [tagI (case (if right?
+                        (.inc lefts)
+                        lefts)
+                  0 _.ICONST_0
+                  1 _.ICONST_1
+                  2 _.ICONST_2
+                  3 _.ICONST_3
+                  4 _.ICONST_4
+                  5 _.ICONST_5
+                  tag (_.int (.int tag)))]]
+    (wrap (|>> tagI
                (flagI right?)
                memberI
                (_.INVOKESTATIC //.$Runtime
-- 
cgit v1.2.3