{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language TypeApplications #-}
module Data.Bytes.Parser.Leb128
(
word16
, word32
, word64
, int16
, int32
, int64
) where
import Data.Bits (testBit,(.&.),unsafeShiftR,xor,complement)
import Data.Bits (unsafeShiftL,(.|.))
import Data.Bytes.Parser (Parser)
import Data.Int (Int16,Int32,Int64)
import Data.Word (Word8,Word16,Word32,Word64)
import qualified Data.Bytes.Parser as P
word16 :: e -> Parser e s Word16
word16 e = do
w <- stepBoundedWord e 16 0 0
pure (fromIntegral @Word64 @Word16 w)
word32 :: e -> Parser e s Word32
word32 e = do
w <- stepBoundedWord e 32 0 0
pure (fromIntegral @Word64 @Word32 w)
word64 :: e -> Parser e s Word64
word64 e = stepBoundedWord e 64 0 0
int16 :: e -> Parser e s Int16
int16 = fmap zigzagDecode16 . word16
int32 :: e -> Parser e s Int32
int32 = fmap zigzagDecode32 . word32
int64 :: e -> Parser e s Int64
int64 = fmap zigzagDecode64 . word64
stepBoundedWord :: e -> Int -> Word64 -> Int -> Parser e s Word64
stepBoundedWord e !bitLimit !acc0 !accShift = do
raw <- P.any e
let number = raw .&. 0x7F
acc1 = acc0 .|.
unsafeShiftL (fromIntegral @Word8 @Word64 number) accShift
accShift' = accShift + 7
if accShift' <= bitLimit
then if testBit raw 7
then stepBoundedWord e bitLimit acc1 accShift'
else pure acc1
else if fromIntegral @Word8 @Word raw < twoExp (bitLimit - accShift)
then pure acc1
else P.fail e
twoExp :: Int -> Word
twoExp x = unsafeShiftL 1 x
zigzagDecode16 :: Word16 -> Int16
zigzagDecode16 n =
fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))
zigzagDecode32 :: Word32 -> Int32
zigzagDecode32 n =
fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))
zigzagDecode64 :: Word64 -> Int64
zigzagDecode64 n =
fromIntegral ((unsafeShiftR n 1) `xor` (complement (n .&. 1) + 1))