1 -----------------------------------------------------------------------------
3 -- Suitable for use with Hugs 1.4 on 32 bit systems.
4 -----------------------------------------------------------------------------
10 , word8ToWord32 -- :: Word8 -> Word32
11 , word32ToWord8 -- :: Word32 -> Word8
12 , word16ToWord32 -- :: Word16 -> Word32
13 , word32ToWord16 -- :: Word32 -> Word16
14 , word8ToInt -- :: Word8 -> Int
15 , intToWord8 -- :: Int -> Word8
16 , word16ToInt -- :: Word16 -> Int
17 , intToWord16 -- :: Int -> Word16
18 , word32ToInt -- :: Word32 -> Int
19 , intToWord32 -- :: Int -> Word32
25 -----------------------------------------------------------------------------
26 -- The "official" coercion functions
27 -----------------------------------------------------------------------------
29 word8ToWord32 :: Word8 -> Word32
30 word32ToWord8 :: Word32 -> Word8
31 word16ToWord32 :: Word16 -> Word32
32 word32ToWord16 :: Word32 -> Word16
34 word8ToInt :: Word8 -> Int
35 intToWord8 :: Int -> Word8
36 word16ToInt :: Word16 -> Int
37 intToWord16 :: Int -> Word16
38 word32ToInt :: Word32 -> Int
39 intToWord32 :: Int -> Word32
41 word8ToInt = word32ToInt . word8ToWord32
42 intToWord8 = word32ToWord8 . intToWord32
43 word16ToInt = word32ToInt . word16ToWord32
44 intToWord16 = word32ToWord16 . intToWord32
46 word32ToInt (W32 x) = primWordToInt x
47 intToWord32 x = W32 (primIntToWord x)
50 -----------------------------------------------------------------------------
52 -----------------------------------------------------------------------------
54 newtype Word8 = W8 Word32
56 word8ToWord32 (W8 x) = x .&. 0xff
59 instance Eq Word8 where (==) = binop (==)
60 instance Ord Word8 where compare = binop compare
62 instance Num Word8 where
63 x + y = to (binop (+) x y)
64 x - y = to (binop (-) x y)
65 negate = to . negate . from
66 x * y = to (binop (*) x y)
69 fromInteger = to . fromInteger
72 instance Bounded Word8 where
76 instance Real Word8 where
77 toRational x = toInteger x % 1
79 instance Integral Word8 where
80 x `div` y = to (binop div x y)
81 x `quot` y = to (binop quot x y)
82 x `rem` y = to (binop rem x y)
83 x `mod` y = to (binop mod x y)
84 x `quotRem` y = to2 (binop quotRem x y)
86 toInteger = toInteger . from
89 instance Ix Word8 where
92 | inRange b i = word32ToInt (from (i - m))
93 | otherwise = error "index: Index out of range"
94 inRange (m,n) i = m <= i && i <= n
96 instance Enum Word8 where
97 toEnum = to . intToWord32
98 fromEnum = word32ToInt . from
99 enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word8)]
100 enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word8)]
101 where last = if d < c then minBound else maxBound
103 instance Read Word8 where
104 readsPrec p = readDec
106 instance Show Word8 where
107 showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
109 instance Bits Word8 where
110 x .&. y = to (binop (.&.) x y)
111 x .|. y = to (binop (.|.) x y)
112 x `xor` y = to (binop xor x y)
113 complement = to . complement . from
114 x `shift` i = to (from x `shift` i)
117 setBit x i = to (setBit (from x) i)
118 clearBit x i = to (clearBit (from x) i)
119 complementBit x i = to (complementBit (from x) i)
120 testBit x i = testBit (from x) i
124 -----------------------------------------------------------------------------
126 -----------------------------------------------------------------------------
128 newtype Word16 = W16 Word32
130 word16ToWord32 (W16 x) = x .&. 0xffff
133 instance Eq Word16 where (==) = binop (==)
134 instance Ord Word16 where compare = binop compare
136 instance Num Word16 where
137 x + y = to (binop (+) x y)
138 x - y = to (binop (-) x y)
139 negate = to . negate . from
140 x * y = to (binop (*) x y)
143 fromInteger = to . fromInteger
144 fromInt = intToWord16
146 instance Bounded Word16 where
150 instance Real Word16 where
151 toRational x = toInteger x % 1
153 instance Integral Word16 where
154 x `div` y = to (binop div x y)
155 x `quot` y = to (binop quot x y)
156 x `rem` y = to (binop rem x y)
157 x `mod` y = to (binop mod x y)
158 x `quotRem` y = to2 (binop quotRem x y)
160 toInteger = toInteger . from
163 instance Ix Word16 where
166 | inRange b i = word32ToInt (from (i - m))
167 | otherwise = error "index: Index out of range"
168 inRange (m,n) i = m <= i && i <= n
170 instance Enum Word16 where
171 toEnum = to . intToWord32
172 fromEnum = word32ToInt . from
173 enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Word16)]
174 enumFromThen c d = map toEnum [fromEnum c, fromEnum d .. fromEnum (last::Word16)]
175 where last = if d < c then minBound else maxBound
177 instance Read Word16 where
178 readsPrec p = readDec
180 instance Show Word16 where
181 showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
183 instance Bits Word16 where
184 x .&. y = to (binop (.&.) x y)
185 x .|. y = to (binop (.|.) x y)
186 x `xor` y = to (binop xor x y)
187 complement = to . complement . from
188 x `shift` i = to (from x `shift` i)
191 setBit x i = to (setBit (from x) i)
192 clearBit x i = to (clearBit (from x) i)
193 complementBit x i = to (complementBit (from x) i)
194 testBit x i = testBit (from x) i
198 -----------------------------------------------------------------------------
200 -----------------------------------------------------------------------------
202 newtype Word32 = W32 Word
204 w32 :: Word32 -> Word
207 lift0 :: Word -> Word32
208 lift1 :: (Word -> Word) -> (Word32 -> Word32)
209 lift2 :: (Word -> Word -> Word) -> (Word32 -> Word32 -> Word32)
210 lift2' :: (Word -> Word -> (Word,Word)) -> (Word32 -> Word32 -> (Word32,Word32))
213 lift1 f (W32 x) = W32 (f x)
214 lift2 f (W32 x) (W32 y) = W32 (f x y)
216 lift2' f (W32 x) (W32 y) = case f x y of (a,b) -> (W32 a, W32 b)
218 instance Eq Word32 where
219 x == y = primEqWord (w32 x) (w32 y)
220 x /= y = primNeWord (w32 x) (w32 y)
222 instance Ord Word32 where
223 x < y = primLtWord (w32 x) (w32 y)
224 x <= y = primLeWord (w32 x) (w32 y)
225 x >= y = primGeWord (w32 x) (w32 y)
226 x > y = primGtWord (w32 x) (w32 y)
228 instance Num Word32 where
229 (+) = lift2 primPlusWord
230 (-) = lift2 primMinusWord
231 negate = lift1 primNegateWord
232 (*) = lift2 primTimesWord
234 signum x = if x == 0 then 0 else 1
235 fromInteger = W32 . primIntegerToWord
236 fromInt = W32 . primIntToWord
238 instance Bounded Word32 where
240 maxBound = W32 primMaxWord
242 instance Real Word32 where
243 toRational x = toInteger x % 1
245 instance Integral Word32 where
246 quotRem = lift2' primQuotRemWord
247 quot = lift2 primQuotWord
248 rem = lift2 primRemWord
249 divMod = lift2' primQuotRemWord -- no difference for unsigned values!
250 div = lift2 primQuotWord
251 mod = lift2 primRemWord
252 toInteger = primWordToInteger . w32
253 toInt = primWordToInt . w32
255 instance Ix Word32 where
258 | inRange b i = word32ToInt (i - m)
259 | otherwise = error "index: Index out of range"
260 inRange (m,n) i = m <= i && i <= n
262 instance Enum Word32 where
266 enumFrom w = [w .. maxBound]
268 | w1 <= w2 = eft32 w1 w2
270 enumFromThen w1 w2 = [w1, w2 .. last]
273 | w1 < w2 = maxBound::Word32
274 | otherwise = minBound
275 enumFromThenTo w1 w2 last = eftt32 w1 (w2 - w1) (>last)
277 --------------------------------
278 -- Begin stolen from GHC (but then modified!)
279 --------------------------------
281 -- Termination is easy because the step is 1
282 eft32 :: Word32 -> Word32 -> [Word32]
283 eft32 now last = go now
287 | otherwise = x : (go `strict` (x+1))
289 -- Termination is hard because the step is not 1
290 -- Warning: this code is known not to work near maxBound
291 eftt32 :: Word32 -> Word32 -> (Word32->Bool) -> [Word32]
292 eftt32 now step done = go now
296 | otherwise = now : (go `strict` (now+step))
298 --------------------------------
299 -- End stolen from GHC.
300 --------------------------------
302 instance Read Word32 where
303 readsPrec p = readDec
305 instance Show Word32 where
306 showsPrec p = showInt . toInteger -- a particularily counterintuitive name!
308 instance Bits Word32 where
309 (.&.) = lift2 primAndWord
310 (.|.) = lift2 primOrWord
311 xor = lift2 primXorWord
312 complement = lift1 primNotWord
314 | n >= 0 = W32 (primShiftLWord (w32 x) (primIntToWord n))
315 | otherwise = W32 (primShiftRLWord (w32 x) (primIntToWord (-n)))
318 setBit x i = x .|. bit i
319 clearBit x i = x .&. complement (bit i)
320 complementBit x i = x `xor` bit i
321 testBit x i = x .&. bit i /= 0
325 -----------------------------------------------------------------------------
327 -----------------------------------------------------------------------------
329 data Word64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded)
331 w64ToInteger W64{lo,hi} = toInteger lo + 0x100000000 * toInteger hi
332 integerToW64 x = case x `quotRem` 0x100000000 of
333 (h,l) -> W64{lo=fromInteger l, hi=fromInteger h}
335 instance Show Word64 where
336 showsPrec p = showInt . w64ToInteger
338 instance Read Word64 where
339 readsPrec p s = [ (integerToW64 x,r) | (x,r) <- readDec s ]
341 -----------------------------------------------------------------------------
342 -- End of exported definitions
344 -- The remainder of this file consists of definitions which are only
345 -- used in the implementation.
346 -----------------------------------------------------------------------------
348 -----------------------------------------------------------------------------
349 -- Enumeration code: copied from Prelude
350 -----------------------------------------------------------------------------
352 numericEnumFrom :: Real a => a -> [a]
353 numericEnumFromThen :: Real a => a -> a -> [a]
354 numericEnumFromTo :: Real a => a -> a -> [a]
355 numericEnumFromThenTo :: Real a => a -> a -> a -> [a]
356 numericEnumFrom n = n : strict numericEnumFrom (n+1)
357 numericEnumFromThen n m = iterate ((m-n)+) n
358 numericEnumFromTo n m = takeWhile (<= m) (numericEnumFrom n)
359 numericEnumFromThenTo n n' m = takeWhile (if n' >= n then (<= m) else (>= m))
360 (numericEnumFromThen n n')
362 -----------------------------------------------------------------------------
363 -- Coercions - used to make the instance declarations more uniform
364 -----------------------------------------------------------------------------
370 instance Coerce Word8 where
374 instance Coerce Word16 where
375 from = word16ToWord32
378 binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
379 binop op x y = from x `op` from y
381 to2 :: Coerce word => (Word32, Word32) -> (word, word)
382 to2 (x,y) = (to x, to y)
384 -----------------------------------------------------------------------------
385 -- Code copied from the Prelude
386 -----------------------------------------------------------------------------
388 absReal x | x >= 0 = x
391 signumReal x | x == 0 = 0
395 -----------------------------------------------------------------------------
397 -----------------------------------------------------------------------------