From 1b1289f3c7cba2895500623a1fa748e9b2873669 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Mon, 15 Jan 2007 14:20:05 +0000 Subject: [PATCH] Fix crash with (minBound :: Int*) `div (-1) as result is maxBound + 1. --- GHC/Err.lhs | 8 ++- GHC/Err.lhs-boot | 5 +- GHC/Int.hs | 212 ++++++++++++++++++++++++++++++++---------------------- GHC/Real.lhs | 46 +++++++----- 4 files changed, 167 insertions(+), 104 deletions(-) diff --git a/GHC/Err.lhs b/GHC/Err.lhs index 85453aa..946ca36 100644 --- a/GHC/Err.lhs +++ b/GHC/Err.lhs @@ -32,6 +32,7 @@ module GHC.Err , absentErr -- :: a , divZeroError -- :: a + , overflowError -- :: a , error -- :: String -> a , assertError -- :: String -> Bool -> a -> a @@ -130,12 +131,17 @@ untangle coded message not_bar c = c /= '|' \end{code} -Divide by zero. We put it here because it is needed relatively early +Divide by zero and arithmetic overflow. +We put them here because they are needed relatively early in the libraries before the Exception type has been defined yet. \begin{code} {-# NOINLINE divZeroError #-} divZeroError :: a divZeroError = throw (ArithException DivideByZero) + +{-# NOINLINE overflowError #-} +overflowError :: a +overflowError = throw (ArithException Overflow) \end{code} diff --git a/GHC/Err.lhs-boot b/GHC/Err.lhs-boot index 70afbb9..5b49c4e 100644 --- a/GHC/Err.lhs-boot +++ b/GHC/Err.lhs-boot @@ -4,7 +4,7 @@ -- Ghc.Err.hs-boot --------------------------------------------------------------------------- -module GHC.Err( error, divZeroError ) where +module GHC.Err( error, divZeroError, overflowError ) where -- The type signature for 'error' is a gross hack. -- First, we can't give an accurate type for error, because it mentions @@ -20,4 +20,7 @@ error :: a -- divide by zero is needed quite early divZeroError :: a + +-- overflow is needed quite early +overflowError :: a \end{code} diff --git a/GHC/Int.hs b/GHC/Int.hs index 7ee7b1b..c2ce279 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -78,26 +78,32 @@ instance Enum Int8 where instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) - | y /= 0 = I8# (narrow8Int# (x# `quotInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I8# (narrow8Int# (x# `quotInt#` y#)) rem x@(I8# x#) y@(I8# y#) - | y /= 0 = I8# (narrow8Int# (x# `remInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I8# (narrow8Int# (x# `remInt#` y#)) div x@(I8# x#) y@(I8# y#) - | y /= 0 = I8# (narrow8Int# (x# `divInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I8# (narrow8Int# (x# `divInt#` y#)) mod x@(I8# x#) y@(I8# y#) - | y /= 0 = I8# (narrow8Int# (x# `modInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I8# (narrow8Int# (x# `modInt#` y#)) quotRem x@(I8# x#) y@(I8# y#) - | y /= 0 = (I8# (narrow8Int# (x# `quotInt#` y#)), - I8# (narrow8Int# (x# `remInt#` y#))) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I8# (narrow8Int# (x# `quotInt#` y#)), + I8# (narrow8Int# (x# `remInt#` y#))) divMod x@(I8# x#) y@(I8# y#) - | y /= 0 = (I8# (narrow8Int# (x# `divInt#` y#)), - I8# (narrow8Int# (x# `modInt#` y#))) - | otherwise = divZeroError - toInteger (I8# x#) = S# x# + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I8# (narrow8Int# (x# `divInt#` y#)), + I8# (narrow8Int# (x# `modInt#` y#))) + toInteger (I8# x#) = S# x# instance Bounded Int8 where minBound = -0x80 @@ -185,26 +191,32 @@ instance Enum Int16 where instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) - | y /= 0 = I16# (narrow16Int# (x# `quotInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I16# (narrow16Int# (x# `quotInt#` y#)) rem x@(I16# x#) y@(I16# y#) - | y /= 0 = I16# (narrow16Int# (x# `remInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I16# (narrow16Int# (x# `remInt#` y#)) div x@(I16# x#) y@(I16# y#) - | y /= 0 = I16# (narrow16Int# (x# `divInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I16# (narrow16Int# (x# `divInt#` y#)) mod x@(I16# x#) y@(I16# y#) - | y /= 0 = I16# (narrow16Int# (x# `modInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I16# (narrow16Int# (x# `modInt#` y#)) quotRem x@(I16# x#) y@(I16# y#) - | y /= 0 = (I16# (narrow16Int# (x# `quotInt#` y#)), - I16# (narrow16Int# (x# `remInt#` y#))) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I16# (narrow16Int# (x# `quotInt#` y#)), + I16# (narrow16Int# (x# `remInt#` y#))) divMod x@(I16# x#) y@(I16# y#) - | y /= 0 = (I16# (narrow16Int# (x# `divInt#` y#)), - I16# (narrow16Int# (x# `modInt#` y#))) - | otherwise = divZeroError - toInteger (I16# x#) = S# x# + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I16# (narrow16Int# (x# `divInt#` y#)), + I16# (narrow16Int# (x# `modInt#` y#))) + toInteger (I16# x#) = S# x# instance Bounded Int16 where minBound = -0x8000 @@ -302,23 +314,31 @@ instance Enum Int32 where instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (x# `quotInt32#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (x# `quotInt32#` y#) rem x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (x# `remInt32#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (x# `remInt32#` y#) div x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (x# `divInt32#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (x# `divInt32#` y#) mod x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (x# `modInt32#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (x# `modInt32#` y#) quotRem x@(I32# x#) y@(I32# y#) - | y /= 0 = (I32# (x# `quotInt32#` y#), I32# (x# `remInt32#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I32# (x# `quotInt32#` y#), + I32# (x# `remInt32#` y#)) divMod x@(I32# x#) y@(I32# y#) - | y /= 0 = (I32# (x# `divInt32#` y#), I32# (x# `modInt32#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I32# (x# `divInt32#` y#), + I32# (x# `modInt32#` y#)) toInteger x@(I32# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = S# (int32ToInt# x#) @@ -448,26 +468,32 @@ instance Enum Int32 where instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (narrow32Int# (x# `quotInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (narrow32Int# (x# `quotInt#` y#)) rem x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (narrow32Int# (x# `remInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (narrow32Int# (x# `remInt#` y#)) div x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (narrow32Int# (x# `divInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (narrow32Int# (x# `divInt#` y#)) mod x@(I32# x#) y@(I32# y#) - | y /= 0 = I32# (narrow32Int# (x# `modInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I32# (narrow32Int# (x# `modInt#` y#)) quotRem x@(I32# x#) y@(I32# y#) - | y /= 0 = (I32# (narrow32Int# (x# `quotInt#` y#)), - I32# (narrow32Int# (x# `remInt#` y#))) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I32# (narrow32Int# (x# `quotInt#` y#)), + I32# (narrow32Int# (x# `remInt#` y#))) divMod x@(I32# x#) y@(I32# y#) - | y /= 0 = (I32# (narrow32Int# (x# `divInt#` y#)), - I32# (narrow32Int# (x# `modInt#` y#))) - | otherwise = divZeroError - toInteger (I32# x#) = S# x# + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I32# (narrow32Int# (x# `divInt#` y#)), + I32# (narrow32Int# (x# `modInt#` y#))) + toInteger (I32# x#) = S# x# instance Read Int32 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] @@ -572,27 +598,37 @@ instance Enum Int64 where instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `quotInt64#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `quotInt64#` y#) rem x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `remInt64#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `remInt64#` y#) div x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `divInt64#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `divInt64#` y#) mod x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `modInt64#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `modInt64#` y#) quotRem x@(I64# x#) y@(I64# y#) - | y /= 0 = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I64# (x# `quotInt64#` y#), + I64# (x# `remInt64#` y#)) divMod x@(I64# x#) y@(I64# y#) - | y /= 0 = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I64# (x# `divInt64#` y#), + I64# (x# `modInt64#` y#)) toInteger x@(I64# x#) - | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) - = S# (int64ToInt# x#) - | otherwise = case int64ToInteger# x# of (# s, d #) -> J# s d + | x >= fromIntegral (minBound::Int) && + x <= fromIntegral (maxBound::Int) + = S# (int64ToInt# x#) + | otherwise = case int64ToInteger# x# of + (# s, d #) -> J# s d divInt64#, modInt64# :: Int64# -> Int64# -> Int64# @@ -729,24 +765,30 @@ instance Enum Int64 where instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `quotInt#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `quotInt#` y#) rem x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `remInt#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `remInt#` y#) div x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `divInt#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `divInt#` y#) mod x@(I64# x#) y@(I64# y#) - | y /= 0 = I64# (x# `modInt#` y#) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = I64# (x# `modInt#` y#) quotRem x@(I64# x#) y@(I64# y#) - | y /= 0 = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#)) - | otherwise = divZeroError + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#)) divMod x@(I64# x#) y@(I64# y#) - | y /= 0 = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#)) - | otherwise = divZeroError - toInteger (I64# x#) = S# x# + | y == 0 = divZeroError + | x == minBound && y == (-1) = overflowError + | otherwise = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#)) + toInteger (I64# x#) = S# x# instance Read Int64 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] diff --git a/GHC/Real.lhs b/GHC/Real.lhs index 31e8160..575f116 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -231,23 +231,35 @@ instance Real Int where instance Integral Int where toInteger i = int2Integer i -- give back a full-blown Integer - a `quot` 0 = divZeroError - a `quot` b = a `quotInt` b - - a `rem` 0 = divZeroError - a `rem` b = a `remInt` b - - a `div` 0 = divZeroError - a `div` b = a `divInt` b - - a `mod` 0 = divZeroError - a `mod` b = a `modInt` b - - a `quotRem` 0 = divZeroError - a `quotRem` b = a `quotRemInt` b - - a `divMod` 0 = divZeroError - a `divMod` b = a `divModInt` b + a `quot` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `quotInt` b + + a `rem` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `remInt` b + + a `div` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `divInt` b + + a `mod` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `modInt` b + + a `quotRem` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `quotRemInt` b + + a `divMod` b + | b == 0 = divZeroError + | a == minBound && b == (-1) = overflowError + | otherwise = a `divModInt` b \end{code} -- 1.7.10.4