summaryrefslogtreecommitdiff
path: root/src/Data/Bits
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /src/Data/Bits
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (diff)
Factor out some new libraries
word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search
Diffstat (limited to 'src/Data/Bits')
-rw-r--r--src/Data/Bits/ByteString.hs132
1 files changed, 0 insertions, 132 deletions
diff --git a/src/Data/Bits/ByteString.hs b/src/Data/Bits/ByteString.hs
deleted file mode 100644
index bf0316fd..00000000
--- a/src/Data/Bits/ByteString.hs
+++ /dev/null
@@ -1,132 +0,0 @@
1{-# LANGUAGE OverloadedStrings #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3-------------------------------------------------------------------------------
4-- |
5-- Module : Data.Bits.ByteString
6-- Copyright : (c) 2016 Michael Carpenter
7-- License : BSD3
8-- Maintainer : Michael Carpenter <oldmanmike.dev@gmail.com>
9-- Stability : experimental
10-- Portability : portable
11--
12-------------------------------------------------------------------------------
13module Data.Bits.ByteString where
14
15import Data.Bits
16import qualified Data.ByteString as B
17import Data.Word
18
19instance Bits B.ByteString where
20
21 (.&.) a b = B.pack $ B.zipWith (.&.) a b
22 {-# INLINE (.&.) #-}
23
24 (.|.) a b = B.pack $ B.zipWith (.|.) a b
25 {-# INLINE (.|.) #-}
26
27 xor a b = B.pack $ B.zipWith xor a b
28 {-# INLINE xor #-}
29
30 complement = B.map complement
31 {-# INLINE complement #-}
32
33 shift x i
34 | i < 0 = x `shiftR` (-i)
35 | i > 0 = x `shiftL` i
36 | otherwise = x
37 {-# INLINE shift #-}
38
39 shiftR bs 0 = bs
40 shiftR "" _ = B.empty
41 shiftR bs i
42 | i `mod` 8 == 0 =
43 B.take (B.length bs) $ B.append
44 (B.replicate (i `div` 8) 0)
45 (B.drop (i `div` 8) bs)
46 | i `mod` 8 /= 0 =
47 B.pack $ take (B.length bs)
48 $ (replicate (i `div` 8) (0 :: Word8))
49 ++ (go (i `mod` 8) 0 $ B.unpack (B.take (B.length bs - (i `div` 8)) bs))
50 where
51 go _ _ [] = []
52 go j w1 (w2:wst) = (maskR j w1 w2) : go j w2 wst
53 maskR j w1 w2 = (shiftL w1 (8-j)) .|. (shiftR w2 j)
54 shiftR _ _ = error "I can't believe you've done this."
55 {-# INLINE shiftR #-}
56
57 shiftL bs 0 = bs
58 shiftL "" _ = B.empty
59 shiftL bs i
60 | i `mod` 8 == 0 =
61 B.take (B.length bs) $ B.append
62 (B.drop (i `div` 8) bs)
63 (B.replicate (i `div` 8) 0)
64 | i `mod` 8 /= 0 =
65 B.pack $ drop ((i `div` 8) - B.length bs)
66 $ (tail (go (i `mod` 8) 0 $ B.unpack (B.drop (i `div` 8) bs)))
67 ++ (replicate (i `div` 8) 0)
68 where
69 go j w1 [] = [shiftL w1 j]
70 go j w1 (w2:wst) = (maskL j w1 w2) : go j w2 wst
71 maskL j w1 w2 = (shiftL w1 j) .|. (shiftR w2 (8-j))
72 shiftL _ _ = error "I can't believe you've done this."
73 {-# INLINE shiftL #-}
74
75 rotate x i
76 | i < 0 = x `rotateR` (-i)
77 | i > 0 = x `rotateL` i
78 | otherwise = x
79 {-# INLINE rotate #-}
80
81 rotateR bs 0 = bs
82 rotateR bs i
83 | B.length bs == 0 = B.empty
84 | B.length bs == 1 = B.singleton (rotateR (bs `B.index` 0) i)
85 | B.length bs > 1 = do
86 let shiftedWords =
87 B.append
88 (B.drop (nWholeWordsToShift i) bs)
89 (B.take (nWholeWordsToShift i) bs)
90 let tmpShiftedBits = (shiftR shiftedWords (i `mod` 8))
91 let rotatedBits = (shiftL (B.last shiftedWords) (8 - (i `mod` 8))) .|. (B.head tmpShiftedBits)
92 rotatedBits `B.cons` (B.tail tmpShiftedBits)
93 where
94 nWholeWordsToShift n = (B.length bs - (n `div` 8))
95 rotateR _ _ = error "I can't believe you've done this."
96 {-# INLINE rotateR #-}
97
98 rotateL bs 0 = bs
99 rotateL bs i
100 | B.length bs == 0 = B.empty
101 | B.length bs == 1 = B.singleton (rotateL (bs `B.index` 0) i)
102 | i `mod` 8 == 0 = B.append
103 (B.drop (i `div` 8) bs)
104 (B.take (i `div` 8) bs)
105 | B.length bs > 1 = do
106 let shiftedWords =
107 B.append
108 (B.drop (i `div` 8) bs)
109 (B.take (i `div` 8) bs)
110 let tmpShiftedBits = (shiftL shiftedWords (i `mod` 8))
111 let rotatedBits = (shiftR (B.head shiftedWords) (8 - (i `mod` 8))) .|. (B.last tmpShiftedBits)
112 (B.init tmpShiftedBits) `B.snoc` rotatedBits
113 rotateL _ _ = error "I can't believe you've done this."
114 {-# INLINE rotateL #-}
115
116 bitSize x = 8 * B.length x
117 {-# INLINE bitSize #-}
118
119 bitSizeMaybe x = Just (8 * B.length x)
120 {-# INLINE bitSizeMaybe #-}
121
122 isSigned _ = False
123 {-# INLINE isSigned #-}
124
125 testBit x i = testBit (B.index x (B.length x - (i `div` 8) - 1)) (i `mod` 8)
126 {-# INLINE testBit #-}
127
128 bit i = (bit $ mod i 8) `B.cons` (B.replicate (div i 8) (255 :: Word8))
129 {-# INLINE bit #-}
130
131 popCount x = sum $ map popCount $ B.unpack x
132 {-# INLINE popCount #-}