[commit: base] ghc-7.6: Fix #7233: avoid overflow in divInt64# (a191908)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : ghc-7.6

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

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

commit a191908df094a9243ea3fe1de2fdb43a1d715de5
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Wed Oct 24 16:57:39 2012 +0100

    Fix #7233: avoid overflow in divInt64#
    
    MERGED from commit 4137f8c1259e02dc1992c9d6771f45f495e7cef4

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

 GHC/Int.hs |   24 ++++++++++++++++--------
 1 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/GHC/Int.hs b/GHC/Int.hs
index 21c0f4f..59e22ab 100644
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -620,18 +620,26 @@ instance Integral Int64 where
 
 
 divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
+
+-- Define div in terms of quot, being careful to avoid overflow (#7233)
 x# `divInt64#` y#
-    | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#)
-        = ((x# `minusInt64#` y#) `minusInt64#` intToInt64# 1#) `quotInt64#` y#
-    | (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)
-        = ((x# `minusInt64#` y#) `plusInt64#` intToInt64# 1#) `quotInt64#` y#
-    | otherwise                = x# `quotInt64#` y#
+    | (x# `gtInt64#` zero) && (y# `ltInt64#` zero)
+        = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one
+    | (x# `ltInt64#` zero) && (y# `gtInt64#` zero)
+        = ((x# `plusInt64#` one)  `quotInt64#` y#) `minusInt64#` one
+    | otherwise
+        = x# `quotInt64#` y#
+    where
+    !zero = intToInt64# 0#
+    !one  = intToInt64# 1#
+
 x# `modInt64#` y#
-    | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) ||
-      (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)
-        = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0#
+    | (x# `gtInt64#` zero) && (y# `ltInt64#` zero) ||
+      (x# `ltInt64#` zero) && (y# `gtInt64#` zero)
+        = if r# `neInt64#` zero then r# `plusInt64#` y# else zero
     | otherwise = r#
     where
+    !zero = intToInt64# 0#
     !r# = x# `remInt64#` y#
 
 instance Read Int64 where