#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#else
#define safe
#endif
module Data.Bit.Internal where
import safe Data.Bits
import safe Data.List
import safe Data.Typeable
import safe Data.Word
#if !MIN_VERSION_base(4,3,0)
import safe Control.Monad
mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
mfilter p xs = do x <- xs; guard (p x); return x
#endif
newtype Bit = Bit Bool
deriving (Bounded, Eq, Ord, Typeable)
fromBool b = Bit b
toBool (Bit b) = b
instance Enum Bit where
toEnum = fromBool . toEnum
fromEnum = fromEnum . toBool
lg2 :: Int -> Int
lg2 n = i
where Just i = findIndex (>= toInteger n) (iterate (`shiftL` 1) 1)
wordSize :: Int
wordSize = bitSize (0 :: Word)
lgWordSize, wordSizeMask, wordSizeMaskC :: Int
lgWordSize = lg2 wordSize
wordSizeMask = wordSize 1
wordSizeMaskC = complement wordSizeMask
divWordSize x = shiftR x lgWordSize
modWordSize x = x .&. (wordSize 1)
mulWordSize x = shiftL x lgWordSize
nWords nBits = divWordSize (nBits + wordSize 1)
nBits nWords = mulWordSize nWords
aligned x = (x .&. wordSizeMask == 0)
notAligned x = x /= alignDown x
alignUp x
| x == x' = x'
| otherwise = x' + wordSize
where x' = alignDown x
alignDown x = x .&. wordSizeMaskC
readBit :: Int -> Word -> Bit
readBit i w = fromBool (testBit w i)
extendToWord :: Bit -> Word
extendToWord (Bit False) = 0
extendToWord (Bit True) = complement 0
mask :: Int -> Word
mask b = m
where
m | b >= bitSize m = complement 0
| b < 0 = 0
| otherwise = bit b 1
masked b x = x .&. mask b
isMasked b x = (masked b x == x)
meld b lo hi = (lo .&. m) .|. (hi .&. complement m)
where m = mask b
extractWord :: Int -> Word -> Word -> Word
extractWord k lo hi = (lo `shiftR` k) .|. (hi `shiftL` (wordSize k))
spliceWord :: Int -> Word -> Word -> Word -> (Word, Word)
spliceWord k lo hi x =
( meld k lo (x `shiftL` k)
, meld k (x `shiftR` (wordSize k)) hi
)
reverseWord :: Word -> Word
reverseWord x = foldr swap x masks
where
nextMask (d, x) = (d', x `xor` shift x d')
where !d' = d `shiftR` 1
!(_:masks) =
takeWhile ((0 /=) . snd)
(iterate nextMask (bitSize x, maxBound))
swap (n, m) x = ((x .&. m) `shiftL` n) .|. ((x .&. complement m) `shiftR` n)
reversePartialWord n w
| n >= wordSize = reverseWord w
| otherwise = reverseWord w `shiftR` (wordSize n)
diff :: Word -> Word -> Word
diff w1 w2 = w1 .&. complement w2
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704
popCount :: Bits a => a -> Int
popCount = loop 0
where
loop !n 0 = n
loop !n x = loop (n+1) (x .&. (x 1))
#endif
ffs :: Word -> Maybe Int
ffs 0 = Nothing
ffs x = Just $! (popCount (x `xor` complement (x)) 1)
bitsInWord :: Int -> Word -> [Int] -> [Int]
bitsInWord j = loop id
where
loop is !w = case ffs w of
Nothing -> is
Just i -> loop (is . (j + i :)) (clearBit w i)
selectWord :: Word -> Word -> (Int, Word)
selectWord m x = loop 0 0 0
where
loop !i !ct !y
| i >= wordSize = (ct, y)
| testBit m i = loop (i+1) (ct+1) (if testBit x i then setBit y ct else y)
| otherwise = loop (i+1) ct y