[Git][ghc/ghc][wip/no-narrow-n] Get rid of `narrow<N>{Int, Word}#` as primops
John Ericson (@Ericson2314)
gitlab at gitlab.haskell.org
Thu Oct 12 18:02:15 UTC 2023
John Ericson pushed to branch wip/no-narrow-n at Glasgow Haskell Compiler / GHC
Commits:
8cd6f681 by John Ericson at 2023-10-12T14:02:01-04:00
Get rid of `narrow<N>{Int,Word}#` as primops
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
- - - - -
10 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- + libraries/base/GHC/Prim/Deprecated.hs
- libraries/base/base.cabal
- libraries/base/src/GHC/Bits.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/GHC/Float/ConversionUtils.hs
- libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1053,18 +1053,6 @@ primop BRev64Op "bitReverse64#" GenPrimOp Word64# -> Word64#
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.}
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -624,39 +624,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
@@ -1460,18 +1427,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 (primOpId 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
@@ -1531,7 +1486,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##;
@@ -1669,16 +1624,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
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1081,13 +1081,6 @@ emitPrimOp cfg primop =
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
@@ -1664,14 +1657,6 @@ emitPrimOp cfg primop =
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
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -445,15 +445,6 @@ genPrim prof bound ty op = case op of
, rh |= app "h$reverseWord" [l]
]
------------------------------- Narrow -------------------------------------------
-
- Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= signExtend8 x
- Narrow16IntOp -> \[r] [x] -> PrimInline $ r |= signExtend16 x
- Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= toI32 x
- Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x
- Narrow16WordOp -> \[r] [x] -> PrimInline $ r |= mask16 x
- Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= toU32 x
-
------------------------------ Double -------------------------------------------
DoubleGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)
=====================================
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 = i `andI#` 0xFF#
+
+narrow16Int# :: Int# -> Int#
+narrow16Int# i = i `andI#` 0xFFFF#
+
+narrow32Int# :: Int# -> Int#
+narrow32Int# i = i `andI#` 0xFFFFFFFF#
+
+narrow8Word# :: Word# -> Word#
+narrow8Word# i = i `and#` 0xFF##
+
+narrow16Word# :: Word# -> Word#
+narrow16Word# i = i `and#` 0xFFFF##
+
+narrow32Word# :: Word# -> Word#
+narrow32Word# i = i `and#` 0xFFFFFFFF##
=====================================
libraries/base/base.cabal
=====================================
@@ -354,6 +354,7 @@ Library
GHC.Event.PSQ
GHC.Event.Unique
GHC.Foreign.Internal
+ GHC.Prim.Deprecated
-- GHC.IOPort -- TODO: hide again after debug
GHC.Unicode.Internal.Bits
GHC.Unicode.Internal.Char.DerivedCoreProperties
=====================================
libraries/base/src/GHC/Bits.hs
=====================================
@@ -719,6 +719,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)))
-- > }
-- > }
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -38,6 +38,7 @@ module GHC.Exts
module GHC.Prim,
module GHC.Prim.Ext,
+ module GHC.Prim.Deprecated,
-- ** Running 'RealWorld' state thread
runRW#,
@@ -138,6 +139,7 @@ import GHC.Types
-- GHC's internal representation of 'TyCon's, for 'Typeable'
, Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr )
import qualified GHC.Prim.Ext
+import qualified GHC.Prim.Deprecated
import GHC.ArrayArray
import GHC.Base hiding ( coerce )
import GHC.Ptr
=====================================
libraries/base/src/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"#
=====================================
libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs
=====================================
@@ -57,11 +57,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 it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8cd6f6815f2b3820763ea15c29e1a5f2757ac719
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8cd6f6815f2b3820763ea15c29e1a5f2757ac719
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231012/db835ab0/attachment-0001.html>
More information about the ghc-commits
mailing list