summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp12
-rw-r--r--compiler/GHC/Core/Opt/ConstantFold.hs57
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs15
-rw-r--r--libraries/base/GHC/Bits.hs2
-rwxr-xr-xlibraries/base/GHC/Exts.hs2
-rw-r--r--libraries/base/GHC/Float/ConversionUtils.hs2
-rw-r--r--libraries/base/GHC/Prim/Deprecated.hs39
-rw-r--r--libraries/base/base.cabal1
-rw-r--r--libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs4
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))
View Lorry Controller Status