fe4be9299f7f9a44d79331bceca0ca1ef391a969
[ghc.git] / libraries / integer-gmp / GHC / Integer / Type.lhs
1 \begin{code}
2 {-# LANGUAGE BangPatterns, CPP, UnboxedTuples, UnliftedFFITypes, MagicHash, NoImplicitPrelude #-}
3 {-# OPTIONS_HADDOCK hide #-}
4
5 -- Commentary of Integer library is located on the wiki:
6 -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer
7 --
8 -- It gives an in-depth description of implementation details and
9 -- decisions.
10
11 #include "MachDeps.h"
12 #if SIZEOF_HSWORD == 4
13 #define INT_MINBOUND (-2147483648#)
14 #define NEG_INT_MINBOUND (S# 2147483647# `plusInteger` S# 1#)
15 #elif SIZEOF_HSWORD == 8
16 #define INT_MINBOUND (-9223372036854775808#)
17 #define NEG_INT_MINBOUND (S# 9223372036854775807# `plusInteger` S# 1#)
18 #else
19 #error Unknown SIZEOF_HSWORD; can't define INT_MINBOUND and NEG_INT_MINBOUND
20 #endif
21
22 module GHC.Integer.Type where
23
24 import GHC.Prim (
25     -- Other types we use, convert from, or convert to
26     Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#,
27     indexIntArray#,
28     -- Conversions between those types
29     int2Word#, int2Double#, int2Float#, word2Int#,
30     -- Operations on Int# that we use for operations on S#
31     quotInt#, remInt#, quotRemInt#, negateInt#,
32     (*#), (-#),
33     (==#), (/=#), (<=#), (>=#), (<#), (>#),
34     mulIntMayOflo#, addIntC#, subIntC#,
35     and#, or#, xor#,
36  )
37
38 import GHC.Integer.GMP.Prim (
39     -- GMP-related primitives
40     MPZ#,
41     cmpInteger#, cmpIntegerInt#,
42     plusInteger#, plusIntegerInt#, minusInteger#, minusIntegerInt#,
43     timesInteger#, timesIntegerInt#,
44     quotRemInteger#, quotRemIntegerWord#,
45     quotInteger#, quotIntegerWord#, remInteger#, remIntegerWord#,
46     divModInteger#, divModIntegerWord#,
47     divInteger#, divIntegerWord#, modInteger#, modIntegerWord#,
48     divExactInteger#, divExactIntegerWord#,
49     gcdInteger#, gcdExtInteger#, gcdIntegerInt#, gcdInt#,
50     decodeDouble#,
51     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
52     andInteger#, orInteger#, xorInteger#, complementInteger#,
53     testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#,
54     powInteger#, powModInteger#, powModSecInteger#, recipModInteger#,
55     nextPrimeInteger#, testPrimeInteger#,
56     sizeInBaseInteger#,
57     importIntegerFromByteArray#, importIntegerFromAddr#,
58     exportIntegerToMutableByteArray#, exportIntegerToAddr#,
59 #if WORD_SIZE_IN_BITS < 64
60     int64ToInteger#,  integerToInt64#,
61     word64ToInteger#, integerToWord64#,
62 #endif
63  )
64
65 #if WORD_SIZE_IN_BITS < 64
66 import GHC.IntWord64 (
67             Int64#, Word64#,
68             int64ToWord64#, intToInt64#,
69             int64ToInt#, word64ToInt64#,
70             geInt64#, leInt64#, leWord64#,
71        )
72 #endif
73
74 import GHC.Classes
75 import GHC.Types
76
77 default ()
78 \end{code}
79
80 %*********************************************************
81 %*                                                      *
82 \subsection{The @Integer@ type}
83 %*                                                      *
84 %*********************************************************
85
86 Convenient boxed Integer PrimOps.
87
88 \begin{code}
89 -- | Arbitrary-precision integers.
90 data Integer
91    = S# Int#                            -- small integers
92    | J# Int# ByteArray#                 -- large integers
93
94 mkInteger :: Bool   -- non-negative?
95           -> [Int]  -- absolute value in 31 bit chunks, least significant first
96                     -- ideally these would be Words rather than Ints, but
97                     -- we don't have Word available at the moment.
98           -> Integer
99 mkInteger nonNegative is = let abs = f is
100                            in if nonNegative then abs else negateInteger abs
101     where f [] = S# 0#
102           f (I# i : is') = S# i `orInteger` shiftLInteger (f is') 31#
103
104 {-# NOINLINE smallInteger #-}
105 smallInteger :: Int# -> Integer
106 smallInteger i = S# i
107
108 {-# NOINLINE wordToInteger #-}
109 wordToInteger :: Word# -> Integer
110 wordToInteger w = if isTrue# (i >=# 0#)
111                   then S# i
112                   else case word2Integer# w of (# s, d #) -> J# s d
113     where
114       !i = word2Int# w
115
116 {-# NOINLINE integerToWord #-}
117 integerToWord :: Integer -> Word#
118 integerToWord (S# i) = int2Word# i
119 integerToWord (J# s d) = integer2Word# s d
120
121 #if WORD_SIZE_IN_BITS < 64
122 {-# NOINLINE integerToWord64 #-}
123 integerToWord64 :: Integer -> Word64#
124 integerToWord64 (S# i) = int64ToWord64# (intToInt64# i)
125 integerToWord64 (J# s d) = integerToWord64# s d
126
127 {-# NOINLINE word64ToInteger #-}
128 word64ToInteger :: Word64# -> Integer
129 word64ToInteger w = if isTrue# (w `leWord64#` int64ToWord64# (intToInt64# 0x7FFFFFFF#))
130                     then S# (int64ToInt# (word64ToInt64# w))
131                     else case word64ToInteger# w of
132                          (# s, d #) -> J# s d
133
134 {-# NOINLINE integerToInt64 #-}
135 integerToInt64 :: Integer -> Int64#
136 integerToInt64 (S# i) = intToInt64# i
137 integerToInt64 (J# s d) = integerToInt64# s d
138
139 {-# NOINLINE int64ToInteger #-}
140 int64ToInteger :: Int64# -> Integer
141 int64ToInteger i = if isTrue# (i `leInt64#` intToInt64# 0x7FFFFFFF#) &&
142                       isTrue# (i `geInt64#` intToInt64# -0x80000000#)
143                    then smallInteger (int64ToInt# i)
144                    else case int64ToInteger# i of
145                         (# s, d #) -> J# s d
146 #endif
147
148 integerToInt :: Integer -> Int#
149 {-# NOINLINE integerToInt #-}
150 integerToInt (S# i)   = i
151 integerToInt (J# s d) = integer2Int# s d
152
153 -- This manually floated out constant is needed as GHC doesn't do it on its own
154 minIntAsBig :: Integer
155 minIntAsBig = case int2Integer# INT_MINBOUND of { (# s, d #) -> J# s d }
156
157 -- | Promote 'S#' to 'J#'
158 toBig :: Integer -> Integer
159 toBig (S# i)     = case int2Integer# i of { (# s, d #) -> J# s d }
160 toBig i@(J# _ _) = i
161
162 -- | Demote 'J#' to 'S#' if possible. See also 'smartJ#'.
163 toSmall :: Integer -> Integer
164 toSmall i@(S# _)    = i
165 toSmall (J# s# mb#) = smartJ# s# mb#
166
167
168 -- | Smart 'J#' constructor which tries to construct 'S#' if possible
169 smartJ# :: Int# -> ByteArray# -> Integer
170 smartJ# 0# _ = S# 0#
171 smartJ# 1# mb#  | isTrue# (v ># 0#) = S# v
172     where
173       v = indexIntArray# mb# 0#
174 smartJ# (-1#) mb# | isTrue# (v <# 0#) = S# v
175     where
176       v = negateInt# (indexIntArray# mb# 0#)
177 smartJ# s# mb# = J# s# mb#
178
179 -- |Construct 'Integer' out of a 'MPZ#' as returned by GMP wrapper primops
180 --
181 -- IMPORTANT: The 'ByteArray#' element MUST NOT be accessed unless the
182 -- size-element indicates more than one limb!
183 --
184 -- See notes at definition site of 'MPZ#' in "GHC.Integer.GMP.Prim"
185 -- for more details.
186 mpzToInteger :: MPZ# -> Integer
187 mpzToInteger (# 0#, _, _ #) = S# 0#
188 mpzToInteger (# 1#, _, w# #) | isTrue# (v# >=# 0#) = S# v#
189                              | True = case word2Integer# w# of (# _, d #) -> J# 1# d
190     where
191       v# = word2Int# w#
192 mpzToInteger (# -1#, _, w# #) | isTrue# (v# <=# 0#) = S# v#
193                               | True = case word2Integer# w# of (# _, d #) -> J# -1# d
194     where
195       v# = negateInt# (word2Int# w#)
196 mpzToInteger (# s#, mb#, _ #) = J# s# mb#
197
198 -- | Variant of 'mpzToInteger' for pairs of 'Integer's
199 mpzToInteger2 :: (# MPZ#, MPZ# #) -> (# Integer, Integer #)
200 mpzToInteger2 (# mpz1, mpz2 #) = (# i1, i2 #)
201     where
202       !i1 = mpzToInteger mpz1 -- This use of `!` avoids creating thunks,
203       !i2 = mpzToInteger mpz2 -- see also Note [Use S# if possible].
204
205 -- |Negate MPZ#
206 mpzNeg :: MPZ# -> MPZ#
207 mpzNeg (# s#, mb#, w# #) = (# negateInt# s#, mb#, w# #)
208
209 \end{code}
210
211 Note [Use S# if possible]
212 ~~~~~~~~~~~~~~~~~~~~~~~~~
213 It's a big win to use S#, rather than J#, whenever possible.  Not only
214 does it take less space, but (probably more important) subsequent
215 operations are more efficient. See Trac #8638.
216
217 'smartJ#' is the smart constructor for J# that performs the necessary
218 tests.  When returning a nested result, we always use smartJ# strictly,
219 thus
220        let !r = smartJ# a b in (# r, somthing_else #)
221 to avoid creating a thunk that is subsequently evaluated to a J#.
222 smartJ# itself does a pretty small amount of work, so it's not worth
223 thunking it.
224
225 We call 'smartJ#' in places like quotRemInteger where a big input
226 might produce a small output.
227
228 Just using smartJ# in this way has good results:
229
230         Program           Size    Allocs   Runtime   Elapsed  TotalMem
231 --------------------------------------------------------------------------------
232          gamteb          +0.1%    -19.0%      0.03      0.03     +0.0%
233           kahan          +0.2%     -1.2%      0.17      0.17     +0.0%
234          mandel          +0.1%     -7.7%      0.05      0.05     +0.0%
235           power          +0.1%    -40.8%    -32.5%    -32.5%     +0.0%
236          symalg          +0.2%     -0.5%      0.01      0.01     +0.0%
237 --------------------------------------------------------------------------------
238             Min          +0.0%    -40.8%    -32.5%    -32.5%     -5.1%
239             Max          +0.2%     +0.1%     +2.0%     +2.0%     +0.0%
240  Geometric Mean          +0.1%     -1.0%     -2.5%     -2.5%     -0.1%
241
242 %*********************************************************
243 %*                                                      *
244 \subsection{Dividing @Integers@}
245 %*                                                      *
246 %*********************************************************
247
248 \begin{code}
249 -- XXX There's no good reason for us using unboxed tuples for the
250 -- results, but we don't have Data.Tuple available.
251
252 -- Note that we don't check for divide-by-zero here. That needs
253 -- to be done where it's used.
254 -- (we don't have error)
255
256 {-# NOINLINE quotRemInteger #-}
257 quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
258 quotRemInteger (S# INT_MINBOUND) b = quotRemInteger minIntAsBig b
259 quotRemInteger (S# i) (S# j) = case quotRemInt# i j of
260                                    (# q, r #) -> (# S# q, S# r #)
261 quotRemInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#)
262   = case quotRemIntegerWord# s1 d1 (int2Word# (negateInt# b)) of
263           (# q, r #) -> let !q' = mpzToInteger(mpzNeg q)
264                             !r' = mpzToInteger(mpzNeg r)
265                         in (# q', r' #)
266 quotRemInteger (J# s1 d1) (S# b)
267   = mpzToInteger2(quotRemIntegerWord# s1 d1 (int2Word# b))
268 quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
269 quotRemInteger (J# s1 d1) (J# s2 d2)
270   = mpzToInteger2(quotRemInteger# s1 d1 s2 d2) -- See Note [Use S# if possible]
271
272 {-# NOINLINE divModInteger #-}
273 divModInteger :: Integer -> Integer -> (# Integer, Integer #)
274 divModInteger (S# INT_MINBOUND) b = divModInteger minIntAsBig b
275 divModInteger (S# i) (S# j) = (# S# d, S# m #)
276     where
277       -- NB. don't inline these.  (# S# (i `quotInt#` j), ... #) means
278       -- (# let q = i `quotInt#` j in S# q, ... #) which builds a
279       -- useless thunk.  Placing the bindings here means they'll be
280       -- evaluated strictly.
281       !d = i `divInt#` j
282       !m = i `modInt#` j
283 divModInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#)
284   = case divModIntegerWord# (negateInt# s1) d1 (int2Word# (negateInt# b)) of
285           (# q, r #) -> let !q' = mpzToInteger (mpzNeg q)
286                             !r' = mpzToInteger r
287                         in (# q', r' #)
288 divModInteger (J# s1 d1) (S# b)
289   = mpzToInteger2(divModIntegerWord# s1 d1 (int2Word# b))
290 divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
291 divModInteger (J# s1 d1) (J# s2 d2) = mpzToInteger2 (divModInteger# s1 d1 s2 d2)
292
293 {-# NOINLINE remInteger #-}
294 remInteger :: Integer -> Integer -> Integer
295 remInteger (S# INT_MINBOUND) b = remInteger minIntAsBig b
296 remInteger (S# a) (S# b) = S# (remInt# a b)
297 {- Special case doesn't work, because a 1-element J# has the range
298    -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
299 remInteger ia@(S# a) (J# sb b)
300   | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
301   | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
302   | 0# <# sb   = ia
303   | otherwise  = S# (0# -# a)
304 -}
305 remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
306 remInteger (J# sa a) (S# b)
307   = mpzToInteger (remIntegerWord# sa a w)
308   where
309     w = int2Word# (if isTrue# (b <# 0#) then negateInt# b else b)
310 remInteger (J# sa a) (J# sb b)
311   = mpzToInteger (remInteger# sa a sb b)
312
313 {-# NOINLINE quotInteger #-}
314 quotInteger :: Integer -> Integer -> Integer
315 quotInteger (S# INT_MINBOUND) b = quotInteger minIntAsBig b
316 quotInteger (S# a) (S# b) = S# (quotInt# a b)
317 {- Special case disabled, see remInteger above
318 quotInteger (S# a) (J# sb b)
319   | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
320   | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
321   | otherwise  = S# 0
322 -}
323 quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
324 quotInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
325   = mpzToInteger (mpzNeg (quotIntegerWord# sa a (int2Word# (negateInt# b))))
326 quotInteger (J# sa a) (S# b)
327   = mpzToInteger (quotIntegerWord# sa a (int2Word# b))
328 quotInteger (J# sa a) (J# sb b)
329   = mpzToInteger (quotInteger# sa a sb b)
330
331 {-# NOINLINE modInteger #-}
332 modInteger :: Integer -> Integer -> Integer
333 modInteger (S# INT_MINBOUND) b = modInteger minIntAsBig b
334 modInteger (S# a) (S# b) = S# (modInt# a b)
335 modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib
336 modInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
337   = mpzToInteger (mpzNeg (remIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b))))
338 modInteger (J# sa a) (S# b)
339   = mpzToInteger (modIntegerWord# sa a (int2Word# b))
340 modInteger (J# sa a) (J# sb b)
341   = mpzToInteger (modInteger# sa a sb b)
342
343 {-# NOINLINE divInteger #-}
344 divInteger :: Integer -> Integer -> Integer
345 divInteger (S# INT_MINBOUND) b = divInteger minIntAsBig b
346 divInteger (S# a) (S# b) = S# (divInt# a b)
347 divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib
348 divInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
349   = mpzToInteger (divIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))
350 divInteger (J# sa a) (S# b)
351   = mpzToInteger (divIntegerWord# sa a (int2Word# b))
352 divInteger (J# sa a) (J# sb b)
353   = mpzToInteger (divInteger# sa a sb b)
354 \end{code}
355
356
357
358 \begin{code}
359 -- | Compute greatest common divisor.
360 {-# NOINLINE gcdInteger #-}
361 gcdInteger :: Integer -> Integer -> Integer
362 -- SUP: Do we really need the first two cases?
363 gcdInteger (S# INT_MINBOUND) b = gcdInteger minIntAsBig b
364 gcdInteger a (S# INT_MINBOUND) = gcdInteger a minIntAsBig
365 gcdInteger (S# a) (S# b) = S# (gcdInt a b)
366 gcdInteger ia@(S# a)  ib@(J# sb b)
367  =      if isTrue# (a  ==# 0#) then absInteger ib
368    else if isTrue# (sb ==# 0#) then absInteger ia
369    else                             S# (gcdIntegerInt# absSb b absA)
370        where !absA  = if isTrue# (a  <# 0#) then negateInt# a  else a
371              !absSb = if isTrue# (sb <# 0#) then negateInt# sb else sb
372 gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
373 gcdInteger (J# sa a) (J# sb b)   = mpzToInteger (gcdInteger# sa a sb b)
374
375 -- | Extended euclidean algorithm.
376 --
377 -- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@
378 -- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.
379 {-# NOINLINE gcdExtInteger #-}
380 gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
381 gcdExtInteger a@(S# _)   b@(S# _) = gcdExtInteger (toBig a) (toBig b)
382 gcdExtInteger a@(S# _) b@(J# _ _) = gcdExtInteger (toBig a) b
383 gcdExtInteger a@(J# _ _) b@(S# _) = gcdExtInteger a (toBig b)
384 gcdExtInteger (J# sa a) (J# sb b) = mpzToInteger2 (gcdExtInteger# sa a sb b)
385
386 -- | Compute least common multiple.
387 {-# NOINLINE lcmInteger #-}
388 lcmInteger :: Integer -> Integer -> Integer
389 lcmInteger a b =      if a `eqInteger` S# 0# then S# 0#
390                  else if b `eqInteger` S# 0# then S# 0#
391                  else (divExact aa (gcdInteger aa ab)) `timesInteger` ab
392   where aa = absInteger a
393         ab = absInteger b
394
395 -- | Compute greatest common divisor.
396 gcdInt :: Int# -> Int# -> Int#
397 gcdInt 0# y  = absInt y
398 gcdInt x  0# = absInt x
399 gcdInt x  y  = gcdInt# (absInt x) (absInt y)
400
401 absInt :: Int# -> Int#
402 absInt x = if isTrue# (x <# 0#) then negateInt# x else x
403
404 divExact :: Integer -> Integer -> Integer
405 divExact (S# INT_MINBOUND) b = divExact minIntAsBig b
406 divExact (S# a) (S# b) = S# (quotInt# a b)
407 divExact (S# a) (J# sb b)
408   = S# (quotInt# a (integer2Int# sb b))
409 divExact (J# sa a) (S# b) | isTrue# (b <# 0#)
410   = mpzToInteger (divExactIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))
411 divExact (J# sa a) (S# b) = mpzToInteger (divExactIntegerWord# sa a (int2Word# b))
412 divExact (J# sa a) (J# sb b) = mpzToInteger (divExactInteger# sa a sb b)
413 \end{code}
414
415
416 %*********************************************************
417 %*                                                      *
418 \subsection{The @Integer@ instances for @Eq@, @Ord@}
419 %*                                                      *
420 %*********************************************************
421
422 \begin{code}
423 {-# NOINLINE eqInteger# #-}
424 eqInteger# :: Integer -> Integer -> Int#
425 eqInteger# (S# i)     (S# j)     = i ==# j
426 eqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ==# 0#
427 eqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ==# 0#
428 eqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
429
430 {-# NOINLINE neqInteger# #-}
431 neqInteger# :: Integer -> Integer -> Int#
432 neqInteger# (S# i)     (S# j)     = i /=# j
433 neqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i /=# 0#
434 neqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i /=# 0#
435 neqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
436
437 {-# INLINE eqInteger  #-}
438 {-# INLINE neqInteger #-}
439 eqInteger, neqInteger :: Integer -> Integer -> Bool
440 eqInteger  a b = isTrue# (a `eqInteger#`  b)
441 neqInteger a b = isTrue# (a `neqInteger#` b)
442
443 instance  Eq Integer  where
444     (==) = eqInteger
445     (/=) = neqInteger
446
447 ------------------------------------------------------------------------
448
449 {-# NOINLINE leInteger# #-}
450 leInteger# :: Integer -> Integer -> Int#
451 leInteger# (S# i)     (S# j)     = i <=# j
452 leInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <=# 0#
453 leInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i >=# 0#
454 leInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
455
456 {-# NOINLINE gtInteger# #-}
457 gtInteger# :: Integer -> Integer -> Int#
458 gtInteger# (S# i)     (S# j)     = i ># j
459 gtInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ># 0#
460 gtInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <# 0#
461 gtInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
462
463 {-# NOINLINE ltInteger# #-}
464 ltInteger# :: Integer -> Integer -> Int#
465 ltInteger# (S# i)     (S# j)     = i <# j
466 ltInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <# 0#
467 ltInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ># 0#
468 ltInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
469
470 {-# NOINLINE geInteger# #-}
471 geInteger# :: Integer -> Integer -> Int#
472 geInteger# (S# i)     (S# j)     = i >=# j
473 geInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i >=# 0#
474 geInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <=# 0#
475 geInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
476
477 {-# INLINE leInteger #-}
478 {-# INLINE ltInteger #-}
479 {-# INLINE geInteger #-}
480 {-# INLINE gtInteger #-}
481 leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
482 leInteger a b = isTrue# (a `leInteger#` b)
483 gtInteger a b = isTrue# (a `gtInteger#` b)
484 ltInteger a b = isTrue# (a `ltInteger#` b)
485 geInteger a b = isTrue# (a `geInteger#` b)
486
487 {-# NOINLINE compareInteger #-}
488 compareInteger :: Integer -> Integer -> Ordering
489 compareInteger (S# i)  (S# j)
490    =      if isTrue# (i ==# j) then EQ
491      else if isTrue# (i <=# j) then LT
492      else                           GT
493 compareInteger (J# s d) (S# i)
494    = case cmpIntegerInt# s d i of { res# ->
495      if isTrue# (res# <# 0#) then LT else
496      if isTrue# (res# ># 0#) then GT else EQ
497      }
498 compareInteger (S# i) (J# s d)
499    = case cmpIntegerInt# s d i of { res# ->
500      if isTrue# (res# ># 0#) then LT else
501      if isTrue# (res# <# 0#) then GT else EQ
502      }
503 compareInteger (J# s1 d1) (J# s2 d2)
504    = case cmpInteger# s1 d1 s2 d2 of { res# ->
505      if isTrue# (res# <# 0#) then LT else
506      if isTrue# (res# ># 0#) then GT else EQ
507      }
508
509 instance Ord Integer where
510     (<=) = leInteger
511     (<)  = ltInteger
512     (>)  = gtInteger
513     (>=) = geInteger
514     compare = compareInteger
515 \end{code}
516
517
518 %*********************************************************
519 %*                                                      *
520 \subsection{The @Integer@ instances for @Num@}
521 %*                                                      *
522 %*********************************************************
523
524 \begin{code}
525 {-# NOINLINE absInteger #-}
526 absInteger :: Integer -> Integer
527 absInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
528 absInteger n@(S# i)   = if isTrue# (i >=# 0#) then n else S# (negateInt# i)
529 absInteger n@(J# s d) = if isTrue# (s >=# 0#) then n else J# (negateInt# s) d
530
531 {-# NOINLINE signumInteger #-}
532 signumInteger :: Integer -> Integer
533 signumInteger (S# i) = if isTrue# (i <# 0#) then S# -1#
534                        else if isTrue# (i ==# 0#) then S# 0#
535                        else S# 1#
536 signumInteger (J# s d)
537   = let
538         !cmp = cmpIntegerInt# s d 0#
539     in
540     if      isTrue# (cmp >#  0#) then S# 1#
541     else if isTrue# (cmp ==# 0#) then S# 0#
542     else                              S# (negateInt# 1#)
543
544 {-# NOINLINE plusInteger #-}
545 plusInteger :: Integer -> Integer -> Integer
546 plusInteger (S# i)      (S# j)   = case addIntC# i j of
547                                    (# r, c #) ->
548                                        if isTrue# (c ==# 0#)
549                                        then S# r
550                                        else case int2Integer# i of
551                                             (# s, d #) -> mpzToInteger (plusIntegerInt# s d j)
552 plusInteger i1@(J# _ _) (S# 0#)   = i1
553 plusInteger (J# s1 d1)  (S# j)    = mpzToInteger (plusIntegerInt# s1 d1 j)
554 plusInteger i1@(S# _) i2@(J# _ _) = plusInteger i2 i1
555 plusInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (plusInteger# s1 d1 s2 d2)
556
557 {-# NOINLINE minusInteger #-}
558 minusInteger :: Integer -> Integer -> Integer
559 minusInteger (S# i)      (S# j)    = case subIntC# i j of
560                                      (# r, c #) ->
561                                          if isTrue# (c ==# 0#) then S# r
562                                          else case int2Integer# i of
563                                               (# s, d #) -> mpzToInteger (minusIntegerInt# s d j)
564 minusInteger i1@(J# _ _) (S# 0#)   = i1
565 minusInteger (J# s1 d1)  (S# j)    = mpzToInteger (minusIntegerInt# s1 d1 j)
566 minusInteger (S# 0#)    (J# s2 d2) = J# (negateInt# s2) d2
567 minusInteger (S# i)     (J# s2 d2) = mpzToInteger (plusIntegerInt# (negateInt# s2) d2 i)
568 minusInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (minusInteger# s1 d1 s2 d2)
569
570 {-# NOINLINE timesInteger #-}
571 timesInteger :: Integer -> Integer -> Integer
572 timesInteger (S# i) (S# j)         = if isTrue# (mulIntMayOflo# i j ==# 0#)
573                                      then S# (i *# j)
574                                      else case int2Integer# i of
575                                           (# s, d #) -> mpzToInteger (timesIntegerInt# s d j)
576 timesInteger (S# 0#)     _         = S# 0#
577 timesInteger (S# -1#)    i2        = negateInteger i2
578 timesInteger (S# 1#)     i2        = i2
579 timesInteger (S# i1)    (J# s2 d2) = mpzToInteger (timesIntegerInt# s2 d2 i1)
580 timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i2 i1 -- swap args & retry
581 timesInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (timesInteger# s1 d1 s2 d2)
582
583 {-# NOINLINE negateInteger #-}
584 negateInteger :: Integer -> Integer
585 negateInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
586 negateInteger (S# i)            = S# (negateInt# i)
587 negateInteger (J# s d)          = J# (negateInt# s) d
588 \end{code}
589
590
591 %*********************************************************
592 %*                                                      *
593 \subsection{The @Integer@ stuff for Double@}
594 %*                                                      *
595 %*********************************************************
596
597 \begin{code}
598 {-# NOINLINE encodeFloatInteger #-}
599 encodeFloatInteger :: Integer -> Int# -> Float#
600 encodeFloatInteger (S# i) j     = int_encodeFloat# i j
601 encodeFloatInteger (J# s# d#) e = encodeFloat# s# d# e
602
603 {-# NOINLINE encodeDoubleInteger #-}
604 encodeDoubleInteger :: Integer -> Int# -> Double#
605 encodeDoubleInteger (S# i) j     = int_encodeDouble# i j
606 encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e
607
608 {-# NOINLINE decodeDoubleInteger #-}
609 decodeDoubleInteger :: Double# -> (# Integer, Int# #)
610 decodeDoubleInteger d = case decodeDouble# d of
611                         (# exp#, man# #) -> let !man = mpzToInteger man#
612                                             in (# man, exp# #)
613
614 -- previous code: doubleFromInteger n = fromInteger n = encodeFloat n 0
615 -- doesn't work too well, because encodeFloat is defined in
616 -- terms of ccalls which can never be simplified away.  We
617 -- want simple literals like (fromInteger 3 :: Float) to turn
618 -- into (F# 3.0), hence the special case for S# here.
619
620 {-# NOINLINE doubleFromInteger #-}
621 doubleFromInteger :: Integer -> Double#
622 doubleFromInteger (S# i#) = int2Double# i#
623 doubleFromInteger (J# s# d#) = encodeDouble# s# d# 0#
624
625 {-# NOINLINE floatFromInteger #-}
626 floatFromInteger :: Integer -> Float#
627 floatFromInteger (S# i#) = int2Float# i#
628 floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
629
630 foreign import ccall unsafe "integer_cbits_encodeFloat"
631         encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
632 foreign import ccall unsafe "__int_encodeFloat"
633         int_encodeFloat# :: Int# -> Int# -> Float#
634
635 foreign import ccall unsafe "integer_cbits_encodeDouble"
636         encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
637 foreign import ccall unsafe "__int_encodeDouble"
638         int_encodeDouble# :: Int# -> Int# -> Double#
639 \end{code}
640
641 %*********************************************************
642 %*                                                      *
643 \subsection{The @Integer@ Bit definitions@}
644 %*                                                      *
645 %*********************************************************
646
647 We explicitly pattern match against J# and S# in order to produce
648 Core that doesn't have pattern matching errors, as that would
649 introduce a spurious dependency to base.
650
651 \begin{code}
652 {-# NOINLINE andInteger #-}
653 andInteger :: Integer -> Integer -> Integer
654 (S# x)     `andInteger`   (S# y)     = S# (word2Int# (int2Word# x `and#` int2Word# y))
655 x@(S# _)   `andInteger` y@(J# _ _)   = toBig x `andInteger` y
656 x@(J# _ _) `andInteger` y@(S# _)     = x `andInteger` toBig y
657 (J# s1 d1) `andInteger`   (J# s2 d2) =
658      mpzToInteger (andInteger# s1 d1 s2 d2)
659
660 {-# NOINLINE orInteger #-}
661 orInteger :: Integer -> Integer -> Integer
662 (S# x)     `orInteger`   (S# y)     = S# (word2Int# (int2Word# x `or#` int2Word# y))
663 x@(S# _)   `orInteger` y@(J# _ _)   = toBig x `orInteger` y
664 x@(J# _ _) `orInteger` y@(S# _)     = x `orInteger` toBig y
665 (J# s1 d1) `orInteger`   (J# s2 d2) =
666      mpzToInteger (orInteger# s1 d1 s2 d2)
667
668 {-# NOINLINE xorInteger #-}
669 xorInteger :: Integer -> Integer -> Integer
670 (S# x)     `xorInteger`   (S# y)     = S# (word2Int# (int2Word# x `xor#` int2Word# y))
671 x@(S# _)   `xorInteger` y@(J# _ _)   = toBig x `xorInteger` y
672 x@(J# _ _) `xorInteger` y@(S# _)     = x `xorInteger` toBig y
673 (J# s1 d1) `xorInteger`   (J# s2 d2) =
674      mpzToInteger (xorInteger# s1 d1 s2 d2)
675
676 {-# NOINLINE complementInteger #-}
677 complementInteger :: Integer -> Integer
678 complementInteger (S# x)
679     = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
680 complementInteger (J# s d)
681     = mpzToInteger (complementInteger# s d)
682
683 {-# NOINLINE shiftLInteger #-}
684 shiftLInteger :: Integer -> Int# -> Integer
685 shiftLInteger j@(S# _) i = shiftLInteger (toBig j) i
686 shiftLInteger (J# s d) i = mpzToInteger (mul2ExpInteger# s d i)
687
688 {-# NOINLINE shiftRInteger #-}
689 shiftRInteger :: Integer -> Int# -> Integer
690 shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i
691 shiftRInteger (J# s d) i = mpzToInteger (fdivQ2ExpInteger# s d i)
692
693 {-# NOINLINE testBitInteger #-}
694 testBitInteger :: Integer -> Int# -> Bool
695 testBitInteger j@(S# _) i = testBitInteger (toBig j) i
696 testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#)
697
698 -- | \"@'powInteger' /b/ /e/@\" computes base @/b/@ raised to exponent @/e/@.
699 {-# NOINLINE powInteger #-}
700 powInteger :: Integer -> Word# -> Integer
701 powInteger j@(S# _) e = powInteger (toBig j) e
702 powInteger (J# s d) e = mpzToInteger (powInteger# s d e)
703
704 -- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
705 -- exponent @/e/@ modulo @/m/@.
706 --
707 -- Negative exponents are supported if an inverse modulo @/m/@
708 -- exists. It's advised to avoid calling this primitive with negative
709 -- exponents unless it is guaranteed the inverse exists, as failure to
710 -- do so will likely cause program abortion due to a divide-by-zero
711 -- fault. See also 'recipModInteger'.
712 {-# NOINLINE powModInteger #-}
713 powModInteger :: Integer -> Integer -> Integer -> Integer
714 powModInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
715     mpzToInteger (powModInteger# s1 d1 s2 d2 s3 d3)
716 powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m)
717
718 -- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
719 -- exponent @/e/@ modulo @/m/@. It is required that @/e/ > 0@ and
720 -- @/m/@ is odd.
721 --
722 -- This is a \"secure\" variant of 'powModInteger' using the
723 -- @mpz_powm_sec()@ function which is designed to be resilient to side
724 -- channel attacks and is therefore intended for cryptographic
725 -- applications.
726 {-# NOINLINE powModSecInteger #-}
727 powModSecInteger :: Integer -> Integer -> Integer -> Integer
728 powModSecInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
729     mpzToInteger (powModSecInteger# s1 d1 s2 d2 s3 d3)
730 powModSecInteger b e m = powModSecInteger (toBig b) (toBig e) (toBig m)
731
732 -- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If
733 -- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <
734 -- abs(/m/)@, otherwise the result is @0@.
735 --
736 -- Note: The implementation exploits the undocumented property of
737 -- @mpz_invert()@ to not mangle the result operand (which is initialized
738 -- to 0) in case of non-existence of the inverse.
739 {-# NOINLINE recipModInteger #-}
740 recipModInteger :: Integer -> Integer -> Integer
741 recipModInteger j@(S# _) m@(S# _)   = recipModInteger (toBig j) (toBig m)
742 recipModInteger j@(S# _) m@(J# _ _) = recipModInteger (toBig j) m
743 recipModInteger j@(J# _ _) m@(S# _) = recipModInteger j (toBig m)
744 recipModInteger (J# s d) (J# ms md) = mpzToInteger (recipModInteger# s d ms md)
745
746 -- | Probalistic Miller-Rabin primality test.
747 --
748 -- \"@'testPrimeInteger' /n/ /k/@\" determines whether @/n/@ is prime
749 -- and returns one of the following results:
750 --
751 -- * @2#@ is returned if @/n/@ is definitely prime,
752 --
753 -- * @1#@ if @/n/@ is a /probable prime/, or
754 --
755 -- * @0#@ if @/n/@ is definitely not a prime.
756 --
757 -- The @/k/@ argument controls how many test rounds are performed for
758 -- determining a /probable prime/. For more details, see
759 -- <http://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fprobab_005fprime_005fp-360 GMP documentation for `mpz_probab_prime_p()`>.
760 {-# NOINLINE testPrimeInteger #-}
761 testPrimeInteger :: Integer -> Int# -> Int#
762 testPrimeInteger j@(S# _) reps = testPrimeInteger (toBig j) reps
763 testPrimeInteger (J# s d) reps = testPrimeInteger# s d reps
764
765 -- | Compute next prime greater than @/n/@ probalistically.
766 --
767 -- According to the GMP documentation, the underlying function
768 -- @mpz_nextprime()@ \"uses a probabilistic algorithm to identify
769 -- primes. For practical purposes it's adequate, the chance of a
770 -- composite passing will be extremely small.\"
771 {-# NOINLINE nextPrimeInteger #-}
772 nextPrimeInteger :: Integer -> Integer
773 nextPrimeInteger j@(S# _) = nextPrimeInteger (toBig j)
774 nextPrimeInteger (J# s d) = mpzToInteger (nextPrimeInteger# s d)
775
776 -- | Compute number of digits (without sign) in given @/base/@.
777 --
778 -- It's recommended to avoid calling 'sizeInBaseInteger' for small
779 -- integers as this function would currently convert those to big
780 -- integers in order to call @mpz_sizeinbase()@.
781 --
782 -- This function wraps @mpz_sizeinbase()@ which has some
783 -- implementation pecularities to take into account:
784 --
785 -- * \"@'sizeInBaseInteger' 0 /base/ = 1@\" (see also comment in 'exportIntegerToMutableByteArray').
786 --
787 -- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@
788 --   (Note: the documentation claims that only @/base/ <= 62#@ is
789 --   supported, however the actual implementation supports up to base 256).
790 --
791 -- * If @/base/@ is a power of 2, the result will be exact. In other
792 --   cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large
793 --   sometimes.
794 --
795 -- * \"@'sizeInBaseInteger' /i/ 2#@\" can be used to determine the most
796 --   significant bit of @/i/@.
797 {-# NOINLINE sizeInBaseInteger #-}
798 sizeInBaseInteger :: Integer -> Int# -> Word#
799 sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b
800 sizeInBaseInteger j@(S# _) b = sizeInBaseInteger (toBig j) b -- TODO
801
802 -- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation.
803 --
804 -- The call
805 --
806 -- @
807 -- 'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /order/
808 -- @
809 --
810 -- writes
811 --
812 -- * the 'Integer' @/i/@
813 --
814 -- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@
815 --
816 -- * with most significant byte first if @order@ is @1#@ or least
817 --   significant byte first if @order@ is @-1#@, and
818 --
819 -- * returns number of bytes written.
820 --
821 -- Use \"@'sizeInBaseInteger' /i/ 256#@\" to compute the exact number of
822 -- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,
823 -- 'exportIntegerToMutableByteArray' will write and report zero bytes
824 -- written, whereas 'sizeInBaseInteger' report one byte.
825 --
826 -- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
827 -- integers as this function would currently convert those to big
828 -- integers in order to call @mpz_export()@.
829 {-# NOINLINE exportIntegerToMutableByteArray #-}
830 exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
831 exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e
832 exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO
833
834 -- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.
835 --
836 -- @
837 -- 'exportIntegerToAddr' /addr/ /o/ /e/
838 -- @
839 --
840 -- See description of 'exportIntegerToMutableByteArray' for more details.
841 {-# NOINLINE exportIntegerToAddr #-}
842 exportIntegerToAddr :: Integer -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
843 exportIntegerToAddr (J# s d) addr o e = exportIntegerToAddr# s d addr o e
844 exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e -- TODO
845
846 -- | Read 'Integer' (without sign) from byte-array in base-256 representation.
847 --
848 -- The call
849 --
850 -- @
851 -- 'importIntegerFromByteArray' /ba/ /offset/ /size/ /order/
852 -- @
853 --
854 -- reads
855 --
856 -- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@
857 --
858 -- * with most significant byte first if @/order/@ is @1#@ or least
859 --   significant byte first if @/order/@ is @-1#@, and
860 --
861 -- * returns a new 'Integer'
862 {-# NOINLINE importIntegerFromByteArray #-}
863 importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
864 importIntegerFromByteArray ba o l e = mpzToInteger (importIntegerFromByteArray# ba o l e)
865
866 -- | Read 'Integer' (without sign) from memory location at @/addr/@ in
867 -- base-256 representation.
868 --
869 -- @
870 -- 'importIntegerFromAddr' /addr/ /size/ /order/
871 -- @
872 --
873 -- See description of 'importIntegerFromByteArray' for more details.
874 {-# NOINLINE importIntegerFromAddr #-}
875 importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #)
876 importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of
877                                       (# st', mpz #) -> let !j = mpzToInteger mpz in (# st', j #)
878
879 \end{code}
880
881 %*********************************************************
882 %*                                                      *
883 \subsection{The @Integer@ hashing@}
884 %*                                                      *
885 %*********************************************************
886
887 \begin{code}
888 -- This is used by hashUnique
889
890 -- | hashInteger returns the same value as 'fromIntegral', although in
891 -- unboxed form.  It might be a reasonable hash function for 'Integer',
892 -- given a suitable distribution of 'Integer' values.
893
894 hashInteger :: Integer -> Int#
895 hashInteger = integerToInt
896 \end{code}
897