From: simonmar Date: Wed, 18 Sep 2002 11:32:44 +0000 (+0000) Subject: [project @ 2002-09-18 11:32:43 by simonmar] X-Git-Tag: nhc98-1-18-release~850 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=be44c54248f9a5a5bd6168af464013b405c15aab;p=ghc-base.git [project @ 2002-09-18 11:32:43 by simonmar] Sort out the divide-by-zero situation. Some integer division operations called error on a divide by zero, and some didn't test for it. Now we always raise the DivideByZero exception. MERGE TO STABLE --- diff --git a/GHC/Err.hi-boot b/GHC/Err.hi-boot index 13facf3..4ae901a 100644 --- a/GHC/Err.hi-boot +++ b/GHC/Err.hi-boot @@ -15,3 +15,6 @@ module GHC.Err where -- to mention 'error' so that it gets exported from this .hi-boot -- file. error :: GHC.Base.String -> a + +-- divide by zero is needed quite early +divZeroError :: a diff --git a/GHC/Err.lhs b/GHC/Err.lhs index 43834aa..a44e1a5 100644 --- a/GHC/Err.lhs +++ b/GHC/Err.lhs @@ -30,6 +30,7 @@ module GHC.Err , runtimeError -- :: Addr# -> a -- Addr# points to UTF8 encoded C string , absentErr -- :: a + , divZeroError -- :: a , error -- :: String -> a , assertError -- :: String -> Bool -> a -> a @@ -126,3 +127,13 @@ untangle coded message } not_bar c = c /= '|' \end{code} + +Divide by zero. We put it here because it is needed relatively early +in the libraries before the Exception type has been defined yet. + +\begin{code} +{-# NOINLINE divZeroError #-} +divZeroError :: a +divZeroError = throw (ArithException DivideByZero) +\end{code} + diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 6f7d9c9..fcce633 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -478,7 +478,7 @@ data Exception = ArithException ArithException -- ^Exceptions raised by arithmetic -- operations. (NOTE: GHC currently does not throw - -- 'ArithException's). + -- 'ArithException's except for 'DivideByZero'). | ArrayException ArrayException -- ^Exceptions raised by array-related -- operations. (NOTE: GHC currently does not throw diff --git a/GHC/Int.hs b/GHC/Int.hs index 309542a..025ebdb 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -21,6 +21,7 @@ module GHC.Int ( import Data.Bits +import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Enum import GHC.Num @@ -80,24 +81,24 @@ instance Enum Int8 where instance Integral Int8 where quot x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `quotInt#` y#)) - | otherwise = divZeroError "quot{Int8}" x + | otherwise = divZeroError rem x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `remInt#` y#)) - | otherwise = divZeroError "rem{Int8}" x + | otherwise = divZeroError div x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `divInt#` y#)) - | otherwise = divZeroError "div{Int8}" x + | otherwise = divZeroError mod x@(I8# x#) y@(I8# y#) | y /= 0 = I8# (narrow8Int# (x# `modInt#` y#)) - | otherwise = divZeroError "mod{Int8}" x + | otherwise = divZeroError quotRem x@(I8# x#) y@(I8# y#) | y /= 0 = (I8# (narrow8Int# (x# `quotInt#` y#)), I8# (narrow8Int# (x# `remInt#` y#))) - | otherwise = divZeroError "quotRem{Int8}" x + | otherwise = divZeroError divMod x@(I8# x#) y@(I8# y#) | y /= 0 = (I8# (narrow8Int# (x# `divInt#` y#)), I8# (narrow8Int# (x# `modInt#` y#))) - | otherwise = divZeroError "divMod{Int8}" x + | otherwise = divZeroError toInteger (I8# x#) = S# x# instance Bounded Int8 where @@ -189,24 +190,24 @@ instance Enum Int16 where instance Integral Int16 where quot x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `quotInt#` y#)) - | otherwise = divZeroError "quot{Int16}" x + | otherwise = divZeroError rem x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `remInt#` y#)) - | otherwise = divZeroError "rem{Int16}" x + | otherwise = divZeroError div x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `divInt#` y#)) - | otherwise = divZeroError "div{Int16}" x + | otherwise = divZeroError mod x@(I16# x#) y@(I16# y#) | y /= 0 = I16# (narrow16Int# (x# `modInt#` y#)) - | otherwise = divZeroError "mod{Int16}" x + | otherwise = divZeroError quotRem x@(I16# x#) y@(I16# y#) | y /= 0 = (I16# (narrow16Int# (x# `quotInt#` y#)), I16# (narrow16Int# (x# `remInt#` y#))) - | otherwise = divZeroError "quotRem{Int16}" x + | otherwise = divZeroError divMod x@(I16# x#) y@(I16# y#) | y /= 0 = (I16# (narrow16Int# (x# `divInt#` y#)), I16# (narrow16Int# (x# `modInt#` y#))) - | otherwise = divZeroError "divMod{Int16}" x + | otherwise = divZeroError toInteger (I16# x#) = S# x# instance Bounded Int16 where @@ -305,22 +306,22 @@ instance Enum Int32 where instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `quotInt32#` y#) - | otherwise = divZeroError "quot{Int32}" x + | otherwise = divZeroError rem x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `remInt32#` y#) - | otherwise = divZeroError "rem{Int32}" x + | otherwise = divZeroError div x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `divInt32#` y#) - | otherwise = divZeroError "div{Int32}" x + | otherwise = divZeroError mod x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (x# `modInt32#` y#) - | otherwise = divZeroError "mod{Int32}" x + | otherwise = divZeroError quotRem x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (x# `quotInt32#` y#), I32# (x# `remInt32#` y#)) - | otherwise = divZeroError "quotRem{Int32}" x + | otherwise = divZeroError divMod x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (x# `divInt32#` y#), I32# (x# `modInt32#` y#)) - | otherwise = divZeroError "divMod{Int32}" x + | otherwise = divZeroError toInteger x@(I32# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = S# (int32ToInt# x#) @@ -449,24 +450,24 @@ instance Enum Int32 where instance Integral Int32 where quot x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `quotInt#` y#)) - | otherwise = divZeroError "quot{Int32}" x + | otherwise = divZeroError rem x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `remInt#` y#)) - | otherwise = divZeroError "rem{Int32}" x + | otherwise = divZeroError div x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `divInt#` y#)) - | otherwise = divZeroError "div{Int32}" x + | otherwise = divZeroError mod x@(I32# x#) y@(I32# y#) | y /= 0 = I32# (narrow32Int# (x# `modInt#` y#)) - | otherwise = divZeroError "mod{Int32}" x + | otherwise = divZeroError quotRem x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (narrow32Int# (x# `quotInt#` y#)), I32# (narrow32Int# (x# `remInt#` y#))) - | otherwise = divZeroError "quotRem{Int32}" x + | otherwise = divZeroError divMod x@(I32# x#) y@(I32# y#) | y /= 0 = (I32# (narrow32Int# (x# `divInt#` y#)), I32# (narrow32Int# (x# `modInt#` y#))) - | otherwise = divZeroError "divMod{Int32}" x + | otherwise = divZeroError toInteger (I32# x#) = S# x# instance Read Int32 where @@ -575,22 +576,22 @@ instance Enum Int64 where instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `quotInt64#` y#) - | otherwise = divZeroError "quot{Int64}" x + | otherwise = divZeroError rem x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `remInt64#` y#) - | otherwise = divZeroError "rem{Int64}" x + | otherwise = divZeroError div x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `divInt64#` y#) - | otherwise = divZeroError "div{Int64}" x + | otherwise = divZeroError mod x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `modInt64#` y#) - | otherwise = divZeroError "mod{Int64}" x + | otherwise = divZeroError quotRem x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#)) - | otherwise = divZeroError "quotRem{Int64}" x + | otherwise = divZeroError divMod x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) - | otherwise = divZeroError "divMod{Int64}" x + | otherwise = divZeroError toInteger x@(I64# x#) | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = S# (int64ToInt# x#) @@ -730,22 +731,22 @@ instance Enum Int64 where instance Integral Int64 where quot x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `quotInt#` y#) - | otherwise = divZeroError "quot{Int64}" x + | otherwise = divZeroError rem x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `remInt#` y#) - | otherwise = divZeroError "rem{Int64}" x + | otherwise = divZeroError div x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `divInt#` y#) - | otherwise = divZeroError "div{Int64}" x + | otherwise = divZeroError mod x@(I64# x#) y@(I64# y#) | y /= 0 = I64# (x# `modInt#` y#) - | otherwise = divZeroError "mod{Int64}" x + | otherwise = divZeroError quotRem x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#)) - | otherwise = divZeroError "quotRem{Int64}" x + | otherwise = divZeroError divMod x@(I64# x#) y@(I64# y#) | y /= 0 = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#)) - | otherwise = divZeroError "divMod{Int64}" x + | otherwise = divZeroError toInteger (I64# x#) = S# x# instance Read Int64 where diff --git a/GHC/Num.lhs b/GHC/Num.lhs index a0c61e7..17d35ef 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -79,15 +79,9 @@ instance Num Int where | otherwise = 1 fromInteger = integer2Int -\end{code} - - -\begin{code} --- These can't go in GHC.Base with the defn of Int, because --- we don't have pairs defined at that time! quotRemInt :: Int -> Int -> (Int, Int) -a@(I# _) `quotRemInt` b@(I# _) = (a `quotInt` b, a `remInt` b) +quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b) -- OK, so I made it a little stricter. Shoot me. (WDP 94/10) divModInt :: Int -> Int -> (Int, Int) @@ -95,7 +89,6 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) -- Stricter. Sorry if you don't like it. (WDP 94/10) \end{code} - %********************************************************* %* * \subsection{The @Integer@ type} diff --git a/GHC/Real.lhs b/GHC/Real.lhs index a656c5f..239ab16 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -172,18 +172,22 @@ instance Real Int where instance Integral Int where toInteger i = int2Integer i -- give back a full-blown Integer - -- Following chks for zero divisor are non-standard (WDP) - a `quot` b = if b /= 0 - then a `quotInt` b - else error "Prelude.Integral.quot{Int}: divide by 0" - a `rem` b = if b /= 0 - then a `remInt` b - else error "Prelude.Integral.rem{Int}: divide by 0" + a `quot` 0 = divZeroError + a `quot` b = a `quotInt` b - x `div` y = x `divInt` y - x `mod` y = x `modInt` y + 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 \end{code} @@ -201,14 +205,19 @@ instance Real Integer where instance Integral Integer where toInteger n = n + a `quot` 0 = divZeroError n `quot` d = n `quotInteger` d - n `rem` d = n `remInteger` d - n `div` d = q where (q,_) = divMod n d - n `mod` d = r where (_,r) = divMod n d + a `rem` 0 = divZeroError + n `rem` d = n `remInteger` d + a `divMod` 0 = divZeroError a `divMod` b = a `divModInteger` b + + a `quotRem` 0 = divZeroError a `quotRem` b = a `quotRemInteger` b + + -- use the defaults for div & mod \end{code} diff --git a/GHC/Word.hs b/GHC/Word.hs index 0d0c60b..2332c13 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -18,11 +18,12 @@ module GHC.Word ( Word(..), Word8(..), Word16(..), Word32(..), Word64(..), - divZeroError, toEnumError, fromEnumError, succError, predError) + toEnumError, fromEnumError, succError, predError) where import Data.Bits +import {-# SOURCE #-} GHC.Err import GHC.Base import GHC.Enum import GHC.Num @@ -35,11 +36,6 @@ import GHC.Show -- Helper functions ------------------------------------------------------------------------ -{-# NOINLINE divZeroError #-} -divZeroError :: (Show a) => String -> a -> b -divZeroError meth x = - error $ "Integral." ++ meth ++ ": divide by 0 (" ++ show x ++ " / 0)" - {-# NOINLINE toEnumError #-} toEnumError :: (Show a) => String -> Int -> (a,a) -> b toEnumError inst_ty i bnds = @@ -115,22 +111,22 @@ instance Enum Word where instance Integral Word where quot x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) - | otherwise = divZeroError "quot{Word}" x + | otherwise = divZeroError rem x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `remWord#` y#) - | otherwise = divZeroError "rem{Word}" x + | otherwise = divZeroError div x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `quotWord#` y#) - | otherwise = divZeroError "div{Word}" x + | otherwise = divZeroError mod x@(W# x#) y@(W# y#) | y /= 0 = W# (x# `remWord#` y#) - | otherwise = divZeroError "mod{Word}" x + | otherwise = divZeroError quotRem x@(W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word}" x + | otherwise = divZeroError divMod x@(W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) - | otherwise = divZeroError "divMod{Word}" x + | otherwise = divZeroError toInteger (W# x#) | i# >=# 0# = S# i# | otherwise = case word2Integer# x# of (# s, d #) -> J# s d @@ -227,22 +223,22 @@ instance Enum Word8 where instance Integral Word8 where quot x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) - | otherwise = divZeroError "quot{Word8}" x + | otherwise = divZeroError rem x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `remWord#` y#) - | otherwise = divZeroError "rem{Word8}" x + | otherwise = divZeroError div x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `quotWord#` y#) - | otherwise = divZeroError "div{Word8}" x + | otherwise = divZeroError mod x@(W8# x#) y@(W8# y#) | y /= 0 = W8# (x# `remWord#` y#) - | otherwise = divZeroError "mod{Word8}" x + | otherwise = divZeroError quotRem x@(W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word8}" x + | otherwise = divZeroError divMod x@(W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word8}" x + | otherwise = divZeroError toInteger (W8# x#) = S# (word2Int# x#) instance Bounded Word8 where @@ -330,22 +326,22 @@ instance Enum Word16 where instance Integral Word16 where quot x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) - | otherwise = divZeroError "quot{Word16}" x + | otherwise = divZeroError rem x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `remWord#` y#) - | otherwise = divZeroError "rem{Word16}" x + | otherwise = divZeroError div x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `quotWord#` y#) - | otherwise = divZeroError "div{Word16}" x + | otherwise = divZeroError mod x@(W16# x#) y@(W16# y#) | y /= 0 = W16# (x# `remWord#` y#) - | otherwise = divZeroError "mod{Word16}" x + | otherwise = divZeroError quotRem x@(W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word16}" x + | otherwise = divZeroError divMod x@(W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word16}" x + | otherwise = divZeroError toInteger (W16# x#) = S# (word2Int# x#) instance Bounded Word16 where @@ -438,22 +434,22 @@ instance Enum Word32 where instance Integral Word32 where quot x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord32#` y#) - | otherwise = divZeroError "quot{Word32}" x + | otherwise = divZeroError rem x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord32#` y#) - | otherwise = divZeroError "rem{Word32}" x + | otherwise = divZeroError div x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord32#` y#) - | otherwise = divZeroError "div{Word32}" x + | otherwise = divZeroError mod x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord32#` y#) - | otherwise = divZeroError "mod{Word32}" x + | otherwise = divZeroError quotRem x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#)) - | otherwise = divZeroError "quotRem{Word32}" x + | otherwise = divZeroError divMod x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#)) - | otherwise = divZeroError "quotRem{Word32}" x + | otherwise = divZeroError toInteger x@(W32# x#) | x <= fromIntegral (maxBound::Int) = S# (word2Int# (word32ToWord# x#)) | otherwise = case word32ToInteger# x# of (# s, d #) -> J# s d @@ -561,22 +557,22 @@ instance Enum Word32 where instance Integral Word32 where quot x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) - | otherwise = divZeroError "quot{Word32}" x + | otherwise = divZeroError rem x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord#` y#) - | otherwise = divZeroError "rem{Word32}" x + | otherwise = divZeroError div x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `quotWord#` y#) - | otherwise = divZeroError "div{Word32}" x + | otherwise = divZeroError mod x@(W32# x#) y@(W32# y#) | y /= 0 = W32# (x# `remWord#` y#) - | otherwise = divZeroError "mod{Word32}" x + | otherwise = divZeroError quotRem x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word32}" x + | otherwise = divZeroError divMod x@(W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word32}" x + | otherwise = divZeroError toInteger (W32# x#) #if WORD_SIZE_IN_BITS == 32 | i# >=# 0# = S# i# @@ -698,22 +694,22 @@ instance Enum Word64 where instance Integral Word64 where quot x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) - | otherwise = divZeroError "quot{Word64}" x + | otherwise = divZeroError rem x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord64#` y#) - | otherwise = divZeroError "rem{Word64}" x + | otherwise = divZeroError div x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord64#` y#) - | otherwise = divZeroError "div{Word64}" x + | otherwise = divZeroError mod x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord64#` y#) - | otherwise = divZeroError "mod{Word64}" x + | otherwise = divZeroError quotRem x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) - | otherwise = divZeroError "quotRem{Word64}" x + | otherwise = divZeroError divMod x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) - | otherwise = divZeroError "quotRem{Word64}" x + | otherwise = divZeroError toInteger x@(W64# x#) | x <= 0x7FFFFFFF = S# (word2Int# (word64ToWord# x#)) | otherwise = case word64ToInteger# x# of (# s, d #) -> J# s d @@ -826,22 +822,22 @@ instance Enum Word64 where instance Integral Word64 where quot x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) - | otherwise = divZeroError "quot{Word64}" x + | otherwise = divZeroError rem x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord#` y#) - | otherwise = divZeroError "rem{Word64}" x + | otherwise = divZeroError div x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `quotWord#` y#) - | otherwise = divZeroError "div{Word64}" x + | otherwise = divZeroError mod x@(W64# x#) y@(W64# y#) | y /= 0 = W64# (x# `remWord#` y#) - | otherwise = divZeroError "mod{Word64}" x + | otherwise = divZeroError quotRem x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word64}" x + | otherwise = divZeroError divMod x@(W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) - | otherwise = divZeroError "quotRem{Word64}" x + | otherwise = divZeroError toInteger (W64# x#) | i# >=# 0# = S# i# | otherwise = case word2Integer# x# of (# s, d #) -> J# s d