Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/91b37f07da88933d609d81a1f078587a1e4efe52 >--------------------------------------------------------------- commit 91b37f07da88933d609d81a1f078587a1e4efe52 Author: Ian Lynagh <[email protected]> Date: Mon May 21 20:29:11 2012 +0100 Remove some more specialise-Int code >--------------------------------------------------------------- GHC/Base.lhs | 12 +----------- GHC/Num.lhs | 12 ++++++------ GHC/Show.lhs | 7 ++----- 3 files changed, 9 insertions(+), 22 deletions(-) diff --git a/GHC/Base.lhs b/GHC/Base.lhs index 26685a3..2f457a8 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -680,17 +680,10 @@ Definitions of the boxed PrimOps; these will be used in the case of partial applications, etc. \begin{code} -{-# INLINE plusInt #-} -{-# INLINE minusInt #-} -{-# INLINE timesInt #-} {-# INLINE quotInt #-} {-# INLINE remInt #-} -{-# INLINE negateInt #-} -plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int -(I# x) `plusInt` (I# y) = I# (x +# y) -(I# x) `minusInt` (I# y) = I# (x -# y) -(I# x) `timesInt` (I# y) = I# (x *# y) +quotInt, remInt, divInt, modInt :: Int -> Int -> Int (I# x) `quotInt` (I# y) = I# (x `quotInt#` y) (I# x) `remInt` (I# y) = I# (x `remInt#` y) (I# x) `divInt` (I# y) = I# (x `divInt#` y) @@ -724,9 +717,6 @@ x# `divModInt#` y# "1# *# x#" forall x#. 1# *# x# = x# #-} -negateInt :: Int -> Int -negateInt (I# x) = I# (negateInt# x) - {-# RULES "x# ># x#" forall x#. x# ># x# = False "x# >=# x#" forall x#. x# >=# x# = True diff --git a/GHC/Num.lhs b/GHC/Num.lhs index 5dc8ee9..fba9c48 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -83,13 +83,13 @@ subtract x y = y - x \begin{code} instance Num Int where - (+) = plusInt - (-) = minusInt - negate = negateInt - (*) = timesInt - abs n = if n `geInt` 0 then n else negateInt n + I# x + I# y = I# (x +# y) + I# x - I# y = I# (x -# y) + negate (I# x) = I# (negateInt# x) + I# x * I# y = I# (x *# y) + abs n = if n `geInt` 0 then n else negate n - signum n | n `ltInt` 0 = negateInt 1 + signum n | n `ltInt` 0 = negate 1 | n `eqInt` 0 = 0 | otherwise = 1 diff --git a/GHC/Show.lhs b/GHC/Show.lhs index f6900d5..906bb7b 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -416,13 +416,10 @@ Code specific for Ints. -- lower-case hexadecimal digits. intToDigit :: Int -> Char intToDigit (I# i) - | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i) - | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i) + | i >=# 0# && i <=# 9# = unsafeChr (ord '0' + I# i) + | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' + I# i - 10) | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i)) -ten :: Int -ten = I# 10# - showSignedInt :: Int -> Int -> ShowS showSignedInt (I# p) (I# n) r | n <# 0# && p ># 6# = '(' : itos n (')' : r) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
