1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
2 -----------------------------------------------------------------------------
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
12 -- This module defines bitwise operations for signed and unsigned
13 -- integers. Instances of the class 'Bits' for the 'Int' and
14 -- 'Integer' types are available from this module, and instances for
15 -- explicitly sized integral types are available from the
16 -- "Data.Int" and "Data.Word" modules.
18 -----------------------------------------------------------------------------
22 (.&.), (.|.), xor, -- :: a -> a -> a
23 complement, -- :: a -> a
24 shift, -- :: a -> Int -> a
25 rotate, -- :: a -> Int -> a
27 setBit, -- :: a -> Int -> a
28 clearBit, -- :: a -> Int -> a
29 complementBit, -- :: a -> Int -> a
30 testBit, -- :: a -> Int -> Bool
31 bitSize, -- :: a -> Int
32 isSigned, -- :: a -> Bool
33 shiftL, shiftR, -- :: a -> Int -> a
34 rotateL, rotateR -- :: a -> Int -> a
38 -- instance Bits Integer
41 -- Defines the @Bits@ class containing bit-based operations.
42 -- See library document for details on the semantics of the
43 -- individual operations.
45 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
49 #ifdef __GLASGOW_HASKELL__
58 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
64 The 'Bits' class defines bitwise operations over integral types.
66 * Bits are numbered from 0 with bit 0 being the least
69 Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
70 ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
71 'bitSize' and 'isSigned'.
73 class Num a => Bits a where
83 {-| Reverse all the bits in the argument -}
86 {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
87 or right by @-i@ bits otherwise.
88 Right shifts perform sign extension on signed number types;
89 i.e. they fill the top bits with 1 if the @x@ is negative
92 An instance can define either this unified 'shift' or 'shiftL' and
93 'shiftR', depending on which is more convenient for the type in
95 shift :: a -> Int -> a
97 x `shift` i | i<0 = x `shiftR` (-i)
101 {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
102 or right by @-i@ bits otherwise.
104 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
106 An instance can define either this unified 'rotate' or 'rotateL' and
107 'rotateR', depending on which is more convenient for the type in
109 rotate :: a -> Int -> a
111 x `rotate` i | i<0 = x `rotateR` (-i)
112 | i>0 = x `rotateL` i
116 -- Rotation can be implemented in terms of two shifts, but care is
117 -- needed for negative values. This suggested implementation assumes
118 -- 2's-complement arithmetic. It is commented out because it would
119 -- require an extra context (Ord a) on the signature of 'rotate'.
120 x `rotate` i | i<0 && isSigned x && x<0
121 = let left = i+bitSize x in
122 ((x `shift` i) .&. complement ((-1) `shift` left))
124 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
126 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
129 -- | @bit i@ is a value with the @i@th bit set and all other bits clear
132 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
133 setBit :: a -> Int -> a
135 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
136 clearBit :: a -> Int -> a
138 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
139 complementBit :: a -> Int -> a
141 -- | Return 'True' if the @n@th bit of the argument is 1
142 testBit :: a -> Int -> Bool
144 {-| Return the number of bits in the type of the argument. The actual
145 value of the argument is ignored. The function 'bitSize' is
146 undefined for types that do not have a fixed bitsize, like 'Integer'.
150 {-| Return 'True' if the argument is a signed type. The actual
151 value of the argument is ignored -}
152 isSigned :: a -> Bool
155 {-# INLINE setBit #-}
156 {-# INLINE clearBit #-}
157 {-# INLINE complementBit #-}
158 {-# INLINE testBit #-}
160 x `setBit` i = x .|. bit i
161 x `clearBit` i = x .&. complement (bit i)
162 x `complementBit` i = x `xor` bit i
163 x `testBit` i = (x .&. bit i) /= 0
165 {-| Shift the argument left by the specified number of bits
166 (which must be non-negative).
168 An instance can define either this and 'shiftR' or the unified
169 'shift', depending on which is more convenient for the type in
171 shiftL :: a -> Int -> a
172 {-# INLINE shiftL #-}
173 x `shiftL` i = x `shift` i
175 {-| Shift the first argument right by the specified number of bits
176 (which must be non-negative).
177 Right shifts perform sign extension on signed number types;
178 i.e. they fill the top bits with 1 if the @x@ is negative
179 and with 0 otherwise.
181 An instance can define either this and 'shiftL' or the unified
182 'shift', depending on which is more convenient for the type in
184 shiftR :: a -> Int -> a
185 {-# INLINE shiftR #-}
186 x `shiftR` i = x `shift` (-i)
188 {-| Rotate the argument left by the specified number of bits
189 (which must be non-negative).
191 An instance can define either this and 'rotateR' or the unified
192 'rotate', depending on which is more convenient for the type in
194 rotateL :: a -> Int -> a
195 {-# INLINE rotateL #-}
196 x `rotateL` i = x `rotate` i
198 {-| Rotate the argument right by the specified number of bits
199 (which must be non-negative).
201 An instance can define either this and 'rotateL' or the unified
202 'rotate', depending on which is more convenient for the type in
204 rotateR :: a -> Int -> a
205 {-# INLINE rotateR #-}
206 x `rotateR` i = x `rotate` (-i)
208 instance Bits Int where
211 #ifdef __GLASGOW_HASKELL__
212 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
214 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
216 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
218 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
220 (I# x#) `shift` (I# i#)
221 | i# >=# 0# = I# (x# `iShiftL#` i#)
222 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
224 {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
225 (I# x#) `rotate` (I# i#) =
226 I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
227 (x'# `uncheckedShiftRL#` (wsib -# i'#))))
230 !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
231 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
232 bitSize _ = WORD_SIZE_IN_BITS
234 #else /* !__GLASGOW_HASKELL__ */
240 complement = primComplementInt
243 testBit = primTestInt
244 bitSize _ = SIZEOF_HSINT*8
245 #elif defined(__NHC__)
246 (.&.) = nhc_primIntAnd
247 (.|.) = nhc_primIntOr
249 complement = nhc_primIntCompl
250 shiftL = nhc_primIntLsh
251 shiftR = nhc_primIntRsh
256 | i<0 && x<0 = let left = i+bitSize x in
257 ((x `shift` i) .&. complement ((-1) `shift` left))
259 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
261 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
263 #endif /* !__GLASGOW_HASKELL__ */
268 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
269 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
270 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
271 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
272 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
273 foreign import ccall nhc_primIntCompl :: Int -> Int
276 instance Bits Integer where
277 #if defined(__GLASGOW_HASKELL__)
281 complement = complementInteger
282 shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
283 | otherwise = shiftRInteger x (negateInt# i#)
285 -- reduce bitwise binary operations to special cases we can handle
287 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
288 | otherwise = x `posAnd` y
290 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
291 | otherwise = x `posOr` y
293 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
294 | x<0 = complement (complement x `posXOr` y)
295 | y<0 = complement (x `posXOr` complement y)
296 | otherwise = x `posXOr` y
298 -- assuming infinite 2's-complement arithmetic
299 complement a = -1 - a
300 shift x i | i >= 0 = x * 2^i
301 | otherwise = x `div` 2^(-i)
304 rotate x i = shift x i -- since an Integer never wraps around
306 bitSize _ = error "Data.Bits.bitSize(Integer)"
309 #if !defined(__GLASGOW_HASKELL__)
310 -- Crude implementation of bitwise operations on Integers: convert them
311 -- to finite lists of Ints (least significant first), zip and convert
314 -- posAnd requires at least one argument non-negative
315 -- posOr and posXOr require both arguments non-negative
317 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
318 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
319 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
320 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
322 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
323 longZipWith f xs [] = xs
324 longZipWith f [] ys = ys
325 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
327 toInts :: Integer -> [Int]
330 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
331 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
332 | otherwise = fromInteger n
334 fromInts :: [Int] -> Integer
335 fromInts = foldr catInt 0
336 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
338 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
339 #endif /* !__GLASGOW_HASKELL__ */
341 {- Note [Constant folding for rotate]
342 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
343 The INLINE on the Int instance of rotate enables it to be constant
345 sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
348 \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
349 case ww1_sOb of wild_XM {
350 __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
352 whereas before it was left as a call to $wrotate.
354 All other Bits instances seem to inline well enough on their
355 own to enable constant folding; for example 'shift':
356 sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
359 \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
360 case ww1_sOf of wild_XM {
361 __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);