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