Commit c6f4eb4f authored by Artem Pelenitsyn's avatar Artem Pelenitsyn Committed by Ben Gamari

Fix precision of asinh/acosh/atanh by making them primops

Reviewers: hvr, bgamari, simonmar, jrtc27

Reviewed By: bgamari

Subscribers: alpmestan, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D5034
parent c3315921
......@@ -531,6 +531,9 @@ data CallishMachOp
| MO_F64_Asin
| MO_F64_Acos
| MO_F64_Atan
| MO_F64_Asinh
| MO_F64_Acosh
| MO_F64_Atanh
| MO_F64_Log
| MO_F64_Exp
| MO_F64_Fabs
......@@ -545,6 +548,9 @@ data CallishMachOp
| MO_F32_Asin
| MO_F32_Acos
| MO_F32_Atan
| MO_F32_Asinh
| MO_F32_Acosh
| MO_F32_Atanh
| MO_F32_Log
| MO_F32_Exp
| MO_F32_Fabs
......
......@@ -775,6 +775,9 @@ pprCallishMachOp_for_C mop
MO_F64_Tanh -> text "tanh"
MO_F64_Asin -> text "asin"
MO_F64_Acos -> text "acos"
MO_F64_Atanh -> text "atanh"
MO_F64_Asinh -> text "asinh"
MO_F64_Acosh -> text "acosh"
MO_F64_Atan -> text "atan"
MO_F64_Log -> text "log"
MO_F64_Exp -> text "exp"
......@@ -790,6 +793,9 @@ pprCallishMachOp_for_C mop
MO_F32_Asin -> text "asinf"
MO_F32_Acos -> text "acosf"
MO_F32_Atan -> text "atanf"
MO_F32_Asinh -> text "asinhf"
MO_F32_Acosh -> text "acoshf"
MO_F32_Atanh -> text "atanhf"
MO_F32_Log -> text "logf"
MO_F32_Exp -> text "expf"
MO_F32_Sqrt -> text "sqrtf"
......
......@@ -1422,6 +1422,9 @@ callishOp DoubleTanhOp = Just MO_F64_Tanh
callishOp DoubleAsinOp = Just MO_F64_Asin
callishOp DoubleAcosOp = Just MO_F64_Acos
callishOp DoubleAtanOp = Just MO_F64_Atan
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 DoubleExpOp = Just MO_F64_Exp
callishOp DoubleSqrtOp = Just MO_F64_Sqrt
......@@ -1436,6 +1439,9 @@ callishOp FloatTanhOp = Just MO_F32_Tanh
callishOp FloatAsinOp = Just MO_F32_Asin
callishOp FloatAcosOp = Just MO_F32_Acos
callishOp FloatAtanOp = Just MO_F32_Atan
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 FloatExpOp = Just MO_F32_Exp
callishOp FloatSqrtOp = Just MO_F32_Sqrt
......
......@@ -761,6 +761,10 @@ cmmPrimOpFunctions mop = do
MO_F32_Cosh -> fsLit "coshf"
MO_F32_Tanh -> fsLit "tanhf"
MO_F32_Asinh -> fsLit "asinhf"
MO_F32_Acosh -> fsLit "acoshf"
MO_F32_Atanh -> fsLit "atanhf"
MO_F64_Exp -> fsLit "exp"
MO_F64_Log -> fsLit "log"
MO_F64_Sqrt -> fsLit "llvm.sqrt.f64"
......@@ -779,6 +783,10 @@ cmmPrimOpFunctions mop = do
MO_F64_Cosh -> fsLit "cosh"
MO_F64_Tanh -> fsLit "tanh"
MO_F64_Asinh -> fsLit "asinh"
MO_F64_Acosh -> fsLit "acosh"
MO_F64_Atanh -> fsLit "atanh"
MO_Memcpy _ -> fsLit $ "llvm.memcpy." ++ intrinTy1
MO_Memmove _ -> fsLit $ "llvm.memmove." ++ intrinTy1
MO_Memset _ -> fsLit $ "llvm.memset." ++ intrinTy2
......
......@@ -1991,6 +1991,10 @@ genCCall' dflags gcp target dest_regs args
MO_F32_Tanh -> (fsLit "tanh", True)
MO_F32_Pwr -> (fsLit "pow", True)
MO_F32_Asinh -> (fsLit "asinh", True)
MO_F32_Acosh -> (fsLit "acosh", True)
MO_F32_Atanh -> (fsLit "atanh", True)
MO_F64_Exp -> (fsLit "exp", False)
MO_F64_Log -> (fsLit "log", False)
MO_F64_Sqrt -> (fsLit "sqrt", False)
......@@ -2009,6 +2013,10 @@ genCCall' dflags gcp target dest_regs args
MO_F64_Tanh -> (fsLit "tanh", False)
MO_F64_Pwr -> (fsLit "pow", False)
MO_F64_Asinh -> (fsLit "asinh", False)
MO_F64_Acosh -> (fsLit "acosh", False)
MO_F64_Atanh -> (fsLit "atanh", False)
MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False)
MO_Memcpy _ -> (fsLit "memcpy", False)
......
......@@ -633,6 +633,10 @@ outOfLineMachOp_table mop
MO_F32_Cosh -> fsLit "coshf"
MO_F32_Tanh -> fsLit "tanhf"
MO_F32_Asinh -> fsLit "asinhf"
MO_F32_Acosh -> fsLit "acoshf"
MO_F32_Atanh -> fsLit "atanhf"
MO_F64_Exp -> fsLit "exp"
MO_F64_Log -> fsLit "log"
MO_F64_Sqrt -> fsLit "sqrt"
......@@ -651,6 +655,10 @@ outOfLineMachOp_table mop
MO_F64_Cosh -> fsLit "cosh"
MO_F64_Tanh -> fsLit "tanh"
MO_F64_Asinh -> fsLit "asinh"
MO_F64_Acosh -> fsLit "acosh"
MO_F64_Atanh -> fsLit "atanh"
MO_UF_Conv w -> fsLit $ word2FloatLabel w
MO_Memcpy _ -> fsLit "memcpy"
......
......@@ -2747,6 +2747,10 @@ outOfLineCmmOp mop res args
MO_F32_Tanh -> fsLit "tanhf"
MO_F32_Pwr -> fsLit "powf"
MO_F32_Asinh -> fsLit "asinhf"
MO_F32_Acosh -> fsLit "acoshf"
MO_F32_Atanh -> fsLit "atanhf"
MO_F64_Sqrt -> fsLit "sqrt"
MO_F64_Fabs -> fsLit "fabs"
MO_F64_Sin -> fsLit "sin"
......@@ -2764,6 +2768,10 @@ outOfLineCmmOp mop res args
MO_F64_Tanh -> fsLit "tanh"
MO_F64_Pwr -> fsLit "pow"
MO_F64_Asinh -> fsLit "asinh"
MO_F64_Acosh -> fsLit "acosh"
MO_F64_Atanh -> fsLit "atanh"
MO_Memcpy _ -> fsLit "memcpy"
MO_Memset _ -> fsLit "memset"
MO_Memmove _ -> fsLit "memmove"
......
......@@ -618,6 +618,21 @@ primop DoubleTanhOp "tanhDouble#" Monadic
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleAsinhOp "asinhDouble#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleAcoshOp "acoshDouble#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleAtanhOp "atanhDouble#" Monadic
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
primop DoublePowerOp "**##" Dyadic
Double# -> Double# -> Double#
{Exponentiation.}
......@@ -744,6 +759,21 @@ primop FloatTanhOp "tanhFloat#" Monadic
with
code_size = { primOpCodeSizeForeignCall }
primop FloatAsinhOp "asinhFloat#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
primop FloatAcoshOp "acoshFloat#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
primop FloatAtanhOp "atanhFloat#" Monadic
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
primop FloatPowerOp "powerFloat#" Dyadic
Float# -> Float# -> Float#
with
......
......@@ -390,13 +390,9 @@ instance Floating Float where
(**) x y = powerFloat x y
logBase x y = log y / log x
asinh x
| x > huge = log 2 + log x
| x < 0 = -asinh (-x)
| otherwise = log (x + sqrt (1 + x*x))
where huge = 1e10
acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
atanh x = 0.5 * log ((1.0+x) / (1.0-x))
asinh x = asinhFloat x
acosh x = acoshFloat x
atanh x = atanhFloat x
log1p = log1pFloat
expm1 = expm1Float
......@@ -535,13 +531,9 @@ instance Floating Double where
(**) x y = powerDouble x y
logBase x y = log y / log x
asinh x
| x > huge = log 2 + log x
| x < 0 = -asinh (-x)
| otherwise = log (x + sqrt (1 + x*x))
where huge = 1e20
acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
atanh x = 0.5 * log ((1.0+x) / (1.0-x))
asinh x = asinhDouble x
acosh x = acoshDouble x
atanh x = atanhDouble x
log1p = log1pDouble
expm1 = expm1Double
......@@ -1149,6 +1141,7 @@ expFloat, logFloat, 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)
logFloat (F# x) = F# (logFloat# x)
sqrtFloat (F# x) = F# (sqrtFloat# x)
......@@ -1162,6 +1155,9 @@ atanFloat (F# x) = F# (atanFloat# x)
sinhFloat (F# x) = F# (sinhFloat# x)
coshFloat (F# x) = F# (coshFloat# x)
tanhFloat (F# x) = F# (tanhFloat# x)
asinhFloat (F# x) = F# (asinhFloat# x)
acoshFloat (F# x) = F# (acoshFloat# x)
atanhFloat (F# x) = F# (atanhFloat# x)
powerFloat :: Float -> Float -> Float
powerFloat (F# x) (F# y) = F# (powerFloat# x y)
......@@ -1194,6 +1190,7 @@ expDouble, logDouble, 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)
logDouble (D# x) = D# (logDouble# x)
sqrtDouble (D# x) = D# (sqrtDouble# x)
......@@ -1207,6 +1204,9 @@ atanDouble (D# x) = D# (atanDouble# x)
sinhDouble (D# x) = D# (sinhDouble# x)
coshDouble (D# x) = D# (coshDouble# x)
tanhDouble (D# x) = D# (tanhDouble# x)
asinhDouble (D# x) = D# (asinhDouble# x)
acoshDouble (D# x) = D# (acoshDouble# x)
atanhDouble (D# x) = D# (atanhDouble# x)
powerDouble :: Double -> Double -> Double
powerDouble (D# x) (D# y) = D# (x **## y)
......
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