Get rid of `narrow<N>{Int,Word}#` as primopswip/no-narrow-n

These were used to truncate operations when we were using the native
primops for fixed-sized types, to stay in bounds. But now that we used
fixed sized unboxed types for those, I don't believe these primops have
much motivation. There were, after all, compiled by the NCG as just the
`aToB# . bToA#` round tip anyways.

If we get rid of them and just detect such round trips directly, we can
optimize more cases. And similar to @hsyl20's recent `fromIntegral`
changes, once we do handle the "underlying" round tip, there is no point
having the combination be atomic because it's just more work for no gain
to handle it too.

To avoid breakage, we have a new `GHC.Prim.Deprecated` module from which
functions equivalent to the primops are exported.

CC @Bodigrim

9 files changed, 47 insertions, 87 deletions

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 2aa1eefb4b..51cfe7baac 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -1051,18 +1051,6 @@ primop   BRevOp     "bitReverse#"     GenPrimOp   Word# -> Word#
     {Reverse the order of the bits in a word.}
 
 ------------------------------------------------------------------------
-section "Narrowings"
-        {Explicit narrowing of native-sized ints or words.}
-------------------------------------------------------------------------
-
-primop   Narrow8IntOp      "narrow8Int#"      GenPrimOp   Int# -> Int#
-primop   Narrow16IntOp     "narrow16Int#"     GenPrimOp   Int# -> Int#
-primop   Narrow32IntOp     "narrow32Int#"     GenPrimOp   Int# -> Int#
-primop   Narrow8WordOp     "narrow8Word#"     GenPrimOp   Word# -> Word#
-primop   Narrow16WordOp    "narrow16Word#"    GenPrimOp   Word# -> Word#
-primop   Narrow32WordOp    "narrow32Word#"    GenPrimOp   Word# -> Word#
-
-------------------------------------------------------------------------
 section "Double#"
         {Operations on double-precision (64 bit) floating-point numbers.}
 ------------------------------------------------------------------------
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 85327c56a4..2cfaef335e 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -602,39 +602,6 @@ primOpRules nm = \case
    WordToIntOp    -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt) ]
    IntToWordOp    -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord) ]
 
-   Narrow8IntOp   -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt8)
-                                       , subsumedByPrimOp Narrow8IntOp
-                                       , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
-                                       , Narrow8IntOp `subsumesPrimOp` Narrow32IntOp
-                                       , narrowSubsumesAnd IntAndOp Narrow8IntOp 8 ]
-   Narrow16IntOp  -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt16)
-                                       , subsumedByPrimOp Narrow8IntOp
-                                       , subsumedByPrimOp Narrow16IntOp
-                                       , Narrow16IntOp `subsumesPrimOp` Narrow32IntOp
-                                       , narrowSubsumesAnd IntAndOp Narrow16IntOp 16 ]
-   Narrow32IntOp  -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumInt32)
-                                       , subsumedByPrimOp Narrow8IntOp
-                                       , subsumedByPrimOp Narrow16IntOp
-                                       , subsumedByPrimOp Narrow32IntOp
-                                       , removeOp32
-                                       , narrowSubsumesAnd IntAndOp Narrow32IntOp 32 ]
-   Narrow8WordOp  -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord8)
-                                       , subsumedByPrimOp Narrow8WordOp
-                                       , Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
-                                       , Narrow8WordOp `subsumesPrimOp` Narrow32WordOp
-                                       , narrowSubsumesAnd WordAndOp Narrow8WordOp 8 ]
-   Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord16)
-                                       , subsumedByPrimOp Narrow8WordOp
-                                       , subsumedByPrimOp Narrow16WordOp
-                                       , Narrow16WordOp `subsumesPrimOp` Narrow32WordOp
-                                       , narrowSubsumesAnd WordAndOp Narrow16WordOp 16 ]
-   Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumNarrow LitNumWord32)
-                                       , subsumedByPrimOp Narrow8WordOp
-                                       , subsumedByPrimOp Narrow16WordOp
-                                       , subsumedByPrimOp Narrow32WordOp
-                                       , removeOp32
-                                       , narrowSubsumesAnd WordAndOp Narrow32WordOp 32 ]
-
    OrdOp          -> mkPrimOpRule nm 1 [ liftLit charToIntLit
                                        , semiInversePrimOp ChrOp ]
    ChrOp          -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs
@@ -1279,18 +1246,6 @@ semiInversePrimOp primop = do
   matchPrimOpId primop primop_id
   return e
 
-subsumesPrimOp :: PrimOp -> PrimOp -> RuleM CoreExpr
-this `subsumesPrimOp` that = do
-  [Var primop_id `App` e] <- getArgs
-  matchPrimOpId that primop_id
-  return (Var (mkPrimOpId this) `App` e)
-
-subsumedByPrimOp :: PrimOp -> RuleM CoreExpr
-subsumedByPrimOp primop = do
-  [e@(Var primop_id `App` _)] <- getArgs
-  matchPrimOpId primop primop_id
-  return e
-
 -- | Transform `extendWordN (narrowWordN x)` into `x .&. 0xFF..FF`
 extendNarrowPassthrough :: PrimOp -> Integer -> RuleM CoreExpr
 extendNarrowPassthrough narrow_primop n = do
@@ -1350,7 +1305,7 @@ Consider this code:
   chunkToBitmap :: [Bool] -> Word32
   chunkToBitmap chunk = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
 
-This optimises to:
+This optimised to:
 Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->
     case w1_sCT of _ {
       [] -> 0##;
@@ -1488,16 +1443,6 @@ liftLitPlatform f = do
   [Lit lit] <- getArgs
   return $ Lit (f platform lit)
 
-removeOp32 :: RuleM CoreExpr
-removeOp32 = do
-  platform <- getPlatform
-  case platformWordSize platform of
-    PW4 -> do
-      [e] <- getArgs
-      return e
-    PW8 ->
-      mzero
-
 getArgs :: RuleM [CoreExpr]
 getArgs = RuleM $ \_ _ _ args -> Just args
 
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index dff86341b1..8ccdce3e1c 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1106,13 +1106,6 @@ emitPrimOp dflags primop = case primop of
   ChrOp           -> \args -> opNop args  -- Int# and Char# are rep'd the same
   OrdOp           -> \args -> opNop args
 
-  Narrow8IntOp   -> \args -> opNarrow args (MO_SS_Conv, W8)
-  Narrow16IntOp  -> \args -> opNarrow args (MO_SS_Conv, W16)
-  Narrow32IntOp  -> \args -> opNarrow args (MO_SS_Conv, W32)
-  Narrow8WordOp  -> \args -> opNarrow args (MO_UU_Conv, W8)
-  Narrow16WordOp -> \args -> opNarrow args (MO_UU_Conv, W16)
-  Narrow32WordOp -> \args -> opNarrow args (MO_UU_Conv, W32)
-
   DoublePowerOp  -> \args -> opCallish args MO_F64_Pwr
   DoubleSinOp    -> \args -> opCallish args MO_F64_Sin
   DoubleCosOp    -> \args -> opCallish args MO_F64_Cos
@@ -1682,14 +1675,6 @@ emitPrimOp dflags primop = case primop of
   opNop args = opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg
     where [arg] = args
 
-  opNarrow
-    :: [CmmExpr]
-    -> (Width -> Width -> MachOp, Width)
-    -> PrimopCmmEmit
-  opNarrow args (mop, rep) = opIntoRegs $ \[res] -> emitAssign (CmmLocal res) $
-    CmmMachOp (mop rep (wordWidth platform)) [CmmMachOp (mop (wordWidth platform) rep) [arg]]
-    where [arg] = args
-
   -- | These primops are implemented by CallishMachOps, because they sometimes
   -- turn into foreign calls depending on the backend.
   opCallish :: [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
diff --git a/libraries/base/GHC/Bits.hs b/libraries/base/GHC/Bits.hs
index 012550a60b..637ff3ea86 100644
--- a/libraries/base/GHC/Bits.hs
+++ b/libraries/base/GHC/Bits.hs
@@ -714,6 +714,6 @@ own to enable constant folding; for example 'shift':
 -- > i16_to_w16 = \x -> case eta of _
 -- >   { I16# b1 -> case tagToEnum# (<=# 0 b1) of _
 -- >       { False -> Nothing
--- >       ; True -> Just (W16# (narrow16Word# (int2Word# b1)))
+-- >       ; True -> Just (W16# (WordToWord16# (int2Word# b1)))
 -- >       }
 -- >   }
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 29f6bdaca0..3296de38fc 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -36,6 +36,7 @@ module GHC.Exts
         FUN, -- See https://gitlab.haskell.org/ghc/ghc/issues/18302
         module GHC.Prim,
         module GHC.Prim.Ext,
+        module GHC.Prim.Deprecated,
         shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
         isTrue#,
         Void#, -- Previously exported by GHC.Prim
@@ -135,6 +136,7 @@ module GHC.Exts
        ) where
 
 import GHC.Prim hiding ( coerce, TYPE )
+import qualified GHC.Prim.Deprecated
 import qualified GHC.Prim
 import qualified GHC.Prim.Ext
 import GHC.Base hiding ( coerce )
diff --git a/libraries/base/GHC/Float/ConversionUtils.hs b/libraries/base/GHC/Float/ConversionUtils.hs
index fe78ee3101..a8fa0432c3 100644
--- a/libraries/base/GHC/Float/ConversionUtils.hs
+++ b/libraries/base/GHC/Float/ConversionUtils.hs
@@ -61,6 +61,6 @@ elimZerosInt# n e =
 
 -- | Number of trailing zero bits in a byte
 zeroCount :: Int# -> Int#
-zeroCount i = int8ToInt# (indexInt8OffAddr# arr (word2Int# (narrow8Word# (int2Word# i)))) -- index must be in [0,255]
+zeroCount i = int8ToInt# (indexInt8OffAddr# arr (i `andI#` 255#)) -- index must be in [0,255]
   where
     arr = "\8\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\7\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\6\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\5\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0\4\0\1\0\2\0\1\0\3\0\1\0\2\0\1\0"#
diff --git a/libraries/base/GHC/Prim/Deprecated.hs b/libraries/base/GHC/Prim/Deprecated.hs
new file mode 100644
index 0000000000..2cd8f20234
--- /dev/null
+++ b/libraries/base/GHC/Prim/Deprecated.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Provide some functions with the same names and interfaces as removed
+-- primops.
+module GHC.Prim.Deprecated
+  (
+  -- narrowing ops
+    narrow8Int#
+  , narrow16Int#
+  , narrow32Int#
+  , narrow8Word#
+  , narrow16Word#
+  , narrow32Word#
+  ) where
+
+import GHC.Prim
+import GHC.Types () -- Make implicit dependency known to build system
+
+default () -- Double and Integer aren't available yet
+
+narrow8Int#   :: Int# -> Int#
+narrow8Int# i = int8ToInt# (intToInt8# i)
+
+narrow16Int#  :: Int# -> Int#
+narrow16Int# i = int16ToInt# (intToInt16# i)
+
+narrow32Int#  :: Int# -> Int#
+narrow32Int# i = int32ToInt# (intToInt32# i)
+
+narrow8Word#  :: Word# -> Word#
+narrow8Word# i = word8ToWord# (wordToWord8# i)
+
+narrow16Word# :: Word# -> Word#
+narrow16Word# i = word16ToWord# (wordToWord16# i)
+
+narrow32Word# :: Word# -> Word#
+narrow32Word# i = word32ToWord# (wordToWord32# i)
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 0f7023ae79..d2cd89917f 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -334,6 +334,7 @@ Library
         GHC.IO.Handle.Lock.Windows
         GHC.StaticPtr.Internal
         GHC.Event.Internal.Types
+        GHC.Prim.Deprecated
         -- GHC.IOPort -- TODO: hide again after debug
         System.Environment.ExecutablePath
         System.CPUTime.Utils
diff --git a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs b/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
index 3fd4394bcf..9bdd0207c7 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
@@ -53,11 +53,11 @@ narrowGmpSize# x = x
 -- On IL32P64 (i.e. Win64), we have to be careful with CLong not being
 -- 64bit.  This is mostly an issue on values returned from C functions
 -- due to sign-extension.
-narrowGmpSize# = narrow32Int#
+narrowGmpSize# i = int32ToInt# (intToInt32# i)
 #endif
 
 narrowCInt# :: Int# -> Int#
-narrowCInt# = narrow32Int#
+narrowCInt# i = int32ToInt# (intToInt32# i)
 
 bignat_compare :: WordArray# -> WordArray# -> Int#
 bignat_compare x y = narrowCInt# (c_mpn_cmp x y (wordArraySize# x))