From d65e7b1a11573d1c001ce8ab0ced55856e2e8c78 Mon Sep 17 00:00:00 2001
From: Johan Tibell <[email protected]>
Date: Tue, 23 Aug 2011 14:58:13 +0200
Subject: [PATCH 1/1] 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..10ad6e1 100644
a

b

module Data.Bits ( 
33  33  bitSize,  :: a > Int 
34  34  isSigned,  :: a > Bool 
35  35  shiftL, shiftR,  :: a > Int > a 
36   rotateL, rotateR  :: a > Int > a 
 36  rotateL, rotateR,  :: a > Int > a 
 37  popCount  :: a > Int 
37  38  ) 
38  39  
39  40   instance Bits Int 
… 
… 
class Num a => Bits a where 
207  208  {# INLINE rotateR #} 
208  209  x `rotateR` i = x `rotate` (i) 
209  210  
 211  { Return the number of set bits in the argument, known as the 
 212  population count or the Hamming weight. } 
 213  popCount :: a > Int 
 214  popCount = go 0 
 215  where 
 216  go !c 0 = c 
 217  go c w = go (c+1) (w .&. w  1)  clear the least significant bit set 
 218  { This implementation is intentionally naive. Instances are 
 219  expected to override it with something optimized for their 
 220  size. } 
 221  
210  222  instance Bits Int where 
211  223  {# INLINE shift #} 
212  224  
… 
… 
instance Bits Int where 
235  247  !wsib = WORD_SIZE_IN_BITS# { work around preprocessor problem (??) } 
236  248  bitSize _ = WORD_SIZE_IN_BITS 
237  249  
 250  popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#))) 
 251  
238  252  #else /* !__GLASGOW_HASKELL__ */ 
239  253  
240  254  #ifdef __HUGS__ 
diff git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index 9bb7642..ed4c5e1 100644
a

b

instance Bits T where { \ 
320  320  complementBit (T x) n = T (complementBit x n) ; \ 
321  321  testBit (T x) n = testBit x n ; \ 
322  322  bitSize (T x) = bitSize x ; \ 
323   isSigned (T x) = isSigned x } 
 323  isSigned (T x) = isSigned x ; \ 
 324  popCount (T x) = popCount x } 
324  325  
325  326  INSTANCE_BITS(CChar) 
326  327  INSTANCE_BITS(CSChar) 
diff git a/GHC/Int.hs b/GHC/Int.hs
index b029ec8..65d42b4 100644
a

b

instance Bits Int8 where 
149  149  !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) 
150  150  bitSize _ = 8 
151  151  isSigned _ = True 
 152  popCount (I8# x#) = I# (word2Int# (popCnt8# (int2Word# x#))) 
152  153  
153  154  {# RULES 
154  155  "fromIntegral/Int8>Int8" fromIntegral = id :: Int8 > Int8 
… 
… 
instance Bits Int16 where 
293  294  !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) 
294  295  bitSize _ = 16 
295  296  isSigned _ = True 
 297  popCount (I16# x#) = I# (word2Int# (popCnt16# (int2Word# x#))) 
296  298  
297  299  
298  300  {# RULES 
… 
… 
instance Bits Int32 where 
443  445  !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) 
444  446  bitSize _ = 32 
445  447  isSigned _ = True 
 448  popCount (I32# x#) = I# (word2Int# (popCnt32# (int2Word# x#))) 
446  449  
447  450  {# RULES 
448  451  "fromIntegral/Word8>Int32" fromIntegral = \(W8# x#) > I32# (word2Int# x#) 
… 
… 
instance Bits Int64 where 
626  629  !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) 
627  630  bitSize _ = 64 
628  631  isSigned _ = True 
 632  popCount (I64# x#) = 
 633  I64# (word64ToInt64# (popCnt64# (int64ToWord64# x#))) 
629  634  
630  635   give the 64bit shift operations the same treatment as the 32bit 
631  636   ones (see GHC.Base), namely we wrap them in tests to catch the 
… 
… 
instance Bits Int64 where 
751  756  !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) 
752  757  bitSize _ = 64 
753  758  isSigned _ = True 
 759  popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#))) 
754  760  
755  761  {# RULES 
756  762  "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

b

instance Bits Word where 
180  180  !wsib = WORD_SIZE_IN_BITS# { work around preprocessor problem (??) } 
181  181  bitSize _ = WORD_SIZE_IN_BITS 
182  182  isSigned _ = False 
 183  popCount (W# x#) = I# (word2Int# (popCnt# x#)) 
183  184  
184  185  {# RULES 
185  186  "fromIntegral/Int>Word" fromIntegral = \(I# x#) > W# (int2Word# x#) 
… 
… 
instance Bits Word8 where 
286  287  !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) 
287  288  bitSize _ = 8 
288  289  isSigned _ = False 
 290  popCount (W8# x#) = I# (word2Int# (popCnt8# x#)) 
289  291  
290  292  {# RULES 
291  293  "fromIntegral/Word8>Word8" fromIntegral = id :: Word8 > Word8 
… 
… 
instance Bits Word16 where 
419  421  !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) 
420  422  bitSize _ = 16 
421  423  isSigned _ = False 
 424  popCount (W16# x#) = I# (word2Int# (popCnt16# x#)) 
422  425  
423  426  {# RULES 
424  427  "fromIntegral/Word8>Word16" fromIntegral = \(W8# x#) > W16# x# 
… 
… 
instance Bits Word32 where 
593  596  !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) 
594  597  bitSize _ = 32 
595  598  isSigned _ = False 
 599  popCount (W32# x#) = I# (word2Int# (popCnt32# x#)) 
596  600  
597  601  {# RULES 
598  602  "fromIntegral/Word8>Word32" fromIntegral = \(W8# x#) > W32# x# 
… 
… 
instance Bits Word64 where 
719  723  !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) 
720  724  bitSize _ = 64 
721  725  isSigned _ = False 
 726  popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) 
722  727  
723  728   give the 64bit shift operations the same treatment as the 32bit 
724  729   ones (see GHC.Base), namely we wrap them in tests to catch the 
… 
… 
instance Bits Word64 where 
825  830  !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) 
826  831  bitSize _ = 64 
827  832  isSigned _ = False 
 833  popCount (W64# x#) = I# (word2Int# (popCnt64# x#)) 
828  834  
829  835  {# RULES 
830  836  "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

b

instance Bits T where { \ 
108  108  complementBit (T x) n = T (complementBit x n) ; \ 
109  109  testBit (T x) n = testBit x n ; \ 
110  110  bitSize (T x) = bitSize x ; \ 
111   isSigned (T x) = isSigned x } 
 111  isSigned (T x) = isSigned x ; \ 
 112  popCount (T x) = popCount x } 
112  113  
113  114  #define INSTANCE_FRACTIONAL(T) \ 
114  115  instance Fractional T where { \ 