Implement foldl with foldr
[packages/base.git] / GHC / Int.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples,
3 StandaloneDeriving, DeriveDataTypeable, NegativeLiterals #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : GHC.Int
9 -- Copyright : (c) The University of Glasgow 1997-2002
10 -- License : see libraries/base/LICENSE
11 --
12 -- Maintainer : cvs-ghc@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable (GHC Extensions)
15 --
16 -- The sized integral datatypes, 'Int8', 'Int16', 'Int32', and 'Int64'.
17 --
18 -----------------------------------------------------------------------------
19
20 #include "MachDeps.h"
21
22 module GHC.Int (
23 Int8(..), Int16(..), Int32(..), Int64(..),
24 uncheckedIShiftL64#, uncheckedIShiftRA64#
25 ) where
26
27 import Data.Bits
28 import Data.Maybe
29
30 #if WORD_SIZE_IN_BITS < 64
31 import GHC.IntWord64
32 #endif
33
34 import GHC.Base
35 import GHC.Enum
36 import GHC.Num
37 import GHC.Real
38 import GHC.Read
39 import GHC.Arr
40 import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
41 import GHC.Show
42 import GHC.Float () -- for RealFrac methods
43 import Data.Typeable
44
45
46 ------------------------------------------------------------------------
47 -- type Int8
48 ------------------------------------------------------------------------
49
50 -- Int8 is represented in the same way as Int. Operations may assume
51 -- and must ensure that it holds only values from its logical range.
52
53 data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord, Typeable)
54 -- ^ 8-bit signed integer type
55
56 instance Show Int8 where
57 showsPrec p x = showsPrec p (fromIntegral x :: Int)
58
59 instance Num Int8 where
60 (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#))
61 (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#))
62 (I8# x#) * (I8# y#) = I8# (narrow8Int# (x# *# y#))
63 negate (I8# x#) = I8# (narrow8Int# (negateInt# x#))
64 abs x | x >= 0 = x
65 | otherwise = negate x
66 signum x | x > 0 = 1
67 signum 0 = 0
68 signum _ = -1
69 fromInteger i = I8# (narrow8Int# (integerToInt i))
70
71 instance Real Int8 where
72 toRational x = toInteger x % 1
73
74 instance Enum Int8 where
75 succ x
76 | x /= maxBound = x + 1
77 | otherwise = succError "Int8"
78 pred x
79 | x /= minBound = x - 1
80 | otherwise = predError "Int8"
81 toEnum i@(I# i#)
82 | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)
83 = I8# i#
84 | otherwise = toEnumError "Int8" i (minBound::Int8, maxBound::Int8)
85 fromEnum (I8# x#) = I# x#
86 enumFrom = boundedEnumFrom
87 enumFromThen = boundedEnumFromThen
88
89 instance Integral Int8 where
90 quot x@(I8# x#) y@(I8# y#)
91 | y == 0 = divZeroError
92 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
93 | otherwise = I8# (narrow8Int# (x# `quotInt#` y#))
94 rem (I8# x#) y@(I8# y#)
95 | y == 0 = divZeroError
96 | otherwise = I8# (narrow8Int# (x# `remInt#` y#))
97 div x@(I8# x#) y@(I8# y#)
98 | y == 0 = divZeroError
99 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
100 | otherwise = I8# (narrow8Int# (x# `divInt#` y#))
101 mod (I8# x#) y@(I8# y#)
102 | y == 0 = divZeroError
103 | otherwise = I8# (narrow8Int# (x# `modInt#` y#))
104 quotRem x@(I8# x#) y@(I8# y#)
105 | y == 0 = divZeroError
106 -- Note [Order of tests]
107 | y == (-1) && x == minBound = (overflowError, 0)
108 | otherwise = case x# `quotRemInt#` y# of
109 (# q, r #) ->
110 (I8# (narrow8Int# q),
111 I8# (narrow8Int# r))
112 divMod x@(I8# x#) y@(I8# y#)
113 | y == 0 = divZeroError
114 -- Note [Order of tests]
115 | y == (-1) && x == minBound = (overflowError, 0)
116 | otherwise = case x# `divModInt#` y# of
117 (# d, m #) ->
118 (I8# (narrow8Int# d),
119 I8# (narrow8Int# m))
120 toInteger (I8# x#) = smallInteger x#
121
122 instance Bounded Int8 where
123 minBound = -0x80
124 maxBound = 0x7F
125
126 instance Ix Int8 where
127 range (m,n) = [m..n]
128 unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
129 inRange (m,n) i = m <= i && i <= n
130
131 instance Read Int8 where
132 readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
133
134 instance Bits Int8 where
135 {-# INLINE shift #-}
136 {-# INLINE bit #-}
137 {-# INLINE testBit #-}
138
139 (I8# x#) .&. (I8# y#) = I8# (word2Int# (int2Word# x# `and#` int2Word# y#))
140 (I8# x#) .|. (I8# y#) = I8# (word2Int# (int2Word# x# `or#` int2Word# y#))
141 (I8# x#) `xor` (I8# y#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
142 complement (I8# x#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
143 (I8# x#) `shift` (I# i#)
144 | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
145 | otherwise = I8# (x# `iShiftRA#` negateInt# i#)
146 (I8# x#) `shiftL` (I# i#) = I8# (narrow8Int# (x# `iShiftL#` i#))
147 (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
148 (I8# x#) `shiftR` (I# i#) = I8# (x# `iShiftRA#` i#)
149 (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)
150 (I8# x#) `rotate` (I# i#)
151 | isTrue# (i'# ==# 0#)
152 = I8# x#
153 | otherwise
154 = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
155 (x'# `uncheckedShiftRL#` (8# -# i'#)))))
156 where
157 !x'# = narrow8Word# (int2Word# x#)
158 !i'# = word2Int# (int2Word# i# `and#` 7##)
159 bitSizeMaybe i = Just (finiteBitSize i)
160 bitSize i = finiteBitSize i
161 isSigned _ = True
162 popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#)))
163 bit = bitDefault
164 testBit = testBitDefault
165
166 instance FiniteBits Int8 where
167 finiteBitSize _ = 8
168
169 {-# RULES
170 "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
171 "fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
172 "fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
173 #-}
174
175 {-# RULES
176 "properFraction/Float->(Int8,Float)"
177 properFraction = \x ->
178 case properFraction x of {
179 (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Float) }
180 "truncate/Float->Int8"
181 truncate = (fromIntegral :: Int -> Int8) . (truncate :: Float -> Int)
182 "floor/Float->Int8"
183 floor = (fromIntegral :: Int -> Int8) . (floor :: Float -> Int)
184 "ceiling/Float->Int8"
185 ceiling = (fromIntegral :: Int -> Int8) . (ceiling :: Float -> Int)
186 "round/Float->Int8"
187 round = (fromIntegral :: Int -> Int8) . (round :: Float -> Int)
188 #-}
189
190 {-# RULES
191 "properFraction/Double->(Int8,Double)"
192 properFraction = \x ->
193 case properFraction x of {
194 (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Double) }
195 "truncate/Double->Int8"
196 truncate = (fromIntegral :: Int -> Int8) . (truncate :: Double -> Int)
197 "floor/Double->Int8"
198 floor = (fromIntegral :: Int -> Int8) . (floor :: Double -> Int)
199 "ceiling/Double->Int8"
200 ceiling = (fromIntegral :: Int -> Int8) . (ceiling :: Double -> Int)
201 "round/Double->Int8"
202 round = (fromIntegral :: Int -> Int8) . (round :: Double -> Int)
203 #-}
204
205 ------------------------------------------------------------------------
206 -- type Int16
207 ------------------------------------------------------------------------
208
209 -- Int16 is represented in the same way as Int. Operations may assume
210 -- and must ensure that it holds only values from its logical range.
211
212 data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord, Typeable)
213 -- ^ 16-bit signed integer type
214
215 instance Show Int16 where
216 showsPrec p x = showsPrec p (fromIntegral x :: Int)
217
218 instance Num Int16 where
219 (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#))
220 (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#))
221 (I16# x#) * (I16# y#) = I16# (narrow16Int# (x# *# y#))
222 negate (I16# x#) = I16# (narrow16Int# (negateInt# x#))
223 abs x | x >= 0 = x
224 | otherwise = negate x
225 signum x | x > 0 = 1
226 signum 0 = 0
227 signum _ = -1
228 fromInteger i = I16# (narrow16Int# (integerToInt i))
229
230 instance Real Int16 where
231 toRational x = toInteger x % 1
232
233 instance Enum Int16 where
234 succ x
235 | x /= maxBound = x + 1
236 | otherwise = succError "Int16"
237 pred x
238 | x /= minBound = x - 1
239 | otherwise = predError "Int16"
240 toEnum i@(I# i#)
241 | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)
242 = I16# i#
243 | otherwise = toEnumError "Int16" i (minBound::Int16, maxBound::Int16)
244 fromEnum (I16# x#) = I# x#
245 enumFrom = boundedEnumFrom
246 enumFromThen = boundedEnumFromThen
247
248 instance Integral Int16 where
249 quot x@(I16# x#) y@(I16# y#)
250 | y == 0 = divZeroError
251 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
252 | otherwise = I16# (narrow16Int# (x# `quotInt#` y#))
253 rem (I16# x#) y@(I16# y#)
254 | y == 0 = divZeroError
255 | otherwise = I16# (narrow16Int# (x# `remInt#` y#))
256 div x@(I16# x#) y@(I16# y#)
257 | y == 0 = divZeroError
258 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
259 | otherwise = I16# (narrow16Int# (x# `divInt#` y#))
260 mod (I16# x#) y@(I16# y#)
261 | y == 0 = divZeroError
262 | otherwise = I16# (narrow16Int# (x# `modInt#` y#))
263 quotRem x@(I16# x#) y@(I16# y#)
264 | y == 0 = divZeroError
265 -- Note [Order of tests]
266 | y == (-1) && x == minBound = (overflowError, 0)
267 | otherwise = case x# `quotRemInt#` y# of
268 (# q, r #) ->
269 (I16# (narrow16Int# q),
270 I16# (narrow16Int# r))
271 divMod x@(I16# x#) y@(I16# y#)
272 | y == 0 = divZeroError
273 -- Note [Order of tests]
274 | y == (-1) && x == minBound = (overflowError, 0)
275 | otherwise = case x# `divModInt#` y# of
276 (# d, m #) ->
277 (I16# (narrow16Int# d),
278 I16# (narrow16Int# m))
279 toInteger (I16# x#) = smallInteger x#
280
281 instance Bounded Int16 where
282 minBound = -0x8000
283 maxBound = 0x7FFF
284
285 instance Ix Int16 where
286 range (m,n) = [m..n]
287 unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
288 inRange (m,n) i = m <= i && i <= n
289
290 instance Read Int16 where
291 readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
292
293 instance Bits Int16 where
294 {-# INLINE shift #-}
295 {-# INLINE bit #-}
296 {-# INLINE testBit #-}
297
298 (I16# x#) .&. (I16# y#) = I16# (word2Int# (int2Word# x# `and#` int2Word# y#))
299 (I16# x#) .|. (I16# y#) = I16# (word2Int# (int2Word# x# `or#` int2Word# y#))
300 (I16# x#) `xor` (I16# y#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
301 complement (I16# x#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
302 (I16# x#) `shift` (I# i#)
303 | isTrue# (i# >=# 0#) = I16# (narrow16Int# (x# `iShiftL#` i#))
304 | otherwise = I16# (x# `iShiftRA#` negateInt# i#)
305 (I16# x#) `shiftL` (I# i#) = I16# (narrow16Int# (x# `iShiftL#` i#))
306 (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
307 (I16# x#) `shiftR` (I# i#) = I16# (x# `iShiftRA#` i#)
308 (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)
309 (I16# x#) `rotate` (I# i#)
310 | isTrue# (i'# ==# 0#)
311 = I16# x#
312 | otherwise
313 = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
314 (x'# `uncheckedShiftRL#` (16# -# i'#)))))
315 where
316 !x'# = narrow16Word# (int2Word# x#)
317 !i'# = word2Int# (int2Word# i# `and#` 15##)
318 bitSizeMaybe i = Just (finiteBitSize i)
319 bitSize i = finiteBitSize i
320 isSigned _ = True
321 popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#)))
322 bit = bitDefault
323 testBit = testBitDefault
324
325 instance FiniteBits Int16 where
326 finiteBitSize _ = 16
327
328 {-# RULES
329 "fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
330 "fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x#
331 "fromIntegral/Int16->Int16" fromIntegral = id :: Int16 -> Int16
332 "fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
333 "fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
334 #-}
335
336 {-# RULES
337 "properFraction/Float->(Int16,Float)"
338 properFraction = \x ->
339 case properFraction x of {
340 (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Float) }
341 "truncate/Float->Int16"
342 truncate = (fromIntegral :: Int -> Int16) . (truncate :: Float -> Int)
343 "floor/Float->Int16"
344 floor = (fromIntegral :: Int -> Int16) . (floor :: Float -> Int)
345 "ceiling/Float->Int16"
346 ceiling = (fromIntegral :: Int -> Int16) . (ceiling :: Float -> Int)
347 "round/Float->Int16"
348 round = (fromIntegral :: Int -> Int16) . (round :: Float -> Int)
349 #-}
350
351 {-# RULES
352 "properFraction/Double->(Int16,Double)"
353 properFraction = \x ->
354 case properFraction x of {
355 (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Double) }
356 "truncate/Double->Int16"
357 truncate = (fromIntegral :: Int -> Int16) . (truncate :: Double -> Int)
358 "floor/Double->Int16"
359 floor = (fromIntegral :: Int -> Int16) . (floor :: Double -> Int)
360 "ceiling/Double->Int16"
361 ceiling = (fromIntegral :: Int -> Int16) . (ceiling :: Double -> Int)
362 "round/Double->Int16"
363 round = (fromIntegral :: Int -> Int16) . (round :: Double -> Int)
364 #-}
365
366 ------------------------------------------------------------------------
367 -- type Int32
368 ------------------------------------------------------------------------
369
370 -- Int32 is represented in the same way as Int.
371 #if WORD_SIZE_IN_BITS > 32
372 -- Operations may assume and must ensure that it holds only values
373 -- from its logical range.
374 #endif
375
376 data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord, Typeable)
377 -- ^ 32-bit signed integer type
378
379 instance Show Int32 where
380 showsPrec p x = showsPrec p (fromIntegral x :: Int)
381
382 instance Num Int32 where
383 (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#))
384 (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#))
385 (I32# x#) * (I32# y#) = I32# (narrow32Int# (x# *# y#))
386 negate (I32# x#) = I32# (narrow32Int# (negateInt# x#))
387 abs x | x >= 0 = x
388 | otherwise = negate x
389 signum x | x > 0 = 1
390 signum 0 = 0
391 signum _ = -1
392 fromInteger i = I32# (narrow32Int# (integerToInt i))
393
394 instance Enum Int32 where
395 succ x
396 | x /= maxBound = x + 1
397 | otherwise = succError "Int32"
398 pred x
399 | x /= minBound = x - 1
400 | otherwise = predError "Int32"
401 #if WORD_SIZE_IN_BITS == 32
402 toEnum (I# i#) = I32# i#
403 #else
404 toEnum i@(I# i#)
405 | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)
406 = I32# i#
407 | otherwise = toEnumError "Int32" i (minBound::Int32, maxBound::Int32)
408 #endif
409 fromEnum (I32# x#) = I# x#
410 enumFrom = boundedEnumFrom
411 enumFromThen = boundedEnumFromThen
412
413 instance Integral Int32 where
414 quot x@(I32# x#) y@(I32# y#)
415 | y == 0 = divZeroError
416 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
417 | otherwise = I32# (narrow32Int# (x# `quotInt#` y#))
418 rem (I32# x#) y@(I32# y#)
419 | y == 0 = divZeroError
420 -- The quotRem CPU instruction fails for minBound `quotRem` -1,
421 -- but minBound `rem` -1 is well-defined (0). We therefore
422 -- special-case it.
423 | y == (-1) = 0
424 | otherwise = I32# (narrow32Int# (x# `remInt#` y#))
425 div x@(I32# x#) y@(I32# y#)
426 | y == 0 = divZeroError
427 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
428 | otherwise = I32# (narrow32Int# (x# `divInt#` y#))
429 mod (I32# x#) y@(I32# y#)
430 | y == 0 = divZeroError
431 -- The divMod CPU instruction fails for minBound `divMod` -1,
432 -- but minBound `mod` -1 is well-defined (0). We therefore
433 -- special-case it.
434 | y == (-1) = 0
435 | otherwise = I32# (narrow32Int# (x# `modInt#` y#))
436 quotRem x@(I32# x#) y@(I32# y#)
437 | y == 0 = divZeroError
438 -- Note [Order of tests]
439 | y == (-1) && x == minBound = (overflowError, 0)
440 | otherwise = case x# `quotRemInt#` y# of
441 (# q, r #) ->
442 (I32# (narrow32Int# q),
443 I32# (narrow32Int# r))
444 divMod x@(I32# x#) y@(I32# y#)
445 | y == 0 = divZeroError
446 -- Note [Order of tests]
447 | y == (-1) && x == minBound = (overflowError, 0)
448 | otherwise = case x# `divModInt#` y# of
449 (# d, m #) ->
450 (I32# (narrow32Int# d),
451 I32# (narrow32Int# m))
452 toInteger (I32# x#) = smallInteger x#
453
454 instance Read Int32 where
455 readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
456
457 instance Bits Int32 where
458 {-# INLINE shift #-}
459 {-# INLINE bit #-}
460 {-# INLINE testBit #-}
461
462 (I32# x#) .&. (I32# y#) = I32# (word2Int# (int2Word# x# `and#` int2Word# y#))
463 (I32# x#) .|. (I32# y#) = I32# (word2Int# (int2Word# x# `or#` int2Word# y#))
464 (I32# x#) `xor` (I32# y#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
465 complement (I32# x#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
466 (I32# x#) `shift` (I# i#)
467 | isTrue# (i# >=# 0#) = I32# (narrow32Int# (x# `iShiftL#` i#))
468 | otherwise = I32# (x# `iShiftRA#` negateInt# i#)
469 (I32# x#) `shiftL` (I# i#) = I32# (narrow32Int# (x# `iShiftL#` i#))
470 (I32# x#) `unsafeShiftL` (I# i#) =
471 I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
472 (I32# x#) `shiftR` (I# i#) = I32# (x# `iShiftRA#` i#)
473 (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)
474 (I32# x#) `rotate` (I# i#)
475 | isTrue# (i'# ==# 0#)
476 = I32# x#
477 | otherwise
478 = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
479 (x'# `uncheckedShiftRL#` (32# -# i'#)))))
480 where
481 !x'# = narrow32Word# (int2Word# x#)
482 !i'# = word2Int# (int2Word# i# `and#` 31##)
483 bitSizeMaybe i = Just (finiteBitSize i)
484 bitSize i = finiteBitSize i
485 isSigned _ = True
486 popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#)))
487 bit = bitDefault
488 testBit = testBitDefault
489
490 instance FiniteBits Int32 where
491 finiteBitSize _ = 32
492
493 {-# RULES
494 "fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
495 "fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
496 "fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# x#
497 "fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# x#
498 "fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32
499 "fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
500 "fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
501 #-}
502
503 {-# RULES
504 "properFraction/Float->(Int32,Float)"
505 properFraction = \x ->
506 case properFraction x of {
507 (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Float) }
508 "truncate/Float->Int32"
509 truncate = (fromIntegral :: Int -> Int32) . (truncate :: Float -> Int)
510 "floor/Float->Int32"
511 floor = (fromIntegral :: Int -> Int32) . (floor :: Float -> Int)
512 "ceiling/Float->Int32"
513 ceiling = (fromIntegral :: Int -> Int32) . (ceiling :: Float -> Int)
514 "round/Float->Int32"
515 round = (fromIntegral :: Int -> Int32) . (round :: Float -> Int)
516 #-}
517
518 {-# RULES
519 "properFraction/Double->(Int32,Double)"
520 properFraction = \x ->
521 case properFraction x of {
522 (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Double) }
523 "truncate/Double->Int32"
524 truncate = (fromIntegral :: Int -> Int32) . (truncate :: Double -> Int)
525 "floor/Double->Int32"
526 floor = (fromIntegral :: Int -> Int32) . (floor :: Double -> Int)
527 "ceiling/Double->Int32"
528 ceiling = (fromIntegral :: Int -> Int32) . (ceiling :: Double -> Int)
529 "round/Double->Int32"
530 round = (fromIntegral :: Int -> Int32) . (round :: Double -> Int)
531 #-}
532
533 instance Real Int32 where
534 toRational x = toInteger x % 1
535
536 instance Bounded Int32 where
537 minBound = -0x80000000
538 maxBound = 0x7FFFFFFF
539
540 instance Ix Int32 where
541 range (m,n) = [m..n]
542 unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
543 inRange (m,n) i = m <= i && i <= n
544
545 ------------------------------------------------------------------------
546 -- type Int64
547 ------------------------------------------------------------------------
548
549 #if WORD_SIZE_IN_BITS < 64
550
551 data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# deriving( Typeable )
552 -- ^ 64-bit signed integer type
553
554 instance Eq Int64 where
555 (I64# x#) == (I64# y#) = isTrue# (x# `eqInt64#` y#)
556 (I64# x#) /= (I64# y#) = isTrue# (x# `neInt64#` y#)
557
558 instance Ord Int64 where
559 (I64# x#) < (I64# y#) = isTrue# (x# `ltInt64#` y#)
560 (I64# x#) <= (I64# y#) = isTrue# (x# `leInt64#` y#)
561 (I64# x#) > (I64# y#) = isTrue# (x# `gtInt64#` y#)
562 (I64# x#) >= (I64# y#) = isTrue# (x# `geInt64#` y#)
563
564 instance Show Int64 where
565 showsPrec p x = showsPrec p (toInteger x)
566
567 instance Num Int64 where
568 (I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#)
569 (I64# x#) - (I64# y#) = I64# (x# `minusInt64#` y#)
570 (I64# x#) * (I64# y#) = I64# (x# `timesInt64#` y#)
571 negate (I64# x#) = I64# (negateInt64# x#)
572 abs x | x >= 0 = x
573 | otherwise = negate x
574 signum x | x > 0 = 1
575 signum 0 = 0
576 signum _ = -1
577 fromInteger i = I64# (integerToInt64 i)
578
579 instance Enum Int64 where
580 succ x
581 | x /= maxBound = x + 1
582 | otherwise = succError "Int64"
583 pred x
584 | x /= minBound = x - 1
585 | otherwise = predError "Int64"
586 toEnum (I# i#) = I64# (intToInt64# i#)
587 fromEnum x@(I64# x#)
588 | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
589 = I# (int64ToInt# x#)
590 | otherwise = fromEnumError "Int64" x
591 enumFrom = integralEnumFrom
592 enumFromThen = integralEnumFromThen
593 enumFromTo = integralEnumFromTo
594 enumFromThenTo = integralEnumFromThenTo
595
596 instance Integral Int64 where
597 quot x@(I64# x#) y@(I64# y#)
598 | y == 0 = divZeroError
599 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
600 | otherwise = I64# (x# `quotInt64#` y#)
601 rem (I64# x#) y@(I64# y#)
602 | y == 0 = divZeroError
603 -- The quotRem CPU instruction fails for minBound `quotRem` -1,
604 -- but minBound `rem` -1 is well-defined (0). We therefore
605 -- special-case it.
606 | y == (-1) = 0
607 | otherwise = I64# (x# `remInt64#` y#)
608 div x@(I64# x#) y@(I64# y#)
609 | y == 0 = divZeroError
610 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
611 | otherwise = I64# (x# `divInt64#` y#)
612 mod (I64# x#) y@(I64# y#)
613 | y == 0 = divZeroError
614 -- The divMod CPU instruction fails for minBound `divMod` -1,
615 -- but minBound `mod` -1 is well-defined (0). We therefore
616 -- special-case it.
617 | y == (-1) = 0
618 | otherwise = I64# (x# `modInt64#` y#)
619 quotRem x@(I64# x#) y@(I64# y#)
620 | y == 0 = divZeroError
621 -- Note [Order of tests]
622 | y == (-1) && x == minBound = (overflowError, 0)
623 | otherwise = (I64# (x# `quotInt64#` y#),
624 I64# (x# `remInt64#` y#))
625 divMod x@(I64# x#) y@(I64# y#)
626 | y == 0 = divZeroError
627 -- Note [Order of tests]
628 | y == (-1) && x == minBound = (overflowError, 0)
629 | otherwise = (I64# (x# `divInt64#` y#),
630 I64# (x# `modInt64#` y#))
631 toInteger (I64# x) = int64ToInteger x
632
633
634 divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
635
636 -- Define div in terms of quot, being careful to avoid overflow (#7233)
637 x# `divInt64#` y#
638 | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
639 = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one
640 | isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
641 = ((x# `plusInt64#` one) `quotInt64#` y#) `minusInt64#` one
642 | otherwise
643 = x# `quotInt64#` y#
644 where
645 !zero = intToInt64# 0#
646 !one = intToInt64# 1#
647
648 x# `modInt64#` y#
649 | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero) ||
650 isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
651 = if isTrue# (r# `neInt64#` zero) then r# `plusInt64#` y# else zero
652 | otherwise = r#
653 where
654 !zero = intToInt64# 0#
655 !r# = x# `remInt64#` y#
656
657 instance Read Int64 where
658 readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
659
660 instance Bits Int64 where
661 {-# INLINE shift #-}
662 {-# INLINE bit #-}
663 {-# INLINE testBit #-}
664
665 (I64# x#) .&. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))
666 (I64# x#) .|. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `or64#` int64ToWord64# y#))
667 (I64# x#) `xor` (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))
668 complement (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))
669 (I64# x#) `shift` (I# i#)
670 | isTrue# (i# >=# 0#) = I64# (x# `iShiftL64#` i#)
671 | otherwise = I64# (x# `iShiftRA64#` negateInt# i#)
672 (I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL64#` i#)
673 (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)
674 (I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA64#` i#)
675 (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)
676 (I64# x#) `rotate` (I# i#)
677 | isTrue# (i'# ==# 0#)
678 = I64# x#
679 | otherwise
680 = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`
681 (x'# `uncheckedShiftRL64#` (64# -# i'#))))
682 where
683 !x'# = int64ToWord64# x#
684 !i'# = word2Int# (int2Word# i# `and#` 63##)
685 bitSizeMaybe i = Just (finiteBitSize i)
686 bitSize i = finiteBitSize i
687 isSigned _ = True
688 popCount (I64# x#) =
689 I# (word2Int# (popCnt64# (int64ToWord64# x#)))
690 bit = bitDefault
691 testBit = testBitDefault
692
693 -- give the 64-bit shift operations the same treatment as the 32-bit
694 -- ones (see GHC.Base), namely we wrap them in tests to catch the
695 -- cases when we're shifting more than 64 bits to avoid unspecified
696 -- behaviour in the C shift operations.
697
698 iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#
699
700 a `iShiftL64#` b | isTrue# (b >=# 64#) = intToInt64# 0#
701 | otherwise = a `uncheckedIShiftL64#` b
702
703 a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#))
704 then intToInt64# (-1#)
705 else intToInt64# 0#
706 | otherwise = a `uncheckedIShiftRA64#` b
707
708 {-# RULES
709 "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#)
710 "fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#))
711 "fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#)
712 "fromIntegral/Int64->Int" fromIntegral = \(I64# x#) -> I# (int64ToInt# x#)
713 "fromIntegral/Int64->Word" fromIntegral = \(I64# x#) -> W# (int2Word# (int64ToInt# x#))
714 "fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#)
715 "fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64
716 #-}
717
718 -- No RULES for RealFrac methods if Int is smaller than Int64, we can't
719 -- go through Int and whether going through Integer is faster is uncertain.
720 #else
721
722 -- Int64 is represented in the same way as Int.
723 -- Operations may assume and must ensure that it holds only values
724 -- from its logical range.
725
726 data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord, Typeable)
727 -- ^ 64-bit signed integer type
728
729 instance Show Int64 where
730 showsPrec p x = showsPrec p (fromIntegral x :: Int)
731
732 instance Num Int64 where
733 (I64# x#) + (I64# y#) = I64# (x# +# y#)
734 (I64# x#) - (I64# y#) = I64# (x# -# y#)
735 (I64# x#) * (I64# y#) = I64# (x# *# y#)
736 negate (I64# x#) = I64# (negateInt# x#)
737 abs x | x >= 0 = x
738 | otherwise = negate x
739 signum x | x > 0 = 1
740 signum 0 = 0
741 signum _ = -1
742 fromInteger i = I64# (integerToInt i)
743
744 instance Enum Int64 where
745 succ x
746 | x /= maxBound = x + 1
747 | otherwise = succError "Int64"
748 pred x
749 | x /= minBound = x - 1
750 | otherwise = predError "Int64"
751 toEnum (I# i#) = I64# i#
752 fromEnum (I64# x#) = I# x#
753 enumFrom = boundedEnumFrom
754 enumFromThen = boundedEnumFromThen
755
756 instance Integral Int64 where
757 quot x@(I64# x#) y@(I64# y#)
758 | y == 0 = divZeroError
759 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
760 | otherwise = I64# (x# `quotInt#` y#)
761 rem (I64# x#) y@(I64# y#)
762 | y == 0 = divZeroError
763 -- The quotRem CPU instruction fails for minBound `quotRem` -1,
764 -- but minBound `rem` -1 is well-defined (0). We therefore
765 -- special-case it.
766 | y == (-1) = 0
767 | otherwise = I64# (x# `remInt#` y#)
768 div x@(I64# x#) y@(I64# y#)
769 | y == 0 = divZeroError
770 | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
771 | otherwise = I64# (x# `divInt#` y#)
772 mod (I64# x#) y@(I64# y#)
773 | y == 0 = divZeroError
774 -- The divMod CPU instruction fails for minBound `divMod` -1,
775 -- but minBound `mod` -1 is well-defined (0). We therefore
776 -- special-case it.
777 | y == (-1) = 0
778 | otherwise = I64# (x# `modInt#` y#)
779 quotRem x@(I64# x#) y@(I64# y#)
780 | y == 0 = divZeroError
781 -- Note [Order of tests]
782 | y == (-1) && x == minBound = (overflowError, 0)
783 | otherwise = case x# `quotRemInt#` y# of
784 (# q, r #) ->
785 (I64# q, I64# r)
786 divMod x@(I64# x#) y@(I64# y#)
787 | y == 0 = divZeroError
788 -- Note [Order of tests]
789 | y == (-1) && x == minBound = (overflowError, 0)
790 | otherwise = case x# `divModInt#` y# of
791 (# d, m #) ->
792 (I64# d, I64# m)
793 toInteger (I64# x#) = smallInteger x#
794
795 instance Read Int64 where
796 readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
797
798 instance Bits Int64 where
799 {-# INLINE shift #-}
800 {-# INLINE bit #-}
801 {-# INLINE testBit #-}
802
803 (I64# x#) .&. (I64# y#) = I64# (word2Int# (int2Word# x# `and#` int2Word# y#))
804 (I64# x#) .|. (I64# y#) = I64# (word2Int# (int2Word# x# `or#` int2Word# y#))
805 (I64# x#) `xor` (I64# y#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))
806 complement (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
807 (I64# x#) `shift` (I# i#)
808 | isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#)
809 | otherwise = I64# (x# `iShiftRA#` negateInt# i#)
810 (I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL#` i#)
811 (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)
812 (I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA#` i#)
813 (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)
814 (I64# x#) `rotate` (I# i#)
815 | isTrue# (i'# ==# 0#)
816 = I64# x#
817 | otherwise
818 = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
819 (x'# `uncheckedShiftRL#` (64# -# i'#))))
820 where
821 !x'# = int2Word# x#
822 !i'# = word2Int# (int2Word# i# `and#` 63##)
823 bitSizeMaybe i = Just (finiteBitSize i)
824 bitSize i = finiteBitSize i
825 isSigned _ = True
826 popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#)))
827 bit = bitDefault
828 testBit = testBitDefault
829
830 {-# RULES
831 "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
832 "fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
833 #-}
834
835 {-# RULES
836 "properFraction/Float->(Int64,Float)"
837 properFraction = \x ->
838 case properFraction x of {
839 (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) }
840 "truncate/Float->Int64"
841 truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int)
842 "floor/Float->Int64"
843 floor = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int)
844 "ceiling/Float->Int64"
845 ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int)
846 "round/Float->Int64"
847 round = (fromIntegral :: Int -> Int64) . (round :: Float -> Int)
848 #-}
849
850 {-# RULES
851 "properFraction/Double->(Int64,Double)"
852 properFraction = \x ->
853 case properFraction x of {
854 (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) }
855 "truncate/Double->Int64"
856 truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int)
857 "floor/Double->Int64"
858 floor = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int)
859 "ceiling/Double->Int64"
860 ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int)
861 "round/Double->Int64"
862 round = (fromIntegral :: Int -> Int64) . (round :: Double -> Int)
863 #-}
864
865 uncheckedIShiftL64# :: Int# -> Int# -> Int#
866 uncheckedIShiftL64# = uncheckedIShiftL#
867
868 uncheckedIShiftRA64# :: Int# -> Int# -> Int#
869 uncheckedIShiftRA64# = uncheckedIShiftRA#
870 #endif
871
872 instance FiniteBits Int64 where
873 finiteBitSize _ = 64
874
875 instance Real Int64 where
876 toRational x = toInteger x % 1
877
878 instance Bounded Int64 where
879 minBound = -0x8000000000000000
880 maxBound = 0x7FFFFFFFFFFFFFFF
881
882 instance Ix Int64 where
883 range (m,n) = [m..n]
884 unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
885 inRange (m,n) i = m <= i && i <= n
886
887
888 {-
889 Note [Order of tests]
890
891 Suppose we had a definition like:
892
893 quot x y
894 | y == 0 = divZeroError
895 | x == minBound && y == (-1) = overflowError
896 | otherwise = x `primQuot` y
897
898 Note in particular that the
899 x == minBound
900 test comes before the
901 y == (-1)
902 test.
903
904 this expands to something like:
905
906 case y of
907 0 -> divZeroError
908 _ -> case x of
909 -9223372036854775808 ->
910 case y of
911 -1 -> overflowError
912 _ -> x `primQuot` y
913 _ -> x `primQuot` y
914
915 Now if we have the call (x `quot` 2), and quot gets inlined, then we get:
916
917 case 2 of
918 0 -> divZeroError
919 _ -> case x of
920 -9223372036854775808 ->
921 case 2 of
922 -1 -> overflowError
923 _ -> x `primQuot` 2
924 _ -> x `primQuot` 2
925
926 which simplifies to:
927
928 case x of
929 -9223372036854775808 -> x `primQuot` 2
930 _ -> x `primQuot` 2
931
932 Now we have a case with two identical branches, which would be
933 eliminated (assuming it doesn't affect strictness, which it doesn't in
934 this case), leaving the desired:
935
936 x `primQuot` 2
937
938 except in the minBound branch we know what x is, and GHC cleverly does
939 the division at compile time, giving:
940
941 case x of
942 -9223372036854775808 -> -4611686018427387904
943 _ -> x `primQuot` 2
944
945 So instead we use a definition like:
946
947 quot x y
948 | y == 0 = divZeroError
949 | y == (-1) && x == minBound = overflowError
950 | otherwise = x `primQuot` y
951
952 which gives us:
953
954 case y of
955 0 -> divZeroError
956 -1 ->
957 case x of
958 -9223372036854775808 -> overflowError
959 _ -> x `primQuot` y
960 _ -> x `primQuot` y
961
962 for which our call (x `quot` 2) expands to:
963
964 case 2 of
965 0 -> divZeroError
966 -1 ->
967 case x of
968 -9223372036854775808 -> overflowError
969 _ -> x `primQuot` 2
970 _ -> x `primQuot` 2
971
972 which simplifies to:
973
974 x `primQuot` 2
975
976 as required.
977
978
979
980 But we now have the same problem with a constant numerator: the call
981 (2 `quot` y) expands to
982
983 case y of
984 0 -> divZeroError
985 -1 ->
986 case 2 of
987 -9223372036854775808 -> overflowError
988 _ -> 2 `primQuot` y
989 _ -> 2 `primQuot` y
990
991 which simplifies to:
992
993 case y of
994 0 -> divZeroError
995 -1 -> 2 `primQuot` y
996 _ -> 2 `primQuot` y
997
998 which simplifies to:
999
1000 case y of
1001 0 -> divZeroError
1002 -1 -> -2
1003 _ -> 2 `primQuot` y
1004
1005
1006 However, constant denominators are more common than constant numerators,
1007 so the
1008 y == (-1) && x == minBound
1009 order gives us better code in the common case.
1010 -}