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