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' 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)
114 | 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
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 x `setBit` i = x .|. bit i
157 x `clearBit` i = x .&. complement (bit i)
158 x `complementBit` i = x `xor` bit i
159 x `testBit` i = (x .&. bit i) /= 0
161 {-| Shift the argument left by the specified number of bits
162 (which must be non-negative).
164 An instance can define either this and 'shiftR' or the unified
165 'shift', depending on which is more convenient for the type in
167 shiftL :: a -> Int -> a
168 x `shiftL` i = x `shift` i
170 {-| Shift the first argument right by the specified number of bits
171 (which must be non-negative).
172 Right shifts perform sign extension on signed number types;
173 i.e. they fill the top bits with 1 if the @x@ is negative
174 and with 0 otherwise.
176 An instance can define either this and 'shiftL' or the unified
177 'shift', depending on which is more convenient for the type in
179 shiftR :: a -> Int -> a
180 x `shiftR` i = x `shift` (-i)
182 {-| Rotate the argument left by the specified number of bits
183 (which must be non-negative).
185 An instance can define either this and 'rotateR' or the unified
186 'rotate', depending on which is more convenient for the type in
188 rotateL :: a -> Int -> a
189 x `rotateL` i = x `rotate` i
191 {-| Rotate the argument right by the specified number of bits
192 (which must be non-negative).
194 An instance can define either this and 'rotateL' or the unified
195 'rotate', depending on which is more convenient for the type in
197 rotateR :: a -> Int -> a
198 x `rotateR` i = x `rotate` (-i)
200 instance Bits Int where
203 #ifdef __GLASGOW_HASKELL__
204 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
206 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
208 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
210 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
212 (I# x#) `shift` (I# i#)
213 | i# >=# 0# = I# (x# `iShiftL#` i#)
214 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
216 -- Important for constant folding (May 2008):
217 {-# INLINE rotate #-}
218 (I# x#) `rotate` (I# i#) =
219 I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
220 (x'# `uncheckedShiftRL#` (wsib -# i'#))))
223 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
224 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
225 bitSize _ = WORD_SIZE_IN_BITS
226 #else /* !__GLASGOW_HASKELL__ */
232 complement = primComplementInt
235 testBit = primTestInt
236 bitSize _ = SIZEOF_HSINT*8
237 #elif defined(__NHC__)
238 (.&.) = nhc_primIntAnd
239 (.|.) = nhc_primIntOr
241 complement = nhc_primIntCompl
242 shiftL = nhc_primIntLsh
243 shiftR = nhc_primIntRsh
248 | i<0 && x<0 = let left = i+bitSize x in
249 ((x `shift` i) .&. complement ((-1) `shift` left))
251 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
253 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
255 #endif /* !__GLASGOW_HASKELL__ */
260 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
261 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
262 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
263 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
264 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
265 foreign import ccall nhc_primIntCompl :: Int -> Int
268 instance Bits Integer where
269 #if defined(__GLASGOW_HASKELL__)
273 complement = complementInteger
275 -- reduce bitwise binary operations to special cases we can handle
277 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
278 | otherwise = x `posAnd` y
280 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
281 | otherwise = x `posOr` y
283 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
284 | x<0 = complement (complement x `posXOr` y)
285 | y<0 = complement (x `posXOr` complement y)
286 | otherwise = x `posXOr` y
288 -- assuming infinite 2's-complement arithmetic
289 complement a = -1 - a
292 shift x i | i >= 0 = x * 2^i
293 | otherwise = x `div` 2^(-i)
295 rotate x i = shift x i -- since an Integer never wraps around
297 bitSize _ = error "Data.Bits.bitSize(Integer)"
300 #if !defined(__GLASGOW_HASKELL__)
301 -- Crude implementation of bitwise operations on Integers: convert them
302 -- to finite lists of Ints (least significant first), zip and convert
305 -- posAnd requires at least one argument non-negative
306 -- posOr and posXOr require both arguments non-negative
308 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
309 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
310 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
311 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
313 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
314 longZipWith f xs [] = xs
315 longZipWith f [] ys = ys
316 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
318 toInts :: Integer -> [Int]
321 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
322 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
323 | otherwise = fromInteger n
325 fromInts :: [Int] -> Integer
326 fromInts = foldr catInt 0
327 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
329 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
330 #endif /* !__GLASGOW_HASKELL__ */