[Git][ghc/ghc][master] Introduce log1p and expm1 primops
Marge Bot
gitlab at gitlab.haskell.org
Sun Jun 9 22:41:09 UTC 2019
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
f7370333 by chessai at 2019-06-09T22:41:02Z
Introduce log1p and expm1 primops
Previously log and exp were primitives yet log1p and expm1 were FFI
calls. Fix this non-uniformity.
- - - - -
12 changed files:
- compiler/cmm/CmmMachOp.hs
- compiler/cmm/PprC.hs
- compiler/codeGen/StgCmmPrim.hs
- compiler/llvmGen/LlvmCodeGen/CodeGen.hs
- compiler/nativeGen/PPC/CodeGen.hs
- compiler/nativeGen/SPARC/CodeGen.hs
- compiler/nativeGen/X86/CodeGen.hs
- compiler/prelude/primops.txt.pp
- libraries/base/GHC/Float.hs
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/codeGen/should_run/cgrun078.hs
- + testsuite/tests/codeGen/should_run/cgrun078.stdout
Changes:
=====================================
compiler/cmm/CmmMachOp.hs
=====================================
@@ -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
=====================================
compiler/cmm/PprC.hs
=====================================
@@ -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"
=====================================
compiler/codeGen/StgCmmPrim.hs
=====================================
@@ -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
=====================================
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
=====================================
@@ -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"
=====================================
compiler/nativeGen/PPC/CodeGen.hs
=====================================
@@ -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
=====================================
compiler/nativeGen/SPARC/CodeGen.hs
=====================================
@@ -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"
=====================================
compiler/nativeGen/X86/CodeGen.hs
=====================================
@@ -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"
=====================================
compiler/prelude/primops.txt.pp
=====================================
@@ -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
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -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
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -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, [''])
=====================================
testsuite/tests/codeGen/should_run/cgrun078.hs
=====================================
@@ -0,0 +1,44 @@
+{-# 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
=====================================
testsuite/tests/codeGen/should_run/cgrun078.stdout
=====================================
@@ -0,0 +1,4 @@
+True
+True
+True
+True
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f737033329817335bc01ab16a385b4b5ec5b3b5d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/f737033329817335bc01ab16a385b4b5ec5b3b5d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190609/f701ff33/attachment-0001.html>
More information about the ghc-commits
mailing list