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 class Num a => Bits a where
80 {-| Reverse all the bits in the argument -}
83 {-| Shift the argument left by the specified number of bits.
84 Right shifts (signed) are specified by giving a negative value.
86 An instance can define either this unified 'shift' or 'shiftL' and
87 'shiftR', depending on which is more convenient for the type in
89 shift :: a -> Int -> a
91 x `shift` i | i<0 = x `shiftR` (-i)
95 {-| Rotate the argument left by the specified number of bits.
96 Right rotates are specified by giving a negative value.
98 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
100 An instance can define either this unified 'rotate' or 'rotateL' and
101 'rotateR', depending on which is more convenient for the type in
103 rotate :: a -> Int -> a
105 x `rotate` i | i<0 = x `rotateR` (-i)
107 | i>0 = x `rotateL` i
110 -- Rotation can be implemented in terms of two shifts, but care is
111 -- needed for negative values. This suggested implementation assumes
112 -- 2's-complement arithmetic. It is commented out because it would
113 -- require an extra context (Ord a) on the signature of 'rotate'.
114 x `rotate` i | i<0 && isSigned x && x<0
115 = let left = i+bitSize x in
116 ((x `shift` i) .&. complement ((-1) `shift` left))
118 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
120 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
123 -- | @bit i@ is a value with the @i@th bit set
126 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
127 setBit :: a -> Int -> a
129 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
130 clearBit :: a -> Int -> a
132 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
133 complementBit :: a -> Int -> a
135 -- | Return 'True' if the @n@th bit of the argument is 1
136 testBit :: a -> Int -> Bool
138 {-| Return the number of bits in the type of the argument. The actual
139 value of the argument is ignored. The function 'bitSize' is
140 undefined for types that do not have a fixed bitsize, like 'Integer'.
144 {-| Return 'True' if the argument is a signed type. The actual
145 value of the argument is ignored -}
146 isSigned :: a -> Bool
149 x `setBit` i = x .|. bit i
150 x `clearBit` i = x .&. complement (bit i)
151 x `complementBit` i = x `xor` bit i
152 x `testBit` i = (x .&. bit i) /= 0
154 {-| Shift the argument left by the specified number of bits
155 (which must be non-negative).
157 An instance can define either this and 'shiftR' or the unified
158 'shift', depending on which is more convenient for the type in
160 shiftL :: a -> Int -> a
161 x `shiftL` i = x `shift` i
163 {-| Shift the argument right (signed) by the specified number of bits
164 (which must be non-negative).
166 An instance can define either this and 'shiftL' or the unified
167 'shift', depending on which is more convenient for the type in
169 shiftR :: a -> Int -> a
170 x `shiftR` i = x `shift` (-i)
172 {-| Rotate the argument left by the specified number of bits
173 (which must be non-negative).
175 An instance can define either this and 'rotateR' or the unified
176 'rotate', depending on which is more convenient for the type in
178 rotateL :: a -> Int -> a
179 x `rotateL` i = x `rotate` i
181 {-| Rotate the argument right by the specified number of bits
182 (which must be non-negative).
184 An instance can define either this and 'rotateL' or the unified
185 'rotate', depending on which is more convenient for the type in
187 rotateR :: a -> Int -> a
188 x `rotateR` i = x `rotate` (-i)
190 instance Bits Int where
191 #ifdef __GLASGOW_HASKELL__
192 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
193 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
194 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
195 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
196 (I# x#) `shift` (I# i#)
197 | i# >=# 0# = I# (x# `iShiftL#` i#)
198 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
199 (I# x#) `rotate` (I# i#) =
200 I# (word2Int# ((x'# `shiftL#` i'#) `or#`
201 (x'# `shiftRL#` (wsib -# i'#))))
204 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
205 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
206 bitSize _ = WORD_SIZE_IN_BITS
207 #else /* !__GLASGOW_HASKELL__ */
213 complement = primComplementInt
216 testBit = primTestInt
217 bitSize _ = SIZEOF_HSINT*8
218 #elif defined(__NHC__)
219 (.&.) = nhc_primIntAnd
220 (.|.) = nhc_primIntOr
222 complement = nhc_primIntCompl
223 shiftL = nhc_primIntLsh
224 shiftR = nhc_primIntRsh
229 | i<0 && x<0 = let left = i+bitSize x in
230 ((x `shift` i) .&. complement ((-1) `shift` left))
232 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
234 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
236 #endif /* !__GLASGOW_HASKELL__ */
241 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
242 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
243 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
244 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
245 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
246 foreign import ccall nhc_primIntCompl :: Int -> Int
249 instance Bits Integer where
250 #ifdef __GLASGOW_HASKELL__
251 (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
252 x@(S# _) .&. y = toBig x .&. y
253 x .&. y@(S# _) = x .&. toBig y
254 (J# s1 d1) .&. (J# s2 d2) =
255 case andInteger# s1 d1 s2 d2 of
258 (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
259 x@(S# _) .|. y = toBig x .|. y
260 x .|. y@(S# _) = x .|. toBig y
261 (J# s1 d1) .|. (J# s2 d2) =
262 case orInteger# s1 d1 s2 d2 of
265 (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
266 x@(S# _) `xor` y = toBig x `xor` y
267 x `xor` y@(S# _) = x `xor` toBig y
268 (J# s1 d1) `xor` (J# s2 d2) =
269 case xorInteger# s1 d1 s2 d2 of
272 complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
273 complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
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 #ifndef __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__ */