Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f0b9de4c829edffabe3f0c858f33c5e5f69dc738 >--------------------------------------------------------------- commit f0b9de4c829edffabe3f0c858f33c5e5f69dc738 Author: Ian Lynagh <[email protected]> Date: Sun Jan 29 20:14:46 2012 +0000 Use the new quotRemInt# primop >--------------------------------------------------------------- GHC/Base.lhs | 5 +++++ GHC/Int.hs | 24 ++++++++++++++++-------- GHC/Num.lhs | 4 ---- GHC/Show.lhs | 12 ++++++++---- 4 files changed, 29 insertions(+), 16 deletions(-) diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 4b10767..26ea47a 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -707,6 +707,11 @@ plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> In (I# x) `divInt` (I# y) = I# (x `divInt#` y) (I# x) `modInt` (I# y) = I# (x `modInt#` y) +quotRemInt :: Int -> Int -> (Int, Int) +(I# x) `quotRemInt` (I# y) = case x `quotRemInt#` y of + (# q, r #) -> + (I# q, I# r) + {-# RULES "x# +# 0#" forall x#. x# +# 0# = x# "0# +# x#" forall x#. 0# +# x# = x# diff --git a/GHC/Int.hs b/GHC/Int.hs index 4738966..bcf2a7d 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, +{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} @@ -105,8 +105,10 @@ instance Integral Int8 where | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I8# (narrow8Int# (x# `quotInt#` y#)), - I8# (narrow8Int# (x# `remInt#` y#))) + | otherwise = case x# `quotRemInt#` y# of + (# q, r #) -> + (I8# (narrow8Int# q), + I8# (narrow8Int# r)) divMod x@(I8# x#) y@(I8# y#) | y == 0 = divZeroError -- Note [Order of tests] @@ -256,8 +258,10 @@ instance Integral Int16 where | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I16# (narrow16Int# (x# `quotInt#` y#)), - I16# (narrow16Int# (x# `remInt#` y#))) + | otherwise = case x# `quotRemInt#` y# of + (# q, r #) -> + (I16# (narrow16Int# q), + I16# (narrow16Int# r)) divMod x@(I16# x#) y@(I16# y#) | y == 0 = divZeroError -- Note [Order of tests] @@ -421,8 +425,10 @@ instance Integral Int32 where | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I32# (narrow32Int# (x# `quotInt#` y#)), - I32# (narrow32Int# (x# `remInt#` y#))) + | otherwise = case x# `quotRemInt#` y# of + (# q, r #) -> + (I32# (narrow32Int# q), + I32# (narrow32Int# r)) divMod x@(I32# x#) y@(I32# y#) | y == 0 = divZeroError -- Note [Order of tests] @@ -747,7 +753,9 @@ instance Integral Int64 where | y == 0 = divZeroError -- Note [Order of tests] | y == (-1) && x == minBound = (overflowError, 0) - | otherwise = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#)) + | otherwise = case x# `quotRemInt#` y# of + (# q, r #) -> + (I64# q, I64# r) divMod x@(I64# x#) y@(I64# y#) | y == 0 = divZeroError -- Note [Order of tests] diff --git a/GHC/Num.lhs b/GHC/Num.lhs index edc6bdd..644b8f4 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -96,10 +96,6 @@ instance Num Int where {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (integerToInt i) -quotRemInt :: Int -> Int -> (Int, Int) -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) divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) -- Stricter. Sorry if you don't like it. (WDP 94/10) diff --git a/GHC/Show.lhs b/GHC/Show.lhs index d3df071..2c82ab9 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -434,16 +434,20 @@ itos n# cs let !(I# minInt#) = minInt in if n# ==# minInt# -- negateInt# minInt overflows, so we can't do that: - then '-' : itos' (negateInt# (n# `quotInt#` 10#)) - (itos' (negateInt# (n# `remInt#` 10#)) cs) + then '-' : (case n# `quotRemInt#` 10# of + (# q, r #) -> + itos' (negateInt# q) (itos' (negateInt# r) cs)) else '-' : itos' (negateInt# n#) cs | otherwise = itos' n# cs where itos' :: Int# -> String -> String itos' x# cs' | x# <# 10# = C# (chr# (ord# '0'# +# x#)) : cs' - | otherwise = case chr# (ord# '0'# +# (x# `remInt#` 10#)) of { c# -> - itos' (x# `quotInt#` 10#) (C# c# : cs') } + | otherwise = case x# `quotRemInt#` 10# of + (# q, r #) -> + case chr# (ord# '0'# +# r) of + c# -> + itos' q (C# c# : cs') \end{code} Instances for types of the generic deriving mechanism. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
