Numeric exceptions: replace FFI calls with primops

ghc-bignum needs a way to raise numerical exceptions defined in base
package. At the time we used FFI calls into primops defined in the RTS.
These FFI calls had to be wrapped into hacky bottoming functions because
"foreign import prim" syntax doesn't support giving a bottoming demand
to the foreign call (cf #16929).

These hacky wrapper functions trip up the JavaScript backend (#21078)
because they are polymorphic in their return type. This commit
replaces them with primops very similar to raise# but raising predefined
exceptions.

1 files changed, 4 insertions, 18 deletions

diff --git a/libraries/ghc-prim/GHC/Prim/Exception.hs b/libraries/ghc-prim/GHC/Prim/Exception.hs
index 5984dab09c..71c17f96a4 100644
--- a/libraries/ghc-prim/GHC/Prim/Exception.hs
+++ b/libraries/ghc-prim/GHC/Prim/Exception.hs
@@ -1,9 +1,6 @@
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE UnliftedFFITypes #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE EmptyCase #-}
 
 -- | Primitive exceptions.
 --
@@ -16,7 +13,7 @@ module GHC.Prim.Exception
 where
 
 import GHC.Prim
-import GHC.Magic
+import GHC.Types ()
 
 default () -- Double and Integer aren't available yet
 
@@ -31,25 +28,14 @@ default () -- Double and Integer aren't available yet
 --
 -- See also: Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make.
 
-foreign import prim "stg_raiseOverflowzh" raiseOverflow# :: State# RealWorld -> (# State# RealWorld, (# #) #)
-foreign import prim "stg_raiseUnderflowzh" raiseUnderflow# :: State# RealWorld -> (# State# RealWorld, (# #) #)
-foreign import prim "stg_raiseDivZZerozh" raiseDivZero# :: State# RealWorld -> (# State# RealWorld, (# #) #)
-
--- We give a bottoming demand signature to 'raiseOverflow', 'raiseUnderflow' and
--- 'raiseDivZero' in "GHC.Core.Make". NOINLINE pragmas are necessary because if
--- we ever inlined them we would lose that information.
-
 -- | Raise 'GHC.Exception.Type.overflowException'
 raiseOverflow :: a
-{-# NOINLINE raiseOverflow #-}
-raiseOverflow = runRW# (\s -> case raiseOverflow# s of (# _, _ #) -> let x = x in x)
+raiseOverflow = raiseOverflow# (# #)
 
 -- | Raise 'GHC.Exception.Type.underflowException'
 raiseUnderflow :: a
-{-# NOINLINE raiseUnderflow #-}
-raiseUnderflow = runRW# (\s -> case raiseUnderflow# s of (# _, _ #) -> let x = x in x)
+raiseUnderflow = raiseUnderflow# (# #)
 
 -- | Raise 'GHC.Exception.Type.divZeroException'
 raiseDivZero :: a
-{-# NOINLINE raiseDivZero #-}
-raiseDivZero = runRW# (\s -> case raiseDivZero# s of (# _, _ #) -> let x = x in x)
+raiseDivZero = raiseDivZero# (# #)