1 {-# LANGUAGE BangPatterns #-}
2 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
3 -----------------------------------------------------------------------------
6 -- Copyright : (c) The University of Glasgow 2001
7 -- License : BSD-style (see the file libraries/base/LICENSE)
9 -- Maintainer : libraries@haskell.org
10 -- Stability : experimental
11 -- Portability : portable
13 -- This module defines bitwise operations for signed and unsigned
14 -- integers. Instances of the class 'Bits' for the 'Int' and
15 -- 'Integer' types are available from this module, and instances for
16 -- explicitly sized integral types are available from the
17 -- "Data.Int" and "Data.Word" modules.
19 -----------------------------------------------------------------------------
23 (.&.), (.|.), xor, -- :: a -> a -> a
24 complement, -- :: a -> a
25 shift, -- :: a -> Int -> a
26 rotate, -- :: a -> Int -> a
28 setBit, -- :: a -> Int -> a
29 clearBit, -- :: a -> Int -> a
30 complementBit, -- :: a -> Int -> a
31 testBit, -- :: a -> Int -> Bool
32 bitSize, -- :: a -> Int
33 isSigned, -- :: a -> Bool
34 shiftL, shiftR, -- :: a -> Int -> a
35 rotateL, rotateR -- :: a -> Int -> a
39 -- instance Bits Integer
42 -- Defines the @Bits@ class containing bit-based operations.
43 -- See library document for details on the semantics of the
44 -- individual operations.
46 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
50 #ifdef __GLASGOW_HASKELL__
59 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
65 The 'Bits' class defines bitwise operations over integral types.
67 * Bits are numbered from 0 with bit 0 being the least
70 Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
71 ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
72 'bitSize' and 'isSigned'.
74 class Num a => Bits a where
84 {-| Reverse all the bits in the argument -}
87 {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
88 or right by @-i@ bits otherwise.
89 Right shifts perform sign extension on signed number types;
90 i.e. they fill the top bits with 1 if the @x@ is negative
93 An instance can define either this unified 'shift' or 'shiftL' and
94 'shiftR', depending on which is more convenient for the type in
96 shift :: a -> Int -> a
98 x `shift` i | i<0 = x `shiftR` (-i)
102 {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
103 or right by @-i@ bits otherwise.
105 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
107 An instance can define either this unified 'rotate' or 'rotateL' and
108 'rotateR', depending on which is more convenient for the type in
110 rotate :: a -> Int -> a
112 x `rotate` i | i<0 = x `rotateR` (-i)
113 | i>0 = x `rotateL` i
117 -- Rotation can be implemented in terms of two shifts, but care is
118 -- needed for negative values. This suggested implementation assumes
119 -- 2's-complement arithmetic. It is commented out because it would
120 -- require an extra context (Ord a) on the signature of 'rotate'.
121 x `rotate` i | i<0 && isSigned x && x<0
122 = let left = i+bitSize x in
123 ((x `shift` i) .&. complement ((-1) `shift` left))
125 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
127 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
130 -- | @bit i@ is a value with the @i@th bit set and all other bits clear
133 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
134 setBit :: a -> Int -> a
136 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
137 clearBit :: a -> Int -> a
139 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
140 complementBit :: a -> Int -> a
142 -- | Return 'True' if the @n@th bit of the argument is 1
143 testBit :: a -> Int -> Bool
145 {-| Return the number of bits in the type of the argument. The actual
146 value of the argument is ignored. The function 'bitSize' is
147 undefined for types that do not have a fixed bitsize, like 'Integer'.
151 {-| Return 'True' if the argument is a signed type. The actual
152 value of the argument is ignored -}
153 isSigned :: a -> Bool
156 {-# INLINE setBit #-}
157 {-# INLINE clearBit #-}
158 {-# INLINE complementBit #-}
159 {-# INLINE testBit #-}
161 x `setBit` i = x .|. bit i
162 x `clearBit` i = x .&. complement (bit i)
163 x `complementBit` i = x `xor` bit i
164 x `testBit` i = (x .&. bit i) /= 0
166 {-| Shift the argument left by the specified number of bits
167 (which must be non-negative).
169 An instance can define either this and 'shiftR' or the unified
170 'shift', depending on which is more convenient for the type in
172 shiftL :: a -> Int -> a
173 {-# INLINE shiftL #-}
174 x `shiftL` i = x `shift` i
176 {-| Shift the first argument right by the specified number of bits
177 (which must be non-negative).
178 Right shifts perform sign extension on signed number types;
179 i.e. they fill the top bits with 1 if the @x@ is negative
180 and with 0 otherwise.
182 An instance can define either this and 'shiftL' or the unified
183 'shift', depending on which is more convenient for the type in
185 shiftR :: a -> Int -> a
186 {-# INLINE shiftR #-}
187 x `shiftR` i = x `shift` (-i)
189 {-| Rotate the argument left by the specified number of bits
190 (which must be non-negative).
192 An instance can define either this and 'rotateR' or the unified
193 'rotate', depending on which is more convenient for the type in
195 rotateL :: a -> Int -> a
196 {-# INLINE rotateL #-}
197 x `rotateL` i = x `rotate` i
199 {-| Rotate the argument right by the specified number of bits
200 (which must be non-negative).
202 An instance can define either this and 'rotateL' or the unified
203 'rotate', depending on which is more convenient for the type in
205 rotateR :: a -> Int -> a
206 {-# INLINE rotateR #-}
207 x `rotateR` i = x `rotate` (-i)
209 instance Bits Int where
212 #ifdef __GLASGOW_HASKELL__
213 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
215 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
217 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
219 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
221 (I# x#) `shift` (I# i#)
222 | i# >=# 0# = I# (x# `iShiftL#` i#)
223 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
225 {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
226 (I# x#) `rotate` (I# i#) =
227 I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
228 (x'# `uncheckedShiftRL#` (wsib -# i'#))))
231 !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
232 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
233 bitSize _ = WORD_SIZE_IN_BITS
235 #else /* !__GLASGOW_HASKELL__ */
241 complement = primComplementInt
244 testBit = primTestInt
245 bitSize _ = SIZEOF_HSINT*8
246 #elif defined(__NHC__)
247 (.&.) = nhc_primIntAnd
248 (.|.) = nhc_primIntOr
250 complement = nhc_primIntCompl
251 shiftL = nhc_primIntLsh
252 shiftR = nhc_primIntRsh
257 | i<0 && x<0 = let left = i+bitSize x in
258 ((x `shift` i) .&. complement ((-1) `shift` left))
260 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
262 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
264 #endif /* !__GLASGOW_HASKELL__ */
269 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
270 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
271 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
272 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
273 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
274 foreign import ccall nhc_primIntCompl :: Int -> Int
277 instance Bits Integer where
278 #if defined(__GLASGOW_HASKELL__)
282 complement = complementInteger
283 shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
284 | otherwise = shiftRInteger x (negateInt# i#)
286 -- reduce bitwise binary operations to special cases we can handle
288 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
289 | otherwise = x `posAnd` y
291 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
292 | otherwise = x `posOr` y
294 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
295 | x<0 = complement (complement x `posXOr` y)
296 | y<0 = complement (x `posXOr` complement y)
297 | otherwise = x `posXOr` y
299 -- assuming infinite 2's-complement arithmetic
300 complement a = -1 - a
301 shift x i | i >= 0 = x * 2^i
302 | otherwise = x `div` 2^(-i)
305 rotate x i = shift x i -- since an Integer never wraps around
307 bitSize _ = error "Data.Bits.bitSize(Integer)"
310 #if !defined(__GLASGOW_HASKELL__)
311 -- Crude implementation of bitwise operations on Integers: convert them
312 -- to finite lists of Ints (least significant first), zip and convert
315 -- posAnd requires at least one argument non-negative
316 -- posOr and posXOr require both arguments non-negative
318 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
319 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
320 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
321 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
323 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
324 longZipWith f xs [] = xs
325 longZipWith f [] ys = ys
326 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
328 toInts :: Integer -> [Int]
331 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
332 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
333 | otherwise = fromInteger n
335 fromInts :: [Int] -> Integer
336 fromInts = foldr catInt 0
337 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
339 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
340 #endif /* !__GLASGOW_HASKELL__ */
342 {- Note [Constant folding for rotate]
343 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
344 The INLINE on the Int instance of rotate enables it to be constant
346 sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
349 \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
350 case ww1_sOb of wild_XM {
351 __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
353 whereas before it was left as a call to $wrotate.
355 All other Bits instances seem to inline well enough on their
356 own to enable constant folding; for example 'shift':
357 sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
360 \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
361 case ww1_sOf of wild_XM {
362 __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);