aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
diff options
context:
space:
mode:
authorEduardo Julian2019-04-18 23:35:18 -0400
committerEduardo Julian2019-04-18 23:35:18 -0400
commitf59327398a0350a42b640b247ea3d392011b4e94 (patch)
tree4074d5e295089918824ce1071b2fd5bbc8009068 /new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
parentf46f8cc03a8c0d0694240023d3a0f5dbd24b8fe4 (diff)
Improvements and fixes for JVM extensions.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux166
1 files changed, 75 insertions, 91 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