Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7afc8f048b54d3a496585a9d2b674585ee3de495 >--------------------------------------------------------------- commit 7afc8f048b54d3a496585a9d2b674585ee3de495 Author: Johan Tibell <[email protected]> Date: Tue Aug 23 14:58:13 2011 +0200 Add Data.Bits.popCount >--------------------------------------------------------------- Data/Bits.hs | 16 +++++++++++++++- Foreign/C/Types.hs | 3 ++- GHC/Int.hs | 6 ++++++ GHC/Word.hs | 6 ++++++ include/CTypes.h | 3 ++- 5 files changed, 31 insertions(+), 3 deletions(-) diff --git a/Data/Bits.hs b/Data/Bits.hs index a400c2f..855436d 100644 --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -33,7 +33,8 @@ module Data.Bits ( bitSize, -- :: a -> Int isSigned, -- :: a -> Bool shiftL, shiftR, -- :: a -> Int -> a - rotateL, rotateR -- :: a -> Int -> a + rotateL, rotateR, -- :: a -> Int -> a + popCount -- :: a -> Int ) -- instance Bits Int @@ -207,6 +208,17 @@ class Num a => Bits a where {-# INLINE rotateR #-} x `rotateR` i = x `rotate` (-i) + {-| Return the number of set bits in the argument. This number is + known as the population count or the Hamming weight. -} + popCount :: a -> Int + popCount = go 0 + where + go !c 0 = c + go c w = go (c+1) (w .&. w - 1) -- clear the least significant bit set + {- This implementation is intentionally naive. Instances are + expected to override it with something optimized for their + size. -} + instance Bits Int where {-# INLINE shift #-} @@ -235,6 +247,8 @@ instance Bits Int where !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS + popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#))) + #else /* !__GLASGOW_HASKELL__ */ #ifdef __HUGS__ diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index 9bb7642..ed4c5e1 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -320,7 +320,8 @@ instance Bits T where { \ complementBit (T x) n = T (complementBit x n) ; \ testBit (T x) n = testBit x n ; \ bitSize (T x) = bitSize x ; \ - isSigned (T x) = isSigned x } + isSigned (T x) = isSigned x ; \ + popCount (T x) = popCount x } INSTANCE_BITS(CChar) INSTANCE_BITS(CSChar) diff --git a/GHC/Int.hs b/GHC/Int.hs index b029ec8..65d42b4 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -149,6 +149,7 @@ instance Bits Int8 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = True + popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#))) {-# RULES "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8 @@ -293,6 +294,7 @@ instance Bits Int16 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = True + popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#))) {-# RULES @@ -443,6 +445,7 @@ instance Bits Int32 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = True + popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#))) {-# RULES "fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#) @@ -626,6 +629,8 @@ instance Bits Int64 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True + popCount (I64# x#) = + I64# (word64ToInt64# (popCnt64# (int64ToWord64# x#))) -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the @@ -751,6 +756,7 @@ instance Bits Int64 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True + popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#))) {-# RULES "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x# diff --git a/GHC/Word.hs b/GHC/Word.hs index 99ac8a7..2714898 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -180,6 +180,7 @@ instance Bits Word where !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS isSigned _ = False + popCount (W# x#) = I# (word2Int# (popCnt# x#)) {-# RULES "fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#) @@ -286,6 +287,7 @@ instance Bits Word8 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = False + popCount (W8# x#) = I# (word2Int# (popCnt8# x#)) {-# RULES "fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8 @@ -419,6 +421,7 @@ instance Bits Word16 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = False + popCount (W16# x#) = I# (word2Int# (popCnt16# x#)) {-# RULES "fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x# @@ -593,6 +596,7 @@ instance Bits Word32 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = False + popCount (W32# x#) = I# (word2Int# (popCnt32# x#)) {-# RULES "fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x# @@ -719,6 +723,7 @@ instance Bits Word64 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False + popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) -- give the 64-bit shift operations the same treatment as the 32-bit -- ones (see GHC.Base), namely we wrap them in tests to catch the @@ -825,6 +830,7 @@ instance Bits Word64 where !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False + popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) {-# RULES "fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x# diff --git a/include/CTypes.h b/include/CTypes.h index 3ca9f1c..345a434 100644 --- a/include/CTypes.h +++ b/include/CTypes.h @@ -108,7 +108,8 @@ instance Bits T where { \ complementBit (T x) n = T (complementBit x n) ; \ testBit (T x) n = testBit x n ; \ bitSize (T x) = bitSize x ; \ - isSigned (T x) = isSigned x } + isSigned (T x) = isSigned x ; \ + popCount (T x) = popCount x } #define INSTANCE_FRACTIONAL(T) \ instance Fractional T where { \ _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
