diff --git a/codec-jvm b/codec-jvm index aec41c86..f9b30f1a 160000 --- a/codec-jvm +++ b/codec-jvm @@ -1 +1 @@ -Subproject commit aec41c86d4e052cba4b2fc551c9639b9a5904c5f +Subproject commit f9b30f1a2fce281901ed044684061dbe39e7b3c7 diff --git a/compiler/Eta/CodeGen/Expr.hs b/compiler/Eta/CodeGen/Expr.hs index 30fe1a6e..ffc36fce 100644 --- a/compiler/Eta/CodeGen/Expr.hs +++ b/compiler/Eta/CodeGen/Expr.hs @@ -545,19 +545,19 @@ comparisonPrimOp primop cmpOp CharGeOp = liftUnsignedOp ifge cmpOp CharGtOp = liftUnsignedOp ifgt - cmpOp DoubleEqOp = liftTypedCmpOp jdouble ifeq - cmpOp DoubleNeOp = liftTypedCmpOp jdouble ifne - cmpOp DoubleGeOp = liftTypedCmpOp jdouble ifge - cmpOp DoubleLeOp = liftTypedCmpOp jdouble ifle - cmpOp DoubleGtOp = liftTypedCmpOp jdouble ifgt - cmpOp DoubleLtOp = liftTypedCmpOp jdouble iflt - - cmpOp FloatEqOp = liftTypedCmpOp jfloat ifeq - cmpOp FloatNeOp = liftTypedCmpOp jfloat ifne - cmpOp FloatGeOp = liftTypedCmpOp jfloat ifge - cmpOp FloatLeOp = liftTypedCmpOp jfloat ifle - cmpOp FloatGtOp = liftTypedCmpOp jfloat ifgt - cmpOp FloatLtOp = liftTypedCmpOp jfloat iflt + cmpOp DoubleEqOp = liftNormalOp if_dcmpeq + cmpOp DoubleNeOp = liftNormalOp if_dcmpne + cmpOp DoubleGeOp = liftNormalOp if_dcmpge + cmpOp DoubleLeOp = liftNormalOp if_dcmple + cmpOp DoubleGtOp = liftNormalOp if_dcmpgt + cmpOp DoubleLtOp = liftNormalOp if_dcmplt + + cmpOp FloatEqOp = liftNormalOp if_fcmpeq + cmpOp FloatNeOp = liftNormalOp if_fcmpne + cmpOp FloatGeOp = liftNormalOp if_fcmpge + cmpOp FloatLeOp = liftNormalOp if_fcmple + cmpOp FloatGtOp = liftNormalOp if_fcmpgt + cmpOp FloatLtOp = liftNormalOp if_fcmplt cmpOp AddrEqOp = liftTypedCmpOp jlong ifeq cmpOp AddrNeOp = liftTypedCmpOp jlong ifne diff --git a/compiler/Eta/CodeGen/Prim.hs b/compiler/Eta/CodeGen/Prim.hs index ff60edfb..7b49469a 100644 --- a/compiler/Eta/CodeGen/Prim.hs +++ b/compiler/Eta/CodeGen/Prim.hs @@ -667,12 +667,12 @@ simpleOp CharLeOp = Just $ unsignedCmp ifle simpleOp CharLtOp = Just $ unsignedCmp iflt -- Double# ops -simpleOp DoubleEqOp = Just $ typedCmp jdouble ifeq -simpleOp DoubleNeOp = Just $ typedCmp jdouble ifne -simpleOp DoubleGeOp = Just $ typedCmp jdouble ifge -simpleOp DoubleLeOp = Just $ typedCmp jdouble ifle -simpleOp DoubleGtOp = Just $ typedCmp jdouble ifgt -simpleOp DoubleLtOp = Just $ typedCmp jdouble iflt +simpleOp DoubleEqOp = Just $ floatCmp if_dcmpeq +simpleOp DoubleNeOp = Just $ floatCmp if_dcmpne +simpleOp DoubleGeOp = Just $ floatCmp if_dcmpge +simpleOp DoubleLeOp = Just $ floatCmp if_dcmple +simpleOp DoubleGtOp = Just $ floatCmp if_dcmpgt +simpleOp DoubleLtOp = Just $ floatCmp if_dcmplt simpleOp DoubleAddOp = Just $ normalOp dadd simpleOp DoubleSubOp = Just $ normalOp dsub @@ -697,12 +697,12 @@ simpleOp DoubleTanhOp = Just $ normalOp $ doubleMathEndoOp "tanh" simpleOp DoublePowerOp = Just $ normalOp $ doubleMathOp "pow" [jdouble, jdouble] jdouble -- Float# ops -simpleOp FloatEqOp = Just $ typedCmp jfloat ifeq -simpleOp FloatNeOp = Just $ typedCmp jfloat ifne -simpleOp FloatGeOp = Just $ typedCmp jfloat ifge -simpleOp FloatLeOp = Just $ typedCmp jfloat ifle -simpleOp FloatGtOp = Just $ typedCmp jfloat ifgt -simpleOp FloatLtOp = Just $ typedCmp jfloat iflt +simpleOp FloatEqOp = Just $ floatCmp if_fcmpeq +simpleOp FloatNeOp = Just $ floatCmp if_fcmpne +simpleOp FloatGeOp = Just $ floatCmp if_fcmpge +simpleOp FloatLeOp = Just $ floatCmp if_fcmple +simpleOp FloatGtOp = Just $ floatCmp if_fcmpgt +simpleOp FloatLtOp = Just $ floatCmp if_fcmplt simpleOp FloatAddOp = Just $ normalOp fadd simpleOp FloatSubOp = Just $ normalOp fsub @@ -1048,6 +1048,9 @@ typedCmp ft ifop [arg1, arg2] <> ifop (iconst jint 1) (iconst jint 0) typedCmp _ _ _ = error $ "typedCmp: bad typedCmp" +floatCmp :: (Code -> Code -> Code) -> [Code] -> Code +floatCmp ifop args = fold args <> ifop (iconst jint 1) (iconst jint 0) + unsignedCmp :: (Code -> Code -> Code) -> [Code] -> Code unsignedCmp ifop args = typedCmp jlong ifop $ map unsignedExtend args