[commit: ghc-prim] master: Move divInt#/modInt# from base (7398a64)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/7398a64cb94c8c548fb50baebcf0d528885c0436

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

commit 7398a64cb94c8c548fb50baebcf0d528885c0436
Author: Ian Lynagh <igloo at earth.li>
Date:   Tue Jun 19 19:21:29 2012 +0100

    Move divInt#/modInt# from base
    
    This allows them to be shared with integer-gmp

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

 GHC/Classes.hs |   26 +++++++++++++++++++++++++-
 GHC/Types.hs   |    1 +
 2 files changed, 26 insertions(+), 1 deletions(-)

diff --git a/GHC/Classes.hs b/GHC/Classes.hs
index 7586af4..863a8fa 100644
--- a/GHC/Classes.hs
+++ b/GHC/Classes.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
 {-# OPTIONS_HADDOCK hide #-}
@@ -285,3 +285,27 @@ deriving instance Ord Arity
 deriving instance Ord Associativity
 deriving instance Ord Fixity
 
+------------------------------------------------------------------------
+-- These don't really belong here, but we don't have a better place to
+-- put them
+
+divInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+        -- Be careful NOT to overflow if we do any additional arithmetic
+        -- on the arguments...  the following  previous version of this
+        -- code has problems with overflow:
+--    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+--    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    =      if (x# ># 0#) && (y# <# 0#) then ((x# -# 1#) `quotInt#` y#) -# 1#
+      else if (x# <# 0#) && (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1#
+      else x# `quotInt#` y#
+
+modInt# :: Int# -> Int# -> Int#
+x# `modInt#` y#
+    = if (x# ># 0#) && (y# <# 0#) ||
+         (x# <# 0#) && (y# ># 0#)
+      then if r# /=# 0# then r# +# y# else 0#
+      else r#
+    where
+    !r# = x# `remInt#` y#
+
diff --git a/GHC/Types.hs b/GHC/Types.hs
index c8868da..e7983e7 100644
--- a/GHC/Types.hs
+++ b/GHC/Types.hs
@@ -84,3 +84,4 @@ newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
 -- The type constructor is special in that GHC pretends that it
 -- has kind (? -> ? -> Fact) rather than (* -> * -> *)
 data (~) a b = Eq# ((~#) a b)
+