{-# LANGUAGE PatternGuards #-}
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, bitSizeMaybe, zeroBits),
FiniteBits(finiteBitSize))
import Data.List (foldl')
import Data.Word (Word8)
{-# INLINE repeat #-}
repeat :: (Bits b) => Bool -> b
repeat :: forall b. Bits b => Bool -> b
repeat Bool
False = b
forall a. Bits a => a
zeroBits
repeat Bool
True = b -> b
forall a. Bits a => a -> a
complement b
forall a. Bits a => a
zeroBits
{-# INLINE map #-}
map :: (Bits b) => (Bool -> Bool) -> b -> b
map :: forall b. Bits b => (Bool -> Bool) -> b -> b
map Bool -> Bool
f = case (Bool -> Bool
f Bool
False, Bool -> Bool
f Bool
True) of
(Bool
False, Bool
False) -> \b
_ -> b
forall a. Bits a => a
zeroBits
(Bool
False, Bool
True ) -> b -> b
forall a. a -> a
id
(Bool
True, Bool
False) -> b -> b
forall a. Bits a => a -> a
complement
(Bool
True, Bool
True ) -> \b
_ -> b -> b
forall a. Bits a => a -> a
complement b
forall a. Bits a => a
zeroBits
{-# INLINE zipWith #-}
zipWith :: (Bits b) => (Bool -> Bool -> Bool) -> b -> b -> b
zipWith :: forall b. Bits b => (Bool -> Bool -> Bool) -> b -> b -> b
zipWith Bool -> Bool -> Bool
f = case (Bool -> Bool -> Bool
f Bool
False Bool
False, Bool -> Bool -> Bool
f Bool
False Bool
True, Bool -> Bool -> Bool
f Bool
True Bool
False, Bool -> Bool -> Bool
f Bool
True Bool
True) of
(Bool
False, Bool
False, Bool
False, Bool
False) -> \b
_ b
_ -> b
forall a. Bits a => a
zeroBits
(Bool
False, Bool
False, Bool
False, Bool
True ) -> b -> b -> b
forall a. Bits a => a -> a -> a
(.&.)
(Bool
False, Bool
False, Bool
True, Bool
False) -> \b
x b
y -> b
x b -> b -> b
forall a. Bits a => a -> a -> a
.&. b -> b
forall a. Bits a => a -> a
complement b
y
(Bool
False, Bool
False, Bool
True, Bool
True ) -> \b
x b
_ -> b
x
(Bool
False, Bool
True, Bool
False, Bool
False) -> \b
x b
y -> b -> b
forall a. Bits a => a -> a
complement b
x b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
y
(Bool
False, Bool
True, Bool
False, Bool
True ) -> \b
_ b
y -> b
y
(Bool
False, Bool
True, Bool
True, Bool
False) -> b -> b -> b
forall a. Bits a => a -> a -> a
xor
(Bool
False, Bool
True, Bool
True, Bool
True ) -> b -> b -> b
forall a. Bits a => a -> a -> a
(.|.)
(Bool
True, Bool
False, Bool
False, Bool
False) -> \b
x b
y -> b -> b
forall a. Bits a => a -> a
complement (b
x b -> b -> b
forall a. Bits a => a -> a -> a
.|. b
y)
(Bool
True, Bool
False, Bool
False, Bool
True ) -> \b
x b
y -> b -> b
forall a. Bits a => a -> a
complement (b
x b -> b -> b
forall a. Bits a => a -> a -> a
`xor` b
y)
(Bool
True, Bool
False, Bool
True, Bool
False) -> \b
_ b
y -> b -> b
forall a. Bits a => a -> a
complement b
y
(Bool
True, Bool
False, Bool
True, Bool
True ) -> \b
x b
y -> b
x b -> b -> b
forall a. Bits a => a -> a -> a
.|. b -> b
forall a. Bits a => a -> a
complement b
y
(Bool
True, Bool
True, Bool
False, Bool
False) -> \b
x b
_ -> b -> b
forall a. Bits a => a -> a
complement b
x
(Bool
True, Bool
True, Bool
False, Bool
True ) -> \b
x b
y -> b -> b
forall a. Bits a => a -> a
complement b
x b -> b -> b
forall a. Bits a => a -> a -> a
.|. b
y
(Bool
True, Bool
True, Bool
True, Bool
False) -> \b
x b
y -> b -> b
forall a. Bits a => a -> a
complement (b
x b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
y)
(Bool
True, Bool
True, Bool
True, Bool
True ) -> \b
_ b
_ -> b -> b
forall a. Bits a => a -> a
complement b
forall a. Bits a => a
zeroBits
{-# INLINE or #-}
or :: (Bits b) => b -> Bool
or :: forall b. Bits b => b -> Bool
or b
b = b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
forall a. Bits a => a
zeroBits
{-# INLINE and #-}
and :: (Bits b) => b -> Bool
and :: forall b. Bits b => b -> Bool
and b
b = b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> b
forall a. Bits a => a -> a
complement b
forall a. Bits a => a
zeroBits
{-# INLINE any #-}
any :: (Bits b) => (Bool -> Bool) -> b -> Bool
any :: forall b. Bits b => (Bool -> Bool) -> b -> Bool
any Bool -> Bool
f = b -> Bool
forall b. Bits b => b -> Bool
or (b -> Bool) -> (b -> b) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> b -> b
forall b. Bits b => (Bool -> Bool) -> b -> b
map Bool -> Bool
f
{-# INLINE all #-}
all :: (Bits b) => (Bool -> Bool) -> b -> Bool
all :: forall b. Bits b => (Bool -> Bool) -> b -> Bool
all Bool -> Bool
f = b -> Bool
forall b. Bits b => b -> Bool
and (b -> Bool) -> (b -> b) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> b -> b
forall b. Bits b => (Bool -> Bool) -> b -> b
map Bool -> Bool
f
{-# INLINE isUniform #-}
isUniform :: (Bits b) => b -> Maybe Bool
isUniform :: forall b. Bits b => b -> Maybe Bool
isUniform b
b
| b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
forall a. Bits a => a
zeroBits = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
| b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> b
forall a. Bits a => a -> a
complement b
forall a. Bits a => a
zeroBits = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
| Bool
otherwise = Maybe Bool
forall a. Maybe a
Nothing
{-# INLINE mask #-}
mask :: (Num b, Bits b) => Int -> b
mask :: forall b. (Num b, Bits b) => Int -> b
mask Int
n = Int -> b
forall a. Bits a => Int -> a
bit Int
n b -> b -> b
forall a. Num a => a -> a -> a
- Int -> b
forall a. Bits a => Int -> a
bit Int
0
{-# INLINE splitAt #-}
splitAt :: (Num b, Bits b) => Int -> b -> (b, b)
splitAt :: forall b. (Num b, Bits b) => Int -> b -> (b, b)
splitAt Int
n b
b = (b
b b -> b -> b
forall a. Bits a => a -> a -> a
.&. Int -> b
forall b. (Num b, Bits b) => Int -> b
mask Int
n, b
b b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` Int
n)
{-# INLINE joinAt #-}
joinAt :: (Bits b) => Int -> b -> b -> b
joinAt :: forall b. Bits b => Int -> b -> b -> b
joinAt Int
n b
lsb b
msb = b
lsb b -> b -> b
forall a. Bits a => a -> a -> a
.|. (b
msb b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftL` Int
n)
{-# INLINE packWord8LE #-}
packWord8LE :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8LE :: Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8LE Bool
a Bool
b Bool
c Bool
d Bool
e Bool
f Bool
g Bool
h = Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
a Word8
1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
b Word8
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
c Word8
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
d Word8
8 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
e Word8
16 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
f Word8
32 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
g Word8
64 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Word8 -> Word8
forall {a}. Num a => Bool -> a -> a
z Bool
h Word8
128
where z :: Bool -> a -> a
z Bool
False a
_ = a
0
z Bool
True a
n = a
n
{-# INLINE packWord8BE #-}
packWord8BE :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8BE :: Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8BE Bool
a Bool
b Bool
c Bool
d Bool
e Bool
f Bool
g Bool
h = Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
packWord8LE Bool
h Bool
g Bool
f Bool
e Bool
d Bool
c Bool
b Bool
a
{-# INLINE unpackWord8LE #-}
unpackWord8LE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8LE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8LE Word8
w = (Word8 -> Bool
b Word8
1, Word8 -> Bool
b Word8
2, Word8 -> Bool
b Word8
4, Word8 -> Bool
b Word8
8, Word8 -> Bool
b Word8
16, Word8 -> Bool
b Word8
32, Word8 -> Bool
b Word8
64, Word8 -> Bool
b Word8
128)
where b :: Word8 -> Bool
b Word8
z = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
z Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
{-# INLINE unpackWord8BE #-}
unpackWord8BE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8BE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
unpackWord8BE Word8
w = (Word8 -> Bool
b Word8
128, Word8 -> Bool
b Word8
64, Word8 -> Bool
b Word8
32, Word8 -> Bool
b Word8
16, Word8 -> Bool
b Word8
8, Word8 -> Bool
b Word8
4, Word8 -> Bool
b Word8
2, Word8 -> Bool
b Word8
1)
where b :: Word8 -> Bool
b Word8
z = Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
z Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
{-# INLINE fromBool #-}
fromBool :: (Bits b) => Bool -> b
fromBool :: forall b. Bits b => Bool -> b
fromBool Bool
False = b
forall a. Bits a => a
zeroBits
fromBool Bool
True = Int -> b
forall a. Bits a => Int -> a
bit Int
0
{-# INLINE fromListLE #-}
fromListLE :: (Bits b) => [Bool] -> b
fromListLE :: forall b. Bits b => [Bool] -> b
fromListLE = (Bool -> b -> b) -> b -> [Bool] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> b -> b
forall {a}. Bits a => Bool -> a -> a
f b
forall a. Bits a => a
zeroBits
where
f :: Bool -> a -> a
f Bool
b a
i = Bool -> a
forall b. Bits b => Bool -> b
fromBool Bool
b a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
i a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
{-# INLINE toListLE #-}
toListLE :: (Bits b) => b -> [Bool]
toListLE :: forall b. Bits b => b -> [Bool]
toListLE b
b0 | Just Int
n <- b -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe b
b0 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
P.map (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
b0) [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
| Bool
otherwise = b -> [Bool]
forall b. Bits b => b -> [Bool]
go b
b0
where go :: t -> [Bool]
go t
b | t
forall a. Bits a => a
zeroBits t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
b = []
| Bool
otherwise = t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
b Int
0 Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: t -> [Bool]
go (t
b t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
{-# INLINE fromListBE #-}
fromListBE :: (Bits b) => [Bool] -> b
fromListBE :: forall b. Bits b => [Bool] -> b
fromListBE = (b -> Bool -> b) -> b -> [Bool] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Bool -> b
forall {a}. Bits a => a -> Bool -> a
f b
forall a. Bits a => a
zeroBits
where
f :: a -> Bool -> a
f a
i Bool
b = (a
i a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Bool -> a
forall b. Bits b => Bool -> b
fromBool Bool
b
{-# INLINE toListBE #-}
toListBE :: (FiniteBits b) => b -> [Bool]
toListBE :: forall b. FiniteBits b => b -> [Bool]
toListBE b
b = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
P.map (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit b
b) [b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Int
0]