Introduce log1p and expm1 primops

Previously log and exp were primitives yet log1p and expm1 were FFI
calls. Fix this non-uniformity.

8 files changed, 50 insertions, 0 deletions

diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index 7cd5c1bc20..053b425ea1 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/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
 
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 822de431a4..bacdc9face 100644
--- a/compiler/cmm/PprC.hs
+++ b/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"
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 5e3d03579a..f5b8e0f3d6 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/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
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 236b26dbdf..28f38d09ec 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/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"
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 8540c780e3..03e8e42d9a 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/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
 
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 851a6f2f0a..ea81219c69 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/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"
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index b46ef6a935..21e18ee6fd 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/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"
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 39e7c4799c..5b5dd9dc8d 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/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