Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f4cc96cd1a9d78ee250c8f26797e0b72a8008a1c >--------------------------------------------------------------- commit f4cc96cd1a9d78ee250c8f26797e0b72a8008a1c Author: Johan Tibell <[email protected]> Date: Tue Feb 14 09:38:19 2012 -0800 Fix bug in popCountDefault. Fixes #5872 Also add an INLINABLE pragma so that the function can be specialized at the call site. >--------------------------------------------------------------- Data/Bits.hs | 3 ++- 1 files changed, 2 insertions(+), 1 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index cac9128..496f592 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -257,7 +257,8 @@ popCountDefault :: (Bits a, Num a) => a -> Int popCountDefault = go 0 where go !c 0 = c - go c w = go (c+1) (w .&. w - 1) -- clear the least significant + go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant +{-# INLINABLE popCountDefault #-} instance Bits Int where {-# INLINE shift #-} _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
