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