2385ab9ae5eb97b9371b9e379fd0a794fef9f1e8
[packages/base.git] / Data / Bits.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Data.Bits
7 -- Copyright : (c) The University of Glasgow 2001
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : experimental
12 -- Portability : portable
13 --
14 -- This module defines bitwise operations for signed and unsigned
15 -- integers. Instances of the class 'Bits' for the 'Int' and
16 -- 'Integer' types are available from this module, and instances for
17 -- explicitly sized integral types are available from the
18 -- "Data.Int" and "Data.Word" modules.
19 --
20 -----------------------------------------------------------------------------
21
22 module Data.Bits (
23 Bits(
24 (.&.), (.|.), xor,
25 complement,
26 shift,
27 rotate,
28 bit,
29 setBit,
30 clearBit,
31 complementBit,
32 testBit,
33 bitSizeMaybe,
34 bitSize,
35 isSigned,
36 shiftL, shiftR,
37 unsafeShiftL, unsafeShiftR,
38 rotateL, rotateR,
39 popCount
40 ),
41 FiniteBits(finiteBitSize),
42
43 bitDefault,
44 testBitDefault,
45 popCountDefault
46 ) where
47
48 -- Defines the @Bits@ class containing bit-based operations.
49 -- See library document for details on the semantics of the
50 -- individual operations.
51
52 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
53 #include "MachDeps.h"
54 #endif
55
56 #ifdef __GLASGOW_HASKELL__
57 import Data.Maybe
58 import GHC.Enum
59 import GHC.Num
60 import GHC.Base
61 #endif
62
63 #ifdef __HUGS__
64 import Hugs.Bits
65 #endif
66
67 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
68 infixl 7 .&.
69 infixl 6 `xor`
70 infixl 5 .|.
71
72 {-# DEPRECATED bitSize "Use bitSizeMaybe or finiteBitSize instead" #-} -- deprecated in 7.8
73
74 {-|
75 The 'Bits' class defines bitwise operations over integral types.
76
77 * Bits are numbered from 0 with bit 0 being the least
78 significant bit.
79
80 Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
81 ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
82 'bitSize', 'isSigned', 'testBit', 'bit', and 'popCount'. The latter three can
83 be implemented using `testBitDefault', 'bitDefault, and 'popCountDefault', if
84 @a@ is also an instance of 'Num'.
85 -}
86 class Eq a => Bits a where
87 -- | Bitwise \"and\"
88 (.&.) :: a -> a -> a
89
90 -- | Bitwise \"or\"
91 (.|.) :: a -> a -> a
92
93 -- | Bitwise \"xor\"
94 xor :: a -> a -> a
95
96 {-| Reverse all the bits in the argument -}
97 complement :: a -> a
98
99 {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
100 or right by @-i@ bits otherwise.
101 Right shifts perform sign extension on signed number types;
102 i.e. they fill the top bits with 1 if the @x@ is negative
103 and with 0 otherwise.
104
105 An instance can define either this unified 'shift' or 'shiftL' and
106 'shiftR', depending on which is more convenient for the type in
107 question. -}
108 shift :: a -> Int -> a
109
110 x `shift` i | i<0 = x `shiftR` (-i)
111 | i>0 = x `shiftL` i
112 | otherwise = x
113
114 {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
115 or right by @-i@ bits otherwise.
116
117 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
118
119 An instance can define either this unified 'rotate' or 'rotateL' and
120 'rotateR', depending on which is more convenient for the type in
121 question. -}
122 rotate :: a -> Int -> a
123
124 x `rotate` i | i<0 = x `rotateR` (-i)
125 | i>0 = x `rotateL` i
126 | otherwise = x
127
128 {-
129 -- Rotation can be implemented in terms of two shifts, but care is
130 -- needed for negative values. This suggested implementation assumes
131 -- 2's-complement arithmetic. It is commented out because it would
132 -- require an extra context (Ord a) on the signature of 'rotate'.
133 x `rotate` i | i<0 && isSigned x && x<0
134 = let left = i+bitSize x in
135 ((x `shift` i) .&. complement ((-1) `shift` left))
136 .|. (x `shift` left)
137 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
138 | i==0 = x
139 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
140 -}
141
142 -- | @bit i@ is a value with the @i@th bit set and all other bits clear
143 bit :: Int -> a
144
145 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
146 setBit :: a -> Int -> a
147
148 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
149 clearBit :: a -> Int -> a
150
151 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
152 complementBit :: a -> Int -> a
153
154 -- | Return 'True' if the @n@th bit of the argument is 1
155 testBit :: a -> Int -> Bool
156
157 {-| Return the number of bits in the type of the argument. The actual
158 value of the argument is ignored. Returns Nothing
159 for types that do not have a fixed bitsize, like 'Integer'.
160 -}
161 bitSizeMaybe :: a -> Maybe Int
162
163 {-| Return the number of bits in the type of the argument. The actual
164 value of the argument is ignored. The function 'bitSize' is
165 undefined for types that do not have a fixed bitsize, like 'Integer'.
166 -}
167 bitSize :: a -> Int
168
169 {-| Return 'True' if the argument is a signed type. The actual
170 value of the argument is ignored -}
171 isSigned :: a -> Bool
172
173 {-# INLINE setBit #-}
174 {-# INLINE clearBit #-}
175 {-# INLINE complementBit #-}
176 x `setBit` i = x .|. bit i
177 x `clearBit` i = x .&. complement (bit i)
178 x `complementBit` i = x `xor` bit i
179
180 {-| Shift the argument left by the specified number of bits
181 (which must be non-negative).
182
183 An instance can define either this and 'shiftR' or the unified
184 'shift', depending on which is more convenient for the type in
185 question. -}
186 shiftL :: a -> Int -> a
187 {-# INLINE shiftL #-}
188 x `shiftL` i = x `shift` i
189
190 {-| Shift the argument left by the specified number of bits. The
191 result is undefined for negative shift amounts and shift amounts
192 greater or equal to the 'bitSize'.
193
194 Defaults to 'shiftL' unless defined explicitly by an instance. -}
195 unsafeShiftL :: a -> Int -> a
196 {-# INLINE unsafeShiftL #-}
197 x `unsafeShiftL` i = x `shiftL` i
198
199 {-| Shift the first argument right by the specified number of bits. The
200 result is undefined for negative shift amounts and shift amounts
201 greater or equal to the 'bitSize'.
202
203 Right shifts perform sign extension on signed number types;
204 i.e. they fill the top bits with 1 if the @x@ is negative
205 and with 0 otherwise.
206
207 An instance can define either this and 'shiftL' or the unified
208 'shift', depending on which is more convenient for the type in
209 question. -}
210 shiftR :: a -> Int -> a
211 {-# INLINE shiftR #-}
212 x `shiftR` i = x `shift` (-i)
213
214 {-| Shift the first argument right by the specified number of bits, which
215 must be non-negative an smaller than the number of bits in the type.
216
217 Right shifts perform sign extension on signed number types;
218 i.e. they fill the top bits with 1 if the @x@ is negative
219 and with 0 otherwise.
220
221 Defaults to 'shiftR' unless defined explicitly by an instance. -}
222 unsafeShiftR :: a -> Int -> a
223 {-# INLINE unsafeShiftR #-}
224 x `unsafeShiftR` i = x `shiftR` i
225
226 {-| Rotate the argument left by the specified number of bits
227 (which must be non-negative).
228
229 An instance can define either this and 'rotateR' or the unified
230 'rotate', depending on which is more convenient for the type in
231 question. -}
232 rotateL :: a -> Int -> a
233 {-# INLINE rotateL #-}
234 x `rotateL` i = x `rotate` i
235
236 {-| Rotate the argument right by the specified number of bits
237 (which must be non-negative).
238
239 An instance can define either this and 'rotateL' or the unified
240 'rotate', depending on which is more convenient for the type in
241 question. -}
242 rotateR :: a -> Int -> a
243 {-# INLINE rotateR #-}
244 x `rotateR` i = x `rotate` (-i)
245
246 {-| Return the number of set bits in the argument. This number is
247 known as the population count or the Hamming weight. -}
248 popCount :: a -> Int
249
250 class Bits b => FiniteBits b where
251 finiteBitSize :: b -> Int
252
253 -- The defaults below are written with lambdas so that e.g.
254 -- bit = bitDefault
255 -- is fully applied, so inlining will happen
256
257 -- | Default implementation for 'bit'.
258 --
259 -- Note that: @bitDefault i = 1 `shiftL` i@
260 bitDefault :: (Bits a, Num a) => Int -> a
261 bitDefault = \i -> 1 `shiftL` i
262 {-# INLINE bitDefault #-}
263
264 -- | Default implementation for 'testBit'.
265 --
266 -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
267 testBitDefault :: (Bits a, Num a) => a -> Int -> Bool
268 testBitDefault = \x i -> (x .&. bit i) /= 0
269 {-# INLINE testBitDefault #-}
270
271 -- | Default implementation for 'popCount'.
272 --
273 -- This implementation is intentionally naive. Instances are expected to provide
274 -- an optimized implementation for their size.
275 popCountDefault :: (Bits a, Num a) => a -> Int
276 popCountDefault = go 0
277 where
278 go !c 0 = c
279 go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
280 {-# INLINABLE popCountDefault #-}
281
282 instance Bits Int where
283 {-# INLINE shift #-}
284 {-# INLINE bit #-}
285 {-# INLINE testBit #-}
286
287 #ifdef __GLASGOW_HASKELL__
288 bit = bitDefault
289
290 testBit = testBitDefault
291
292 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
293
294 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
295
296 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
297
298 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
299
300 (I# x#) `shift` (I# i#)
301 | i# >=# 0# = I# (x# `iShiftL#` i#)
302 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
303 (I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#)
304 (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
305 (I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#)
306 (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
307
308 {-# INLINE rotate #-} -- See Note [Constant folding for rotate]
309 (I# x#) `rotate` (I# i#) =
310 I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
311 (x'# `uncheckedShiftRL#` (wsib -# i'#))))
312 where
313 !x'# = int2Word# x#
314 !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
315 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
316 bitSizeMaybe i = Just (finiteBitSize i)
317 bitSize i = finiteBitSize i
318
319 popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
320
321 #else /* !__GLASGOW_HASKELL__ */
322
323 popCount = popCountDefault
324
325 #ifdef __HUGS__
326 (.&.) = primAndInt
327 (.|.) = primOrInt
328 xor = primXorInt
329 complement = primComplementInt
330 shift = primShiftInt
331 bit = primBitInt
332 testBit = primTestInt
333 bitSize _ = SIZEOF_HSINT*8
334 #endif
335
336 x `rotate` i
337 | i<0 && x<0 = let left = i+bitSize x in
338 ((x `shift` i) .&. complement ((-1) `shift` left))
339 .|. (x `shift` left)
340 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
341 | i==0 = x
342 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
343
344 #endif /* !__GLASGOW_HASKELL__ */
345
346 isSigned _ = True
347
348 instance FiniteBits Int where
349 finiteBitSize _ = WORD_SIZE_IN_BITS
350
351 #if defined(__GLASGOW_HASKELL__)
352 instance Bits Word where
353 {-# INLINE shift #-}
354 {-# INLINE bit #-}
355 {-# INLINE testBit #-}
356
357 (W# x#) .&. (W# y#) = W# (x# `and#` y#)
358 (W# x#) .|. (W# y#) = W# (x# `or#` y#)
359 (W# x#) `xor` (W# y#) = W# (x# `xor#` y#)
360 complement (W# x#) = W# (x# `xor#` mb#)
361 where !(W# mb#) = maxBound
362 (W# x#) `shift` (I# i#)
363 | i# >=# 0# = W# (x# `shiftL#` i#)
364 | otherwise = W# (x# `shiftRL#` negateInt# i#)
365 (W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#)
366 (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
367 (W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#)
368 (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
369 (W# x#) `rotate` (I# i#)
370 | i'# ==# 0# = W# x#
371 | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
372 where
373 !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
374 !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
375 bitSizeMaybe i = Just (finiteBitSize i)
376 bitSize i = finiteBitSize i
377 isSigned _ = False
378 popCount (W# x#) = I# (word2Int# (popCnt# x#))
379 bit = bitDefault
380 testBit = testBitDefault
381
382 instance FiniteBits Word where
383 finiteBitSize _ = WORD_SIZE_IN_BITS
384 #endif
385
386 instance Bits Integer where
387 #if defined(__GLASGOW_HASKELL__)
388 (.&.) = andInteger
389 (.|.) = orInteger
390 xor = xorInteger
391 complement = complementInteger
392 shift x i@(I# i#) | i >= 0 = shiftLInteger x i#
393 | otherwise = shiftRInteger x (negateInt# i#)
394 testBit x (I# i) = testBitInteger x i
395 #else
396 -- reduce bitwise binary operations to special cases we can handle
397
398 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
399 | otherwise = x `posAnd` y
400
401 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
402 | otherwise = x `posOr` y
403
404 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
405 | x<0 = complement (complement x `posXOr` y)
406 | y<0 = complement (x `posXOr` complement y)
407 | otherwise = x `posXOr` y
408
409 -- assuming infinite 2's-complement arithmetic
410 complement a = -1 - a
411 shift x i | i >= 0 = x * 2^i
412 | otherwise = x `div` 2^(-i)
413 testBit = testBitDefault
414 #endif
415
416 bit = bitDefault
417 popCount = popCountDefault
418
419 rotate x i = shift x i -- since an Integer never wraps around
420
421 bitSizeMaybe _ = Nothing
422 bitSize _ = error "Data.Bits.bitSize(Integer)"
423 isSigned _ = True
424
425 #if !defined(__GLASGOW_HASKELL__)
426 -- Crude implementation of bitwise operations on Integers: convert them
427 -- to finite lists of Ints (least significant first), zip and convert
428 -- back again.
429
430 -- posAnd requires at least one argument non-negative
431 -- posOr and posXOr require both arguments non-negative
432
433 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
434 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
435 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
436 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
437
438 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
439 longZipWith f xs [] = xs
440 longZipWith f [] ys = ys
441 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
442
443 toInts :: Integer -> [Int]
444 toInts n
445 | n == 0 = []
446 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
447 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
448 | otherwise = fromInteger n
449
450 fromInts :: [Int] -> Integer
451 fromInts = foldr catInt 0
452 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
453
454 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
455 #endif /* !__GLASGOW_HASKELL__ */
456
457 {- Note [Constant folding for rotate]
458 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
459 The INLINE on the Int instance of rotate enables it to be constant
460 folded. For example:
461 sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
462 goes to:
463 Main.$wfold =
464 \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
465 case ww1_sOb of wild_XM {
466 __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
467 10000000 -> ww_sO7
468 whereas before it was left as a call to $wrotate.
469
470 All other Bits instances seem to inline well enough on their
471 own to enable constant folding; for example 'shift':
472 sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
473 goes to:
474 Main.$wfold =
475 \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
476 case ww1_sOf of wild_XM {
477 __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
478 10000000 -> ww_sOb
479 }
480 -}
481