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