expand advice on importing these modules
[packages/old-time.git] / Data / Bits.hs
1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Data.Bits
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
11 --
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.
17 --
18 -----------------------------------------------------------------------------
19
20 module Data.Bits (
21 Bits(
22 (.&.), (.|.), xor, -- :: a -> a -> a
23 complement, -- :: a -> a
24 shift, -- :: a -> Int -> a
25 rotate, -- :: a -> Int -> a
26 bit, -- :: 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
35 )
36
37 -- instance Bits Int
38 -- instance Bits Integer
39 ) where
40
41 -- Defines the @Bits@ class containing bit-based operations.
42 -- See library document for details on the semantics of the
43 -- individual operations.
44
45 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
46 #include "MachDeps.h"
47 #endif
48
49 #ifdef __GLASGOW_HASKELL__
50 import GHC.Num
51 import GHC.Real
52 import GHC.Base
53 #endif
54
55 #ifdef __HUGS__
56 import Hugs.Bits
57 #endif
58
59 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
60 infixl 7 .&.
61 infixl 6 `xor`
62 infixl 5 .|.
63
64 {-|
65 The 'Bits' class defines bitwise operations over integral types.
66
67 * Bits are numbered from 0 with bit 0 being the least
68 significant bit.
69
70 Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
71 ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
72 'bitSize' and 'isSigned'.
73 -}
74 class Num a => Bits a where
75 -- | Bitwise \"and\"
76 (.&.) :: a -> a -> a
77
78 -- | Bitwise \"or\"
79 (.|.) :: a -> a -> a
80
81 -- | Bitwise \"xor\"
82 xor :: a -> a -> a
83
84 {-| Reverse all the bits in the argument -}
85 complement :: a -> a
86
87 {-| Shift the argument left by the specified number of bits.
88 Right shifts (signed) are specified by giving a negative value.
89
90 An instance can define either this unified 'shift' or 'shiftL' and
91 'shiftR', depending on which is more convenient for the type in
92 question. -}
93 shift :: a -> Int -> a
94
95 x `shift` i | i<0 = x `shiftR` (-i)
96 | i==0 = x
97 | i>0 = x `shiftL` i
98
99 {-| Rotate the argument left by the specified number of bits.
100 Right rotates are specified by giving a negative value.
101
102 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
103
104 An instance can define either this unified 'rotate' or 'rotateL' and
105 'rotateR', depending on which is more convenient for the type in
106 question. -}
107 rotate :: a -> Int -> a
108
109 x `rotate` i | i<0 = x `rotateR` (-i)
110 | i==0 = x
111 | i>0 = x `rotateL` i
112
113 {-
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))
121 .|. (x `shift` left)
122 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
123 | i==0 = x
124 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
125 -}
126
127 -- | @bit i@ is a value with the @i@th bit set
128 bit :: Int -> a
129
130 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
131 setBit :: a -> Int -> a
132
133 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
134 clearBit :: a -> Int -> a
135
136 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
137 complementBit :: a -> Int -> a
138
139 -- | Return 'True' if the @n@th bit of the argument is 1
140 testBit :: a -> Int -> Bool
141
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'.
145 -}
146 bitSize :: a -> Int
147
148 {-| Return 'True' if the argument is a signed type. The actual
149 value of the argument is ignored -}
150 isSigned :: a -> Bool
151
152 bit i = 1 `shiftL` i
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
157
158 {-| Shift the argument left by the specified number of bits
159 (which must be non-negative).
160
161 An instance can define either this and 'shiftR' or the unified
162 'shift', depending on which is more convenient for the type in
163 question. -}
164 shiftL :: a -> Int -> a
165 x `shiftL` i = x `shift` i
166
167 {-| Shift the argument right (signed) by the specified number of bits
168 (which must be non-negative).
169
170 An instance can define either this and 'shiftL' or the unified
171 'shift', depending on which is more convenient for the type in
172 question. -}
173 shiftR :: a -> Int -> a
174 x `shiftR` i = x `shift` (-i)
175
176 {-| Rotate the argument left by the specified number of bits
177 (which must be non-negative).
178
179 An instance can define either this and 'rotateR' or the unified
180 'rotate', depending on which is more convenient for the type in
181 question. -}
182 rotateL :: a -> Int -> a
183 x `rotateL` i = x `rotate` i
184
185 {-| Rotate the argument right by the specified number of bits
186 (which must be non-negative).
187
188 An instance can define either this and 'rotateL' or the unified
189 'rotate', depending on which is more convenient for the type in
190 question. -}
191 rotateR :: a -> Int -> a
192 x `rotateR` i = x `rotate` (-i)
193
194 instance Bits Int where
195 #ifdef __GLASGOW_HASKELL__
196 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
197 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
198 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
199 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
200 (I# x#) `shift` (I# i#)
201 | i# >=# 0# = I# (x# `iShiftL#` i#)
202 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
203 (I# x#) `rotate` (I# i#) =
204 I# (word2Int# ((x'# `shiftL#` i'#) `or#`
205 (x'# `shiftRL#` (wsib -# i'#))))
206 where
207 x'# = int2Word# x#
208 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
209 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
210 bitSize _ = WORD_SIZE_IN_BITS
211 #else /* !__GLASGOW_HASKELL__ */
212
213 #ifdef __HUGS__
214 (.&.) = primAndInt
215 (.|.) = primOrInt
216 xor = primXorInt
217 complement = primComplementInt
218 shift = primShiftInt
219 bit = primBitInt
220 testBit = primTestInt
221 bitSize _ = SIZEOF_HSINT*8
222 #elif defined(__NHC__)
223 (.&.) = nhc_primIntAnd
224 (.|.) = nhc_primIntOr
225 xor = nhc_primIntXor
226 complement = nhc_primIntCompl
227 shiftL = nhc_primIntLsh
228 shiftR = nhc_primIntRsh
229 bitSize _ = 32
230 #endif /* __NHC__ */
231
232 x `rotate` i
233 | i<0 && x<0 = let left = i+bitSize x in
234 ((x `shift` i) .&. complement ((-1) `shift` left))
235 .|. (x `shift` left)
236 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
237 | i==0 = x
238 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
239
240 #endif /* !__GLASGOW_HASKELL__ */
241
242 isSigned _ = True
243
244 #ifdef __NHC__
245 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
246 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
247 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
248 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
249 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
250 foreign import ccall nhc_primIntCompl :: Int -> Int
251 #endif /* __NHC__ */
252
253 instance Bits Integer where
254 #ifdef __GLASGOW_HASKELL__
255 (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
256 x@(S# _) .&. y = toBig x .&. y
257 x .&. y@(S# _) = x .&. toBig y
258 (J# s1 d1) .&. (J# s2 d2) =
259 case andInteger# s1 d1 s2 d2 of
260 (# s, d #) -> J# s d
261
262 (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
263 x@(S# _) .|. y = toBig x .|. y
264 x .|. y@(S# _) = x .|. toBig y
265 (J# s1 d1) .|. (J# s2 d2) =
266 case orInteger# s1 d1 s2 d2 of
267 (# s, d #) -> J# s d
268
269 (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
270 x@(S# _) `xor` y = toBig x `xor` y
271 x `xor` y@(S# _) = x `xor` toBig y
272 (J# s1 d1) `xor` (J# s2 d2) =
273 case xorInteger# s1 d1 s2 d2 of
274 (# s, d #) -> J# s d
275
276 complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
277 complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
278 #else
279 -- reduce bitwise binary operations to special cases we can handle
280
281 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
282 | otherwise = x `posAnd` y
283
284 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
285 | otherwise = x `posOr` y
286
287 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
288 | x<0 = complement (complement x `posXOr` y)
289 | y<0 = complement (x `posXOr` complement y)
290 | otherwise = x `posXOr` y
291
292 -- assuming infinite 2's-complement arithmetic
293 complement a = -1 - a
294 #endif
295
296 shift x i | i >= 0 = x * 2^i
297 | otherwise = x `div` 2^(-i)
298
299 rotate x i = shift x i -- since an Integer never wraps around
300
301 bitSize _ = error "Data.Bits.bitSize(Integer)"
302 isSigned _ = True
303
304 #ifndef __GLASGOW_HASKELL__
305 -- Crude implementation of bitwise operations on Integers: convert them
306 -- to finite lists of Ints (least significant first), zip and convert
307 -- back again.
308
309 -- posAnd requires at least one argument non-negative
310 -- posOr and posXOr require both arguments non-negative
311
312 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
313 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
314 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
315 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
316
317 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
318 longZipWith f xs [] = xs
319 longZipWith f [] ys = ys
320 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
321
322 toInts :: Integer -> [Int]
323 toInts n
324 | n == 0 = []
325 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
326 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
327 | otherwise = fromInteger n
328
329 fromInts :: [Int] -> Integer
330 fromInts = foldr catInt 0
331 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
332
333 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
334 #endif /* !__GLASGOW_HASKELL__ */