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