blob: bf0316fdaa266a67609858b12dc1ac93db773b27 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-------------------------------------------------------------------------------
-- |
-- Module : Data.Bits.ByteString
-- Copyright : (c) 2016 Michael Carpenter
-- License : BSD3
-- Maintainer : Michael Carpenter <oldmanmike.dev@gmail.com>
-- Stability : experimental
-- Portability : portable
--
-------------------------------------------------------------------------------
module Data.Bits.ByteString where
import Data.Bits
import qualified Data.ByteString as B
import Data.Word
instance Bits B.ByteString where
(.&.) a b = B.pack $ B.zipWith (.&.) a b
{-# INLINE (.&.) #-}
(.|.) a b = B.pack $ B.zipWith (.|.) a b
{-# INLINE (.|.) #-}
xor a b = B.pack $ B.zipWith xor a b
{-# INLINE xor #-}
complement = B.map complement
{-# INLINE complement #-}
shift x i
| i < 0 = x `shiftR` (-i)
| i > 0 = x `shiftL` i
| otherwise = x
{-# INLINE shift #-}
shiftR bs 0 = bs
shiftR "" _ = B.empty
shiftR bs i
| i `mod` 8 == 0 =
B.take (B.length bs) $ B.append
(B.replicate (i `div` 8) 0)
(B.drop (i `div` 8) bs)
| i `mod` 8 /= 0 =
B.pack $ take (B.length bs)
$ (replicate (i `div` 8) (0 :: Word8))
++ (go (i `mod` 8) 0 $ B.unpack (B.take (B.length bs - (i `div` 8)) bs))
where
go _ _ [] = []
go j w1 (w2:wst) = (maskR j w1 w2) : go j w2 wst
maskR j w1 w2 = (shiftL w1 (8-j)) .|. (shiftR w2 j)
shiftR _ _ = error "I can't believe you've done this."
{-# INLINE shiftR #-}
shiftL bs 0 = bs
shiftL "" _ = B.empty
shiftL bs i
| i `mod` 8 == 0 =
B.take (B.length bs) $ B.append
(B.drop (i `div` 8) bs)
(B.replicate (i `div` 8) 0)
| i `mod` 8 /= 0 =
B.pack $ drop ((i `div` 8) - B.length bs)
$ (tail (go (i `mod` 8) 0 $ B.unpack (B.drop (i `div` 8) bs)))
++ (replicate (i `div` 8) 0)
where
go j w1 [] = [shiftL w1 j]
go j w1 (w2:wst) = (maskL j w1 w2) : go j w2 wst
maskL j w1 w2 = (shiftL w1 j) .|. (shiftR w2 (8-j))
shiftL _ _ = error "I can't believe you've done this."
{-# INLINE shiftL #-}
rotate x i
| i < 0 = x `rotateR` (-i)
| i > 0 = x `rotateL` i
| otherwise = x
{-# INLINE rotate #-}
rotateR bs 0 = bs
rotateR bs i
| B.length bs == 0 = B.empty
| B.length bs == 1 = B.singleton (rotateR (bs `B.index` 0) i)
| B.length bs > 1 = do
let shiftedWords =
B.append
(B.drop (nWholeWordsToShift i) bs)
(B.take (nWholeWordsToShift i) bs)
let tmpShiftedBits = (shiftR shiftedWords (i `mod` 8))
let rotatedBits = (shiftL (B.last shiftedWords) (8 - (i `mod` 8))) .|. (B.head tmpShiftedBits)
rotatedBits `B.cons` (B.tail tmpShiftedBits)
where
nWholeWordsToShift n = (B.length bs - (n `div` 8))
rotateR _ _ = error "I can't believe you've done this."
{-# INLINE rotateR #-}
rotateL bs 0 = bs
rotateL bs i
| B.length bs == 0 = B.empty
| B.length bs == 1 = B.singleton (rotateL (bs `B.index` 0) i)
| i `mod` 8 == 0 = B.append
(B.drop (i `div` 8) bs)
(B.take (i `div` 8) bs)
| B.length bs > 1 = do
let shiftedWords =
B.append
(B.drop (i `div` 8) bs)
(B.take (i `div` 8) bs)
let tmpShiftedBits = (shiftL shiftedWords (i `mod` 8))
let rotatedBits = (shiftR (B.head shiftedWords) (8 - (i `mod` 8))) .|. (B.last tmpShiftedBits)
(B.init tmpShiftedBits) `B.snoc` rotatedBits
rotateL _ _ = error "I can't believe you've done this."
{-# INLINE rotateL #-}
bitSize x = 8 * B.length x
{-# INLINE bitSize #-}
bitSizeMaybe x = Just (8 * B.length x)
{-# INLINE bitSizeMaybe #-}
isSigned _ = False
{-# INLINE isSigned #-}
testBit x i = testBit (B.index x (B.length x - (i `div` 8) - 1)) (i `mod` 8)
{-# INLINE testBit #-}
bit i = (bit $ mod i 8) `B.cons` (B.replicate (div i 8) (255 :: Word8))
{-# INLINE bit #-}
popCount x = sum $ map popCount $ B.unpack x
{-# INLINE popCount #-}
|
