summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-04-30 14:33:39 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-05-03 19:48:56 -0400
commit8d6b25254e7cb881e06054ce175ed3d6ef97eedb (patch)
tree5f45c8faa5edc3dc88b9e8b6e6358df2e524685a
parent4512ad2d6a8e65ea43c86c816411cb13b822f674 (diff)
downloadhaskell-8d6b25254e7cb881e06054ce175ed3d6ef97eedb.tar.gz
Move shift ops out of GHC.Base
With a quick flavour I get: before T12545(normal) ghc/alloc 8628109152 after T12545(normal) ghc/alloc 8559741088
-rw-r--r--libraries/base/GHC/Base.hs66
-rw-r--r--libraries/base/GHC/Int.hs47
-rw-r--r--libraries/base/GHC/Word.hs25
3 files changed, 72 insertions, 66 deletions
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 65289acaa7..5eb0da3ea1 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -1656,18 +1656,6 @@ shiftL# :: Word# -> Int# -> Word#
a `shiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
| otherwise = a `uncheckedShiftL#` b
-shiftLWord8# :: Word8# -> Int# -> Word8#
-a `shiftLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0##
- | otherwise = a `uncheckedShiftLWord8#` b
-
-shiftLWord16# :: Word16# -> Int# -> Word16#
-a `shiftLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0##
- | otherwise = a `uncheckedShiftLWord16#` b
-
-shiftLWord32# :: Word32# -> Int# -> Word32#
-a `shiftLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0##
- | otherwise = a `uncheckedShiftLWord32#` b
-
-- | Shift the argument right by the specified number of bits
-- (which must be non-negative).
-- The "RL" means "right, logical" (as opposed to RA for arithmetic)
@@ -1676,36 +1664,12 @@ shiftRL# :: Word# -> Int# -> Word#
a `shiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
| otherwise = a `uncheckedShiftRL#` b
-shiftRLWord8# :: Word8# -> Int# -> Word8#
-a `shiftRLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0##
- | otherwise = a `uncheckedShiftRLWord8#` b
-
-shiftRLWord16# :: Word16# -> Int# -> Word16#
-a `shiftRLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0##
- | otherwise = a `uncheckedShiftRLWord16#` b
-
-shiftRLWord32# :: Word32# -> Int# -> Word32#
-a `shiftRLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0##
- | otherwise = a `uncheckedShiftRLWord32#` b
-
-- | Shift the argument left by the specified number of bits
-- (which must be non-negative).
iShiftL# :: Int# -> Int# -> Int#
a `iShiftL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
| otherwise = a `uncheckedIShiftL#` b
-shiftLInt8# :: Int8# -> Int# -> Int8#
-a `shiftLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0#
- | otherwise = a `uncheckedShiftLInt8#` b
-
-shiftLInt16# :: Int16# -> Int# -> Int16#
-a `shiftLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0#
- | otherwise = a `uncheckedShiftLInt16#` b
-
-shiftLInt32# :: Int32# -> Int# -> Int32#
-a `shiftLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0#
- | otherwise = a `uncheckedShiftLInt32#` b
-
-- | Shift the argument right (signed) by the specified number of bits
-- (which must be non-negative).
-- The "RA" means "right, arithmetic" (as opposed to RL for logical)
@@ -1715,24 +1679,6 @@ a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#)
else 0#
| otherwise = a `uncheckedIShiftRA#` b
-shiftRAInt8# :: Int8# -> Int# -> Int8#
-a `shiftRAInt8#` b | isTrue# (b >=# 8#) = if isTrue# (a `ltInt8#` (intToInt8# 0#))
- then intToInt8# (-1#)
- else intToInt8# 0#
- | otherwise = a `uncheckedShiftRAInt8#` b
-
-shiftRAInt16# :: Int16# -> Int# -> Int16#
-a `shiftRAInt16#` b | isTrue# (b >=# 16#) = if isTrue# (a `ltInt16#` (intToInt16# 0#))
- then intToInt16# (-1#)
- else intToInt16# 0#
- | otherwise = a `uncheckedShiftRAInt16#` b
-
-shiftRAInt32# :: Int32# -> Int# -> Int32#
-a `shiftRAInt32#` b | isTrue# (b >=# 32#) = if isTrue# (a `ltInt32#` (intToInt32# 0#))
- then intToInt32# (-1#)
- else intToInt32# 0#
- | otherwise = a `uncheckedShiftRAInt32#` b
-
-- | Shift the argument right (unsigned) by the specified number of bits
-- (which must be non-negative).
-- The "RL" means "right, logical" (as opposed to RA for arithmetic)
@@ -1740,18 +1686,6 @@ iShiftRL# :: Int# -> Int# -> Int#
a `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
| otherwise = a `uncheckedIShiftRL#` b
-shiftRLInt8# :: Int8# -> Int# -> Int8#
-a `shiftRLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0#
- | otherwise = a `uncheckedShiftRLInt8#` b
-
-shiftRLInt16# :: Int16# -> Int# -> Int16#
-a `shiftRLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0#
- | otherwise = a `uncheckedShiftRLInt16#` b
-
-shiftRLInt32# :: Int32# -> Int# -> Int32#
-a `shiftRLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0#
- | otherwise = a `uncheckedShiftRLInt32#` b
-
-- Rules for C strings (the functions themselves are now in GHC.CString)
{-# RULES
"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index 7e6802c67f..a9feb3d890 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -27,6 +27,8 @@
module GHC.Int (
Int(..), Int8(..), Int16(..), Int32(..), Int64(..),
uncheckedIShiftL64#, uncheckedIShiftRA64#,
+ shiftRLInt8#, shiftRLInt16#, shiftRLInt32#,
+
-- * Equality operators
-- | See GHC.Classes#matching_overloaded_methods_in_rules
eqInt, neInt, gtInt, geInt, ltInt, leInt,
@@ -34,6 +36,7 @@ module GHC.Int (
eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16,
eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32,
eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64
+
) where
import Data.Bits
@@ -1299,3 +1302,47 @@ so the
y == (-1) && x == minBound
order gives us better code in the common case.
-}
+
+shiftRLInt8# :: Int8# -> Int# -> Int8#
+a `shiftRLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0#
+ | otherwise = a `uncheckedShiftRLInt8#` b
+
+shiftRLInt16# :: Int16# -> Int# -> Int16#
+a `shiftRLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0#
+ | otherwise = a `uncheckedShiftRLInt16#` b
+
+shiftRLInt32# :: Int32# -> Int# -> Int32#
+a `shiftRLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0#
+ | otherwise = a `uncheckedShiftRLInt32#` b
+
+shiftLInt8# :: Int8# -> Int# -> Int8#
+a `shiftLInt8#` b | isTrue# (b >=# 8#) = intToInt8# 0#
+ | otherwise = a `uncheckedShiftLInt8#` b
+
+shiftLInt16# :: Int16# -> Int# -> Int16#
+a `shiftLInt16#` b | isTrue# (b >=# 16#) = intToInt16# 0#
+ | otherwise = a `uncheckedShiftLInt16#` b
+
+shiftLInt32# :: Int32# -> Int# -> Int32#
+a `shiftLInt32#` b | isTrue# (b >=# 32#) = intToInt32# 0#
+ | otherwise = a `uncheckedShiftLInt32#` b
+
+
+shiftRAInt8# :: Int8# -> Int# -> Int8#
+a `shiftRAInt8#` b | isTrue# (b >=# 8#) = if isTrue# (a `ltInt8#` (intToInt8# 0#))
+ then intToInt8# (-1#)
+ else intToInt8# 0#
+ | otherwise = a `uncheckedShiftRAInt8#` b
+
+shiftRAInt16# :: Int16# -> Int# -> Int16#
+a `shiftRAInt16#` b | isTrue# (b >=# 16#) = if isTrue# (a `ltInt16#` (intToInt16# 0#))
+ then intToInt16# (-1#)
+ else intToInt16# 0#
+ | otherwise = a `uncheckedShiftRAInt16#` b
+
+shiftRAInt32# :: Int32# -> Int# -> Int32#
+a `shiftRAInt32#` b | isTrue# (b >=# 32#) = if isTrue# (a `ltInt32#` (intToInt32# 0#))
+ then intToInt32# (-1#)
+ else intToInt32# 0#
+ | otherwise = a `uncheckedShiftRAInt32#` b
+
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
index 7a81d0fc19..c704f3afc7 100644
--- a/libraries/base/GHC/Word.hs
+++ b/libraries/base/GHC/Word.hs
@@ -1105,3 +1105,28 @@ bitReverse64 (W64# w#) = W64# (bitReverse# w#)
fromIntegral = naturalFromWord . (fromIntegral :: Word64 -> Word)
#-}
#endif
+
+shiftRLWord8# :: Word8# -> Int# -> Word8#
+a `shiftRLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0##
+ | otherwise = a `uncheckedShiftRLWord8#` b
+
+shiftRLWord16# :: Word16# -> Int# -> Word16#
+a `shiftRLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0##
+ | otherwise = a `uncheckedShiftRLWord16#` b
+
+shiftRLWord32# :: Word32# -> Int# -> Word32#
+a `shiftRLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0##
+ | otherwise = a `uncheckedShiftRLWord32#` b
+
+shiftLWord8# :: Word8# -> Int# -> Word8#
+a `shiftLWord8#` b | isTrue# (b >=# 8#) = wordToWord8# 0##
+ | otherwise = a `uncheckedShiftLWord8#` b
+
+shiftLWord16# :: Word16# -> Int# -> Word16#
+a `shiftLWord16#` b | isTrue# (b >=# 16#) = wordToWord16# 0##
+ | otherwise = a `uncheckedShiftLWord16#` b
+
+shiftLWord32# :: Word32# -> Int# -> Word32#
+a `shiftLWord32#` b | isTrue# (b >=# 32#) = wordToWord32# 0##
+ | otherwise = a `uncheckedShiftLWord32#` b
+