1{-# LANGUAGE PatternGuards #-}
2{-|
3
4Module      :  Data.Bits.Bitwise
5Copyright   :  (c) Claude Heiland-Allen 2012
6License     :  BSD3
7
8Maintainer  :  claude@mathr.co.uk
9Stability   :  unstable
10Portability :  portable
11
12Lifting boolean operations on 'Bool' to bitwise operations on 'Bits'.
13
14Packing bits into words, and unpacking words into bits.
15
16-}
17module Data.Bits.Bitwise
18  (
19  -- * Boolean operations lifted to bitwise operations.
20    repeat
21  , map
22  , zipWith
23  , or
24  , and
25  , any
26  , all
27  , isUniform
28  -- * Splitting\/joining 'Bits' to\/from (lsb, msb).
29  , mask
30  , splitAt
31  , joinAt
32  , fromBool
33  -- * (Un)packing 'Bits' to\/from lists of 'Bool'.
34  , fromListLE
35  , toListLE
36  , fromListBE
37  , toListBE
38  -- * (Un)packing 'Word8' to\/from 8-tuples of 'Bool'.
39  , packWord8LE
40  , unpackWord8LE
41  , packWord8BE
42  , unpackWord8BE
43  ) where
44
45import Prelude hiding (repeat, map, zipWith, any, all, or, and, splitAt)
46import qualified Prelude as P
47
48import Data.Bits (Bits(complement, (.&.), (.|.), xor, bit, shiftL, shiftR, testBit, bitSizeMaybe, zeroBits),
49                  FiniteBits(finiteBitSize))
50import Data.List (foldl')
51import Data.Word (Word8)
52
53-- | Lift a boolean constant to a bitwise constant.
54{-# INLINE repeat #-}
55repeat :: (Bits b) => Bool -> b
56repeat False = zeroBits
57repeat True = complement zeroBits
58
59-- | Lift a unary boolean operation to a bitwise operation.
60--
61--   The implementation is by exhaustive input\/output case analysis:
62--   thus the operation provided must be total.
63--
64{-# INLINE map #-}
65map :: (Bits b) => (Bool -> Bool) {- ^ operation -} -> b -> b
66map f = case (f False, f True) of
67  (False, False) -> \_ -> zeroBits
68  (False, True ) -> id
69  (True,  False) -> complement
70  (True,  True ) -> \_ -> complement zeroBits
71
72-- | Lift a binary boolean operation to a bitwise operation.
73--
74--   The implementation is by exhaustive input\/output case analysis:
75--   thus the operation provided must be total.
76--
77{-# INLINE zipWith #-}
78zipWith :: (Bits b) => (Bool -> Bool -> Bool) {- ^ operation -} -> b -> b -> b
79zipWith f = case (f False False, f False True, f True False, f True True) of
80  (False, False, False, False) -> \_ _ -> zeroBits
81  (False, False, False, True ) -> (.&.)
82  (False, False, True,  False) -> \x y -> x .&. complement y
83  (False, False, True,  True ) -> \x _ -> x
84  (False, True,  False, False) -> \x y -> complement x .&. y
85  (False, True,  False, True ) -> \_ y -> y
86  (False, True,  True,  False) -> xor
87  (False, True,  True,  True ) -> (.|.)
88  (True,  False, False, False) -> \x y -> complement (x .|. y)
89  (True,  False, False, True ) -> \x y -> complement (x `xor` y)
90  (True,  False, True,  False) -> \_ y -> complement y
91  (True,  False, True,  True ) -> \x y -> x .|. complement y
92  (True,  True,  False, False) -> \x _ -> complement x
93  (True,  True,  False, True ) -> \x y -> complement x .|. y
94  (True,  True,  True,  False) -> \x y -> complement (x .&. y)
95  (True,  True,  True,  True ) -> \_ _ -> complement zeroBits
96
97-- zipWith3 would have 256 cases? not sure..
98
99-- | True when any bit is set.
100{-# INLINE or #-}
101or  :: (Bits b) => b -> Bool
102or  b = b /= zeroBits
103
104-- | True when all bits are set.
105{-# INLINE and #-}
106and :: (Bits b) => b -> Bool
107and b = b == complement zeroBits
108
109-- | True when the predicate is true for any bit.
110{-# INLINE any #-}
111any :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool
112any f = or  . map f
113
114-- | True when the predicate is true for all bits.
115{-# INLINE all #-}
116all :: (Bits b) => (Bool -> Bool) {- ^ predicate -} -> b -> Bool
117all f = and . map f
118
119-- | Determine if a 'Bits' is all 1s, all 0s, or neither.
120{-# INLINE isUniform #-}
121isUniform :: (Bits b) => b -> Maybe Bool
122isUniform b
123  | b == zeroBits            = Just False
124  | b == complement zeroBits = Just True
125  | otherwise                = Nothing
126
127-- | A mask with count least significant bits set.
128{-# INLINE mask #-}
129mask :: (Num b, Bits b) => Int {- ^ count -} -> b
130mask n = bit n - bit 0
131
132-- | Split a word into (lsb, msb).  Ensures lsb has no set bits
133--   above the split point.
134{-# INLINE splitAt #-}
135splitAt :: (Num b, Bits b) => Int {- ^ split point -} -> b {- ^ word -} -> (b, b) {- ^ (lsb, msb) -}
136splitAt n b = (b .&. mask n, b `shiftR` n)
137
138-- | Join lsb with msb to make a word.  Assumes lsb has no set bits
139--   above the join point.
140{-# INLINE joinAt #-}
141joinAt :: (Bits b) => Int {- ^ join point -} -> b {- ^ least significant bits -} -> b {- ^ most significant bits -} -> b {- ^ word -}
142joinAt n lsb msb = lsb .|. (msb `shiftL` n)
143
144-- | Pack bits into a byte in little-endian order.
145{-# INLINE packWord8LE #-}
146packWord8LE :: Bool {- ^ least significant bit -} -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool {- ^ most significant bit -} -> Word8
147packWord8LE  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
148  where z False _ = 0
149        z True  n = n
150
151-- | Pack bits into a byte in big-endian order.
152{-# INLINE packWord8BE #-}
153packWord8BE :: Bool {- ^ most significant bit -} -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool {- ^ least significant bit -} -> Word8
154packWord8BE a b c d e f g h = packWord8LE h g f e d c b a
155
156-- | Extract the bits from a byte in little-endian order.
157{-# INLINE unpackWord8LE #-}
158unpackWord8LE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) {- ^ (least significant bit, ..., most significant bit) -}
159unpackWord8LE w = (b 1, b 2, b 4, b 8, b 16, b 32, b 64, b 128)
160  where b z = w .&. z /= 0
161
162-- | Extract the bits from a byte in big-endian order.
163{-# INLINE unpackWord8BE #-}
164unpackWord8BE :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) {- ^ (most significant bit, ..., least significant bit) -}
165unpackWord8BE w = (b 128, b 64, b 32, b 16, b 8, b 4, b 2, b 1)
166  where b z = w .&. z /= 0
167
168-- | The least significant bit.
169{-# INLINE fromBool #-}
170fromBool :: (Bits b) => Bool -> b
171fromBool False = zeroBits
172fromBool True  = bit 0
173
174-- | Convert a little-endian list of bits to 'Bits'.
175{-# INLINE fromListLE #-}
176fromListLE :: (Bits b) => [Bool] {- ^ \[least significant bit, ..., most significant bit\] -} -> b
177fromListLE = foldr f zeroBits
178  where
179    f b i = fromBool b .|. (i `shiftL` 1)
180
181-- | Convert a 'Bits' to a list of bits, in
182--   little-endian order.
183{-# INLINE toListLE #-}
184toListLE :: (Bits b) => b -> [Bool] {- ^ \[least significant bit, ..., most significant bit\] -}
185toListLE b0 | Just n <- bitSizeMaybe b0 = P.map (testBit b0) [0..n-1]
186            | otherwise = go b0
187  where go b | zeroBits == b = []
188             | otherwise = testBit b 0 : go (b `shiftR` 1)
189
190-- | Convert a big-endian list of bits to 'Bits'.
191{-# INLINE fromListBE #-}
192fromListBE :: (Bits b) => [Bool] {- ^ \[most significant bit, ..., least significant bit\] -} -> b
193fromListBE = foldl' f zeroBits
194  where
195    f i b = (i `shiftL` 1) .|. fromBool b
196
197-- | Convert a 'FiniteBits' to a list of bits, in
198--   big-endian order.
199{-# INLINE toListBE #-}
200toListBE :: (FiniteBits b) => b -> [Bool] {- ^ \[most significant bit, ..., least significant bit\] -}
201toListBE b = P.map (testBit b) [finiteBitSize b - 1, finiteBitSize b - 2 .. 0]
202