module Data.Bits.Bitwise
(
repeat
, map
, zipWith
, or
, and
, any
, all
, isUniform
, mask
, splitAt
, joinAt
, fromBool
, fromListLE
, toListLE
, fromListBE
, toListBE
, packWord8LE
, unpackWord8LE
, packWord8BE
, unpackWord8BE
) where
import Prelude hiding (repeat, map, zipWith, any, all, or, and, splitAt)
import qualified Prelude as P
import Data.Bits (Bits(complement, (.&.), (.|.), xor, bit, shiftL, shiftR, testBit, bitSize))
import Data.List (foldl')
import Data.Word (Word8)
repeat :: (Num b, Bits b) => Bool -> b
repeat False = 0
repeat True = complement 0
map :: (Num b, Bits b) => (Bool -> Bool) -> b -> b
map f = case (f False, f True) of
(False, False) -> \_ -> 0
(False, True ) -> id
(True, False) -> complement
(True, True ) -> \_ -> complement 0
zipWith :: (Num b, Bits b) => (Bool -> Bool -> Bool) -> b -> b -> b
zipWith f = case (f False False, f False True, f True False, f True True) of
(False, False, False, False) -> \_ _ -> 0
(False, False, False, True ) -> (.&.)
(False, False, True, False) -> \x y -> x .&. complement y
(False, False, True, True ) -> \x _ -> x
(False, True, False, False) -> \x y -> complement x .&. y
(False, True, False, True ) -> \_ y -> y
(False, True, True, False) -> xor
(False, True, True, True ) -> (.|.)
(True, False, False, False) -> \x y -> complement (x .|. y)
(True, False, False, True ) -> \x y -> complement (x `xor` y)
(True, False, True, False) -> \_ y -> complement y
(True, False, True, True ) -> \x y -> x .|. complement y
(True, True, False, False) -> \x _ -> complement x
(True, True, False, True ) -> \x y -> complement x .|. y
(True, True, True, False) -> \x y -> complement (x .&. y)
(True, True, True, True ) -> \_ _ -> complement 0
or :: (Num b, Bits b) => b -> Bool
or b = b /= 0
and :: (Num b, Bits b) => b -> Bool
and b = b == complement 0
any :: (Num b, Bits b) => (Bool -> Bool) -> b -> Bool
any f = or . map f
all :: (Num b, Bits b) => (Bool -> Bool) -> b -> Bool
all f = and . map f
isUniform :: (Num b, Bits b) => b -> Maybe Bool
isUniform b
| b == 0 = Just False
| b == complement 0 = Just True
| otherwise = Nothing
mask :: (Num b, Bits b) => Int -> b
mask n = bit n bit 0
splitAt :: (Num b, Bits b) => Int -> b -> (b, b)
splitAt n b = (b .&. mask n, b `shiftR` n)
joinAt :: (Num b, Bits b) => Int -> b -> b -> b
joinAt n lsb msb = lsb .|. (msb `shiftL` n)
packWord8LE :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8LE a b c d e f g h = z a 1 .|. z b 2 .|. z c 4 .|. z d 8 .|. z e 16 .|. z f 32 .|. z g 64 .|. z h 128
where z False _ = 0
z True n = n
packWord8BE :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8BE a b c d e f g h = packWord8LE h g f e d c b a
unpackWord8LE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8LE w = (b 1, b 2, b 4, b 8, b 16, b 32, b 64, b 128)
where b z = w .&. z /= 0
unpackWord8BE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8BE w = (b 128, b 64, b 32, b 16, b 8, b 4, b 2, b 1)
where b z = w .&. z /= 0
fromBool :: (Num b, Bits b) => Bool -> b
fromBool False = 0
fromBool True = bit 0
fromListLE :: (Num b, Bits b) => [Bool] -> b
fromListLE = foldr f 0
where
f b i = fromBool b .|. (i `shiftL` 1)
toListLE :: (Num b, Bits b) => b -> [Bool]
toListLE b = P.map (testBit b) [0 .. bitSize b 1]
fromListBE :: (Num b, Bits b) => [Bool] -> b
fromListBE = foldl' f 0
where
f i b = (i `shiftL` 1) .|. fromBool b
toListBE :: (Num b, Bits b) => b -> [Bool]
toListBE b = P.map (testBit b) [bitSize b 1, bitSize b 2 .. 0]