40670cf · binary-bits · git.iko.soy

213-- E.g. two words of 5 bits: ABCDE, VWXYZ

214-- - BB: ABCDEVWX YZxxxxxx

215-- - LB: XYZABCDE xxxxxxVW

216−-- - BL: EDCBAZYX WVxxxxxx -- not implemented

216+-- - BL: EDCBAZYX WVxxxxxx

217−-- - LL: XWVEDCBA xxxxxxZY -- not implemented

217+-- - LL: XWVEDCBA xxxxxxZY

218−data BitOrder = BB | LB deriving (Show)

218+data BitOrder = BB | LB | BL | LL deriving (Show)

219

220+-- | Reverse the @n@ least important bits of the given value

221+reverseBits :: (Num a, FastBits a, Bits a) => Int -> a -> a

222+reverseBits n value = rec value n 0

223+ where

224+ -- rec v i r, where

225+ -- v is orginal value shifted

226+ -- i is the remaining number of bits

227+ -- r is current value

228+ rec 0 0 r = r

229+ rec 0 i r = r `fastShiftL` i

230+ rec v i r = rec (v `fastShiftR` 1) (i-1) ((r `fastShiftL` 1) .|. (v .&. 0x1))

220

231

221-- | Read a single bit

232-- | Read a single bit

222readBool :: S -> Bool

233readBool :: S -> Bool

223readBool (S bs o bo) = case bo of

234readBool (S bs o bo) = case bo of

224 BB -> testBit (unsafeHead bs) (7-o)

235 BB -> testBit (unsafeHead bs) (7-o)

236+ BL -> testBit (unsafeHead bs) (7-o)

225 LB -> testBit (unsafeHead bs) o

237 LB -> testBit (unsafeHead bs) o

238+ LL -> testBit (unsafeHead bs) o

226

239

227-- | Extract a range of bits from (ws :: ByteString)

240-- | Extract a range of bits from (ws :: ByteString)

228--

241--

231extract bo bs o n

244extract bo bs o n

232 | n == 0 = 0

245 | n == 0 = 0

233 | B.length bs == 0 = error "Empty ByteString"

246 | B.length bs == 0 = error "Empty ByteString"

234− | otherwise = mask n (foldlWithIndex' f 0 bs)

247+ | otherwise = rev . mask n . foldlWithIndex' f 0 $ bs

235 where

248 where

236 -- B.foldl' with index

249 -- B.foldl' with index

237 foldlWithIndex' op b = fst . B.foldl' g (b,0)

250 foldlWithIndex' op b = fst . B.foldl' g (b,0)

238 where g (b',i) w = (op b' w i, (i+1))

251 where g (b',i) w = (op b' w i, (i+1))

239

252

240 -- 'or' correctly shifted words

253 -- 'or' correctly shifted words

241− f b w i = b .|. (fromIntegral w `fastShift` off i)

254+ f b w i = b .|. (fromIntegral w `fastShift` off i)

242

255

243 -- co-offset

256 -- co-offset

244− r = B.length bs * 8 - (o + n)

257+ r = B.length bs * 8 - (o + n)

245

258

246 -- shift offset depending on the byte position (0..B.length-1)

259 -- shift offset depending on the byte position (0..B.length-1)

247− off i = case bo of

260+ off i = case bo of

248 LB -> 8*i - o

261 LB -> 8*i - o

262+ LL -> 8*i - o

249 BB -> (B.length bs -1 - i) * 8 - r

263 BB -> (B.length bs -1 - i) * 8 - r

264+ BL -> (B.length bs -1 - i) * 8 - r

265+

266+ -- reverse bits if necessary

267+ rev = case bo of

268+ LL -> reverseBits n

269+ BL -> reverseBits n

270+ BB -> id

271+ LB -> id

250

272

251

273

252-- | Generic readWord

274-- | Generic readWord

275-- Examples:

297-- Examples:

276-- BB: xxxABCDE FGHIJKLM NOPQRxxx -> ABCDEFGH IJKLMNOP QRxxxxxx

298-- BB: xxxABCDE FGHIJKLM NOPQRxxx -> ABCDEFGH IJKLMNOP QRxxxxxx

277-- LB: NOPQRxxx FGHIJKLM xxxABCDE -> ABCDEFGH IJKLMNOP QRxxxxxx

299-- LB: NOPQRxxx FGHIJKLM xxxABCDE -> ABCDEFGH IJKLMNOP QRxxxxxx

300+-- BL: xxxRQPON MLKJIHGF EDCBAxxx -> ABCDEFGH IJKLMNOP QRxxxxxx

301+-- LL: EDCBAxxx MLKJIHGF xxxRQPON -> ABCDEFGH IJKLMNOP QRxxxxxx

278readByteString :: Int -> S -> ByteString

302readByteString :: Int -> S -> ByteString

279−readByteString n (S bs o bo)

303+readByteString n (S bs o bo) =

304+ let

305+ bs' = unsafeTake (n+1) bs

306+ rev = B.map (reverseBits 9)

280− | o == 0 = case bo of

307+ in case (o,bo) of

281− BB -> unsafeTake n bs

308+ (0,BB) -> unsafeTake n bs

282− LB -> B.reverse (unsafeTake n bs)

309+ (0,LB) -> B.reverse (unsafeTake n bs)

283−

310+ (0,BL) -> rev (unsafeTake n bs)

311+ (0,LL) -> rev (B.reverse (unsafeTake n bs))

312+ (_,BL) -> rev (readByteString n (S (B.reverse bs') o LB))

313+ (_,LL) -> rev (readByteString n (S (B.reverse bs') o BB))

314+ (_,LB) -> readByteString n (S (B.reverse bs') o BB)

284− | otherwise = unsafePerformIO $ do

315+ (_,BB) -> unsafePerformIO $ do

285− let len = n+1

316+ let len = n+1

286− ptr <- mallocBytes len

317+ ptr <- mallocBytes len

287− case bo of

288− BB -> do

289− let f r i = do

318+ let f r i = do

290− let

319+ let

291− w = unsafeIndex bs (len-i)

320+ w = unsafeIndex bs (len-i)

292− w' = (w `fastShiftL` o) .|. r

321+ w' = (w `fastShiftL` o) .|. r

293− r' = w `fastShiftR` (8-o)

322+ r' = w `fastShiftR` (8-o)

294− poke (ptr `plusPtr` (len-i)) w'

323+ poke (ptr `plusPtr` (len-i)) w'

295− return r'

324+ return r'

296− foldM_ f 0 [1..len]

325+ foldM_ f 0 [1..len]

297− unsafeInit <$> unsafePackMallocCStringLen (ptr,len)

326+ unsafeInit <$> unsafePackMallocCStringLen (ptr,len)

298−

327+

299− LB -> do

300− let f r i = do

301− let

302− w = unsafeIndex bs (i-1)

303− w' = (w `fastShiftL` (8-o)) .|. r

304− r' = w `fastShiftR` o

305− poke (ptr `plusPtr` (len-i)) w'

306− return r'

307− foldM_ f 0 [1..len]

308− unsafeTail <$> unsafePackMallocCStringLen (ptr,len)

309

328

310------------------------------------------------------------------------

329------------------------------------------------------------------------

311-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'

330-- | 'BitGet' is a monad, applicative and a functor. See 'runBitGet'