Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/d0059677ed3290bb14d7b49b2f0b9819980b8e44 >--------------------------------------------------------------- commit d0059677ed3290bb14d7b49b2f0b9819980b8e44 Author: Johan Tibell <[email protected]> Date: Thu Dec 13 09:00:38 2012 -0800 highestBitMask: use shiftRL instead of shiftR >--------------------------------------------------------------- GHC/Event/IntMap.hs | 16 ++++++++-------- 1 files changed, 8 insertions(+), 8 deletions(-) diff --git a/GHC/Event/IntMap.hs b/GHC/Event/IntMap.hs index 7e7814e..c850311 100644 --- a/GHC/Event/IntMap.hs +++ b/GHC/Event/IntMap.hs @@ -333,15 +333,15 @@ branchMask p1 p2 -- | Return a word where only the highest bit is set. highestBitMask :: Nat -> Nat -highestBitMask x1 = let x2 = x1 .|. x1 `shiftR` 1 - x3 = x2 .|. x2 `shiftR` 2 - x4 = x3 .|. x3 `shiftR` 4 - x5 = x4 .|. x4 `shiftR` 8 - x6 = x5 .|. x5 `shiftR` 16 +highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1 + x3 = x2 .|. x2 `shiftRL` 2 + x4 = x3 .|. x3 `shiftRL` 4 + x5 = x4 .|. x4 `shiftRL` 8 + x6 = x5 .|. x5 `shiftRL` 16 #if !(WORD_SIZE_IN_BITS==32) - x7 = x6 .|. x6 `shiftR` 32 - in x7 `xor` (x7 `shiftR` 1) + x7 = x6 .|. x6 `shiftRL` 32 + in x7 `xor` (x7 `shiftRL` 1) #else - in x6 `xor` (x6 `shiftR` 1) + in x6 `xor` (x6 `shiftRL` 1) #endif {-# INLINE highestBitMask #-} _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
