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