From f59327398a0350a42b640b247ea3d392011b4e94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 18 Apr 2019 23:35:18 -0400 Subject: Improvements and fixes for JVM extensions. --- .../luxc/lang/translation/jvm/procedure/host.lux | 166 ++++++++++----------- 1 file changed, 75 insertions(+), 91 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux') 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: ( inputI) (Unary Inst) (if (is? _.NOP ) + inputI (|>> inputI - (_.unwrap ) - (_.wrap )) - (|>> inputI - (_.unwrap ) - - (_.wrap ))))] + )))] [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 [ ] +(template [ ] [(def: ( [xI yI]) (Binary Inst) - (|>> xI (_.unwrap ) - yI (_.unwrap ) - (_.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 + ))] + + [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 [ ] +(template [ ] [(def: ( [xI yI]) (Binary Inst) (<| _.with-label (function (_ @then)) _.with-label (function (_ @end)) - (|>> xI (_.unwrap ) - yI (_.unwrap ) + (|>> xI + yI ( @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 [ ] +(template [ ] [(def: ( [xI yI]) (Binary Inst) (<| _.with-label (function (_ @then)) _.with-label (function (_ @end)) - (|>> xI (_.unwrap ) - yI (_.unwrap ) + (|>> xI + yI (_.int ) (_.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 -- cgit v1.2.3