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