Utils/Containers/Internal/BitUtil.hs

    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__
    {-# LANGUAGE MagicHash #-}
    #endif
    #if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703
    {-# LANGUAGE Safe #-}
    #endif

    #include "containers.h"

    -----------------------------------------------------------------------------
    -- |
    -- 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__.
    --
    -- This 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 Utils.Containers.Internal.BitUtil
        ( bitcount
        , highestBitMask
        , shiftLL
        , shiftRL
        , wordSize
        ) where

    import Data.Bits ((.|.), xor)
    #if MIN_VERSION_base(4,5,0)
    import Data.Bits (popCount, unsafeShiftL, unsafeShiftR)
    #else
    import Data.Bits ((.&.), shiftL, shiftR)
    #endif
    #if MIN_VERSION_base(4,7,0)
    import Data.Bits (finiteBitSize)
    #else
    import Data.Bits (bitSize)
    #endif

    #if !MIN_VERSION_base (4,8,0)
    import Data.Word (Word)
    #endif

    {----------------------------------------------------------------------
      [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 -> Word -> Int
    #if MIN_VERSION_base(4,5,0)
    bitcount a x = a + popCount x
    #else
    bitcount a0 x0 = go a0 x0
      where go a 0 = a
            go a x = go (a + 1) (x .&. (x-1))
    #endif
    {-# 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 :: Word -> Word
    highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1
                            x3 = x2 .|. x2 `shiftRL` 2
                            x4 = x3 .|. x3 `shiftRL` 4
                            x5 = x4 .|. x4 `shiftRL` 8
                            x6 = x5 .|. x5 `shiftRL` 16
    #if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32)
                            x7 = x6 .|. x6 `shiftRL` 32
                         in x7 `xor` (x7 `shiftRL` 1)
    #else
                         in x6 `xor` (x6 `shiftRL` 1)
    #endif
    {-# INLINE highestBitMask #-}

    -- Right and left logical shifts.
    shiftRL, shiftLL :: Word -> Int -> Word
    #if MIN_VERSION_base(4,5,0)
    shiftRL = unsafeShiftR
    shiftLL = unsafeShiftL
    #else
    shiftRL = shiftR
    shiftLL = shiftL
    #endif

    {-# INLINE wordSize #-}
    wordSize :: Int
    #if MIN_VERSION_base(4,7,0)
    wordSize = finiteBitSize (0 :: Word)
    #else
    wordSize = bitSize (0 :: Word)
    #endif