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