fix shift docs to match ffi spec
[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' 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
91 and with 0 otherwise.
92
93 An instance can define either this unified 'shift' or 'shiftL' and
94 'shiftR', depending on which is more convenient for the type in
95 question. -}
96 shift :: a -> Int -> a
97
98 x `shift` i | i<0 = x `shiftR` (-i)
99 | i==0 = x
100 | i>0 = x `shiftL` i
101
102 {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
103 or right by @-i@ bits otherwise.
104
105 For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
106
107 An instance can define either this unified 'rotate' or 'rotateL' and
108 'rotateR', depending on which is more convenient for the type in
109 question. -}
110 rotate :: a -> Int -> a
111
112 x `rotate` i | i<0 = x `rotateR` (-i)
113 | i==0 = x
114 | i>0 = x `rotateL` i
115
116 {-
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))
124 .|. (x `shift` left)
125 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
126 | i==0 = x
127 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
128 -}
129
130 -- | @bit i@ is a value with the @i@th bit set
131 bit :: Int -> a
132
133 -- | @x \`setBit\` i@ is the same as @x .|. bit i@
134 setBit :: a -> Int -> a
135
136 -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
137 clearBit :: a -> Int -> a
138
139 -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
140 complementBit :: a -> Int -> a
141
142 -- | Return 'True' if the @n@th bit of the argument is 1
143 testBit :: a -> Int -> Bool
144
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'.
148 -}
149 bitSize :: a -> Int
150
151 {-| Return 'True' if the argument is a signed type. The actual
152 value of the argument is ignored -}
153 isSigned :: a -> Bool
154
155 bit i = 1 `shiftL` i
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
160
161 {-| Shift the argument left by the specified number of bits
162 (which must be non-negative).
163
164 An instance can define either this and 'shiftR' or the unified
165 'shift', depending on which is more convenient for the type in
166 question. -}
167 shiftL :: a -> Int -> a
168 x `shiftL` i = x `shift` i
169
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.
175
176 An instance can define either this and 'shiftL' or the unified
177 'shift', depending on which is more convenient for the type in
178 question. -}
179 shiftR :: a -> Int -> a
180 x `shiftR` i = x `shift` (-i)
181
182 {-| Rotate the argument left by the specified number of bits
183 (which must be non-negative).
184
185 An instance can define either this and 'rotateR' or the unified
186 'rotate', depending on which is more convenient for the type in
187 question. -}
188 rotateL :: a -> Int -> a
189 x `rotateL` i = x `rotate` i
190
191 {-| Rotate the argument right by the specified number of bits
192 (which must be non-negative).
193
194 An instance can define either this and 'rotateL' or the unified
195 'rotate', depending on which is more convenient for the type in
196 question. -}
197 rotateR :: a -> Int -> a
198 x `rotateR` i = x `rotate` (-i)
199
200 instance Bits Int where
201 {-# INLINE shift #-}
202
203 #ifdef __GLASGOW_HASKELL__
204 (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
205 (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
206 (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
207 complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
208 (I# x#) `shift` (I# i#)
209 | i# >=# 0# = I# (x# `iShiftL#` i#)
210 | otherwise = I# (x# `iShiftRA#` negateInt# i#)
211 (I# x#) `rotate` (I# i#) =
212 I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
213 (x'# `uncheckedShiftRL#` (wsib -# i'#))))
214 where
215 x'# = int2Word# x#
216 i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
217 wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
218 bitSize _ = WORD_SIZE_IN_BITS
219 #else /* !__GLASGOW_HASKELL__ */
220
221 #ifdef __HUGS__
222 (.&.) = primAndInt
223 (.|.) = primOrInt
224 xor = primXorInt
225 complement = primComplementInt
226 shift = primShiftInt
227 bit = primBitInt
228 testBit = primTestInt
229 bitSize _ = SIZEOF_HSINT*8
230 #elif defined(__NHC__)
231 (.&.) = nhc_primIntAnd
232 (.|.) = nhc_primIntOr
233 xor = nhc_primIntXor
234 complement = nhc_primIntCompl
235 shiftL = nhc_primIntLsh
236 shiftR = nhc_primIntRsh
237 bitSize _ = 32
238 #endif /* __NHC__ */
239
240 x `rotate` i
241 | i<0 && x<0 = let left = i+bitSize x in
242 ((x `shift` i) .&. complement ((-1) `shift` left))
243 .|. (x `shift` left)
244 | i<0 = (x `shift` i) .|. (x `shift` (i+bitSize x))
245 | i==0 = x
246 | i>0 = (x `shift` i) .|. (x `shift` (i-bitSize x))
247
248 #endif /* !__GLASGOW_HASKELL__ */
249
250 isSigned _ = True
251
252 #ifdef __NHC__
253 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
254 foreign import ccall nhc_primIntOr :: Int -> Int -> Int
255 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
256 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
257 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
258 foreign import ccall nhc_primIntCompl :: Int -> Int
259 #endif /* __NHC__ */
260
261 instance Bits Integer where
262 #ifdef __GLASGOW_HASKELL__
263 (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
264 x@(S# _) .&. y = toBig x .&. y
265 x .&. y@(S# _) = x .&. toBig y
266 (J# s1 d1) .&. (J# s2 d2) =
267 case andInteger# s1 d1 s2 d2 of
268 (# s, d #) -> J# s d
269
270 (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
271 x@(S# _) .|. y = toBig x .|. y
272 x .|. y@(S# _) = x .|. toBig y
273 (J# s1 d1) .|. (J# s2 d2) =
274 case orInteger# s1 d1 s2 d2 of
275 (# s, d #) -> J# s d
276
277 (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
278 x@(S# _) `xor` y = toBig x `xor` y
279 x `xor` y@(S# _) = x `xor` toBig y
280 (J# s1 d1) `xor` (J# s2 d2) =
281 case xorInteger# s1 d1 s2 d2 of
282 (# s, d #) -> J# s d
283
284 complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
285 complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
286 #else
287 -- reduce bitwise binary operations to special cases we can handle
288
289 x .&. y | x<0 && y<0 = complement (complement x `posOr` complement y)
290 | otherwise = x `posAnd` y
291
292 x .|. y | x<0 || y<0 = complement (complement x `posAnd` complement y)
293 | otherwise = x `posOr` y
294
295 x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
296 | x<0 = complement (complement x `posXOr` y)
297 | y<0 = complement (x `posXOr` complement y)
298 | otherwise = x `posXOr` y
299
300 -- assuming infinite 2's-complement arithmetic
301 complement a = -1 - a
302 #endif
303
304 shift x i | i >= 0 = x * 2^i
305 | otherwise = x `div` 2^(-i)
306
307 rotate x i = shift x i -- since an Integer never wraps around
308
309 bitSize _ = error "Data.Bits.bitSize(Integer)"
310 isSigned _ = True
311
312 #ifndef __GLASGOW_HASKELL__
313 -- Crude implementation of bitwise operations on Integers: convert them
314 -- to finite lists of Ints (least significant first), zip and convert
315 -- back again.
316
317 -- posAnd requires at least one argument non-negative
318 -- posOr and posXOr require both arguments non-negative
319
320 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
321 posAnd x y = fromInts $ zipWith (.&.) (toInts x) (toInts y)
322 posOr x y = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
323 posXOr x y = fromInts $ longZipWith xor (toInts x) (toInts y)
324
325 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
326 longZipWith f xs [] = xs
327 longZipWith f [] ys = ys
328 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
329
330 toInts :: Integer -> [Int]
331 toInts n
332 | n == 0 = []
333 | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
334 where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
335 | otherwise = fromInteger n
336
337 fromInts :: [Int] -> Integer
338 fromInts = foldr catInt 0
339 where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
340
341 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
342 #endif /* !__GLASGOW_HASKELL__ */