Commit f7370333 authored by chessai's avatar chessai Committed by Marge Bot

Introduce log1p and expm1 primops

Previously log and exp were primitives yet log1p and expm1 were FFI
calls. Fix this non-uniformity.
parent a018c3a8
......@@ -556,7 +556,9 @@ data CallishMachOp
| MO_F64_Acosh
| MO_F64_Atanh
| MO_F64_Log
| MO_F64_Log1P
| MO_F64_Exp
| MO_F64_ExpM1
| MO_F64_Fabs
| MO_F64_Sqrt
| MO_F32_Pwr
......@@ -573,7 +575,9 @@ data CallishMachOp
| MO_F32_Acosh
| MO_F32_Atanh
| MO_F32_Log
| MO_F32_Log1P
| MO_F32_Exp
| MO_F32_ExpM1
| MO_F32_Fabs
| MO_F32_Sqrt
......
......@@ -788,7 +788,9 @@ pprCallishMachOp_for_C mop
MO_F64_Acosh -> text "acosh"
MO_F64_Atan -> text "atan"
MO_F64_Log -> text "log"
MO_F64_Log1P -> text "log1p"
MO_F64_Exp -> text "exp"
MO_F64_ExpM1 -> text "expm1"
MO_F64_Sqrt -> text "sqrt"
MO_F64_Fabs -> text "fabs"
MO_F32_Pwr -> text "powf"
......@@ -805,7 +807,9 @@ pprCallishMachOp_for_C mop
MO_F32_Acosh -> text "acoshf"
MO_F32_Atanh -> text "atanhf"
MO_F32_Log -> text "logf"
MO_F32_Log1P -> text "log1pf"
MO_F32_Exp -> text "expf"
MO_F32_ExpM1 -> text "expm1f"
MO_F32_Sqrt -> text "sqrtf"
MO_F32_Fabs -> text "fabsf"
MO_WriteBarrier -> text "write_barrier"
......
......@@ -1513,7 +1513,9 @@ callishOp DoubleAsinhOp = Just MO_F64_Asinh
callishOp DoubleAcoshOp = Just MO_F64_Acosh
callishOp DoubleAtanhOp = Just MO_F64_Atanh
callishOp DoubleLogOp = Just MO_F64_Log
callishOp DoubleLog1POp = Just MO_F64_Log1P
callishOp DoubleExpOp = Just MO_F64_Exp
callishOp DoubleExpM1Op = Just MO_F64_ExpM1
callishOp DoubleSqrtOp = Just MO_F64_Sqrt
callishOp FloatPowerOp = Just MO_F32_Pwr
......@@ -1530,7 +1532,9 @@ callishOp FloatAsinhOp = Just MO_F32_Asinh
callishOp FloatAcoshOp = Just MO_F32_Acosh
callishOp FloatAtanhOp = Just MO_F32_Atanh
callishOp FloatLogOp = Just MO_F32_Log
callishOp FloatLog1POp = Just MO_F32_Log1P
callishOp FloatExpOp = Just MO_F32_Exp
callishOp FloatExpM1Op = Just MO_F32_ExpM1
callishOp FloatSqrtOp = Just MO_F32_Sqrt
callishOp _ = Nothing
......
......@@ -745,7 +745,9 @@ cmmPrimOpFunctions mop = do
return $ case mop of
MO_F32_Exp -> fsLit "expf"
MO_F32_ExpM1 -> fsLit "expm1f"
MO_F32_Log -> fsLit "logf"
MO_F32_Log1P -> fsLit "log1pf"
MO_F32_Sqrt -> fsLit "llvm.sqrt.f32"
MO_F32_Fabs -> fsLit "llvm.fabs.f32"
MO_F32_Pwr -> fsLit "llvm.pow.f32"
......@@ -767,7 +769,9 @@ cmmPrimOpFunctions mop = do
MO_F32_Atanh -> fsLit "atanhf"
MO_F64_Exp -> fsLit "exp"
MO_F64_ExpM1 -> fsLit "expm1"
MO_F64_Log -> fsLit "log"
MO_F64_Log1P -> fsLit "log1p"
MO_F64_Sqrt -> fsLit "llvm.sqrt.f64"
MO_F64_Fabs -> fsLit "llvm.fabs.f64"
MO_F64_Pwr -> fsLit "llvm.pow.f64"
......
......@@ -1955,7 +1955,9 @@ genCCall' dflags gcp target dest_regs args
where
(functionName, reduce) = case mop of
MO_F32_Exp -> (fsLit "exp", True)
MO_F32_ExpM1 -> (fsLit "expm1", True)
MO_F32_Log -> (fsLit "log", True)
MO_F32_Log1P -> (fsLit "log1p", True)
MO_F32_Sqrt -> (fsLit "sqrt", True)
MO_F32_Fabs -> unsupported
......@@ -1977,7 +1979,9 @@ genCCall' dflags gcp target dest_regs args
MO_F32_Atanh -> (fsLit "atanh", True)
MO_F64_Exp -> (fsLit "exp", False)
MO_F64_ExpM1 -> (fsLit "expm1", False)
MO_F64_Log -> (fsLit "log", False)
MO_F64_Log1P -> (fsLit "log1p", False)
MO_F64_Sqrt -> (fsLit "sqrt", False)
MO_F64_Fabs -> unsupported
......
......@@ -616,7 +616,9 @@ outOfLineMachOp_table
outOfLineMachOp_table mop
= case mop of
MO_F32_Exp -> fsLit "expf"
MO_F32_ExpM1 -> fsLit "expm1f"
MO_F32_Log -> fsLit "logf"
MO_F32_Log1P -> fsLit "log1pf"
MO_F32_Sqrt -> fsLit "sqrtf"
MO_F32_Fabs -> unsupported
MO_F32_Pwr -> fsLit "powf"
......@@ -638,7 +640,9 @@ outOfLineMachOp_table mop
MO_F32_Atanh -> fsLit "atanhf"
MO_F64_Exp -> fsLit "exp"
MO_F64_ExpM1 -> fsLit "expm1"
MO_F64_Log -> fsLit "log"
MO_F64_Log1P -> fsLit "log1p"
MO_F64_Sqrt -> fsLit "sqrt"
MO_F64_Fabs -> unsupported
MO_F64_Pwr -> fsLit "pow"
......
......@@ -2875,7 +2875,9 @@ outOfLineCmmOp bid mop res args
MO_F32_Cos -> fsLit "cosf"
MO_F32_Tan -> fsLit "tanf"
MO_F32_Exp -> fsLit "expf"
MO_F32_ExpM1 -> fsLit "expm1f"
MO_F32_Log -> fsLit "logf"
MO_F32_Log1P -> fsLit "log1pf"
MO_F32_Asin -> fsLit "asinf"
MO_F32_Acos -> fsLit "acosf"
......@@ -2896,7 +2898,9 @@ outOfLineCmmOp bid mop res args
MO_F64_Cos -> fsLit "cos"
MO_F64_Tan -> fsLit "tan"
MO_F64_Exp -> fsLit "exp"
MO_F64_ExpM1 -> fsLit "expm1"
MO_F64_Log -> fsLit "log"
MO_F64_Log1P -> fsLit "log1p"
MO_F64_Asin -> fsLit "asin"
MO_F64_Acos -> fsLit "acos"
......
......@@ -763,12 +763,23 @@ primop DoubleExpOp "expDouble#" Monadic
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleExpM1Op "expm1Double#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleLogOp "logDouble#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop DoubleLog1POp "log1pDouble#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop DoubleSqrtOp "sqrtDouble#" Monadic
Double# -> Double#
with
......@@ -904,12 +915,23 @@ primop FloatExpOp "expFloat#" Monadic
with
code_size = { primOpCodeSizeForeignCall }
primop FloatExpM1Op "expm1Float#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
primop FloatLogOp "logFloat#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop FloatLog1POp "log1pFloat#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop FloatSqrtOp "sqrtFloat#" Monadic
Float# -> Float#
with
......
......@@ -1140,13 +1140,16 @@ geFloat (F# x) (F# y) = isTrue# (geFloat# x y)
ltFloat (F# x) (F# y) = isTrue# (ltFloat# x y)
leFloat (F# x) (F# y) = isTrue# (leFloat# x y)
expFloat, logFloat, sqrtFloat, fabsFloat :: Float -> Float
expFloat, expm1Float :: Float -> Float
logFloat, log1pFloat, sqrtFloat, fabsFloat :: Float -> Float
sinFloat, cosFloat, tanFloat :: Float -> Float
asinFloat, acosFloat, atanFloat :: Float -> Float
sinhFloat, coshFloat, tanhFloat :: Float -> Float
asinhFloat, acoshFloat, atanhFloat :: Float -> Float
expFloat (F# x) = F# (expFloat# x)
expm1Float (F# x) = F# (expm1Float# x)
logFloat (F# x) = F# (logFloat# x)
log1pFloat (F# x) = F# (log1pFloat# x)
sqrtFloat (F# x) = F# (sqrtFloat# x)
fabsFloat (F# x) = F# (fabsFloat# x)
sinFloat (F# x) = F# (sinFloat# x)
......@@ -1189,13 +1192,16 @@ double2Float (D# x) = F# (double2Float# x)
float2Double :: Float -> Double
float2Double (F# x) = D# (float2Double# x)
expDouble, logDouble, sqrtDouble, fabsDouble :: Double -> Double
expDouble, expm1Double :: Double -> Double
logDouble, log1pDouble, sqrtDouble, fabsDouble :: Double -> Double
sinDouble, cosDouble, tanDouble :: Double -> Double
asinDouble, acosDouble, atanDouble :: Double -> Double
sinhDouble, coshDouble, tanhDouble :: Double -> Double
asinhDouble, acoshDouble, atanhDouble :: Double -> Double
expDouble (D# x) = D# (expDouble# x)
expm1Double (D# x) = D# (expm1Double# x)
logDouble (D# x) = D# (logDouble# x)
log1pDouble (D# x) = D# (log1pDouble# x)
sqrtDouble (D# x) = D# (sqrtDouble# x)
fabsDouble (D# x) = D# (fabsDouble# x)
sinDouble (D# x) = D# (sinDouble# x)
......@@ -1226,16 +1232,6 @@ foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Doubl
foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int
------------------------------------------------------------------------
-- libm imports for extended floating
------------------------------------------------------------------------
foreign import capi unsafe "math.h log1p" log1pDouble :: Double -> Double
foreign import capi unsafe "math.h expm1" expm1Double :: Double -> Double
foreign import capi unsafe "math.h log1pf" log1pFloat :: Float -> Float
foreign import capi unsafe "math.h expm1f" expm1Float :: Float -> Float
------------------------------------------------------------------------
-- Coercion rules
------------------------------------------------------------------------
......@@ -1324,7 +1320,7 @@ clamp bd k = max (-bd) (min bd k)
Note [Casting from integral to floating point types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To implement something like `reinterpret_cast` from C++ to go from a
floating-point type to an integral type one might niavely think that the
floating-point type to an integral type one might naively think that the
following should work:
cast :: Float -> Word32
......
......@@ -83,6 +83,7 @@ test('cgrun072', normal, compile_and_run, [''])
test('cgrun075', normal, compile_and_run, [''])
test('cgrun076', normal, compile_and_run, [''])
test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], compile_and_run, [''])
test('cgrun078', normal, compile_and_run, [''])
test('T1852', normal, compile_and_run, [''])
test('T1861', extra_run_opts('0'), compile_and_run, [''])
......
{-# LANGUAGE CApiFFI
, CPP
, GHCForeignImportPrim
, MagicHash
#-}
-- | Check that libm foreign import log1p/expm1
-- are equivalent to that of the primops
-- for float/double
module Main ( main ) where
import GHC.Float (Floating(..))
main :: IO ()
main = do
print $ oldEqualsNewDouble log1pDoubleOld log1pDoubleNew randomDouble
print $ oldEqualsNewDouble expm1DoubleOld expm1DoubleNew randomDouble
print $ oldEqualsNewFloat log1pFloatOld log1pFloatNew randomFloat
print $ oldEqualsNewFloat expm1FloatOld expm1FloatNew randomFloat
foreign import capi unsafe "math.h log1p" log1pDoubleOld :: Double -> Double
foreign import capi unsafe "math.h expm1" expm1DoubleOld :: Double -> Double
foreign import capi unsafe "math.h log1pf" log1pFloatOld :: Float -> Float
foreign import capi unsafe "math.h expm1f" expm1FloatOld :: Float -> Float
oldEqualsNewDouble :: (Double -> Double) -> (Double -> Double) -> Double -> Bool
oldEqualsNewDouble f g x = f x == g x
oldEqualsNewFloat :: (Float -> Float) -> (Float -> Float) -> Float -> Bool
oldEqualsNewFloat f g x = f x == g x
log1pDoubleNew, expm1DoubleNew :: Double -> Double
log1pDoubleNew = log1p
expm1DoubleNew = expm1
log1pFloatNew, expm1FloatNew :: Float -> Float
log1pFloatNew = log1p
expm1FloatNew = expm1
randomFloat :: Float
randomFloat = 53213
randomDouble :: Double
randomDouble = 41901526
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment