[commit: base] master: Add Data.Bits.popCount (7afc8f0)
Johan Tibell
johan.tibell at gmail.com
Thu Aug 25 22:38:56 CEST 2011
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 <johan.tibell at gmail.com>
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 { \
More information about the Cvs-libraries
mailing list