{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}

#include <MachDeps.h>

-- | __Signed LEB128 codec__. This codec encodes the two's complement
-- of a signed number
-- [as described here](https://en.wikipedia.org/wiki/LEB128#Signed_LEB128).
--
-- Any /getXXX/ decoder can decode bytes generated using any of the /putXXX/
-- encoders, provided the encoded number fits in the target type.
--
-- __WARNING__: This is not compatible with the /Unsigned LEB128/ codec at
-- "Data.Binary.ULEB128" nor with the /ZigZag LEB128/ codec at
-- "Data.Binary.ZLEB128".
module Data.Binary.SLEB128
 ( SLEB128(..)
   -- * Put
 , putInteger
 , putInt64
 , putInt32
 , putInt16
 , putInt8
 , putInt
 , putNatural
 , putWord64
 , putWord32
 , putWord16
 , putWord8
 , putWord
   -- * Get
 , getInteger
 , getInt64
 , getInt32
 , getInt16
 , getInt8
 , getInt
 , getNatural
 , getWord64
 , getWord32
 , getWord16
 , getWord8
 , getWord
 ) where

import Data.Binary qualified as Bin
import Data.Binary.Get qualified as Bin
import Data.Binary.Put qualified as Bin
import Data.ByteString.Builder.Prim qualified as BB
import Data.ByteString.Builder.Prim.Internal qualified as BB
import Data.Bits
import Data.Coerce
import GHC.Exts
import GHC.Int
import GHC.Word
import GHC.Num.BigNat
import GHC.Num.Natural
import GHC.Num.Integer
import Foreign.Ptr
import Foreign.Storable

--------------------------------------------------------------------------------

-- | Newtype wrapper for 'Bin.Binary' encoding and decoding @x@ using the
-- /Signed LEB128/ codec. Useful in conjunction with @DerivingVia@.
newtype SLEB128 x = SLEB128 x

-- | Note: Maximum allowed number of input bytes is restricted to 1000.
-- Use 'putNatural' if you want a greater limit.
instance Bin.Binary (SLEB128 Integer) where
  put :: SLEB128 Integer -> Put
put = (Integer -> Put) -> SLEB128 Integer -> Put
forall a b. Coercible a b => a -> b
coerce Integer -> Put
putInteger
  {-# INLINE put #-}
  get :: Get (SLEB128 Integer)
get = Get Integer -> Get (SLEB128 Integer)
forall a b. Coercible a b => a -> b
coerce (Int -> Get Integer
getInteger Int
1000)
  {-# INLINE get #-}

-- | Note: Maximum allowed number of input bytes is restricted to 1000.
-- Use 'putNatural' if you want a greater limit.
instance Bin.Binary (SLEB128 Natural) where
  put :: SLEB128 Natural -> Put
put = (Natural -> Put) -> SLEB128 Natural -> Put
forall a b. Coercible a b => a -> b
coerce Natural -> Put
putNatural
  {-# INLINE put #-}
  get :: Get (SLEB128 Natural)
get = Get Natural -> Get (SLEB128 Natural)
forall a b. Coercible a b => a -> b
coerce (Int -> Get Natural
getNatural Int
1000)
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int) where
  put :: SLEB128 Int -> Put
put = (Int -> Put) -> SLEB128 Int -> Put
forall a b. Coercible a b => a -> b
coerce Int -> Put
putInt
  {-# INLINE put #-}
  get :: Get (SLEB128 Int)
get = Get Int -> Get (SLEB128 Int)
forall a b. Coercible a b => a -> b
coerce Get Int
getInt
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word) where
  put :: SLEB128 Word -> Put
put = (Word -> Put) -> SLEB128 Word -> Put
forall a b. Coercible a b => a -> b
coerce Word -> Put
putWord
  {-# INLINE put #-}
  get :: Get (SLEB128 Word)
get = Get Word -> Get (SLEB128 Word)
forall a b. Coercible a b => a -> b
coerce Get Word
getWord
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int8) where
  put :: SLEB128 Int8 -> Put
put = (Int8 -> Put) -> SLEB128 Int8 -> Put
forall a b. Coercible a b => a -> b
coerce Int8 -> Put
putInt8
  {-# INLINE put #-}
  get :: Get (SLEB128 Int8)
get = Get Int8 -> Get (SLEB128 Int8)
forall a b. Coercible a b => a -> b
coerce Get Int8
getInt8
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word8) where
  put :: SLEB128 Word8 -> Put
put = (Word8 -> Put) -> SLEB128 Word8 -> Put
forall a b. Coercible a b => a -> b
coerce Word8 -> Put
putWord8
  {-# INLINE put #-}
  get :: Get (SLEB128 Word8)
get = Get Word8 -> Get (SLEB128 Word8)
forall a b. Coercible a b => a -> b
coerce Get Word8
getWord8
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int16) where
  put :: SLEB128 Int16 -> Put
put = (Int16 -> Put) -> SLEB128 Int16 -> Put
forall a b. Coercible a b => a -> b
coerce Int16 -> Put
putInt16
  {-# INLINE put #-}
  get :: Get (SLEB128 Int16)
get = Get Int16 -> Get (SLEB128 Int16)
forall a b. Coercible a b => a -> b
coerce Get Int16
getInt16
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word16) where
  put :: SLEB128 Word16 -> Put
put = (Word16 -> Put) -> SLEB128 Word16 -> Put
forall a b. Coercible a b => a -> b
coerce Word16 -> Put
putWord16
  {-# INLINE put #-}
  get :: Get (SLEB128 Word16)
get = Get Word16 -> Get (SLEB128 Word16)
forall a b. Coercible a b => a -> b
coerce Get Word16
getWord16
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int32) where
  put :: SLEB128 Int32 -> Put
put = (Int32 -> Put) -> SLEB128 Int32 -> Put
forall a b. Coercible a b => a -> b
coerce Int32 -> Put
putInt32
  {-# INLINE put #-}
  get :: Get (SLEB128 Int32)
get = Get Int32 -> Get (SLEB128 Int32)
forall a b. Coercible a b => a -> b
coerce Get Int32
getInt32
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word32) where
  put :: SLEB128 Word32 -> Put
put = (Word32 -> Put) -> SLEB128 Word32 -> Put
forall a b. Coercible a b => a -> b
coerce Word32 -> Put
putWord32
  {-# INLINE put #-}
  get :: Get (SLEB128 Word32)
get = Get Word32 -> Get (SLEB128 Word32)
forall a b. Coercible a b => a -> b
coerce Get Word32
getWord32
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Int64) where
  put :: SLEB128 Int64 -> Put
put = (Int64 -> Put) -> SLEB128 Int64 -> Put
forall a b. Coercible a b => a -> b
coerce Int64 -> Put
putInt64
  {-# INLINE put #-}
  get :: Get (SLEB128 Int64)
get = Get Int64 -> Get (SLEB128 Int64)
forall a b. Coercible a b => a -> b
coerce Get Int64
getInt64
  {-# INLINE get #-}

instance Bin.Binary (SLEB128 Word64) where
  put :: SLEB128 Word64 -> Put
put = (Word64 -> Put) -> SLEB128 Word64 -> Put
forall a b. Coercible a b => a -> b
coerce Word64 -> Put
putWord64
  {-# INLINE put #-}
  get :: Get (SLEB128 Word64)
get = Get Word64 -> Get (SLEB128 Word64)
forall a b. Coercible a b => a -> b
coerce Get Word64
getWord64
  {-# INLINE get #-}

--------------------------------------------------------------------------------

{-# INLINE putInteger #-}
putInteger :: Integer -> Bin.Put
putInteger :: Integer -> Put
putInteger = \case
    IS Int#
x -> Int -> Put
putInt (Int# -> Int
I# Int#
x)
    IP ByteArray#
x -> ByteArray# -> Int -> Put
putIP ByteArray#
x (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> ByteArray# -> Word
bigNatSizeInBase Word
2 ByteArray#
x)
    IN ByteArray#
x -> ByteArray# -> Put
putIN ByteArray#
x
  where
    {-# INLINE putIP #-}
    putIP :: BigNat# -> Int -> Bin.Put
    putIP :: ByteArray# -> Int -> Put
putIP !ByteArray#
a !Int
m = do
      Word8 -> Put
Bin.putWord8 (Word8# -> Word8
W8# (Word# -> Word8#
wordToWord8# (Word# -> Word# -> Word#
or# (ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
a Int#
0#) Word#
0x80##)))
      let b :: ByteArray#
b = ByteArray# -> Word# -> ByteArray#
bigNatShiftR# ByteArray#
a Word#
7## :: BigNat#
          n :: Int
n = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
7
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WORD_SIZE_IN_BITS - 1
         then ByteArray# -> Int -> Put
putIP ByteArray#
b Int
n
         else Int -> Put
putInt (Int# -> Int
I# (Word# -> Int#
word2Int# (ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
b Int#
0#)))
    -- TODO: Faster 'putIN' implementation, similar to 'putIP'
    {-# INLINE putIN #-}
    putIN :: BigNat# -> Bin.Put
    putIN :: ByteArray# -> Put
putIN !ByteArray#
a = do
      let b :: Integer
b = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
unsafeShiftR (ByteArray# -> Integer
IN ByteArray#
a) Int
7        :: Integer
          c :: Word8
c = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray# -> Integer
IN ByteArray#
a Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0x7f) :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40
      if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
&& Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1
         then Word8 -> Put
Bin.putWord8 Word8
c
         else do Word8 -> Put
Bin.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
                 Integer -> Put
putInteger Integer
b

putNatural :: Natural -> Bin.Put
putNatural :: Natural -> Put
putNatural = Integer -> Put
putInteger (Integer -> Put) -> (Natural -> Integer) -> Natural -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE putNatural #-}

putInt8 :: Int8 -> Bin.Put
putInt8 :: Int8 -> Put
putInt8 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int8 -> Builder) -> Int8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int8 -> Int8 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int8 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int8
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
2 Int8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt8 #-}

putInt16 :: Int16 -> Bin.Put
putInt16 :: Int16 -> Put
putInt16 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int16 -> Builder) -> Int16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int16 -> Int16 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int16 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int16
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
3 Int16 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt16 #-}

putInt32 :: Int32 -> Bin.Put
putInt32 :: Int32 -> Put
putInt32 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int32 -> Builder) -> Int32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int32 -> Int32 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int32 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int32
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
5 Int32 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt32 #-}

putInt64 :: Int64 -> Bin.Put
putInt64 :: Int64 -> Put
putInt64 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int64 -> Builder) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int64 -> Int64 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int64 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int64
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Int64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putInt64 #-}

putInt :: Int -> Bin.Put
putInt :: Int -> Put
putInt =
#if WORD_SIZE_IN_BITS == 64
  Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Int -> Builder) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Int -> Int -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Int -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Int
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Int -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
#elif WORD_SIZE_IN_BITS == 32
  Bin.putBuilder . BB.primBounded (BB.boundedPrim 5 unsafePoke)
#endif
{-# INLINE putInt #-}

putWord8 :: Word8 -> Bin.Put
putWord8 :: Word8 -> Put
putWord8 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word8 -> Builder) -> Word8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word8 -> Word8 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word8 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word8
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
2 Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord8 #-}

putWord16 :: Word16 -> Bin.Put
putWord16 :: Word16 -> Put
putWord16 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word16 -> Builder) -> Word16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word16 -> Word16 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word16 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word16
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
3 Word16 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord16 #-}

putWord32 :: Word32 -> Bin.Put
putWord32 :: Word32 -> Put
putWord32 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word32 -> Builder) -> Word32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word32 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word32
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
5 Word32 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord32 #-}

putWord64 :: Word64 -> Bin.Put
putWord64 :: Word64 -> Put
putWord64 = Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word64 -> Builder) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word64 -> Word64 -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int
-> (Word64 -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word64
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word64 -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
{-# INLINE putWord64 #-}

putWord :: Word -> Bin.Put
putWord :: Word -> Put
putWord =
#if WORD_SIZE_IN_BITS == 64
  Builder -> Put
Bin.putBuilder (Builder -> Put) -> (Word -> Builder) -> Word -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim Word -> Word -> Builder
forall a. BoundedPrim a -> a -> Builder
BB.primBounded (Int -> (Word -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim Word
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BB.boundedPrim Int
10 Word -> Ptr Word8 -> IO (Ptr Word8)
forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke)
#elif WORD_SIZE_IN_BITS == 32
  Bin.putBuilder . BB.primBounded (BB.boundedPrim 5 unsafePoke)
#endif
{-# INLINE putWord #-}

--------------------------------------------------------------------------------

getInteger
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Integer' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each ULEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Integer
getInteger :: Int -> Get Integer
getInteger = (Word8 -> Integer) -> Int -> Get Integer
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger
{-# INLINE getInteger #-}

-- | Like 'getInteger', except it's offered here so that other parsers can use
-- this specilized to types other than 'Integer'. This is unsafe because it
-- only works for signed numbers whose SLEB128 representation is at most as
-- long as the specified 'Int', but none of that is checked by this parser.
{-# INLINE unsafeGetSigned #-}
unsafeGetSigned
  :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Bin.Get a
unsafeGetSigned :: forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> a
fromWord8 = \Int
m -> String -> Get a -> Get a
forall a. String -> Get a -> Get a
Bin.label String
"SLEB128" (Int -> Int -> a -> Get a
go Int
m Int
0 a
0)
  where
    {-# INLINE go #-}
    go :: Int -> Int -> a -> Bin.Get a
    go :: Int -> Int -> a -> Get a
go Int
m Int
i a
o | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m = do
      Word8
w <- Get Word8
Bin.getWord8
      let !a :: a
a = a
o a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> a
fromWord8 (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f)) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)
      if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 then Int -> Int -> a -> Get a
go Int
m (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
a
      else a -> Get a
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$! a
a a -> a -> a
forall a. Num a => a -> a -> a
- Int -> a
forall a. Bits a => Int -> a
bit ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7)
                     a -> a -> a
forall a. Num a => a -> a -> a
* Word8 -> a
fromWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40) Int
6)
    go Int
_ Int
_ a
_ = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input exceeds maximum allowed bytes"

getNatural
  :: Int
  -- ^ /Maximum/ number of bytes to consume. If the 'Natural' number can be
  -- determined before consuming this number of bytes, it will be. If @0@,
  -- parsing fails.
  --
  -- Each ULEB128 byte encodes at most 7 bits of data. That is,
  -- \(length(encoded) == \lceil\frac{length(data)}{7}\rceil\).
  -> Bin.Get Natural
getNatural :: Int -> Get Natural
getNatural = \Int
m -> do
  Integer
i <- Int -> Get Integer
getInteger Int
m
  String -> Get Natural -> Get Natural
forall a. String -> Get a -> Get a
Bin.label String
"SLEB128" (Integer -> Get Natural
forall (m :: * -> *). MonadFail m => Integer -> m Natural
naturalFromInteger Integer
i)
{-# INLINE getNatural #-}

getBoundedIntegral
  :: forall a b
  .  (Bits a, Integral a, Bits b, Integral b)
  => Bin.Get a
  -> Bin.Get b
getBoundedIntegral :: forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral = \Get a
ga -> do
  a
a <- Get a
ga
  Get b -> (b -> Get b) -> Maybe b -> Get b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get b
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"underflow or overflow") b -> Get b
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
a)
{-# INLINE getBoundedIntegral #-}

getInt8 :: Bin.Get Int8
getInt8 :: Get Int8
getInt8 = (Word8 -> Int8) -> Int -> Get Int8
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
2
{-# INLINE getInt8 #-}

getInt16 :: Bin.Get Int16
getInt16 :: Get Int16
getInt16 = (Word8 -> Int16) -> Int -> Get Int16
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
3
{-# INLINE getInt16 #-}

getInt32 :: Bin.Get Int32
getInt32 :: Get Int32
getInt32 = (Word8 -> Int32) -> Int -> Get Int32
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
5
{-# INLINE getInt32 #-}

getInt64 :: Bin.Get Int64
getInt64 :: Get Int64
getInt64 = (Word8 -> Int64) -> Int -> Get Int64
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
{-# INLINE getInt64 #-}

getInt :: Bin.Get Int
getInt :: Get Int
getInt =
#if WORD_SIZE_IN_BITS == 64
  (Word8 -> Int) -> Int -> Get Int
forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
10
#elif WORD_SIZE_IN_BITS == 32
  unsafeGetSigned fromIntegral 5
#endif
{-# INLINE getInt #-}

getWord8 :: Bin.Get Word8
getWord8 :: Get Word8
getWord8 = Get Int16 -> Get Word8
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int16 Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
2)
{-# INLINE getWord8 #-}

getWord16 :: Bin.Get Word16
getWord16 :: Get Word16
getWord16 = Get Int32 -> Get Word16
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int32 Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
3)
{-# INLINE getWord16 #-}

getWord32 :: Bin.Get Word32
getWord32 :: Get Word32
getWord32 = Get Int64 -> Get Word32
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (forall a. (Bits a, Num a) => (Word8 -> a) -> Int -> Get a
unsafeGetSigned @Int64 Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
5)
{-# INLINE getWord32 #-}

getWord64 :: Bin.Get Word64
getWord64 :: Get Word64
getWord64 = Get Integer -> Get Word64
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (Int -> Get Integer
getInteger Int
10)
{-# INLINE getWord64 #-}

getWord :: Bin.Get Word
getWord :: Get Word
getWord =
#if WORD_SIZE_IN_BITS == 64
  Get Integer -> Get Word
forall a b.
(Bits a, Integral a, Bits b, Integral b) =>
Get a -> Get b
getBoundedIntegral (Int -> Get Integer
getInteger Int
10)
#elif WORD_SIZE_IN_BITS == 32
  getBoundedIntegral (unsafeGetSigned @Int64 fromIntegral 5)
#endif
{-# INLINE getWord #-}

--------------------------------------------------------------------------------

-- | SLEB128-encodes @a@ and writes it into 'Ptr'. Returns one past the last
-- written address. None of this is not checked.
{-# INLINE unsafePoke #-}
unsafePoke
  :: forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke :: forall a. (Bits a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)
unsafePoke = \a
a Ptr Word8
p ->
    -- We split neg and pos so that their internal 'if' checks for less things.
    if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a -> Ptr Word8 -> IO (Ptr Word8)
neg a
a Ptr Word8
p else a -> Ptr Word8 -> IO (Ptr Word8)
pos a
a Ptr Word8
p
  where
    {-# INLINE neg #-}
    neg :: a -> Ptr Word8 -> IO (Ptr Word8)
    neg :: a -> Ptr Word8 -> IO (Ptr Word8)
neg = \ !a
a !Ptr Word8
p -> do
      let b :: a
b = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
7          :: a
          c :: Word8
c = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7f) :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40                :: Word8
      if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= -a
1 then do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
         a -> Ptr Word8 -> IO (Ptr Word8)
neg a
b (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
      else do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x40
         Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
    {-# INLINE pos #-}
    pos :: a -> Ptr Word8 -> IO (Ptr Word8)
    pos :: a -> Ptr Word8 -> IO (Ptr Word8)
pos = \ !a
a !Ptr Word8
p -> do
      let b :: a
b = a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
7 :: a
          c :: Word8
c = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a   :: Word8
          d :: Word8
d = Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x40       :: Word8
      if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
|| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 then do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80
         a -> Ptr Word8 -> IO (Ptr Word8)
pos a
b (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1
      else do
         Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word8
c
         Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
1

{-# INLINE naturalFromInteger #-}
naturalFromInteger :: MonadFail m => Integer -> m Natural
naturalFromInteger :: forall (m :: * -> *). MonadFail m => Integer -> m Natural
naturalFromInteger = \case
  IS Int#
x | Int# -> Bool
isTrue# (Int#
0# Int# -> Int# -> Int#
<=# Int#
x) -> Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ Word# -> Natural
naturalFromWord# (Int# -> Word#
int2Word# Int#
x)
  IP ByteArray#
x -> Natural -> m Natural
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> m Natural) -> Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Natural
naturalFromBigNat# ByteArray#
x
  Integer
_ -> String -> m Natural
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"underflow"