Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/03130b0663cafeec6cefa0eee495e97354778b79 >--------------------------------------------------------------- commit 03130b0663cafeec6cefa0eee495e97354778b79 Author: Liyang HU <[email protected]> Date: Fri Jul 22 19:47:36 2011 +0900 Data.Bits: specialise shift[LR] for instance Bits Documentation notes that the second arg of shift[LR] must be positive, yet many definitions of instance Bits rely on the class default, which performs an unnecessary sign check. >--------------------------------------------------------------- Data/Bits.hs | 2 ++ GHC/Int.hs | 12 ++++++++++++ GHC/Word.hs | 14 ++++++++++++++ 3 files changed, 28 insertions(+), 0 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index 35006f4..a400c2f 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -222,6 +222,8 @@ instance Bits Int where (I# x#) `shift` (I# i#) | i# >=# 0# = I# (x# `iShiftL#` i#) | otherwise = I# (x# `iShiftRA#` negateInt# i#) + (I# x#) `shiftL` (I# i#) = I# (x# `iShiftL#` i#) + (I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#) {-# INLINE rotate #-} -- See Note [Constant folding for rotate] (I# x#) `rotate` (I# i#) = diff --git a/GHC/Int.hs b/GHC/Int.hs index 42e5c9f..0244419 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -139,6 +139,8 @@ instance Bits Int8 where (I8# x#) `shift` (I# i#) | i# >=# 0# = I8# (narrow8Int# (x# `iShiftL#` i#)) | otherwise = I8# (x# `iShiftRA#` negateInt# i#) + (I8# x#) `shiftL` (I# i#) = I8# (narrow8Int# (x# `iShiftL#` i#)) + (I8# x#) `shiftR` (I# i#) = I8# (x# `iShiftRA#` i#) (I8# x#) `rotate` (I# i#) | i'# ==# 0# = I8# x# @@ -281,6 +283,8 @@ instance Bits Int16 where (I16# x#) `shift` (I# i#) | i# >=# 0# = I16# (narrow16Int# (x# `iShiftL#` i#)) | otherwise = I16# (x# `iShiftRA#` negateInt# i#) + (I16# x#) `shiftL` (I# i#) = I16# (narrow16Int# (x# `iShiftL#` i#)) + (I16# x#) `shiftR` (I# i#) = I16# (x# `iShiftRA#` i#) (I16# x#) `rotate` (I# i#) | i'# ==# 0# = I16# x# @@ -452,6 +456,8 @@ instance Bits Int32 where (I32# x#) `shift` (I# i#) | i# >=# 0# = I32# (x# `iShiftL32#` i#) | otherwise = I32# (x# `iShiftRA32#` negateInt# i#) + (I32# x#) `shiftL` (I# i#) = I32# (x# `iShiftL32#` i#) + (I32# x#) `shiftR` (I# i#) = I32# (x# `iShiftRA32#` i#) (I32# x#) `rotate` (I# i#) | i'# ==# 0# = I32# x# @@ -571,6 +577,8 @@ instance Bits Int32 where (I32# x#) `shift` (I# i#) | i# >=# 0# = I32# (narrow32Int# (x# `iShiftL#` i#)) | otherwise = I32# (x# `iShiftRA#` negateInt# i#) + (I32# x#) `shiftL` (I# i#) = I32# (narrow32Int# (x# `iShiftL#` i#)) + (I32# x#) `shiftR` (I# i#) = I32# (x# `iShiftRA#` i#) (I32# x#) `rotate` (I# i#) | i'# ==# 0# = I32# x# @@ -754,6 +762,8 @@ instance Bits Int64 where (I64# x#) `shift` (I# i#) | i# >=# 0# = I64# (x# `iShiftL64#` i#) | otherwise = I64# (x# `iShiftRA64#` negateInt# i#) + (I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL64#` i#) + (I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA64#` i#) (I64# x#) `rotate` (I# i#) | i'# ==# 0# = I64# x# @@ -877,6 +887,8 @@ instance Bits Int64 where (I64# x#) `shift` (I# i#) | i# >=# 0# = I64# (x# `iShiftL#` i#) | otherwise = I64# (x# `iShiftRA#` negateInt# i#) + (I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL#` i#) + (I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA#` i#) (I64# x#) `rotate` (I# i#) | i'# ==# 0# = I64# x# diff --git a/GHC/Word.hs b/GHC/Word.hs index dd7e7d5..ff37ef5 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -175,6 +175,8 @@ instance Bits Word where (W# x#) `shift` (I# i#) | i# >=# 0# = W# (x# `shiftL#` i#) | otherwise = W# (x# `shiftRL#` negateInt# i#) + (W# x#) `shiftL` (I# i#) = W# (x# `shiftL#` i#) + (W# x#) `shiftR` (I# i#) = W# (x# `shiftRL#` i#) (W# x#) `rotate` (I# i#) | i'# ==# 0# = W# x# | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#))) @@ -279,6 +281,8 @@ instance Bits Word8 where (W8# x#) `shift` (I# i#) | i# >=# 0# = W8# (narrow8Word# (x# `shiftL#` i#)) | otherwise = W8# (x# `shiftRL#` negateInt# i#) + (W8# x#) `shiftL` (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) + (W8# x#) `shiftR` (I# i#) = W8# (x# `shiftRL#` i#) (W8# x#) `rotate` (I# i#) | i'# ==# 0# = W8# x# | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#` @@ -410,6 +414,8 @@ instance Bits Word16 where (W16# x#) `shift` (I# i#) | i# >=# 0# = W16# (narrow16Word# (x# `shiftL#` i#)) | otherwise = W16# (x# `shiftRL#` negateInt# i#) + (W16# x#) `shiftL` (I# i#) = W16# (narrow16Word# (x# `shiftL#` i#)) + (W16# x#) `shiftR` (I# i#) = W16# (x# `shiftRL#` i#) (W16# x#) `rotate` (I# i#) | i'# ==# 0# = W16# x# | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#` @@ -539,6 +545,8 @@ instance Bits Word32 where (W32# x#) `shift` (I# i#) | i# >=# 0# = W32# (x# `shiftL32#` i#) | otherwise = W32# (x# `shiftRL32#` negateInt# i#) + (W32# x#) `shiftL` (I# i#) = W32# (x# `shiftL32#` i#) + (W32# x#) `shiftR` (I# i#) = W32# (x# `shiftRL32#` i#) (W32# x#) `rotate` (I# i#) | i'# ==# 0# = W32# x# | otherwise = W32# ((x# `shiftL32#` i'#) `or32#` @@ -679,6 +687,8 @@ instance Bits Word32 where (W32# x#) `shift` (I# i#) | i# >=# 0# = W32# (narrow32Word# (x# `shiftL#` i#)) | otherwise = W32# (x# `shiftRL#` negateInt# i#) + (W32# x#) `shiftL` (I# i#) = W32# (narrow32Word# (x# `shiftL#` i#)) + (W32# x#) `shiftR` (I# i#) = W32# (x# `shiftRL#` i#) (W32# x#) `rotate` (I# i#) | i'# ==# 0# = W32# x# | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#` @@ -805,6 +815,8 @@ instance Bits Word64 where (W64# x#) `shift` (I# i#) | i# >=# 0# = W64# (x# `shiftL64#` i#) | otherwise = W64# (x# `shiftRL64#` negateInt# i#) + (W64# x#) `shiftL` (I# i#) = W64# (x# `shiftL64#` i#) + (W64# x#) `shiftR` (I# i#) = W64# (x# `shiftRL64#` i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# | otherwise = W64# ((x# `uncheckedShiftL64#` i'#) `or64#` @@ -909,6 +921,8 @@ instance Bits Word64 where (W64# x#) `shift` (I# i#) | i# >=# 0# = W64# (x# `shiftL#` i#) | otherwise = W64# (x# `shiftRL#` negateInt# i#) + (W64# x#) `shiftL` (I# i#) = W64# (x# `shiftL#` i#) + (W64# x#) `shiftR` (I# i#) = W64# (x# `shiftRL#` i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#` _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
