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

9 files changed, 94 insertions, 14 deletions

diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index 15a5827643..c5e9d9bf27 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/compiler/cmm/CmmMachOp.hs
@@ -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
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 9e8ced88b5..a979d49501 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -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"
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 6ed3ca7402..a6e13086aa 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -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
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 51de1f6850..81791628d5 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -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
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index efd9591c71..f246ec36f1 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -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)
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 98e062df62..a95a22274b 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -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"
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 4551754200..c659064caa 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -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"
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index df92bfaa2f..d4a9d7bd45 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -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
diff --git a/libraries/base/GHC/Float.hs b/libraries/base/GHC/Float.hs
index 7def79e3bb..693a209275 100644
--- a/libraries/base/GHC/Float.hs
+++ b/libraries/base/GHC/Float.hs
@@ -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)