diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/Base.hs | 66 | ||||
| -rw-r--r-- | libraries/base/GHC/Int.hs | 47 | ||||
| -rw-r--r-- | libraries/base/GHC/Word.hs | 25 |
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 + |