Initial commit of integer(-gmp) package; code copied from base
[packages/integer-gmp.git] / GHC / Integer.lhs
1 \begin{code}
2 {-# OPTIONS_GHC -fno-implicit-prelude #-}
3 {-# OPTIONS_HADDOCK hide #-}
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module      :  GHC.Integer
7 -- Copyright   :  (c) The University of Glasgow 1994-2008
8 -- License     :  see libraries/integer-gmp/LICENSE
9 --
10 -- Maintainer  :  cvs-ghc@haskell.org
11 -- Stability   :  internal
12 -- Portability :  non-portable (GHC Extensions)
13 --
14 -- The 'Integer' type.
15 --
16 -----------------------------------------------------------------------------
17
18 #include "MachDeps.h"
19 #if SIZEOF_HSWORD == 4
20 #define INT_MINBOUND (-2147483648#)
21 #define NEG_INT_MINBOUND (S# 2147483647# `plusInteger` S# 1#)
22 #elif SIZEOF_HSWORD == 8
23 #define INT_MINBOUND (-9223372036854775808#)
24 #define NEG_INT_MINBOUND (S# 9223372036854775807# `plusInteger` S# 1#)
25 #else
26 #error Unknown SIZEOF_HSWORD; can't define INT_MINBOUND and NEG_INT_MINBOUND
27 #endif
28
29 module GHC.Integer (
30     Integer,
31     smallInteger, wordToInteger, integerToWord, toInt#,
32     plusInteger, minusInteger, timesInteger, negateInteger,
33     eqInteger, neqInteger, absInteger, signumInteger,
34     leInteger, gtInteger, ltInteger, geInteger, compareInteger,
35     divModInteger, quotRemInteger, quotInteger, remInteger,
36     encodeFloatInteger, decodeFloatInteger, floatFromInteger,
37     encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
38     gcdInteger, lcmInteger,
39     andInteger, orInteger, xorInteger, complementInteger,
40     hashInteger,
41  ) where
42
43 import GHC.Prim (
44     -- Other types we use, convert from, or convert to
45     Int#, Word#, Double#, Float#, ByteArray#,
46     -- Conversions between those types
47     int2Word#, int2Double#, int2Float#, word2Int#,
48     -- Operations on Int# that we use for operations on S#
49     quotInt#, remInt#, negateInt#,
50     (==#), (/=#), (<=#), (>=#), (<#), (>#), (*#), (-#), (+#),
51     mulIntMayOflo#, addIntC#, subIntC#, gcdInt#,
52     and#, or#, xor#,
53     indexIntArray#,
54     -- GMP-related primitives in the RTS
55     cmpInteger#, cmpIntegerInt#,
56     plusInteger#, minusInteger#, timesInteger#,
57     quotRemInteger#, quotInteger#, remInteger#, divModInteger#,
58     gcdInteger#, gcdIntegerInt#, divExactInteger#,
59     decodeDouble#, decodeFloat#,
60     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
61     andInteger#, orInteger#, xorInteger#, complementInteger#,
62  )
63
64 import GHC.Bool
65
66 default ()              -- Double isn't available yet,
67                         -- and we shouldn't be using defaults anyway
68 \end{code}
69
70 %*********************************************************
71 %*                                                      *
72 \subsection{The @Integer@ type}
73 %*                                                      *
74 %*********************************************************
75
76 \begin{code}
77 -- | Arbitrary-precision integers.
78 data Integer
79    = S# Int#                            -- small integers
80 #ifndef ILX
81    | J# Int# ByteArray#                 -- large integers
82 #else
83    | J# Void BigInteger                 -- .NET big ints
84
85 foreign type dotnet "BigInteger" BigInteger
86 #endif
87 \end{code}
88
89 Convenient boxed Integer PrimOps.
90
91 \begin{code}
92 {-# INLINE smallInteger #-}
93 smallInteger :: Int# -> Integer
94 smallInteger i = S# i
95
96 {-# INLINE wordToInteger #-}
97 wordToInteger :: Word# -> Integer
98 wordToInteger w = case word2Integer# w of (# s, d #) -> J# s d
99
100 {-# INLINE integerToWord #-}
101 integerToWord :: Integer -> Word#
102 integerToWord (S# i) = int2Word# i
103 integerToWord (J# s d) = integer2Word# s d
104
105 toInt# :: Integer -> Int#
106 toInt# (S# i)   = i
107 toInt# (J# s d) = integer2Int# s d
108
109 toBig :: Integer -> Integer
110 toBig (S# i)     = case int2Integer# i of { (# s, d #) -> J# s d }
111 toBig i@(J# _ _) = i
112 \end{code}
113
114
115 %*********************************************************
116 %*                                                      *
117 \subsection{Dividing @Integers@}
118 %*                                                      *
119 %*********************************************************
120
121 \begin{code}
122 -- XXX There's no good reason for us using unboxed tuples for the
123 -- results, but we don't have Data.Tuple available.
124
125 -- Note that we don't check for divide-by-zero here. That needs
126 -- to be done where it's used.
127 -- (we don't have error)
128
129 quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
130 quotRemInteger a@(S# INT_MINBOUND) b = quotRemInteger (toBig a) b
131 quotRemInteger (S# i) (S# j) = (# S# (i `quotInt#` j), S# (i `remInt#` j) #)
132 quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
133 quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
134 quotRemInteger (J# s1 d1) (J# s2 d2)
135   = case (quotRemInteger# s1 d1 s2 d2) of
136           (# s3, d3, s4, d4 #)
137             -> (# J# s3 d3, J# s4 d4 #)
138
139 divModInteger :: Integer -> Integer -> (# Integer, Integer #)
140 divModInteger a@(S# INT_MINBOUND) b = divModInteger (toBig a) b
141 divModInteger (S# i) (S# j) = (# S# (i `divInt#` j), S# (i `modInt#` j) #)
142     where
143       -- XXX Copied from GHC.Base
144       divInt# :: Int# -> Int# -> Int#
145       x# `divInt#` y#
146        =      if (x# ># 0#) && (y# <# 0#) then ((x# -# 1#) `quotInt#` y#) -# 1#
147          else if (x# <# 0#) && (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1#
148          else x# `quotInt#` y#
149
150       modInt# :: Int# -> Int# -> Int#
151       x# `modInt#` y#
152        = if (x# ># 0#) && (y# <# 0#) ||
153             (x# <# 0#) && (y# ># 0#)
154          then if r# /=# 0# then r# +# y# else 0#
155          else r#
156           where r# = x# `remInt#` y#
157
158       (&&) :: Bool -> Bool -> Bool
159       True  && x = x
160       False && _ = False
161
162       (||) :: Bool -> Bool -> Bool
163       True  || _ = True
164       False || x = x
165 divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
166 divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
167 divModInteger (J# s1 d1) (J# s2 d2)
168   = case (divModInteger# s1 d1 s2 d2) of
169           (# s3, d3, s4, d4 #)
170             -> (# J# s3 d3, J# s4 d4 #)
171
172 remInteger :: Integer -> Integer -> Integer
173 remInteger a@(S# INT_MINBOUND) b = remInteger (toBig a) b
174 remInteger (S# a) (S# b) = S# (remInt# a b)
175 {- Special case doesn't work, because a 1-element J# has the range
176    -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
177 remInteger ia@(S# a) (J# sb b)
178   | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
179   | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
180   | 0# <# sb   = ia
181   | otherwise  = S# (0# -# a)
182 -}
183 remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
184 remInteger (J# sa a) (S# b)
185   = case int2Integer# b of { (# sb, b' #) ->
186     case remInteger# sa a sb b' of { (# sr, r #) ->
187     S# (integer2Int# sr r) }}
188 remInteger (J# sa a) (J# sb b)
189   = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
190
191 quotInteger :: Integer -> Integer -> Integer
192 quotInteger a@(S# INT_MINBOUND) b = quotInteger (toBig a) b
193 quotInteger (S# a) (S# b) = S# (quotInt# a b)
194 {- Special case disabled, see remInteger above
195 quotInteger (S# a) (J# sb b)
196   | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
197   | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
198   | otherwise  = S# 0
199 -}
200 quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
201 quotInteger (J# sa a) (S# b)
202   = case int2Integer# b of { (# sb, b' #) ->
203     case quotInteger# sa a sb b' of (# sq, q #) -> J# sq q }
204 quotInteger (J# sa a) (J# sb b)
205   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
206 \end{code}
207
208
209
210 \begin{code}
211 -- We can't throw an error here, so it is up to our caller to
212 -- not call us with both arguments being 0.
213 gcdInteger :: Integer -> Integer -> Integer
214 -- SUP: Do we really need the first two cases?
215 gcdInteger a@(S# INT_MINBOUND) b = gcdInteger (toBig a) b
216 gcdInteger a b@(S# INT_MINBOUND) = gcdInteger a (toBig b)
217 gcdInteger (S# a) (S# b) = S# (gcdInt a b)
218     where -- XXX Copied from GHC.Base
219           gcdInt :: Int# -> Int# -> Int#
220           gcdInt 0# y  = absInt y
221           gcdInt x  0# = absInt x
222           gcdInt x  y  = gcdInt# (absInt x) (absInt y)
223
224           absInt x = if x <# 0# then negateInt# x else x
225 gcdInteger ia@(S# a)  ib@(J# sb b)
226  =      if a  ==# 0# then absInteger ib
227    else if sb ==# 0# then absInteger ia
228    else                   S# (gcdIntegerInt# absSb b absA)
229        where absA  = if a  <# 0# then negateInt# a  else a
230              absSb = if sb <# 0# then negateInt# sb else sb
231 gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
232 gcdInteger (J# sa a) (J# sb b)
233   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
234
235 lcmInteger :: Integer -> Integer -> Integer
236 lcmInteger a b =      if a `eqInteger` S# 0# then S# 0#
237                  else if b `eqInteger` S# 0# then S# 0#
238                  else (divExact aa (gcdInteger aa ab)) `timesInteger` ab
239   where aa = absInteger a
240         ab = absInteger b
241
242 divExact :: Integer -> Integer -> Integer
243 divExact a@(S# INT_MINBOUND) b = divExact (toBig a) b
244 divExact (S# a) (S# b) = S# (quotInt# a b)
245 divExact (S# a) (J# sb b)
246   = S# (quotInt# a (integer2Int# sb b))
247 divExact (J# sa a) (S# b)
248   = case int2Integer# b of
249     (# sb, b' #) -> case divExactInteger# sa a sb b' of
250                     (# sd, d #) -> J# sd d
251 divExact (J# sa a) (J# sb b)
252   = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
253 \end{code}
254
255
256 %*********************************************************
257 %*                                                      *
258 \subsection{The @Integer@ instances for @Eq@, @Ord@}
259 %*                                                      *
260 %*********************************************************
261
262 \begin{code}
263 eqInteger :: Integer -> Integer -> Bool
264 eqInteger (S# i)     (S# j)     = i ==# j
265 eqInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i ==# 0#
266 eqInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i ==# 0#
267 eqInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
268
269 neqInteger :: Integer -> Integer -> Bool
270 neqInteger (S# i)     (S# j)     = i /=# j
271 neqInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i /=# 0#
272 neqInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i /=# 0#
273 neqInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
274
275 ------------------------------------------------------------------------
276
277 leInteger :: Integer -> Integer -> Bool
278 leInteger (S# i)     (S# j)     = i <=# j
279 leInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i <=# 0#
280 leInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i >=# 0#
281 leInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
282
283 gtInteger :: Integer -> Integer -> Bool
284 gtInteger (S# i)     (S# j)     = i ># j
285 gtInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i ># 0#
286 gtInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i <# 0#
287 gtInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
288
289 ltInteger :: Integer -> Integer -> Bool
290 ltInteger (S# i)     (S# j)     = i <# j
291 ltInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i <# 0#
292 ltInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i ># 0#
293 ltInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
294
295 geInteger :: Integer -> Integer -> Bool
296 geInteger (S# i)     (S# j)     = i >=# j
297 geInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i >=# 0#
298 geInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i <=# 0#
299 geInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
300
301 -- GT => 1
302 -- EQ => 0
303 -- LT => -1
304 -- XXX Should we just define Ordering higher up?
305 compareInteger :: Integer -> Integer -> Int#
306 compareInteger (S# i)  (S# j)
307    =      if i ==# j then 0#
308      else if i <=# j then -1#
309      else                 1#
310 compareInteger (J# s d) (S# i)
311    = case cmpIntegerInt# s d i of { res# ->
312      if res# <# 0# then -1# else
313      if res# ># 0# then 1# else 0#
314      }
315 compareInteger (S# i) (J# s d)
316    = case cmpIntegerInt# s d i of { res# ->
317      if res# ># 0# then -1# else
318      if res# <# 0# then 1# else 0#
319      }
320 compareInteger (J# s1 d1) (J# s2 d2)
321    = case cmpInteger# s1 d1 s2 d2 of { res# ->
322      if res# <# 0# then -1# else
323      if res# ># 0# then 1# else 0#
324      }
325 \end{code}
326
327
328 %*********************************************************
329 %*                                                      *
330 \subsection{The @Integer@ instances for @Num@}
331 %*                                                      *
332 %*********************************************************
333
334 \begin{code}
335 {-# INLINE absInteger #-}
336 absInteger :: Integer -> Integer
337 absInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
338 absInteger n@(S# i) = if i >=# 0# then n else S# (negateInt# i)
339 absInteger n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
340
341 signumInteger :: Integer -> Integer
342 signumInteger (S# i) = if i <# 0# then S# -1#
343                        else if i ==# 0# then S# 0#
344                        else S# 1#
345 signumInteger (J# s d)
346   = let
347         cmp = cmpIntegerInt# s d 0#
348     in
349     if      cmp >#  0# then S# 1#
350     else if cmp ==# 0# then S# 0#
351     else                    S# (negateInt# 1#)
352
353 plusInteger :: Integer -> Integer -> Integer
354 plusInteger i1@(S# i) i2@(S# j)  = case addIntC# i j of
355                                    (# r, c #) ->
356                                        if c ==# 0#
357                                        then S# r
358                                        else plusInteger (toBig i1) (toBig i2)
359 plusInteger i1@(J# _ _) i2@(S# _) = plusInteger i1 (toBig i2)
360 plusInteger i1@(S# _) i2@(J# _ _) = plusInteger (toBig i1) i2
361 plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of
362                                     (# s, d #) -> J# s d
363
364 minusInteger :: Integer -> Integer -> Integer
365 minusInteger i1@(S# i) i2@(S# j)   = case subIntC# i j of
366                                      (# r, c #) ->
367                                          if c ==# 0# then S# r
368                                          else minusInteger (toBig i1)
369                                                            (toBig i2)
370 minusInteger i1@(J# _ _) i2@(S# _) = minusInteger i1 (toBig i2)
371 minusInteger i1@(S# _) i2@(J# _ _) = minusInteger (toBig i1) i2
372 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of
373                                      (# s, d #) -> J# s d
374
375 timesInteger :: Integer -> Integer -> Integer
376 timesInteger i1@(S# i) i2@(S# j)   = if mulIntMayOflo# i j ==# 0#
377                                      then S# (i *# j)
378                                      else timesInteger (toBig i1) (toBig i2)
379 timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i1 (toBig i2)
380 timesInteger i1@(S# _) i2@(J# _ _) = timesInteger (toBig i1) i2
381 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of
382                                      (# s, d #) -> J# s d
383
384 negateInteger :: Integer -> Integer
385 negateInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
386 negateInteger (S# i)            = S# (negateInt# i)
387 negateInteger (J# s d)          = J# (negateInt# s) d
388 \end{code}
389
390
391 %*********************************************************
392 %*                                                      *
393 \subsection{The @Integer@ stuff for Double@}
394 %*                                                      *
395 %*********************************************************
396
397 \begin{code}
398 encodeFloatInteger :: Integer -> Int# -> Float#
399 encodeFloatInteger (S# i) j     = int_encodeFloat# i j
400 encodeFloatInteger (J# s# d#) e = encodeFloat# s# d# e
401
402 decodeFloatInteger :: Float# -> (# Integer, Int# #)
403 decodeFloatInteger d = case decodeFloat# d of
404                        (# exp#, s#, d# #) -> (# J# s# d#, exp# #)
405
406 encodeDoubleInteger :: Integer -> Int# -> Double#
407 encodeDoubleInteger (S# i) j     = int_encodeDouble# i j
408 encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e
409
410 decodeDoubleInteger :: Double# -> (# Integer, Int# #)
411 decodeDoubleInteger d = case decodeDouble# d of
412                         (# exp#, s#, d# #) -> (# J# s# d#, exp# #)
413
414 -- previous code: doubleFromInteger n = fromInteger n = encodeFloat n 0
415 -- doesn't work too well, because encodeFloat is defined in
416 -- terms of ccalls which can never be simplified away.  We
417 -- want simple literals like (fromInteger 3 :: Float) to turn
418 -- into (F# 3.0), hence the special case for S# here.
419
420 doubleFromInteger :: Integer -> Double#
421 doubleFromInteger (S# i#) = int2Double# i#
422 doubleFromInteger (J# s# d#) = encodeDouble# s# d# 0#
423
424 floatFromInteger :: Integer -> Float#
425 floatFromInteger (S# i#) = int2Float# i#
426 floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
427
428 foreign import ccall unsafe "__encodeFloat"
429         encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
430 foreign import ccall unsafe "__int_encodeFloat"
431         int_encodeFloat# :: Int# -> Int# -> Float#
432
433 foreign import ccall unsafe "__encodeDouble"
434         encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
435 foreign import ccall unsafe "__int_encodeDouble"
436         int_encodeDouble# :: Int# -> Int# -> Double#
437 \end{code}
438
439 %*********************************************************
440 %*                                                      *
441 \subsection{The @Integer@ Bit definitions@}
442 %*                                                      *
443 %*********************************************************
444
445 \begin{code}
446 andInteger :: Integer -> Integer -> Integer
447 (S# x) `andInteger` (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
448 x@(S# _) `andInteger` y = toBig x `andInteger` y
449 x `andInteger` y@(S# _) = x `andInteger` toBig y
450 (J# s1 d1) `andInteger` (J# s2 d2) =
451      case andInteger# s1 d1 s2 d2 of
452        (# s, d #) -> J# s d
453
454 orInteger :: Integer -> Integer -> Integer
455 (S# x) `orInteger` (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
456 x@(S# _) `orInteger` y = toBig x `orInteger` y
457 x `orInteger` y@(S# _) = x `orInteger` toBig y
458 (J# s1 d1) `orInteger` (J# s2 d2) =
459      case orInteger# s1 d1 s2 d2 of
460        (# s, d #) -> J# s d
461
462 xorInteger :: Integer -> Integer -> Integer
463 (S# x) `xorInteger` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
464 x@(S# _) `xorInteger` y = toBig x `xorInteger` y
465 x `xorInteger` y@(S# _) = x `xorInteger` toBig y
466 (J# s1 d1) `xorInteger` (J# s2 d2) =
467      case xorInteger# s1 d1 s2 d2 of
468        (# s, d #) -> J# s d
469
470 complementInteger :: Integer -> Integer
471 complementInteger (S# x)
472     = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
473 complementInteger (J# s d)
474     = case complementInteger# s d of (# s', d' #) -> J# s' d'
475 \end{code}
476
477 %*********************************************************
478 %*                                                      *
479 \subsection{The @Integer@ hashing@}
480 %*                                                      *
481 %*********************************************************
482
483 \begin{code}
484 -- This is used by hashUnique
485
486 hashInteger :: Integer -> Int#
487 hashInteger (S# i) = i
488 hashInteger (J# s d) = if s ==# 0#
489                        then 0#
490                        else indexIntArray# d 0#
491 \end{code}
492