{-# LANGUAGE PatternGuards #-}
{-|

Module      :  Data.Bits.Bitwise
Copyright   :  (c) Claude Heiland-Allen 2012
License     :  BSD3

Maintainer  :  claude@mathr.co.uk
Stability   :  unstable
Portability :  portable

Lifting boolean operations on 'Bool' to bitwise operations on 'Bits'.

Packing bits into words, and unpacking words into bits.

-}
module Data.Bits.Bitwise
  (
  -- * Boolean operations lifted to bitwise operations.
    repeat
  , map
  , zipWith
  , or
  , and
  , any
  , all
  , isUniform
  -- * Splitting\/joining 'Bits' to\/from (lsb, msb).
  , mask
  , splitAt
  , joinAt
  , fromBool
  -- * (Un)packing 'Bits' to\/from lists of 'Bool'.
  , fromListLE
  , toListLE
  , fromListBE
  , toListBE
  -- * (Un)packing 'Word8' to\/from 8-tuples of 'Bool'.
  , 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)

-- | Lift a boolean constant to a bitwise constant.
{-# 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

-- | Lift a unary boolean operation to a bitwise operation.
--
--   The implementation is by exhaustive input\/output case analysis:
--   thus the operation provided must be total.
--
{-# INLINE map #-}
map :: (Bits b) => (Bool -> Bool) {- ^ operation -} -> 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

-- | Lift a binary boolean operation to a bitwise operation.
--
--   The implementation is by exhaustive input\/output case analysis:
--   thus the operation provided must be total.
--
{-# INLINE zipWith #-}
zipWith :: (Bits b) => (Bool -> Bool -> Bool) {- ^ operation -} -> 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

-- zipWith3 would have 256 cases? not sure..

-- | True when any bit is set.
{-# 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

-- | True when all bits are set.
{-# 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

-- | True when the predicate is true for any bit.
{-# INLINE any #-}
any :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> 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

-- | True when the predicate is true for all bits.
{-# INLINE all #-}
all :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> 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

-- | Determine if a 'Bits' is all 1s, all 0s, or neither.
{-# 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

-- | A mask with count least significant bits set.
{-# INLINE mask #-}
mask :: (Num b, Bits b) => Int {- ^ count -} -> 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

-- | Split a word into (lsb, msb).  Ensures lsb has no set bits
--   above the split point.
{-# INLINE splitAt #-}
splitAt :: (Num b, Bits b) => Int {- ^ split point -} -> b {- ^ word -} -> (b, b) {- ^ (lsb, msb) -}
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)

-- | Join lsb with msb to make a word.  Assumes lsb has no set bits
--   above the join point.
{-# INLINE joinAt #-}
joinAt :: (Bits b) => Int {- ^ join point -} -> b {- ^ least significant bits -} -> b {- ^ most significant bits -} -> b {- ^ word -}
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)

-- | Pack bits into a byte in little-endian order.
{-# INLINE packWord8LE #-}
packWord8LE :: Bool {- ^ least significant bit -} -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool {- ^ most significant bit -} -> 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

-- | Pack bits into a byte in big-endian order.
{-# INLINE packWord8BE #-}
packWord8BE :: Bool {- ^ most significant bit -} -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool {- ^ least significant bit -} -> 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

-- | Extract the bits from a byte in little-endian order.
{-# INLINE unpackWord8LE #-}
unpackWord8LE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) {- ^ (least significant bit, ..., most significant bit) -}
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

-- | Extract the bits from a byte in big-endian order.
{-# INLINE unpackWord8BE #-}
unpackWord8BE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) {- ^ (most significant bit, ..., least significant bit) -}
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

-- | The least significant bit.
{-# 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

-- | Convert a little-endian list of bits to 'Bits'.
{-# INLINE fromListLE #-}
fromListLE :: (Bits b) => [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} -> 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)

-- | Convert a 'Bits' to a list of bits, in
--   little-endian order.
{-# INLINE toListLE #-}
toListLE :: (Bits b) => b -> [Bool] {- ^ \[least significant bit, ..., most significant bit\] -}
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)

-- | Convert a big-endian list of bits to 'Bits'.
{-# INLINE fromListBE #-}
fromListBE :: (Bits b) => [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} -> 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

-- | Convert a 'FiniteBits' to a list of bits, in
--   big-endian order.
{-# INLINE toListBE #-}
toListBE :: (FiniteBits b) => b -> [Bool] {- ^ \[most significant bit, ..., least significant bit\] -}
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]