[commit: integer-gmp] master: Add divInteger and modInteger functions (e73a2a4)

Repository : ssh://darcs.haskell.org//srv/darcs/packages/integer-gmp

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e73a2a41e1b7e49196ab6f673a2e63d3ad5f1994

>---------------------------------------------------------------

commit e73a2a41e1b7e49196ab6f673a2e63d3ad5f1994
Author: Ian Lynagh <[email protected]>
Date:   Tue Jun 19 19:33:43 2012 +0100

    Add divInteger and modInteger functions
    
    Now that divModInteger isn't inlined, we were getting allocations for
    both results even if we're just going to throw one away.

>---------------------------------------------------------------

 GHC/Integer.lhs         |    3 ++-
 GHC/Integer/GMP/Prim.hs |    6 ++++++
 GHC/Integer/Type.lhs    |   26 +++++++++++++++++++++++++-
 cbits/gmp-wrappers.cmm  |    2 ++
 4 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/GHC/Integer.lhs b/GHC/Integer.lhs
index bc61d03..57a97e1 100644
--- a/GHC/Integer.lhs
+++ b/GHC/Integer.lhs
@@ -27,7 +27,8 @@ module GHC.Integer (
     plusInteger, minusInteger, timesInteger, negateInteger,
     eqInteger, neqInteger, absInteger, signumInteger,
     leInteger, gtInteger, ltInteger, geInteger, compareInteger,
-    divModInteger, quotRemInteger, quotInteger, remInteger,
+    divModInteger, divInteger, modInteger,
+    quotRemInteger, quotInteger, remInteger,
     encodeFloatInteger, floatFromInteger,
     encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
     -- gcdInteger, lcmInteger,
diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs
index 8de4a8b..354d55f 100644
--- a/GHC/Integer/GMP/Prim.hs
+++ b/GHC/Integer/GMP/Prim.hs
@@ -16,6 +16,8 @@ module GHC.Integer.GMP.Prim (
     quotInteger#,
     remInteger#,
     divModInteger#,
+    divInteger#,
+    modInteger#,
     divExactInteger#,
 
     gcdInteger#,
@@ -101,6 +103,10 @@ foreign import prim "integer_cmm_remIntegerzh" remInteger#
 --
 foreign import prim "integer_cmm_divModIntegerzh" divModInteger#
   :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray#, Int#, ByteArray# #)
+foreign import prim "integer_cmm_divIntegerzh" divInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
+foreign import prim "integer_cmm_modIntegerzh" modInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# Int#, ByteArray# #)
 
 -- | Divisor is guaranteed to be a factor of dividend.
 --
diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs
index 44cc076..be3ebea 100644
--- a/GHC/Integer/Type.lhs
+++ b/GHC/Integer/Type.lhs
@@ -31,7 +31,8 @@ import GHC.Integer.GMP.Prim (
     -- GMP-related primitives
     cmpInteger#, cmpIntegerInt#,
     plusInteger#, minusInteger#, timesInteger#,
-    quotRemInteger#, quotInteger#, remInteger#, divModInteger#,
+    quotRemInteger#, quotInteger#, remInteger#,
+    divModInteger#, divInteger#, modInteger#,
     gcdInteger#, gcdIntegerInt#, gcdInt#, divExactInteger#,
     decodeDouble#,
     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
@@ -232,6 +233,29 @@ quotInteger (J# sa a) (S# b)
     case quotInteger# sa a sb b' of (# sq, q #) -> J# sq q }
 quotInteger (J# sa a) (J# sb b)
   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
+
+{-# NOINLINE modInteger #-}
+modInteger :: Integer -> Integer -> Integer
+modInteger a@(S# INT_MINBOUND) b = modInteger (toBig a) b
+modInteger (S# a) (S# b) = S# (modInt# a b)
+modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib
+modInteger (J# sa a) (S# b)
+  = case int2Integer# b of { (# sb, b' #) ->
+    case modInteger# sa a sb b' of { (# sr, r #) ->
+    S# (integer2Int# sr r) }}
+modInteger (J# sa a) (J# sb b)
+  = case modInteger# sa a sb b of (# sr, r #) -> J# sr r
+
+{-# NOINLINE divInteger #-}
+divInteger :: Integer -> Integer -> Integer
+divInteger a@(S# INT_MINBOUND) b = divInteger (toBig a) b
+divInteger (S# a) (S# b) = S# (divInt# a b)
+divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib
+divInteger (J# sa a) (S# b)
+  = case int2Integer# b of { (# sb, b' #) ->
+    case divInteger# sa a sb b' of (# sq, q #) -> J# sq q }
+divInteger (J# sa a) (J# sb b)
+  = case divInteger# sa a sb b of (# sg, g #) -> J# sg g
 \end{code}
 
 
diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm
index 43df337..145e6de 100644
--- a/cbits/gmp-wrappers.cmm
+++ b/cbits/gmp-wrappers.cmm
@@ -377,6 +377,8 @@ GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,    __gmpz_mul)
 GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,      __gmpz_gcd)
 GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,     __gmpz_tdiv_q)
 GMP_TAKE2_RET1(integer_cmm_remIntegerzh,      __gmpz_tdiv_r)
+GMP_TAKE2_RET1(integer_cmm_divIntegerzh,      __gmpz_fdiv_q)
+GMP_TAKE2_RET1(integer_cmm_modIntegerzh,      __gmpz_fdiv_r)
 GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh, __gmpz_divexact)
 GMP_TAKE2_RET1(integer_cmm_andIntegerzh,      __gmpz_and)
 GMP_TAKE2_RET1(integer_cmm_orIntegerzh,       __gmpz_ior)