{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
module Streamly.Internal.Data.Unbox
(
Unbox(..)
, BoundedPtr (..)
, Peeker (..)
, read
, readUnsafe
, skipByte
, runPeeker
, pokeBoundedPtrUnsafe
, pokeBoundedPtr
, PeekRep(..)
, PokeRep(..)
, SizeOfRep(..)
, genericSizeOf
, genericPeekByteIndex
, genericPokeByteIndex
) where
#include "MachDeps.h"
#include "ArrayMacros.h"
import Control.Monad (void, when)
import Data.Complex (Complex((:+)))
import Data.Functor ((<&>))
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Foreign.Ptr (IntPtr(..), WordPtr(..))
import GHC.Base (IO(..))
import GHC.Fingerprint.Type (Fingerprint(..))
import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
import GHC.Real (Ratio(..))
import GHC.Stable (StablePtr(..))
import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
#if MIN_VERSION_base(4,15,0)
import GHC.RTS.Flags (IoSubSystem(..))
#endif
import Streamly.Internal.Data.Builder (Builder (..))
import GHC.Generics
import GHC.Exts
import GHC.TypeLits
import Prelude hiding (read)
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))
#ifdef DEBUG
import Streamly.Internal.Data.MutByteArray.Type (sizeOfMutableByteArray)
#endif
class Unbox a where
sizeOf :: Proxy a -> Int
{-# INLINE sizeOf #-}
default sizeOf :: (SizeOfRep (Rep a)) => Proxy a -> Int
sizeOf = Proxy a -> Int
forall a. SizeOfRep (Rep a) => Proxy a -> Int
genericSizeOf
peekAt :: Int -> MutByteArray -> IO a
{-# INLINE peekAt #-}
default peekAt :: (Generic a, PeekRep (Rep a)) =>
Int -> MutByteArray -> IO a
peekAt Int
i MutByteArray
arr = MutByteArray -> Int -> IO a
forall a.
(Generic a, PeekRep (Rep a)) =>
MutByteArray -> Int -> IO a
genericPeekByteIndex MutByteArray
arr Int
i
peekByteIndex :: Int -> MutByteArray -> IO a
peekByteIndex = Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt
pokeAt :: Int -> MutByteArray -> a -> IO ()
pokeByteIndex :: Int -> MutByteArray -> a -> IO ()
pokeByteIndex = Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt
{-# INLINE pokeAt #-}
default pokeAt :: (Generic a, PokeRep (Rep a)) =>
Int -> MutByteArray -> a -> IO ()
pokeAt Int
i MutByteArray
arr = MutByteArray -> Int -> a -> IO ()
forall a.
(Generic a, PokeRep (Rep a)) =>
MutByteArray -> Int -> a -> IO ()
genericPokeByteIndex MutByteArray
arr Int
i
{-# DEPRECATED peekByteIndex "Use peekAt." #-}
{-# DEPRECATED pokeByteIndex "Use pokeAt." #-}
{-# INLINE checkBounds #-}
checkBounds :: String -> Int -> MutByteArray -> IO ()
checkBounds :: String -> Int -> MutByteArray -> IO ()
checkBounds String
_label Int
_size MutByteArray
_arr = do
#ifdef DEBUG
sz <- sizeOfMutableByteArray _arr
if (_size > sz)
then error
$ _label
++ ": accessing array at offset = "
++ show (_size - 1)
++ " max valid offset = " ++ show (sz - 1)
else return ()
#else
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \
instance Unbox _type where { \
; {-# INLINE peekAt #-} \
; peekAt off@(I# n) arr@(MutByteArray mbarr) = \
checkBounds "peek" (off + sizeOf (Proxy :: Proxy _type)) arr \
>> (IO $ \s -> \
case _readArray mbarr n s of \
{ (# s1, i #) -> (# s1, _constructor i #) }) \
; {-# INLINE pokeAt #-} \
; pokeAt off@(I# n) arr@(MutByteArray mbarr) (_constructor val) = \
checkBounds "poke" (off + sizeOf (Proxy :: Proxy _type)) arr \
>> (IO $ \s -> (# _writeArray mbarr n val s, () #)) \
; {-# INLINE sizeOf #-} \
; sizeOf _ = _sizeOf \
}
#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType) \
instance _constraint Unbox _type where \
; {-# INLINE peekAt #-} \
; peekAt i arr = \
checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr \
>> _constructor <$> peekAt i arr \
; {-# INLINE pokeAt #-} \
; pokeAt i arr (_constructor a) = \
checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr \
>> pokeAt i arr a \
; {-# INLINE sizeOf #-} \
; sizeOf _ = SIZE_OF(_innerType)
#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \
instance _constraint Unbox _type where { \
; {-# INLINE peekAt #-} \
; peekAt i arr = \
checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr >> \
peekAt i arr >>= \
(\p1 -> peekAt (i + SIZE_OF(_innerType)) arr <&> _constructor p1) \
; {-# INLINE pokeAt #-} \
; pokeAt i arr (_constructor p1 p2) = \
checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr >> \
pokeAt i arr p1 >> \
pokeAt (i + SIZE_OF(_innerType)) arr p2 \
; {-# INLINE sizeOf #-} \
; sizeOf _ = 2 * SIZE_OF(_innerType) \
}
DERIVE_UNBOXED( Char
, C#
, readWord8ArrayAsWideChar#
, writeWord8ArrayAsWideChar#
, SIZEOF_HSCHAR)
DERIVE_UNBOXED( Int8
, I8#
, readInt8Array#
, writeInt8Array#
, 1)
DERIVE_UNBOXED( Int16
, I16#
, readWord8ArrayAsInt16#
, writeWord8ArrayAsInt16#
, 2)
DERIVE_UNBOXED( Int32
, I32#
, readWord8ArrayAsInt32#
, writeWord8ArrayAsInt32#
, 4)
DERIVE_UNBOXED( Int
, I#
, readWord8ArrayAsInt#
, writeWord8ArrayAsInt#
, SIZEOF_HSINT)
DERIVE_UNBOXED( Int64
, I64#
, readWord8ArrayAsInt64#
, writeWord8ArrayAsInt64#
, 8)
DERIVE_UNBOXED( Word
, W#
, readWord8ArrayAsWord#
, writeWord8ArrayAsWord#
, SIZEOF_HSWORD)
DERIVE_UNBOXED( Word8
, W8#
, readWord8Array#
, writeWord8Array#
, 1)
DERIVE_UNBOXED( Word16
, W16#
, readWord8ArrayAsWord16#
, writeWord8ArrayAsWord16#
, 2)
DERIVE_UNBOXED( Word32
, W32#
, readWord8ArrayAsWord32#
, writeWord8ArrayAsWord32#
, 4)
DERIVE_UNBOXED( Word64
, W64#
, readWord8ArrayAsWord64#
, writeWord8ArrayAsWord64#
, 8)
DERIVE_UNBOXED( Double
, D#
, readWord8ArrayAsDouble#
, writeWord8ArrayAsDouble#
, SIZEOF_HSDOUBLE)
DERIVE_UNBOXED( Float
, F#
, readWord8ArrayAsFloat#
, writeWord8ArrayAsFloat#
, SIZEOF_HSFLOAT)
DERIVE_UNBOXED( (StablePtr a)
, StablePtr
, readWord8ArrayAsStablePtr#
, writeWord8ArrayAsStablePtr#
, SIZEOF_HSSTABLEPTR)
DERIVE_UNBOXED( (Ptr a)
, Ptr
, readWord8ArrayAsAddr#
, writeWord8ArrayAsAddr#
, SIZEOF_HSPTR)
DERIVE_UNBOXED( (FunPtr a)
, FunPtr
, readWord8ArrayAsAddr#
, writeWord8ArrayAsAddr#
, SIZEOF_HSFUNPTR)
DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)
DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)
DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)
#if MIN_VERSION_base(4,14,0)
DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)
#endif
DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)
DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)
DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)
DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)
instance Unbox () where
{-# INLINE peekAt #-}
peekAt :: Int -> MutByteArray -> IO ()
peekAt Int
i MutByteArray
arr =
String -> Int -> MutByteArray -> IO ()
checkBounds String
"peek ()" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy () -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy ()
forall {k} (t :: k). Proxy t
Proxy :: Proxy ())) MutByteArray
arr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE pokeAt #-}
pokeAt :: Int -> MutByteArray -> () -> IO ()
pokeAt Int
i MutByteArray
arr ()
_ =
String -> Int -> MutByteArray -> IO ()
checkBounds String
"poke ()" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy () -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy ()
forall {k} (t :: k). Proxy t
Proxy :: Proxy ())) MutByteArray
arr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE sizeOf #-}
sizeOf :: Proxy () -> Int
sizeOf Proxy ()
_ = Int
1
#if MIN_VERSION_base(4,15,0)
instance Unbox IoSubSystem where
{-# INLINE peekAt #-}
peekAt :: Int -> MutByteArray -> IO IoSubSystem
peekAt Int
i MutByteArray
arr =
String -> Int -> MutByteArray -> IO ()
checkBounds
String
"peek IoSubSystem" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy IoSubSystem -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy IoSubSystem
forall {k} (t :: k). Proxy t
Proxy :: Proxy IoSubSystem)) MutByteArray
arr
IO () -> IO IoSubSystem -> IO IoSubSystem
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IoSubSystem
forall a. Enum a => Int -> a
toEnum (Int -> IoSubSystem) -> IO Int -> IO IoSubSystem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutByteArray -> IO Int
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i MutByteArray
arr
{-# INLINE pokeAt #-}
pokeAt :: Int -> MutByteArray -> IoSubSystem -> IO ()
pokeAt Int
i MutByteArray
arr IoSubSystem
a =
String -> Int -> MutByteArray -> IO ()
checkBounds
String
"poke IoSubSystem" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy IoSubSystem -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy IoSubSystem
forall {k} (t :: k). Proxy t
Proxy :: Proxy IoSubSystem)) MutByteArray
arr
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MutByteArray -> Int -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
i MutByteArray
arr (IoSubSystem -> Int
forall a. Enum a => a -> Int
fromEnum IoSubSystem
a)
{-# INLINE sizeOf #-}
sizeOf :: Proxy IoSubSystem -> Int
sizeOf Proxy IoSubSystem
_ = Proxy Int -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Int
forall {k} (t :: k). Proxy t
Proxy :: Proxy Int)
#endif
instance Unbox Bool where
{-# INLINE peekAt #-}
peekAt :: Int -> MutByteArray -> IO Bool
peekAt Int
i MutByteArray
arr = do
String -> Int -> MutByteArray -> IO ()
checkBounds String
"peek Bool" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy Bool -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Bool
forall {k} (t :: k). Proxy t
Proxy :: Proxy Bool)) MutByteArray
arr
Int8
res <- Int -> MutByteArray -> IO Int8
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i MutByteArray
arr
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int8
res Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int8
0 :: Int8)
{-# INLINE pokeAt #-}
pokeAt :: Int -> MutByteArray -> Bool -> IO ()
pokeAt Int
i MutByteArray
arr Bool
a =
String -> Int -> MutByteArray -> IO ()
checkBounds String
"poke Bool" (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy Bool -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Bool
forall {k} (t :: k). Proxy t
Proxy :: Proxy Bool)) MutByteArray
arr
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> if Bool
a
then Int -> MutByteArray -> Int8 -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
i MutByteArray
arr (Int8
1 :: Int8)
else Int -> MutByteArray -> Int8 -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
i MutByteArray
arr (Int8
0 :: Int8)
{-# INLINE sizeOf #-}
sizeOf :: Proxy Bool -> Int
sizeOf Proxy Bool
_ = Int
1
data BoundedPtr =
BoundedPtr
MutByteArray
Int
Int
newtype Peeker a = Peeker (Builder BoundedPtr IO a)
deriving ((forall a b. (a -> b) -> Peeker a -> Peeker b)
-> (forall a b. a -> Peeker b -> Peeker a) -> Functor Peeker
forall a b. a -> Peeker b -> Peeker a
forall a b. (a -> b) -> Peeker a -> Peeker b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Peeker a -> Peeker b
fmap :: forall a b. (a -> b) -> Peeker a -> Peeker b
$c<$ :: forall a b. a -> Peeker b -> Peeker a
<$ :: forall a b. a -> Peeker b -> Peeker a
Functor, Functor Peeker
Functor Peeker
-> (forall a. a -> Peeker a)
-> (forall a b. Peeker (a -> b) -> Peeker a -> Peeker b)
-> (forall a b c.
(a -> b -> c) -> Peeker a -> Peeker b -> Peeker c)
-> (forall a b. Peeker a -> Peeker b -> Peeker b)
-> (forall a b. Peeker a -> Peeker b -> Peeker a)
-> Applicative Peeker
forall a. a -> Peeker a
forall a b. Peeker a -> Peeker b -> Peeker a
forall a b. Peeker a -> Peeker b -> Peeker b
forall a b. Peeker (a -> b) -> Peeker a -> Peeker b
forall a b c. (a -> b -> c) -> Peeker a -> Peeker b -> Peeker c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Peeker a
pure :: forall a. a -> Peeker a
$c<*> :: forall a b. Peeker (a -> b) -> Peeker a -> Peeker b
<*> :: forall a b. Peeker (a -> b) -> Peeker a -> Peeker b
$cliftA2 :: forall a b c. (a -> b -> c) -> Peeker a -> Peeker b -> Peeker c
liftA2 :: forall a b c. (a -> b -> c) -> Peeker a -> Peeker b -> Peeker c
$c*> :: forall a b. Peeker a -> Peeker b -> Peeker b
*> :: forall a b. Peeker a -> Peeker b -> Peeker b
$c<* :: forall a b. Peeker a -> Peeker b -> Peeker a
<* :: forall a b. Peeker a -> Peeker b -> Peeker a
Applicative, Applicative Peeker
Applicative Peeker
-> (forall a b. Peeker a -> (a -> Peeker b) -> Peeker b)
-> (forall a b. Peeker a -> Peeker b -> Peeker b)
-> (forall a. a -> Peeker a)
-> Monad Peeker
forall a. a -> Peeker a
forall a b. Peeker a -> Peeker b -> Peeker b
forall a b. Peeker a -> (a -> Peeker b) -> Peeker b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Peeker a -> (a -> Peeker b) -> Peeker b
>>= :: forall a b. Peeker a -> (a -> Peeker b) -> Peeker b
$c>> :: forall a b. Peeker a -> Peeker b -> Peeker b
>> :: forall a b. Peeker a -> Peeker b -> Peeker b
$creturn :: forall a. a -> Peeker a
return :: forall a. a -> Peeker a
Monad)
{-# INLINE readUnsafe #-}
readUnsafe :: Unbox a => Peeker a
readUnsafe :: forall a. Unbox a => Peeker a
readUnsafe = Builder BoundedPtr IO a -> Peeker a
forall a. Builder BoundedPtr IO a -> Peeker a
Peeker ((BoundedPtr -> IO (a, BoundedPtr)) -> Builder BoundedPtr IO a
forall s (m :: * -> *) a. (s -> m (a, s)) -> Builder s m a
Builder BoundedPtr -> IO (a, BoundedPtr)
forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step)
where
{-# INLINE step #-}
step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step (BoundedPtr MutByteArray
arr Int
pos Int
end) = do
let next :: Int
next = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
#ifdef DEBUG
when (next > end)
$ error $ "readUnsafe: reading beyond limit. next = "
++ show next
++ " end = " ++ show end
#endif
a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
pos MutByteArray
arr
(a, BoundedPtr) -> IO (a, BoundedPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
next Int
end)
{-# INLINE read #-}
read :: Unbox a => Peeker a
read :: forall a. Unbox a => Peeker a
read = Builder BoundedPtr IO a -> Peeker a
forall a. Builder BoundedPtr IO a -> Peeker a
Peeker ((BoundedPtr -> IO (a, BoundedPtr)) -> Builder BoundedPtr IO a
forall s (m :: * -> *) a. (s -> m (a, s)) -> Builder s m a
Builder BoundedPtr -> IO (a, BoundedPtr)
forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step)
where
{-# INLINE step #-}
step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)
step (BoundedPtr MutByteArray
arr Int
pos Int
end) = do
let next :: Int
next = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"read: reading beyond limit. next = "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
next
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" end = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
end
a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
pos MutByteArray
arr
(a, BoundedPtr) -> IO (a, BoundedPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
next Int
end)
{-# INLINE skipByte #-}
skipByte :: Peeker ()
skipByte :: Peeker ()
skipByte = Builder BoundedPtr IO () -> Peeker ()
forall a. Builder BoundedPtr IO a -> Peeker a
Peeker ((BoundedPtr -> IO ((), BoundedPtr)) -> Builder BoundedPtr IO ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> Builder s m a
Builder BoundedPtr -> IO ((), BoundedPtr)
step)
where
{-# INLINE step #-}
step :: BoundedPtr -> IO ((), BoundedPtr)
step :: BoundedPtr -> IO ((), BoundedPtr)
step (BoundedPtr MutByteArray
arr Int
pos Int
end) = do
let next :: Int
next = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
#ifdef DEBUG
when (next > end)
$ error $ "skipByte: reading beyond limit. next = "
++ show next
++ " end = " ++ show end
#endif
((), BoundedPtr) -> IO ((), BoundedPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
next Int
end)
{-# INLINE runPeeker #-}
runPeeker :: Peeker a -> BoundedPtr -> IO a
runPeeker :: forall a. Peeker a -> BoundedPtr -> IO a
runPeeker (Peeker (Builder BoundedPtr -> IO (a, BoundedPtr)
f)) BoundedPtr
ptr = ((a, BoundedPtr) -> a) -> IO (a, BoundedPtr) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, BoundedPtr) -> a
forall a b. (a, b) -> a
fst (BoundedPtr -> IO (a, BoundedPtr)
f BoundedPtr
ptr)
{-# INLINE pokeBoundedPtrUnsafe #-}
pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtrUnsafe a
a (BoundedPtr MutByteArray
arr Int
pos Int
end) = do
let next :: Int
next = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
#ifdef DEBUG
when (next > end)
$ error $ "pokeBoundedPtrUnsafe: reading beyond limit. next = "
++ show next
++ " end = " ++ show end
#endif
Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
pos MutByteArray
arr a
a
BoundedPtr -> IO BoundedPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
next Int
end)
{-# INLINE pokeBoundedPtr #-}
pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtr a
a (BoundedPtr MutByteArray
arr Int
pos Int
end) = do
let next :: Int
next = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error String
"pokeBoundedPtr writing beyond limit"
Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
pos MutByteArray
arr a
a
BoundedPtr -> IO BoundedPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
next Int
end)
type family SumArity (a :: Type -> Type) :: Nat where
SumArity (C1 _ _) = 1
SumArity (f :+: g) = SumArity f + SumArity g
type family TypeErrorMessage (a :: Symbol) :: Constraint where
TypeErrorMessage a = TypeError ('Text a)
type family ArityCheck (b :: Bool) :: Constraint where
ArityCheck 'True = ()
ArityCheck 'False = TypeErrorMessage
"Generic Unbox deriving does not support > 256 constructors."
type MaxArity256 n = ArityCheck (n <=? 256)
class SizeOfRep (f :: Type -> Type) where
sizeOfRep :: f x -> Int
instance SizeOfRep f => SizeOfRep (M1 i c f) where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. M1 i c f x -> Int
sizeOfRep M1 i c f x
_ = f Any -> Int
forall x. f x -> Int
forall (f :: * -> *) x. SizeOfRep f => f x -> Int
sizeOfRep (f x
forall {x}. f x
forall a. HasCallStack => a
undefined :: f x)
instance Unbox a => SizeOfRep (K1 i a) where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. K1 i a x -> Int
sizeOfRep K1 i a x
_ = Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
instance SizeOfRep V1 where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. V1 x -> Int
sizeOfRep = String -> V1 x -> Int
forall a. HasCallStack => String -> a
error String
"sizeOfRep: a value of a Void type must not exist"
instance SizeOfRep U1 where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. U1 x -> Int
sizeOfRep U1 x
_ = Int
0
instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. (:*:) f g x -> Int
sizeOfRep (:*:) f g x
_ = f Any -> Int
forall x. f x -> Int
forall (f :: * -> *) x. SizeOfRep f => f x -> Int
sizeOfRep (f x
forall {x}. f x
forall a. HasCallStack => a
undefined :: f x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ g Any -> Int
forall x. g x -> Int
forall (f :: * -> *) x. SizeOfRep f => f x -> Int
sizeOfRep (g x
forall {x}. g x
forall a. HasCallStack => a
undefined :: g x)
class SizeOfRepSum (f :: Type -> Type) where
sizeOfRepSum :: f x -> Int
instance SizeOfRep a => SizeOfRepSum (C1 c a) where
{-# INLINE sizeOfRepSum #-}
sizeOfRepSum :: forall x. C1 c a x -> Int
sizeOfRepSum = M1 C c a x -> Int
forall x. C1 c a x -> Int
forall (f :: * -> *) x. SizeOfRep f => f x -> Int
sizeOfRep
instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where
{-# INLINE sizeOfRepSum #-}
sizeOfRepSum :: forall x. (:+:) f g x -> Int
sizeOfRepSum (:+:) f g x
_ =
Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (f Any -> Int
forall x. f x -> Int
forall (f :: * -> *) x. SizeOfRepSum f => f x -> Int
sizeOfRepSum (f x
forall {x}. f x
forall a. HasCallStack => a
undefined :: f x)) (g Any -> Int
forall x. g x -> Int
forall (f :: * -> *) x. SizeOfRepSum f => f x -> Int
sizeOfRepSum (g x
forall {x}. g x
forall a. HasCallStack => a
undefined :: g x))
instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>
SizeOfRep (f :+: g) where
{-# INLINE sizeOfRep #-}
sizeOfRep :: forall x. (:+:) f g x -> Int
sizeOfRep (:+:) f g x
_ =
Proxy Word8 -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Word8
forall {k} (t :: k). Proxy t
Proxy :: Proxy Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (f Any -> Int
forall x. f x -> Int
forall (f :: * -> *) x. SizeOfRepSum f => f x -> Int
sizeOfRepSum (f x
forall {x}. f x
forall a. HasCallStack => a
undefined :: f x))
(g Any -> Int
forall x. g x -> Int
forall (f :: * -> *) x. SizeOfRepSum f => f x -> Int
sizeOfRepSum (g x
forall {x}. g x
forall a. HasCallStack => a
undefined :: g x))
{-# INLINE genericSizeOf #-}
genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int
genericSizeOf :: forall a. SizeOfRep (Rep a) => Proxy a -> Int
genericSizeOf Proxy a
_ =
let s :: Int
s = Rep a Any -> Int
forall x. Rep a x -> Int
forall (f :: * -> *) x. SizeOfRep f => f x -> Int
sizeOfRep (Rep a x
forall {x}. Rep a x
forall a. HasCallStack => a
undefined :: Rep a x)
in if Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
s
class PokeRep (f :: Type -> Type) where
pokeRep :: f a -> BoundedPtr -> IO BoundedPtr
instance PokeRep f => PokeRep (M1 i c f) where
{-# INLINE pokeRep #-}
pokeRep :: forall a. M1 i c f a -> BoundedPtr -> IO BoundedPtr
pokeRep M1 i c f a
f = f a -> BoundedPtr -> IO BoundedPtr
forall a. f a -> BoundedPtr -> IO BoundedPtr
forall (f :: * -> *) a.
PokeRep f =>
f a -> BoundedPtr -> IO BoundedPtr
pokeRep (M1 i c f a -> f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i c f a
f)
instance Unbox a => PokeRep (K1 i a) where
{-# INLINE pokeRep #-}
pokeRep :: forall a. K1 i a a -> BoundedPtr -> IO BoundedPtr
pokeRep K1 i a a
a = a -> BoundedPtr -> IO BoundedPtr
forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtrUnsafe (K1 i a a -> a
forall k i c (p :: k). K1 i c p -> c
unK1 K1 i a a
a)
instance PokeRep V1 where
{-# INLINE pokeRep #-}
pokeRep :: forall a. V1 a -> BoundedPtr -> IO BoundedPtr
pokeRep = String -> V1 a -> BoundedPtr -> IO BoundedPtr
forall a. HasCallStack => String -> a
error String
"pokeRep: a value of a Void type should not exist"
instance PokeRep U1 where
{-# INLINE pokeRep #-}
pokeRep :: forall a. U1 a -> BoundedPtr -> IO BoundedPtr
pokeRep U1 a
_ BoundedPtr
x = BoundedPtr -> IO BoundedPtr
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoundedPtr
x
instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where
{-# INLINE pokeRep #-}
pokeRep :: forall a. (:*:) f g a -> BoundedPtr -> IO BoundedPtr
pokeRep (f a
f :*: g a
g) BoundedPtr
ptr = f a -> BoundedPtr -> IO BoundedPtr
forall a. f a -> BoundedPtr -> IO BoundedPtr
forall (f :: * -> *) a.
PokeRep f =>
f a -> BoundedPtr -> IO BoundedPtr
pokeRep f a
f BoundedPtr
ptr IO BoundedPtr -> (BoundedPtr -> IO BoundedPtr) -> IO BoundedPtr
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g a -> BoundedPtr -> IO BoundedPtr
forall a. g a -> BoundedPtr -> IO BoundedPtr
forall (f :: * -> *) a.
PokeRep f =>
f a -> BoundedPtr -> IO BoundedPtr
pokeRep g a
g
class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where
pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where
{-# INLINE pokeRepSum #-}
pokeRepSum :: forall a. Proxy n -> C1 c a a -> BoundedPtr -> IO BoundedPtr
pokeRepSum Proxy n
_ C1 c a a
x BoundedPtr
ptr = do
let tag :: Word8
tag = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)) :: Word8
Word8 -> BoundedPtr -> IO BoundedPtr
forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr
pokeBoundedPtrUnsafe Word8
tag BoundedPtr
ptr IO BoundedPtr -> (BoundedPtr -> IO BoundedPtr) -> IO BoundedPtr
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= C1 c a a -> BoundedPtr -> IO BoundedPtr
forall a. M1 C c a a -> BoundedPtr -> IO BoundedPtr
forall (f :: * -> *) a.
PokeRep f =>
f a -> BoundedPtr -> IO BoundedPtr
pokeRep C1 c a a
x
instance (PokeRepSum n f, PokeRepSum (n + SumArity f) g)
=> PokeRepSum n (f :+: g) where
{-# INLINE pokeRepSum #-}
pokeRepSum :: forall a. Proxy n -> (:+:) f g a -> BoundedPtr -> IO BoundedPtr
pokeRepSum Proxy n
_ (L1 f a
x) BoundedPtr
ptr =
Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
forall (n :: Nat) (f :: * -> *) a.
PokeRepSum n f =>
Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
forall a. Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
pokeRepSum (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n) f a
x BoundedPtr
ptr
pokeRepSum Proxy n
_ (R1 g a
x) BoundedPtr
ptr =
Proxy (n + SumArity f) -> g a -> BoundedPtr -> IO BoundedPtr
forall (n :: Nat) (f :: * -> *) a.
PokeRepSum n f =>
Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
forall a.
Proxy (n + SumArity f) -> g a -> BoundedPtr -> IO BoundedPtr
pokeRepSum (Proxy (n + SumArity f)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (n + SumArity f)) g a
x BoundedPtr
ptr
instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>
PokeRep (f :+: g) where
{-# INLINE pokeRep #-}
pokeRep :: forall a. (:+:) f g a -> BoundedPtr -> IO BoundedPtr
pokeRep = Proxy 0 -> (:+:) f g a -> BoundedPtr -> IO BoundedPtr
forall (n :: Nat) (f :: * -> *) a.
PokeRepSum n f =>
Proxy n -> f a -> BoundedPtr -> IO BoundedPtr
forall a. Proxy 0 -> (:+:) f g a -> BoundedPtr -> IO BoundedPtr
pokeRepSum (Proxy 0
forall {k} (t :: k). Proxy t
Proxy :: Proxy 0)
{-# INLINE genericPokeObject #-}
genericPokeObject :: (Generic a, PokeRep (Rep a)) =>
a -> BoundedPtr -> IO BoundedPtr
genericPokeObject :: forall a.
(Generic a, PokeRep (Rep a)) =>
a -> BoundedPtr -> IO BoundedPtr
genericPokeObject a
a = Rep a Any -> BoundedPtr -> IO BoundedPtr
forall a. Rep a a -> BoundedPtr -> IO BoundedPtr
forall (f :: * -> *) a.
PokeRep f =>
f a -> BoundedPtr -> IO BoundedPtr
pokeRep (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)
genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()
genericPokeObj :: forall a. (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()
genericPokeObj a
a BoundedPtr
ptr = IO BoundedPtr -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO BoundedPtr -> IO ()) -> IO BoundedPtr -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> BoundedPtr -> IO BoundedPtr
forall a.
(Generic a, PokeRep (Rep a)) =>
a -> BoundedPtr -> IO BoundedPtr
genericPokeObject a
a BoundedPtr
ptr
{-# INLINE genericPokeByteIndex #-}
genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>
MutByteArray -> Int -> a -> IO ()
genericPokeByteIndex :: forall a.
(Generic a, PokeRep (Rep a)) =>
MutByteArray -> Int -> a -> IO ()
genericPokeByteIndex MutByteArray
arr Int
index a
x = do
#ifdef DEBUG
end <- sizeOfMutableByteArray arr
genericPokeObj x (BoundedPtr arr index end)
#else
a -> BoundedPtr -> IO ()
forall a. (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()
genericPokeObj a
x (MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
index Int
forall a. HasCallStack => a
undefined)
#endif
class PeekRep (f :: Type -> Type) where
peekRep :: Peeker (f x)
instance PeekRep f => PeekRep (M1 i c f) where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker (M1 i c f x)
peekRep = (f x -> M1 i c f x) -> Peeker (f x) -> Peeker (M1 i c f x)
forall a b. (a -> b) -> Peeker a -> Peeker b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> M1 i c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Peeker (f x)
forall x. Peeker (f x)
forall (f :: * -> *) x. PeekRep f => Peeker (f x)
peekRep
instance Unbox a => PeekRep (K1 i a) where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker (K1 i a x)
peekRep = (a -> K1 i a x) -> Peeker a -> Peeker (K1 i a x)
forall a b. (a -> b) -> Peeker a -> Peeker b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1 Peeker a
forall a. Unbox a => Peeker a
readUnsafe
instance PeekRep V1 where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker (V1 x)
peekRep = String -> Peeker (V1 x)
forall a. HasCallStack => String -> a
error String
"peekRep: a value of a Void type should not exist"
instance PeekRep U1 where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker (U1 x)
peekRep = U1 x -> Peeker (U1 x)
forall a. a -> Peeker a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 x
forall k (p :: k). U1 p
U1
instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker ((:*:) f g x)
peekRep = f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f x -> g x -> (:*:) f g x)
-> Peeker (f x) -> Peeker (g x -> (:*:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker (f x)
forall x. Peeker (f x)
forall (f :: * -> *) x. PeekRep f => Peeker (f x)
peekRep Peeker (g x -> (:*:) f g x) -> Peeker (g x) -> Peeker ((:*:) f g x)
forall a b. Peeker (a -> b) -> Peeker a -> Peeker b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker (g x)
forall x. Peeker (g x)
forall (f :: * -> *) x. PeekRep f => Peeker (f x)
peekRep
class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where
peekRepSum :: Proxy n -> Word8 -> Peeker (f a)
instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where
{-# INLINE peekRepSum #-}
peekRepSum :: forall a. Proxy n -> Word8 -> Peeker (C1 c a a)
peekRepSum Proxy n
_ Word8
_ = Peeker (M1 C c a a)
forall x. Peeker (M1 C c a x)
forall (f :: * -> *) x. PeekRep f => Peeker (f x)
peekRep
instance (PeekRepSum n f, PeekRepSum (n + SumArity f) g)
=> PeekRepSum n (f :+: g) where
{-# INLINE peekRepSum #-}
peekRepSum :: forall a. Proxy n -> Word8 -> Peeker ((:+:) f g a)
peekRepSum Proxy n
curProxy Word8
tag
| Word8
tag Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
firstRightTag =
f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a) -> Peeker (f a) -> Peeker ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy n -> Word8 -> Peeker (f a)
forall (n :: Nat) (f :: * -> *) a.
PeekRepSum n f =>
Proxy n -> Word8 -> Peeker (f a)
forall a. Proxy n -> Word8 -> Peeker (f a)
peekRepSum Proxy n
curProxy Word8
tag
| Bool
otherwise =
g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a) -> Peeker (g a) -> Peeker ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (n + SumArity f) -> Word8 -> Peeker (g a)
forall (n :: Nat) (f :: * -> *) a.
PeekRepSum n f =>
Proxy n -> Word8 -> Peeker (f a)
forall a. Proxy (n + SumArity f) -> Word8 -> Peeker (g a)
peekRepSum (Proxy (n + SumArity f)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (n + SumArity f)) Word8
tag
where
firstRightTag :: Word8
firstRightTag = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Proxy (n + SumArity f) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (n + SumArity f)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (n + SumArity f)))
instance ( MaxArity256 (SumArity (f :+: g))
, KnownNat (SumArity (f :+: g))
, PeekRepSum 0 (f :+: g))
=> PeekRep (f :+: g) where
{-# INLINE peekRep #-}
peekRep :: forall x. Peeker ((:+:) f g x)
peekRep = do
Word8
tag :: Word8 <- Peeker Word8
forall a. Unbox a => Peeker a
readUnsafe
let Int
arity :: Int =
Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy (SumArity f + SumArity g) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SumArity f + SumArity g)
Proxy (SumArity (f :+: g))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumArity (f :+: g))))
Bool -> Peeker () -> Peeker ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arity)
(Peeker () -> Peeker ()) -> Peeker () -> Peeker ()
forall a b. (a -> b) -> a -> b
$ String -> Peeker ()
forall a. HasCallStack => String -> a
error (String -> Peeker ()) -> String -> Peeker ()
forall a b. (a -> b) -> a -> b
$ String
"peek: Tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is greater than the max tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for the data type"
Proxy 0 -> Word8 -> Peeker ((:+:) f g x)
forall (n :: Nat) (f :: * -> *) a.
PeekRepSum n f =>
Proxy n -> Word8 -> Peeker (f a)
forall a. Proxy 0 -> Word8 -> Peeker ((:+:) f g a)
peekRepSum (Proxy 0
forall {k} (t :: k). Proxy t
Proxy :: Proxy 0) Word8
tag
{-# INLINE genericPeeker #-}
genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a
genericPeeker :: forall a. (Generic a, PeekRep (Rep a)) => Peeker a
genericPeeker = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Peeker (Rep a Any) -> Peeker a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker (Rep a Any)
forall x. Peeker (Rep a x)
forall (f :: * -> *) x. PeekRep f => Peeker (f x)
peekRep
{-# INLINE genericPeekBoundedPtr #-}
genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a
genericPeekBoundedPtr :: forall a. (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a
genericPeekBoundedPtr = Peeker a -> BoundedPtr -> IO a
forall a. Peeker a -> BoundedPtr -> IO a
runPeeker Peeker a
forall a. (Generic a, PeekRep (Rep a)) => Peeker a
genericPeeker
{-# INLINE genericPeekByteIndex #-}
genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>
MutByteArray -> Int -> IO a
genericPeekByteIndex :: forall a.
(Generic a, PeekRep (Rep a)) =>
MutByteArray -> Int -> IO a
genericPeekByteIndex MutByteArray
arr Int
index = do
#ifdef DEBUG
end <- sizeOfMutableByteArray arr
genericPeekBoundedPtr (BoundedPtr arr index end)
#else
BoundedPtr -> IO a
forall a. (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a
genericPeekBoundedPtr (MutByteArray -> Int -> Int -> BoundedPtr
BoundedPtr MutByteArray
arr Int
index Int
forall a. HasCallStack => a
undefined)
#endif