Move the int64 conversion functions here, from ghc-prim
[packages/integer-gmp.git] / GHC / Integer.lhs
index ae1a097..424001c 100644 (file)
@@ -1,6 +1,5 @@
 \begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
-{-# OPTIONS_HADDOCK hide #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Integer
 module GHC.Integer (
     Integer,
     smallInteger, wordToInteger, integerToWord, toInt#,
+#if WORD_SIZE_IN_BITS < 64
+    integerToWord64, word64ToInteger,
+    integerToInt64, int64ToInteger,
+#endif
     plusInteger, minusInteger, timesInteger, negateInteger,
     eqInteger, neqInteger, absInteger, signumInteger,
     leInteger, gtInteger, ltInteger, geInteger, compareInteger,
     divModInteger, quotRemInteger, quotInteger, remInteger,
-    encodeFloatInteger, decodeFloatInteger, floatFromInteger,
+    encodeFloatInteger, floatFromInteger,
     encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
     gcdInteger, lcmInteger,
     andInteger, orInteger, xorInteger, complementInteger,
@@ -48,20 +51,39 @@ import GHC.Prim (
     -- Operations on Int# that we use for operations on S#
     quotInt#, remInt#, negateInt#,
     (==#), (/=#), (<=#), (>=#), (<#), (>#), (*#), (-#), (+#),
-    mulIntMayOflo#, addIntC#, subIntC#, gcdInt#,
+    mulIntMayOflo#, addIntC#, subIntC#,
     and#, or#, xor#,
     indexIntArray#,
-    -- GMP-related primitives in the RTS
+ )
+
+import GHC.Integer.Internals (
+    Integer(..),
+
+    -- GMP-related primitives
     cmpInteger#, cmpIntegerInt#,
     plusInteger#, minusInteger#, timesInteger#,
     quotRemInteger#, quotInteger#, remInteger#, divModInteger#,
-    gcdInteger#, gcdIntegerInt#, divExactInteger#,
-    decodeDouble#, decodeFloat#,
+    gcdInteger#, gcdIntegerInt#, gcdInt#, divExactInteger#,
+    decodeDouble#,
     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
     andInteger#, orInteger#, xorInteger#, complementInteger#,
+#if WORD_SIZE_IN_BITS < 64
+    int64ToInteger#,  integerToInt64#,
+    word64ToInteger#, integerToWord64#,
+#endif
  )
 
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64 (
+            Int64#, Word64#,
+            int64ToWord64#, intToInt64#,
+            int64ToInt#, word64ToInt64#,
+            geInt64#, leInt64#, leWord64#,
+       )
+#endif
+
 import GHC.Bool
+import GHC.Ordering
 
 default ()              -- Double isn't available yet,
                         -- and we shouldn't be using defaults anyway
@@ -73,19 +95,6 @@ default ()              -- Double isn't available yet,
 %*                                                      *
 %*********************************************************
 
-\begin{code}
--- | Arbitrary-precision integers.
-data Integer
-   = S# Int#                            -- small integers
-#ifndef ILX
-   | J# Int# ByteArray#                 -- large integers
-#else
-   | J# Void BigInteger                 -- .NET big ints
-
-foreign type dotnet "BigInteger" BigInteger
-#endif
-\end{code}
-
 Convenient boxed Integer PrimOps.
 
 \begin{code}
@@ -102,6 +111,33 @@ integerToWord :: Integer -> Word#
 integerToWord (S# i) = int2Word# i
 integerToWord (J# s d) = integer2Word# s d
 
+#if WORD_SIZE_IN_BITS < 64
+{-# INLINE integerToWord64 #-}
+integerToWord64 :: Integer -> Word64#
+integerToWord64 (S# i) = int64ToWord64# (intToInt64# i)
+integerToWord64 (J# s d) = integerToWord64# s d
+
+word64ToInteger :: Word64# -> Integer
+word64ToInteger w = if w `leWord64#` int64ToWord64# (intToInt64# 0x7FFFFFFF#)
+                    then S# (int64ToInt# (word64ToInt64# w))
+                    else case word64ToInteger# w of
+                         (# s, d #) -> J# s d
+
+integerToInt64 :: Integer -> Int64#
+integerToInt64 (S# i) = intToInt64# i
+integerToInt64 (J# s d) = integerToInt64# s d
+
+int64ToInteger :: Int64# -> Integer
+int64ToInteger i = if ((i `leInt64#` intToInt64# 0x7FFFFFFF#) && 
+                       (i `geInt64#` intToInt64# -0x80000000#))
+                   then smallInteger (int64ToInt# i)
+                   else case int64ToInteger# i of
+                        (# s, d #) -> J# s d
+    where -- XXX Move the (&&) definition below us?
+          True  && x = x
+          False && _ = False
+#endif
+
 toInt# :: Integer -> Int#
 toInt# (S# i)   = i
 toInt# (J# s d) = integer2Int# s d
@@ -128,7 +164,14 @@ toBig i@(J# _ _) = i
 
 quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
 quotRemInteger a@(S# INT_MINBOUND) b = quotRemInteger (toBig a) b
-quotRemInteger (S# i) (S# j) = (# S# (i `quotInt#` j), S# (i `remInt#` j) #)
+quotRemInteger (S# i) (S# j) = (# S# q, S# r #)
+    where
+      -- NB. don't inline these.  (# S# (i `quotInt#` j), ... #) means
+      -- (# let q = i `quotInt#` j in S# q, ... #) which builds a
+      -- useless thunk.  Placing the bindings here means they'll be
+      -- evaluated strictly.
+      !q = i `quotInt#` j
+      !r = i `remInt#`  j
 quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
 quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
 quotRemInteger (J# s1 d1) (J# s2 d2)
@@ -138,8 +181,12 @@ quotRemInteger (J# s1 d1) (J# s2 d2)
 
 divModInteger :: Integer -> Integer -> (# Integer, Integer #)
 divModInteger a@(S# INT_MINBOUND) b = divModInteger (toBig a) b
-divModInteger (S# i) (S# j) = (# S# (i `divInt#` j), S# (i `modInt#` j) #)
+divModInteger (S# i) (S# j) = (# S# d, S# m #)
     where
+      -- NB. don't inline these.  See quotRemInteger above.
+      !d = i `divInt#` j
+      !m = i `modInt#` j
+
       -- XXX Copied from GHC.Base
       divInt# :: Int# -> Int# -> Int#
       x# `divInt#` y#
@@ -153,7 +200,7 @@ divModInteger (S# i) (S# j) = (# S# (i `divInt#` j), S# (i `modInt#` j) #)
             ((x# <# 0#) && (y# ># 0#))
          then if r# /=# 0# then r# +# y# else 0#
          else r#
-          where r# = x# `remInt#` y#
+          where !r# = x# `remInt#` y#
 
       (&&) :: Bool -> Bool -> Bool
       True  && x = x
@@ -215,19 +262,12 @@ gcdInteger :: Integer -> Integer -> Integer
 gcdInteger a@(S# INT_MINBOUND) b = gcdInteger (toBig a) b
 gcdInteger a b@(S# INT_MINBOUND) = gcdInteger a (toBig b)
 gcdInteger (S# a) (S# b) = S# (gcdInt a b)
-    where -- XXX Copied from GHC.Base
-          gcdInt :: Int# -> Int# -> Int#
-          gcdInt 0# y  = absInt y
-          gcdInt x  0# = absInt x
-          gcdInt x  y  = gcdInt# (absInt x) (absInt y)
-
-          absInt x = if x <# 0# then negateInt# x else x
 gcdInteger ia@(S# a)  ib@(J# sb b)
  =      if a  ==# 0# then absInteger ib
    else if sb ==# 0# then absInteger ia
    else                   S# (gcdIntegerInt# absSb b absA)
-       where absA  = if a  <# 0# then negateInt# a  else a
-             absSb = if sb <# 0# then negateInt# sb else sb
+       where !absA  = if a  <# 0# then negateInt# a  else a
+             !absSb = if sb <# 0# then negateInt# sb else sb
 gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
 gcdInteger (J# sa a) (J# sb b)
   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
@@ -239,6 +279,17 @@ lcmInteger a b =      if a `eqInteger` S# 0# then S# 0#
   where aa = absInteger a
         ab = absInteger b
 
+{-# RULES "gcdInteger/Int" forall a b.
+            gcdInteger (S# a) (S# b) = S# (gcdInt a b)
+  #-}
+gcdInt :: Int# -> Int# -> Int#
+gcdInt 0# y  = absInt y
+gcdInt x  0# = absInt x
+gcdInt x  y  = gcdInt# (absInt x) (absInt y)
+
+absInt :: Int# -> Int#
+absInt x = if x <# 0# then negateInt# x else x
+
 divExact :: Integer -> Integer -> Integer
 divExact a@(S# INT_MINBOUND) b = divExact (toBig a) b
 divExact (S# a) (S# b) = S# (quotInt# a b)
@@ -298,29 +349,25 @@ geInteger (J# s d)   (S# i)     = cmpIntegerInt# s d i >=# 0#
 geInteger (S# i)     (J# s d)   = cmpIntegerInt# s d i <=# 0#
 geInteger (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
 
--- GT => 1
--- EQ => 0
--- LT => -1
--- XXX Should we just define Ordering higher up?
-compareInteger :: Integer -> Integer -> Int#
+compareInteger :: Integer -> Integer -> Ordering
 compareInteger (S# i)  (S# j)
-   =      if i ==# j then 0#
-     else if i <=# j then -1#
-     else                 1#
+   =      if i ==# j then EQ
+     else if i <=# j then LT
+     else                 GT
 compareInteger (J# s d) (S# i)
    = case cmpIntegerInt# s d i of { res# ->
-     if res# <# 0# then -1# else
-     if res# ># 0# then 1# else 0#
+     if res# <# 0# then LT else
+     if res# ># 0# then GT else EQ
      }
 compareInteger (S# i) (J# s d)
    = case cmpIntegerInt# s d i of { res# ->
-     if res# ># 0# then -1# else
-     if res# <# 0# then 1# else 0#
+     if res# ># 0# then LT else
+     if res# <# 0# then GT else EQ
      }
 compareInteger (J# s1 d1) (J# s2 d2)
    = case cmpInteger# s1 d1 s2 d2 of { res# ->
-     if res# <# 0# then -1# else
-     if res# ># 0# then 1# else 0#
+     if res# <# 0# then LT else
+     if res# ># 0# then GT else EQ
      }
 \end{code}
 
@@ -344,7 +391,7 @@ signumInteger (S# i) = if i <# 0# then S# -1#
                        else S# 1#
 signumInteger (J# s d)
   = let
-        cmp = cmpIntegerInt# s d 0#
+        !cmp = cmpIntegerInt# s d 0#
     in
     if      cmp >#  0# then S# 1#
     else if cmp ==# 0# then S# 0#
@@ -399,10 +446,6 @@ encodeFloatInteger :: Integer -> Int# -> Float#
 encodeFloatInteger (S# i) j     = int_encodeFloat# i j
 encodeFloatInteger (J# s# d#) e = encodeFloat# s# d# e
 
-decodeFloatInteger :: Float# -> (# Integer, Int# #)
-decodeFloatInteger d = case decodeFloat# d of
-                       (# exp#, s#, d# #) -> (# J# s# d#, exp# #)
-
 encodeDoubleInteger :: Integer -> Int# -> Double#
 encodeDoubleInteger (S# i) j     = int_encodeDouble# i j
 encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e
@@ -425,12 +468,12 @@ floatFromInteger :: Integer -> Float#
 floatFromInteger (S# i#) = int2Float# i#
 floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
 
-foreign import ccall unsafe "__encodeFloat"
+foreign import ccall unsafe "integer_cbits_encodeFloat"
         encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
 foreign import ccall unsafe "__int_encodeFloat"
         int_encodeFloat# :: Int# -> Int# -> Float#
 
-foreign import ccall unsafe "__encodeDouble"
+foreign import ccall unsafe "integer_cbits_encodeDouble"
         encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
 foreign import ccall unsafe "__int_encodeDouble"
         int_encodeDouble# :: Int# -> Int# -> Double#