From 4d2ac2d46a3551fa45e1ffa92bb86d39e43f41dc Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sun, 26 Jun 2011 02:41:16 +0100
Subject: [PATCH] Fix quoteRem, rem, divMod and mod definitions
We now have, e.g.,
maxBound `rem` (-1) == 0
rather than raising overflowError.
---
libraries/base/GHC/Int.hs | 104 +++++++++++++++++++++++-------------
libraries/base/GHC/Real.lhs | 20 ++++---
2 files changed, 80 insertions(+), 44 deletions(-)
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index b80bd1a222c9..d9f131ebd71b 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -93,26 +93,26 @@ instance Integral Int8 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I8# (narrow8Int# (x# `quotInt#` y#))
- rem x@(I8# x#) y@(I8# y#)
+ rem (I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I8# (narrow8Int# (x# `remInt#` y#))
div x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I8# (narrow8Int# (x# `divInt#` y#))
- mod x@(I8# x#) y@(I8# y#)
+ mod (I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I8# (narrow8Int# (x# `modInt#` y#))
quotRem x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I8# (narrow8Int# (x# `quotInt#` y#)),
I8# (narrow8Int# (x# `remInt#` y#)))
divMod x@(I8# x#) y@(I8# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I8# (narrow8Int# (x# `divInt#` y#)),
I8# (narrow8Int# (x# `modInt#` y#)))
toInteger (I8# x#) = smallInteger x#
@@ -235,26 +235,26 @@ instance Integral Int16 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I16# (narrow16Int# (x# `quotInt#` y#))
- rem x@(I16# x#) y@(I16# y#)
+ rem (I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I16# (narrow16Int# (x# `remInt#` y#))
div x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I16# (narrow16Int# (x# `divInt#` y#))
- mod x@(I16# x#) y@(I16# y#)
+ mod (I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I16# (narrow16Int# (x# `modInt#` y#))
quotRem x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I16# (narrow16Int# (x# `quotInt#` y#)),
I16# (narrow16Int# (x# `remInt#` y#)))
divMod x@(I16# x#) y@(I16# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I16# (narrow16Int# (x# `divInt#` y#)),
I16# (narrow16Int# (x# `modInt#` y#)))
toInteger (I16# x#) = smallInteger x#
@@ -389,26 +389,34 @@ instance Integral Int32 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I32# (x# `quotInt32#` y#)
- rem x@(I32# x#) y@(I32# y#)
+ rem (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+ -- but minBound `rem` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I32# (x# `remInt32#` y#)
div x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I32# (x# `divInt32#` y#)
- mod x@(I32# x#) y@(I32# y#)
+ mod (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The divMod CPU instruction fails for minBound `divMod` -1,
+ -- but minBound `mod` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I32# (x# `modInt32#` y#)
quotRem x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I32# (x# `quotInt32#` y#),
I32# (x# `remInt32#` y#))
divMod x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I32# (x# `divInt32#` y#),
I32# (x# `modInt32#` y#))
toInteger x@(I32# x#)
@@ -518,26 +526,34 @@ instance Integral Int32 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I32# (narrow32Int# (x# `quotInt#` y#))
- rem x@(I32# x#) y@(I32# y#)
+ rem (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+ -- but minBound `rem` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I32# (narrow32Int# (x# `remInt#` y#))
div x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I32# (narrow32Int# (x# `divInt#` y#))
- mod x@(I32# x#) y@(I32# y#)
+ mod (I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The divMod CPU instruction fails for minBound `divMod` -1,
+ -- but minBound `mod` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I32# (narrow32Int# (x# `modInt#` y#))
quotRem x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I32# (narrow32Int# (x# `quotInt#` y#)),
I32# (narrow32Int# (x# `remInt#` y#)))
divMod x@(I32# x#) y@(I32# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I32# (narrow32Int# (x# `divInt#` y#)),
I32# (narrow32Int# (x# `modInt#` y#)))
toInteger (I32# x#) = smallInteger x#
@@ -677,26 +693,34 @@ instance Integral Int64 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I64# (x# `quotInt64#` y#)
- rem x@(I64# x#) y@(I64# y#)
+ rem (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+ -- but minBound `rem` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I64# (x# `remInt64#` y#)
div x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I64# (x# `divInt64#` y#)
- mod x@(I64# x#) y@(I64# y#)
+ mod (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The divMod CPU instruction fails for minBound `divMod` -1,
+ -- but minBound `mod` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I64# (x# `modInt64#` y#)
quotRem x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I64# (x# `quotInt64#` y#),
I64# (x# `remInt64#` y#))
divMod x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I64# (x# `divInt64#` y#),
I64# (x# `modInt64#` y#))
toInteger (I64# x) = int64ToInteger x
@@ -810,25 +834,33 @@ instance Integral Int64 where
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I64# (x# `quotInt#` y#)
- rem x@(I64# x#) y@(I64# y#)
+ rem (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+ -- but minBound `rem` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I64# (x# `remInt#` y#)
div x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
| y == (-1) && x == minBound = overflowError -- Note [Order of tests]
| otherwise = I64# (x# `divInt#` y#)
- mod x@(I64# x#) y@(I64# y#)
+ mod (I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- The divMod CPU instruction fails for minBound `divMod` -1,
+ -- but minBound `mod` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | y == (-1) = 0
| otherwise = I64# (x# `modInt#` y#)
quotRem x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#))
divMod x@(I64# x#) y@(I64# y#)
| y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+ -- Note [Order of tests]
+ | y == (-1) && x == minBound = (overflowError, 0)
| otherwise = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#))
toInteger (I64# x#) = smallInteger x#
diff --git a/libraries/base/GHC/Real.lhs b/libraries/base/GHC/Real.lhs
index 6d44e29a602d..50fde96b07a7 100644
--- a/libraries/base/GHC/Real.lhs
+++ b/libraries/base/GHC/Real.lhs
@@ -252,8 +252,10 @@ instance Integral Int where
a `rem` b
| b == 0 = divZeroError
- | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
- -- in GHC.Int
+ -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+ -- but minBound `rem` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | b == (-1) = 0
| otherwise = a `remInt` b
a `div` b
@@ -264,20 +266,22 @@ instance Integral Int where
a `mod` b
| b == 0 = divZeroError
- | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
- -- in GHC.Int
+ -- The divMod CPU instruction fails for minBound `divMod` -1,
+ -- but minBound `mod` -1 is well-defined (0). We therefore
+ -- special-case it.
+ | b == (-1) = 0
| otherwise = a `modInt` b
a `quotRem` b
| b == 0 = divZeroError
- | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
- -- in GHC.Int
+ -- Note [Order of tests] in GHC.Int
+ | b == (-1) && a == minBound = (overflowError, 0)
| otherwise = a `quotRemInt` b
a `divMod` b
| b == 0 = divZeroError
- | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
- -- in GHC.Int
+ -- Note [Order of tests] in GHC.Int
+ | b == (-1) && a == minBound = (overflowError, 0)
| otherwise = a `divModInt` b
\end{code}
--
GitLab