{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} ----------------------------------------------------------------------------- -- | -- Module : Utils.Containers.Internal.BitUtil -- Copyright : (c) Clark Gaebel 2012 -- (c) Johan Tibel 2012 -- License : BSD-style -- Maintainer : libraries@haskell.org -- Portability : portable ----------------------------------------------------------------------------- -- -- = WARNING -- -- This module is considered __internal__. -- -- The Package Versioning Policy __does not apply__. -- -- The contents of this module may change __in any way whatsoever__ -- and __without any warning__ between minor versions of this package. -- -- Authors importing this module are expected to track development -- closely. module GHC.Utils.Containers.Internal.BitUtil ( bitcount , highestBitMask , shiftLL , shiftRL ) where import GHC.Prelude.Basic import Data.Word {---------------------------------------------------------------------- [bitcount] as posted by David F. Place to haskell-cafe on April 11, 2006, based on the code on http://graphics.stanford.edu/~seander/bithacks.html#CountBitsSetKernighan, where the following source is given: Published in 1988, the C Programming Language 2nd Ed. (by Brian W. Kernighan and Dennis M. Ritchie) mentions this in exercise 2-9. On April 19, 2006 Don Knuth pointed out to me that this method "was first published by Peter Wegner in CACM 3 (1960), 322. (Also discovered independently by Derrick Lehmer and published in 1964 in a book edited by Beckenbach.)" ----------------------------------------------------------------------} bitcount :: Int -> Word64 -> Int bitcount :: Int -> Word64 -> Int bitcount Int a Word64 x = Int a Int -> Int -> Int forall a. Num a => a -> a -> a + Word64 -> Int forall a. Bits a => a -> Int popCount Word64 x {-# INLINE bitcount #-} -- The highestBitMask implementation is based on -- http://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2 -- which has been put in the public domain. -- | Return a word where only the highest bit is set. highestBitMask :: Word64 -> Word64 highestBitMask :: Word64 -> Word64 highestBitMask Word64 w = Word64 -> Int -> Word64 shiftLL Word64 1 (Int 63 Int -> Int -> Int forall a. Num a => a -> a -> a - Word64 -> Int forall b. FiniteBits b => b -> Int countLeadingZeros Word64 w) {-# INLINE highestBitMask #-} -- Right and left logical shifts. shiftRL, shiftLL :: Word64 -> Int -> Word64 shiftRL :: Word64 -> Int -> Word64 shiftRL = Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a unsafeShiftR shiftLL :: Word64 -> Int -> Word64 shiftLL = Word64 -> Int -> Word64 forall a. Bits a => a -> Int -> a unsafeShiftL