1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
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__
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 the argument left by the specified number of bits.
88 Right shifts (signed) are specified by giving a negative value.
90 An instance can define either this unified 'shift' or 'shiftL' and
91 'shiftR', depending on which is more convenient for the type in
93 shift :: a -> Int -> a
95 x `shift` i | i<0 = x `shiftR` (-i)
99 {-| Rotate the argument left by the specified number of bits.
100 Right rotates are specified by giving a negative value.
102 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
104 An instance can define either this unified 'rotate' or 'rotateL' and
105 'rotateR', depending on which is more convenient for the type in
107 rotate :: a -> Int -> a
109 x `rotate` i | i<0 = x `rotateR` (-i)
111 | i>0 = x `rotateL` i
114 -- Rotation can be implemented in terms of two shifts, but care is
115 -- needed for negative values. This suggested implementation assumes
116 -- 2's-complement arithmetic. It is commented out because it would
117 -- require an extra context (Ord a) on the signature of 'rotate'.
118 x `rotate` i | i<0 && isSigned x && x<0
119 = let left = i+bitSize x in
120 ((x `shift` i) .&. complement ((-1) `shift` left))
122 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
124 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
127 -- | @bit i@ is a value with the @i@th bit set
130 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
131 setBit :: a -> Int -> a
133 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
134 clearBit :: a -> Int -> a
136 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
137 complementBit :: a -> Int -> a
139 -- | Return 'True' if the @n@th bit of the argument is 1
140 testBit :: a -> Int -> Bool
142 {-| Return the number of bits in the type of the argument. The actual
143 value of the argument is ignored. The function 'bitSize' is
144 undefined for types that do not have a fixed bitsize, like 'Integer'.
148 {-| Return 'True' if the argument is a signed type. The actual
149 value of the argument is ignored -}
150 isSigned :: a -> Bool
153 x `setBit` i = x .|. bit i
154 x `clearBit` i = x .&. complement (bit i)
155 x `complementBit` i = x `xor` bit i
156 x `testBit` i = (x .&. bit i) /= 0
158 {-| Shift the argument left by the specified number of bits
159 (which must be non-negative).
161 An instance can define either this and 'shiftR' or the unified
162 'shift', depending on which is more convenient for the type in
164 shiftL :: a -> Int -> a
165 x `shiftL` i = x `shift` i
167 {-| Shift the argument right (signed) by the specified number of bits
168 (which must be non-negative).
170 An instance can define either this and 'shiftL' or the unified
171 'shift', depending on which is more convenient for the type in
173 shiftR :: a -> Int -> a
174 x `shiftR` i = x `shift` (-i)
176 {-| Rotate the argument left by the specified number of bits
177 (which must be non-negative).
179 An instance can define either this and 'rotateR' or the unified
180 'rotate', depending on which is more convenient for the type in
182 rotateL :: a -> Int -> a
183 x `rotateL` i = x `rotate` i
185 {-| Rotate the argument right by the specified number of bits
186 (which must be non-negative).
188 An instance can define either this and 'rotateL' or the unified
189 'rotate', depending on which is more convenient for the type in
191 rotateR :: a -> Int -> a
192 x `rotateR` i = x `rotate` (-i)
194 instance Bits Int where
197 #ifdef __GLASGOW_HASKELL__
198 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
199 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
200 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
201 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
202 (I# x#) `shift` (I# i#)
203 | i# >=# 0# = I# (x# `iShiftL#` i#)
204 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
205 (I# x#) `rotate` (I# i#) =
206 I# (word2Int# ((x'# `shiftL#` i'#) `or#`
207 (x'# `shiftRL#` (wsib -# i'#))))
210 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
211 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
212 bitSize _ = WORD_SIZE_IN_BITS
213 #else /* !__GLASGOW_HASKELL__ */
219 complement = primComplementInt
222 testBit = primTestInt
223 bitSize _ = SIZEOF_HSINT*8
224 #elif defined(__NHC__)
225 (.&.) = nhc_primIntAnd
226 (.|.) = nhc_primIntOr
228 complement = nhc_primIntCompl
229 shiftL = nhc_primIntLsh
230 shiftR = nhc_primIntRsh
235 | i<0 && x<0 = let left = i+bitSize x in
236 ((x `shift` i) .&. complement ((-1) `shift` left))
238 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
240 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
242 #endif /* !__GLASGOW_HASKELL__ */
247 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
248 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
249 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
250 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
251 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
252 foreign import ccall nhc_primIntCompl :: Int -> Int
255 instance Bits Integer where
256 #ifdef __GLASGOW_HASKELL__
257 (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
258 x@(S# _) .&. y = toBig x .&. y
259 x .&. y@(S# _) = x .&. toBig y
260 (J# s1 d1) .&. (J# s2 d2) =
261 case andInteger# s1 d1 s2 d2 of
264 (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
265 x@(S# _) .|. y = toBig x .|. y
266 x .|. y@(S# _) = x .|. toBig y
267 (J# s1 d1) .|. (J# s2 d2) =
268 case orInteger# s1 d1 s2 d2 of
271 (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
272 x@(S# _) `xor` y = toBig x `xor` y
273 x `xor` y@(S# _) = x `xor` toBig y
274 (J# s1 d1) `xor` (J# s2 d2) =
275 case xorInteger# s1 d1 s2 d2 of
278 complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
279 complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
281 -- reduce bitwise binary operations to special cases we can handle
283 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
284 | otherwise = x `posAnd` y
286 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
287 | otherwise = x `posOr` y
289 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
290 | x<0 = complement (complement x `posXOr` y)
291 | y<0 = complement (x `posXOr` complement y)
292 | otherwise = x `posXOr` y
294 -- assuming infinite 2's-complement arithmetic
295 complement a = -1 - a
298 shift x i | i >= 0 = x * 2^i
299 | otherwise = x `div` 2^(-i)
301 rotate x i = shift x i -- since an Integer never wraps around
303 bitSize _ = error "Data.Bits.bitSize(Integer)"
306 #ifndef __GLASGOW_HASKELL__
307 -- Crude implementation of bitwise operations on Integers: convert them
308 -- to finite lists of Ints (least significant first), zip and convert
311 -- posAnd requires at least one argument non-negative
312 -- posOr and posXOr require both arguments non-negative
314 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
315 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
316 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
317 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
319 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
320 longZipWith f xs [] = xs
321 longZipWith f [] ys = ys
322 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
324 toInts :: Integer -> [Int]
327 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
328 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
329 | otherwise = fromInteger n
331 fromInts :: [Int] -> Integer
332 fromInts = foldr catInt 0
333 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
335 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
336 #endif /* !__GLASGOW_HASKELL__ */