-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Data.Bits
#ifdef __GLASGOW_HASKELL__
import GHC.Num
-import GHC.Real
import GHC.Base
#endif
{-| Reverse all the bits in the argument -}
complement :: a -> a
- {-| Shift the argument left by the specified number of bits.
- Right shifts (signed) are specified by giving a negative value.
+ {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
+ or right by @-i@ bits otherwise.
+ Right shifts perform sign extension on signed number types;
+ i.e. they fill the top bits with 1 if the @x@ is negative
+ and with 0 otherwise.
- An instance can define either this unified 'shift' or 'shiftL' and
- 'shiftR', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this unified 'shift' or 'shiftL' and
+ 'shiftR', depending on which is more convenient for the type in
+ question. -}
shift :: a -> Int -> a
- x `shift` i | i<0 = x `shiftR` (-i)
- | i==0 = x
- | i>0 = x `shiftL` i
+ x `shift` i | i<0 = x `shiftR` (-i)
+ | i>0 = x `shiftL` i
+ | otherwise = x
- {-| Rotate the argument left by the specified number of bits.
- Right rotates are specified by giving a negative value.
+ {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
+ or right by @-i@ bits otherwise.
For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
- An instance can define either this unified 'rotate' or 'rotateL' and
- 'rotateR', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this unified 'rotate' or 'rotateL' and
+ 'rotateR', depending on which is more convenient for the type in
+ question. -}
rotate :: a -> Int -> a
- x `rotate` i | i<0 = x `rotateR` (-i)
- | i==0 = x
- | i>0 = x `rotateL` i
+ x `rotate` i | i<0 = x `rotateR` (-i)
+ | i>0 = x `rotateL` i
+ | otherwise = x
{-
-- Rotation can be implemented in terms of two shifts, but care is
| i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
-}
- -- | @bit i@ is a value with the @i@th bit set
+ -- | @bit i@ is a value with the @i@th bit set and all other bits clear
bit :: Int -> a
-- | @x \`setBit\` i@ is the same as @x .|. bit i@
testBit :: a -> Int -> Bool
{-| Return the number of bits in the type of the argument. The actual
- value of the argument is ignored. The function 'bitSize' is
- undefined for types that do not have a fixed bitsize, like 'Integer'.
- -}
+ value of the argument is ignored. The function 'bitSize' is
+ undefined for types that do not have a fixed bitsize, like 'Integer'.
+ -}
bitSize :: a -> Int
{-| Return 'True' if the argument is a signed type. The actual
value of the argument is ignored -}
isSigned :: a -> Bool
+ {-# INLINE bit #-}
+ {-# INLINE setBit #-}
+ {-# INLINE clearBit #-}
+ {-# INLINE complementBit #-}
+ {-# INLINE testBit #-}
bit i = 1 `shiftL` i
x `setBit` i = x .|. bit i
x `clearBit` i = x .&. complement (bit i)
x `testBit` i = (x .&. bit i) /= 0
{-| Shift the argument left by the specified number of bits
- (which must be non-negative).
+ (which must be non-negative).
- An instance can define either this and 'shiftR' or the unified
- 'shift', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this and 'shiftR' or the unified
+ 'shift', depending on which is more convenient for the type in
+ question. -}
shiftL :: a -> Int -> a
+ {-# INLINE shiftL #-}
x `shiftL` i = x `shift` i
- {-| Shift the argument right (signed) by the specified number of bits
- (which must be non-negative).
+ {-| Shift the first argument right by the specified number of bits
+ (which must be non-negative).
+ Right shifts perform sign extension on signed number types;
+ i.e. they fill the top bits with 1 if the @x@ is negative
+ and with 0 otherwise.
- An instance can define either this and 'shiftL' or the unified
- 'shift', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this and 'shiftL' or the unified
+ 'shift', depending on which is more convenient for the type in
+ question. -}
shiftR :: a -> Int -> a
+ {-# INLINE shiftR #-}
x `shiftR` i = x `shift` (-i)
{-| Rotate the argument left by the specified number of bits
- (which must be non-negative).
+ (which must be non-negative).
- An instance can define either this and 'rotateR' or the unified
- 'rotate', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this and 'rotateR' or the unified
+ 'rotate', depending on which is more convenient for the type in
+ question. -}
rotateL :: a -> Int -> a
+ {-# INLINE rotateL #-}
x `rotateL` i = x `rotate` i
{-| Rotate the argument right by the specified number of bits
- (which must be non-negative).
+ (which must be non-negative).
- An instance can define either this and 'rotateL' or the unified
- 'rotate', depending on which is more convenient for the type in
- question. -}
+ An instance can define either this and 'rotateL' or the unified
+ 'rotate', depending on which is more convenient for the type in
+ question. -}
rotateR :: a -> Int -> a
+ {-# INLINE rotateR #-}
x `rotateR` i = x `rotate` (-i)
instance Bits Int where
+ {-# INLINE shift #-}
+
#ifdef __GLASGOW_HASKELL__
(I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
+
(I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
+
(I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+
complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+
(I# x#) `shift` (I# i#)
| i# >=# 0# = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
+
+ {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
(I# x#) `rotate` (I# i#) =
- I# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (wsib -# i'#))))
- where
- x'# = int2Word# x#
- i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
- wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (wsib -# i'#))))
+ where
+ !x'# = int2Word# x#
+ !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+ !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
bitSize _ = WORD_SIZE_IN_BITS
+
#else /* !__GLASGOW_HASKELL__ */
#ifdef __HUGS__
#endif /* __NHC__ */
x `rotate` i
- | i<0 && x<0 = let left = i+bitSize x in
+ | i<0 && x<0 = let left = i+bitSize x in
((x `shift` i) .&. complement ((-1) `shift` left))
.|. (x `shift` left)
- | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
- | i==0 = x
- | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
+ | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
+ | i==0 = x
+ | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
#endif /* !__GLASGOW_HASKELL__ */
#endif /* __NHC__ */
instance Bits Integer where
-#ifdef __GLASGOW_HASKELL__
- (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
- x@(S# _) .&. y = toBig x .&. y
- x .&. y@(S# _) = x .&. toBig y
- (J# s1 d1) .&. (J# s2 d2) =
- case andInteger# s1 d1 s2 d2 of
- (# s, d #) -> J# s d
-
- (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
- x@(S# _) .|. y = toBig x .|. y
- x .|. y@(S# _) = x .|. toBig y
- (J# s1 d1) .|. (J# s2 d2) =
- case orInteger# s1 d1 s2 d2 of
- (# s, d #) -> J# s d
-
- (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
- x@(S# _) `xor` y = toBig x `xor` y
- x `xor` y@(S# _) = x `xor` toBig y
- (J# s1 d1) `xor` (J# s2 d2) =
- case xorInteger# s1 d1 s2 d2 of
- (# s, d #) -> J# s d
-
- complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
- complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
+#if defined(__GLASGOW_HASKELL__)
+ (.&.) = andInteger
+ (.|.) = orInteger
+ xor = xorInteger
+ complement = complementInteger
+ shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
+ | otherwise = shiftRInteger x (negateInt# i#)
#else
-- reduce bitwise binary operations to special cases we can handle
x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
- | otherwise = x `posAnd` y
+ | otherwise = x `posAnd` y
x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
- | otherwise = x `posOr` y
+ | otherwise = x `posOr` y
x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
- | x<0 = complement (complement x `posXOr` y)
- | y<0 = complement (x `posXOr` complement y)
- | otherwise = x `posXOr` y
+ | x<0 = complement (complement x `posXOr` y)
+ | y<0 = complement (x `posXOr` complement y)
+ | otherwise = x `posXOr` y
-- assuming infinite 2's-complement arithmetic
complement a = -1 - a
-#endif
-
shift x i | i >= 0 = x * 2^i
- | otherwise = x `div` 2^(-i)
+ | otherwise = x `div` 2^(-i)
+#endif
rotate x i = shift x i -- since an Integer never wraps around
bitSize _ = error "Data.Bits.bitSize(Integer)"
isSigned _ = True
-#ifndef __GLASGOW_HASKELL__
+#if !defined(__GLASGOW_HASKELL__)
-- Crude implementation of bitwise operations on Integers: convert them
-- to finite lists of Ints (least significant first), zip and convert
-- back again.
| n == 0 = []
| otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
- | otherwise = fromInteger n
+ | otherwise = fromInteger n
fromInts :: [Int] -> Integer
fromInts = foldr catInt 0
numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
#endif /* !__GLASGOW_HASKELL__ */
+
+{- Note [Constant folding for rotate]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The INLINE on the Int instance of rotate enables it to be constant
+folded. For example:
+ sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
+goes to:
+ Main.$wfold =
+ \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
+ case ww1_sOb of wild_XM {
+ __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
+ 10000000 -> ww_sO7
+whereas before it was left as a call to $wrotate.
+
+All other Bits instances seem to inline well enough on their
+own to enable constant folding; for example 'shift':
+ sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
+ goes to:
+ Main.$wfold =
+ \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
+ case ww1_sOf of wild_XM {
+ __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
+ 10000000 -> ww_sOb
+ }
+-}
+
+
projects / ghc-base.git / blobdiff