Add side-channel attack resilient `powModSecInteger`
[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#,
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 #if WORD_SIZE_IN_BITS < 64
50     int64ToInteger#,  integerToInt64#,
51     word64ToInteger#, integerToWord64#,
52 #endif
53  )
54
55 #if WORD_SIZE_IN_BITS < 64
56 import GHC.IntWord64 (
57             Int64#, Word64#,
58             int64ToWord64#, intToInt64#,
59             int64ToInt#, word64ToInt64#,
60             geInt64#, leInt64#, leWord64#,
61        )
62 #endif
63
64 import GHC.Classes
65 import GHC.Types
66
67 default ()
68 \end{code}
69
70 %*********************************************************
71 %*                                                      *
72 \subsection{The @Integer@ type}
73 %*                                                      *
74 %*********************************************************
75
76 Convenient boxed Integer PrimOps.
77
78 \begin{code}
79 -- | Arbitrary-precision integers.
80 data Integer
81    = S# Int#                            -- small integers
82    | J# Int# ByteArray#                 -- large integers
83
84 mkInteger :: Bool   -- non-negative?
85           -> [Int]  -- absolute value in 31 bit chunks, least significant first
86                     -- ideally these would be Words rather than Ints, but
87                     -- we don't have Word available at the moment.
88           -> Integer
89 mkInteger nonNegative is = let abs = f is
90                            in if nonNegative then abs else negateInteger abs
91     where f [] = S# 0#
92           f (I# i : is') = S# i `orInteger` shiftLInteger (f is') 31#
93
94 {-# NOINLINE smallInteger #-}
95 smallInteger :: Int# -> Integer
96 smallInteger i = S# i
97
98 {-# NOINLINE wordToInteger #-}
99 wordToInteger :: Word# -> Integer
100 wordToInteger w = case word2Integer# w of (# s, d #) -> J# s d
101
102 {-# NOINLINE integerToWord #-}
103 integerToWord :: Integer -> Word#
104 integerToWord (S# i) = int2Word# i
105 integerToWord (J# s d) = integer2Word# s d
106
107 #if WORD_SIZE_IN_BITS < 64
108 {-# NOINLINE integerToWord64 #-}
109 integerToWord64 :: Integer -> Word64#
110 integerToWord64 (S# i) = int64ToWord64# (intToInt64# i)
111 integerToWord64 (J# s d) = integerToWord64# s d
112
113 {-# NOINLINE word64ToInteger #-}
114 word64ToInteger :: Word64# -> Integer
115 word64ToInteger w = if isTrue# (w `leWord64#` int64ToWord64# (intToInt64# 0x7FFFFFFF#))
116                     then S# (int64ToInt# (word64ToInt64# w))
117                     else case word64ToInteger# w of
118                          (# s, d #) -> J# s d
119
120 {-# NOINLINE integerToInt64 #-}
121 integerToInt64 :: Integer -> Int64#
122 integerToInt64 (S# i) = intToInt64# i
123 integerToInt64 (J# s d) = integerToInt64# s d
124
125 {-# NOINLINE int64ToInteger #-}
126 int64ToInteger :: Int64# -> Integer
127 int64ToInteger i = if isTrue# (i `leInt64#` intToInt64# 0x7FFFFFFF#) &&
128                       isTrue# (i `geInt64#` intToInt64# -0x80000000#)
129                    then smallInteger (int64ToInt# i)
130                    else case int64ToInteger# i of
131                         (# s, d #) -> J# s d
132 #endif
133
134 integerToInt :: Integer -> Int#
135 {-# NOINLINE integerToInt #-}
136 integerToInt (S# i)   = i
137 integerToInt (J# s d) = integer2Int# s d
138
139 toBig :: Integer -> Integer
140 toBig (S# i)     = case int2Integer# i of { (# s, d #) -> J# s d }
141 toBig i@(J# _ _) = i
142 \end{code}
143
144
145 %*********************************************************
146 %*                                                      *
147 \subsection{Dividing @Integers@}
148 %*                                                      *
149 %*********************************************************
150
151 \begin{code}
152 -- XXX There's no good reason for us using unboxed tuples for the
153 -- results, but we don't have Data.Tuple available.
154
155 -- Note that we don't check for divide-by-zero here. That needs
156 -- to be done where it's used.
157 -- (we don't have error)
158
159 {-# NOINLINE quotRemInteger #-}
160 quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
161 quotRemInteger a@(S# INT_MINBOUND) b = quotRemInteger (toBig a) b
162 quotRemInteger (S# i) (S# j) = (# S# q, S# r #)
163     where
164       -- NB. don't inline these.  (# S# (i `quotInt#` j), ... #) means
165       -- (# let q = i `quotInt#` j in S# q, ... #) which builds a
166       -- useless thunk.  Placing the bindings here means they'll be
167       -- evaluated strictly.
168       !q = i `quotInt#` j
169       !r = i `remInt#`  j
170 quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
171 quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
172 quotRemInteger (J# s1 d1) (J# s2 d2)
173   = case (quotRemInteger# s1 d1 s2 d2) of
174           (# s3, d3, s4, d4 #)
175             -> (# J# s3 d3, J# s4 d4 #)
176
177 {-# NOINLINE divModInteger #-}
178 divModInteger :: Integer -> Integer -> (# Integer, Integer #)
179 divModInteger a@(S# INT_MINBOUND) b = divModInteger (toBig a) b
180 divModInteger (S# i) (S# j) = (# S# d, S# m #)
181     where
182       -- NB. don't inline these.  See quotRemInteger above.
183       !d = i `divInt#` j
184       !m = i `modInt#` j
185
186 divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
187 divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
188 divModInteger (J# s1 d1) (J# s2 d2)
189   = case (divModInteger# s1 d1 s2 d2) of
190           (# s3, d3, s4, d4 #)
191             -> (# J# s3 d3, J# s4 d4 #)
192
193 {-# NOINLINE remInteger #-}
194 remInteger :: Integer -> Integer -> Integer
195 remInteger a@(S# INT_MINBOUND) b = remInteger (toBig a) b
196 remInteger (S# a) (S# b) = S# (remInt# a b)
197 {- Special case doesn't work, because a 1-element J# has the range
198    -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
199 remInteger ia@(S# a) (J# sb b)
200   | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
201   | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
202   | 0# <# sb   = ia
203   | otherwise  = S# (0# -# a)
204 -}
205 remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
206 remInteger (J# sa a) (S# b)
207   = case int2Integer# b of { (# sb, b' #) ->
208     case remInteger# sa a sb b' of { (# sr, r #) ->
209     S# (integer2Int# sr r) }}
210 remInteger (J# sa a) (J# sb b)
211   = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
212
213 {-# NOINLINE quotInteger #-}
214 quotInteger :: Integer -> Integer -> Integer
215 quotInteger a@(S# INT_MINBOUND) b = quotInteger (toBig a) b
216 quotInteger (S# a) (S# b) = S# (quotInt# a b)
217 {- Special case disabled, see remInteger above
218 quotInteger (S# a) (J# sb b)
219   | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
220   | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
221   | otherwise  = S# 0
222 -}
223 quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
224 quotInteger (J# sa a) (S# b)
225   = case int2Integer# b of { (# sb, b' #) ->
226     case quotInteger# sa a sb b' of (# sq, q #) -> J# sq q }
227 quotInteger (J# sa a) (J# sb b)
228   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
229
230 {-# NOINLINE modInteger #-}
231 modInteger :: Integer -> Integer -> Integer
232 modInteger a@(S# INT_MINBOUND) b = modInteger (toBig a) b
233 modInteger (S# a) (S# b) = S# (modInt# a b)
234 modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib
235 modInteger (J# sa a) (S# b)
236   = case int2Integer# b of { (# sb, b' #) ->
237     case modInteger# sa a sb b' of { (# sr, r #) ->
238     S# (integer2Int# sr r) }}
239 modInteger (J# sa a) (J# sb b)
240   = case modInteger# sa a sb b of (# sr, r #) -> J# sr r
241
242 {-# NOINLINE divInteger #-}
243 divInteger :: Integer -> Integer -> Integer
244 divInteger a@(S# INT_MINBOUND) b = divInteger (toBig a) b
245 divInteger (S# a) (S# b) = S# (divInt# a b)
246 divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib
247 divInteger (J# sa a) (S# b)
248   = case int2Integer# b of { (# sb, b' #) ->
249     case divInteger# sa a sb b' of (# sq, q #) -> J# sq q }
250 divInteger (J# sa a) (J# sb b)
251   = case divInteger# sa a sb b of (# sg, g #) -> J# sg g
252 \end{code}
253
254
255
256 \begin{code}
257 -- We can't throw an error here, so it is up to our caller to
258 -- not call us with both arguments being 0.
259 {-# NOINLINE gcdInteger #-}
260 gcdInteger :: Integer -> Integer -> Integer
261 -- SUP: Do we really need the first two cases?
262 gcdInteger a@(S# INT_MINBOUND) b = gcdInteger (toBig a) b
263 gcdInteger a b@(S# INT_MINBOUND) = gcdInteger a (toBig b)
264 gcdInteger (S# a) (S# b) = S# (gcdInt a b)
265 gcdInteger ia@(S# a)  ib@(J# sb b)
266  =      if isTrue# (a  ==# 0#) then absInteger ib
267    else if isTrue# (sb ==# 0#) then absInteger ia
268    else                             S# (gcdIntegerInt# absSb b absA)
269        where !absA  = if isTrue# (a  <# 0#) then negateInt# a  else a
270              !absSb = if isTrue# (sb <# 0#) then negateInt# sb else sb
271 gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
272 gcdInteger (J# sa a) (J# sb b)
273   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
274
275 -- | For a and b, compute their greatest common divisor g and the
276 -- coefficient s satisfying @a*s + b*t = g@.
277 {-# NOINLINE gcdExtInteger #-}
278 gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
279 gcdExtInteger a@(S# _)   b@(S# _) = gcdExtInteger (toBig a) (toBig b)
280 gcdExtInteger a@(S# _) b@(J# _ _) = gcdExtInteger (toBig a) b
281 gcdExtInteger a@(J# _ _) b@(S# _) = gcdExtInteger a (toBig b)
282 gcdExtInteger (J# sa a) (J# sb b)
283   = case gcdExtInteger# sa a sb b of
284       (# sg, g, ss, s #) -> (# J# sg g, J# ss s #)
285
286 {-# NOINLINE lcmInteger #-}
287 lcmInteger :: Integer -> Integer -> Integer
288 lcmInteger a b =      if a `eqInteger` S# 0# then S# 0#
289                  else if b `eqInteger` S# 0# then S# 0#
290                  else (divExact aa (gcdInteger aa ab)) `timesInteger` ab
291   where aa = absInteger a
292         ab = absInteger b
293
294 gcdInt :: Int# -> Int# -> Int#
295 gcdInt 0# y  = absInt y
296 gcdInt x  0# = absInt x
297 gcdInt x  y  = gcdInt# (absInt x) (absInt y)
298
299 absInt :: Int# -> Int#
300 absInt x = if isTrue# (x <# 0#) then negateInt# x else x
301
302 divExact :: Integer -> Integer -> Integer
303 divExact a@(S# INT_MINBOUND) b = divExact (toBig a) b
304 divExact (S# a) (S# b) = S# (quotInt# a b)
305 divExact (S# a) (J# sb b)
306   = S# (quotInt# a (integer2Int# sb b))
307 divExact (J# sa a) (S# b)
308   = case int2Integer# b of
309     (# sb, b' #) -> case divExactInteger# sa a sb b' of
310                     (# sd, d #) -> J# sd d
311 divExact (J# sa a) (J# sb b)
312   = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
313 \end{code}
314
315
316 %*********************************************************
317 %*                                                      *
318 \subsection{The @Integer@ instances for @Eq@, @Ord@}
319 %*                                                      *
320 %*********************************************************
321
322 \begin{code}
323 {-# NOINLINE eqInteger# #-}
324 eqInteger# :: Integer -> Integer -> Int#
325 eqInteger# (S# i)     (S# j)     = i ==# j
326 eqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ==# 0#
327 eqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ==# 0#
328 eqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
329
330 {-# NOINLINE neqInteger# #-}
331 neqInteger# :: Integer -> Integer -> Int#
332 neqInteger# (S# i)     (S# j)     = i /=# j
333 neqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i /=# 0#
334 neqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i /=# 0#
335 neqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
336
337 {-# INLINE eqInteger  #-}
338 {-# INLINE neqInteger #-}
339 eqInteger, neqInteger :: Integer -> Integer -> Bool
340 eqInteger  a b = isTrue# (a `eqInteger#`  b)
341 neqInteger a b = isTrue# (a `neqInteger#` b)
342
343 instance  Eq Integer  where
344     (==) = eqInteger
345     (/=) = neqInteger
346
347 ------------------------------------------------------------------------
348
349 {-# NOINLINE leInteger# #-}
350 leInteger# :: Integer -> Integer -> Int#
351 leInteger# (S# i)     (S# j)     = i <=# j
352 leInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <=# 0#
353 leInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i >=# 0#
354 leInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
355
356 {-# NOINLINE gtInteger# #-}
357 gtInteger# :: Integer -> Integer -> Int#
358 gtInteger# (S# i)     (S# j)     = i ># j
359 gtInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ># 0#
360 gtInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <# 0#
361 gtInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
362
363 {-# NOINLINE ltInteger# #-}
364 ltInteger# :: Integer -> Integer -> Int#
365 ltInteger# (S# i)     (S# j)     = i <# j
366 ltInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <# 0#
367 ltInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ># 0#
368 ltInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
369
370 {-# NOINLINE geInteger# #-}
371 geInteger# :: Integer -> Integer -> Int#
372 geInteger# (S# i)     (S# j)     = i >=# j
373 geInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i >=# 0#
374 geInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <=# 0#
375 geInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
376
377 {-# INLINE leInteger #-}
378 {-# INLINE ltInteger #-}
379 {-# INLINE geInteger #-}
380 {-# INLINE gtInteger #-}
381 leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
382 leInteger a b = isTrue# (a `leInteger#` b)
383 gtInteger a b = isTrue# (a `gtInteger#` b)
384 ltInteger a b = isTrue# (a `ltInteger#` b)
385 geInteger a b = isTrue# (a `geInteger#` b)
386
387 {-# NOINLINE compareInteger #-}
388 compareInteger :: Integer -> Integer -> Ordering
389 compareInteger (S# i)  (S# j)
390    =      if isTrue# (i ==# j) then EQ
391      else if isTrue# (i <=# j) then LT
392      else                           GT
393 compareInteger (J# s d) (S# i)
394    = case cmpIntegerInt# s d i of { res# ->
395      if isTrue# (res# <# 0#) then LT else
396      if isTrue# (res# ># 0#) then GT else EQ
397      }
398 compareInteger (S# i) (J# s d)
399    = case cmpIntegerInt# s d i of { res# ->
400      if isTrue# (res# ># 0#) then LT else
401      if isTrue# (res# <# 0#) then GT else EQ
402      }
403 compareInteger (J# s1 d1) (J# s2 d2)
404    = case cmpInteger# s1 d1 s2 d2 of { res# ->
405      if isTrue# (res# <# 0#) then LT else
406      if isTrue# (res# ># 0#) then GT else EQ
407      }
408
409 instance Ord Integer where
410     (<=) = leInteger
411     (<)  = ltInteger
412     (>)  = gtInteger
413     (>=) = geInteger
414     compare = compareInteger
415 \end{code}
416
417
418 %*********************************************************
419 %*                                                      *
420 \subsection{The @Integer@ instances for @Num@}
421 %*                                                      *
422 %*********************************************************
423
424 \begin{code}
425 {-# NOINLINE absInteger #-}
426 absInteger :: Integer -> Integer
427 absInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
428 absInteger n@(S# i)   = if isTrue# (i >=# 0#) then n else S# (negateInt# i)
429 absInteger n@(J# s d) = if isTrue# (s >=# 0#) then n else J# (negateInt# s) d
430
431 {-# NOINLINE signumInteger #-}
432 signumInteger :: Integer -> Integer
433 signumInteger (S# i) = if isTrue# (i <# 0#) then S# -1#
434                        else if isTrue# (i ==# 0#) then S# 0#
435                        else S# 1#
436 signumInteger (J# s d)
437   = let
438         !cmp = cmpIntegerInt# s d 0#
439     in
440     if      isTrue# (cmp >#  0#) then S# 1#
441     else if isTrue# (cmp ==# 0#) then S# 0#
442     else                              S# (negateInt# 1#)
443
444 {-# NOINLINE plusInteger #-}
445 plusInteger :: Integer -> Integer -> Integer
446 plusInteger i1@(S# i) i2@(S# j)  = case addIntC# i j of
447                                    (# r, c #) ->
448                                        if isTrue# (c ==# 0#)
449                                        then S# r
450                                        else plusInteger (toBig i1) (toBig i2)
451 plusInteger i1@(J# _ _) i2@(S# _) = plusInteger i1 (toBig i2)
452 plusInteger i1@(S# _) i2@(J# _ _) = plusInteger (toBig i1) i2
453 plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of
454                                     (# s, d #) -> J# s d
455
456 {-# NOINLINE minusInteger #-}
457 minusInteger :: Integer -> Integer -> Integer
458 minusInteger i1@(S# i) i2@(S# j)   = case subIntC# i j of
459                                      (# r, c #) ->
460                                          if isTrue# (c ==# 0#) then S# r
461                                          else minusInteger (toBig i1)
462                                                            (toBig i2)
463 minusInteger i1@(J# _ _) i2@(S# _) = minusInteger i1 (toBig i2)
464 minusInteger i1@(S# _) i2@(J# _ _) = minusInteger (toBig i1) i2
465 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of
466                                      (# s, d #) -> J# s d
467
468 {-# NOINLINE timesInteger #-}
469 timesInteger :: Integer -> Integer -> Integer
470 timesInteger i1@(S# i) i2@(S# j)   = if isTrue# (mulIntMayOflo# i j ==# 0#)
471                                      then S# (i *# j)
472                                      else timesInteger (toBig i1) (toBig i2)
473 timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i1 (toBig i2)
474 timesInteger i1@(S# _) i2@(J# _ _) = timesInteger (toBig i1) i2
475 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of
476                                      (# s, d #) -> J# s d
477
478 {-# NOINLINE negateInteger #-}
479 negateInteger :: Integer -> Integer
480 negateInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
481 negateInteger (S# i)            = S# (negateInt# i)
482 negateInteger (J# s d)          = J# (negateInt# s) d
483 \end{code}
484
485
486 %*********************************************************
487 %*                                                      *
488 \subsection{The @Integer@ stuff for Double@}
489 %*                                                      *
490 %*********************************************************
491
492 \begin{code}
493 {-# NOINLINE encodeFloatInteger #-}
494 encodeFloatInteger :: Integer -> Int# -> Float#
495 encodeFloatInteger (S# i) j     = int_encodeFloat# i j
496 encodeFloatInteger (J# s# d#) e = encodeFloat# s# d# e
497
498 {-# NOINLINE encodeDoubleInteger #-}
499 encodeDoubleInteger :: Integer -> Int# -> Double#
500 encodeDoubleInteger (S# i) j     = int_encodeDouble# i j
501 encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e
502
503 {-# NOINLINE decodeDoubleInteger #-}
504 decodeDoubleInteger :: Double# -> (# Integer, Int# #)
505 decodeDoubleInteger d = case decodeDouble# d of
506                         (# exp#, s#, d# #) -> (# J# s# d#, exp# #)
507
508 -- previous code: doubleFromInteger n = fromInteger n = encodeFloat n 0
509 -- doesn't work too well, because encodeFloat is defined in
510 -- terms of ccalls which can never be simplified away.  We
511 -- want simple literals like (fromInteger 3 :: Float) to turn
512 -- into (F# 3.0), hence the special case for S# here.
513
514 {-# NOINLINE doubleFromInteger #-}
515 doubleFromInteger :: Integer -> Double#
516 doubleFromInteger (S# i#) = int2Double# i#
517 doubleFromInteger (J# s# d#) = encodeDouble# s# d# 0#
518
519 {-# NOINLINE floatFromInteger #-}
520 floatFromInteger :: Integer -> Float#
521 floatFromInteger (S# i#) = int2Float# i#
522 floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
523
524 foreign import ccall unsafe "integer_cbits_encodeFloat"
525         encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
526 foreign import ccall unsafe "__int_encodeFloat"
527         int_encodeFloat# :: Int# -> Int# -> Float#
528
529 foreign import ccall unsafe "integer_cbits_encodeDouble"
530         encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
531 foreign import ccall unsafe "__int_encodeDouble"
532         int_encodeDouble# :: Int# -> Int# -> Double#
533 \end{code}
534
535 %*********************************************************
536 %*                                                      *
537 \subsection{The @Integer@ Bit definitions@}
538 %*                                                      *
539 %*********************************************************
540
541 We explicitly pattern match against J# and S# in order to produce
542 Core that doesn't have pattern matching errors, as that would
543 introduce a spurious dependency to base.
544
545 \begin{code}
546 {-# NOINLINE andInteger #-}
547 andInteger :: Integer -> Integer -> Integer
548 (S# x)     `andInteger`   (S# y)     = S# (word2Int# (int2Word# x `and#` int2Word# y))
549 x@(S# _)   `andInteger` y@(J# _ _)   = toBig x `andInteger` y
550 x@(J# _ _) `andInteger` y@(S# _)     = x `andInteger` toBig y
551 (J# s1 d1) `andInteger`   (J# s2 d2) =
552      case andInteger# s1 d1 s2 d2 of
553        (# s, d #) -> J# s d
554
555 {-# NOINLINE orInteger #-}
556 orInteger :: Integer -> Integer -> Integer
557 (S# x)     `orInteger`   (S# y)     = S# (word2Int# (int2Word# x `or#` int2Word# y))
558 x@(S# _)   `orInteger` y@(J# _ _)   = toBig x `orInteger` y
559 x@(J# _ _) `orInteger` y@(S# _)     = x `orInteger` toBig y
560 (J# s1 d1) `orInteger`   (J# s2 d2) =
561      case orInteger# s1 d1 s2 d2 of
562        (# s, d #) -> J# s d
563
564 {-# NOINLINE xorInteger #-}
565 xorInteger :: Integer -> Integer -> Integer
566 (S# x)     `xorInteger`   (S# y)     = S# (word2Int# (int2Word# x `xor#` int2Word# y))
567 x@(S# _)   `xorInteger` y@(J# _ _)   = toBig x `xorInteger` y
568 x@(J# _ _) `xorInteger` y@(S# _)     = x `xorInteger` toBig y
569 (J# s1 d1) `xorInteger`   (J# s2 d2) =
570      case xorInteger# s1 d1 s2 d2 of
571        (# s, d #) -> J# s d
572
573 {-# NOINLINE complementInteger #-}
574 complementInteger :: Integer -> Integer
575 complementInteger (S# x)
576     = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
577 complementInteger (J# s d)
578     = case complementInteger# s d of (# s', d' #) -> J# s' d'
579
580 {-# NOINLINE shiftLInteger #-}
581 shiftLInteger :: Integer -> Int# -> Integer
582 shiftLInteger j@(S# _) i = shiftLInteger (toBig j) i
583 shiftLInteger (J# s d) i = case mul2ExpInteger# s d i of
584                            (# s', d' #) -> J# s' d'
585
586 {-# NOINLINE shiftRInteger #-}
587 shiftRInteger :: Integer -> Int# -> Integer
588 shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i
589 shiftRInteger (J# s d) i = case fdivQ2ExpInteger# s d i of
590                            (# s', d' #) -> J# s' d'
591
592 {-# NOINLINE testBitInteger #-}
593 testBitInteger :: Integer -> Int# -> Bool
594 testBitInteger j@(S# _) i = testBitInteger (toBig j) i
595 testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#)
596
597 -- | @powInteger b e@ computes base @b@ raised to exponent @e@.
598 {-# NOINLINE powInteger #-}
599 powInteger :: Integer -> Word# -> Integer
600 powInteger j@(S# _) e = powInteger (toBig j) e
601 powInteger (J# s d) e = case powInteger# s d e of
602                             (# s', d' #) -> J# s' d'
603
604 -- | @powModInteger b e m@ computes base @b@ raised to exponent @e@
605 -- modulo @m@.
606 --
607 -- Negative exponents are supported if an inverse modulo @m@
608 -- exists. It's advised to avoid calling this primitive with negative
609 -- exponents unless it is guaranteed the inverse exists, as failure to
610 -- do so will likely cause program abortion due to a divide-by-zero
611 -- fault. See also 'recipModInteger'.
612 {-# NOINLINE powModInteger #-}
613 powModInteger :: Integer -> Integer -> Integer -> Integer
614 powModInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
615     case powModInteger# s1 d1 s2 d2 s3 d3 of
616         (# s', d' #) -> J# s' d'
617 powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m)
618
619 -- | @powModSecInteger b e m@ computes base @b@ raised to exponent @e@
620 -- modulo @m@. It is required that @e@ > 0 and @m@ is odd.
621 --
622 -- This is a \"secure\" variant of 'powModInteger' using the
623 -- @mpz_powm_sec()@ function which is designed to be resilient to side
624 -- channel attacks and is therefore intended for cryptographic
625 -- applications.
626 {-# NOINLINE powModSecInteger #-}
627 powModSecInteger :: Integer -> Integer -> Integer -> Integer
628 powModSecInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
629     case powModSecInteger# s1 d1 s2 d2 s3 d3 of
630         (# s', d' #) -> J# s' d'
631 powModSecInteger b e m = powModSecInteger (toBig b) (toBig e) (toBig m)
632
633 -- | @recipModInteger x m@ computes the inverse of @x@ modulo @m@. If
634 -- the inverse exists, the return value @y@ will satisfy @0 < y <
635 -- abs(m)@, otherwise the result is 0.
636 --
637 -- Note: The implementation exploits the undocumented property of
638 -- @mpz_invert()@ to not mangle the result operand (which is initialized
639 -- to 0) in case of non-existence of the inverse.
640 {-# NOINLINE recipModInteger #-}
641 recipModInteger :: Integer -> Integer -> Integer
642 recipModInteger j@(S# _) m@(S# _)   = recipModInteger (toBig j) (toBig m)
643 recipModInteger j@(S# _) m@(J# _ _) = recipModInteger (toBig j) m
644 recipModInteger j@(J# _ _) m@(S# _) = recipModInteger j (toBig m)
645 recipModInteger (J# s d) (J# ms md) = case recipModInteger# s d ms md of
646                            (# s', d' #) -> J# s' d'
647 \end{code}
648
649
650 %*********************************************************
651 %*                                                      *
652 \subsection{The @Integer@ hashing@}
653 %*                                                      *
654 %*********************************************************
655
656 \begin{code}
657 -- This is used by hashUnique
658
659 -- | hashInteger returns the same value as 'fromIntegral', although in
660 -- unboxed form.  It might be a reasonable hash function for 'Integer',
661 -- given a suitable distribution of 'Integer' values.
662
663 hashInteger :: Integer -> Int#
664 hashInteger = integerToInt
665 \end{code}
666