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