{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
{- |
Module      :  Numeric.PrimBytes
Copyright   :  (c) Artem Chirkin
License     :  BSD3

Facilities for converting Haskell data to and from raw bytes.

The main purpose of this module is to support the implementation of the @DataFrame@
`Numeric.DataFrame.Internal.Backend.Backend`. However, it also comes very useful for
writing FFI. To that end, the `PrimBytes` class is similar to
the `Foreign.Storable.Storable` class: it provides means to write
your data to and read from a raw memory area. Though, it is more flexible in that
it can work with both, foreign pointers and primitive byte arrays,
and it provides means to get data field offsets by their selector names.
On top of that, a `PrimBytes` instance can be derived via
the `GHC.Generics.Generic` machinery.

A derived `PrimBytes` instance tries to pack the data as dense as possible,
while respecting the alignment requirements. In all cases known to me,
the resulting data layout coincides with a corresponding C struct, allowing
to marshal the data without any boilerplate. However, this is not guaranteed,
but you can write a `PrimBytes` instance manually if necessary
(and report an issue plz).


__Note about alignment, size, and padding of the data.__
There are two basic sanity assumptions about these, which are not checked
in this module at all:

  * the alignment is always a power of 2;
  * the size is always rounded up to a multiple of the alignment.

Generated instances of `PrimBytes` meet these assumptions if all components of
a data meet these assumptions too.
You are strongly advised to provide all byte offset arguments to the `PrimBytes`
functions respecting the alignment of the data;
otherwise, the data may be written or read incorrectly.
 -}
module Numeric.PrimBytes
  ( -- * PrimBytes API
    PrimBytes (..)
  , bSizeOf, bAlignOf, bFieldOffsetOf
    -- * Storable API
    --
    -- |
    -- `Foreign.Storable.Storable` can be defined in terms of `PrimBytes`
    -- by doing something like the following for your data type:
    --
    -- @
    --   instance PrimBytes a => Storable a where
    --       sizeOf = bSizeOf
    --       alignment = bAlignOf
    --       peekElemOff = bPeekElemOff
    --       pokeElemOff = bPokeElemOff
    --       peekByteOff = bPeekByteOff
    --       pokeByteOff = bPokeByteOff
    --       peek = bPeek
    --       poke = bPoke
    -- @
  , bPeekElemOff, bPokeElemOff, bPeekByteOff, bPokeByteOff, bPeek, bPoke
    -- * Specialization tools
  , PrimTag (..), primTag
  ) where

#include "MachDeps.h"

import           Data.Kind            (Type)
import           Data.Proxy           (Proxy (..))
import           Data.Type.Equality   ((:~:) (..))
import qualified Data.Type.List       as L
import           Data.Type.Lits
import           Foreign.C.Types
import           GHC.Exts
import           GHC.Generics
import           GHC.Int
import           GHC.IO               (IO (..))
import           GHC.Stable
import           GHC.Word
import           Numeric.Dimensions
import qualified Numeric.Tuple.Lazy   as TL
import qualified Numeric.Tuple.Strict as TS
import           Text.Read            (readMaybe)

{- |

Defines how to read and write your data to and from Haskell unboxed byte arrays
and plain pointers.

Similarly to `Foreign.Storable.Storable`, this class provides functions to get
the size and alignment of a data via phantom arguments.
Thus, the size and alignment of the data must not depend on the data content
(they depend only on the type of the data).
In particular, this means that dynamically sized structures like Haskell lists
or maps are not allowed.

This module provides default implementations for all methods of this class via
`GHC.Generics.Generic`. Hence, to make your data an instance of @PrimBytes@,
it is sufficient to write the instance head:

@
data MyData a b = ...
  deriving Generic

instance (PrimBytes a, PrimBytes b) => PrimBytes (MyData a b)
@

.. or use the @DeriveAnyClass@ extension to make it even shorter:

@
data MyData a b = ...
  deriving (Generic, PrimBytes)
@

The derived instance tries to pack the data as dense as possible, but sometimes
it is better to write the instance by hand.
If a derived type has more than one constructor, the derived instance puts
a @Word32@ tag at the beginning of the byte representation.
All fields of a constructor are packed in a C-like fashion next to each other,
while respecting their alignments.

 -}
class PrimTagged a => PrimBytes a where
    {- | List of field names.

       It is used to get field offsets using `byteFieldOffset` function.

       A Generic-derived instance has this list non-empty only if two
       obvious conditions are met:

       1. The data has only one constructor.
       2. The data uses record syntax to define its fields.
     -}
    type PrimFields a :: [Symbol]
    type PrimFields a = GPrimFields (Rep a)
    -- | Store content of a data type in a primitive byte array
    --   (should be used together with @byteOffset@ function).
    --
    --   Note, the default implementation of this function returns a not pinned
    --   array, which is aligned to @SIZEOF_HSWORD@.
    --   Thus, it ignores the alignment of the underlying data type if it is larger.
    --   However, alignment calculation still makes sense for data types
    --   that are smaller than @SIZEOF_HSWORD@ bytes: they are packed more densely.
    getBytes :: a -> ByteArray#
    getBytes a
a = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
       ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize a
a) State# RealWorld
s0 of
           (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr (MutableByteArray# RealWorld
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# RealWorld
marr Int#
0# a
a State# RealWorld
s1)
       ) of (# State# RealWorld
_, ByteArray#
r #) -> ByteArray#
r
    {-# NOINLINE getBytes #-}
    -- | Store content of a data type in a primitive byte array
    --   (should be used together with @byteOffset@ function).
    --
    --   In contrast to `getBytes`, this function returns a pinned byte array,
    --   aligned to the @byteAlign@ bytes of this data.
    --
    --   Note, GC guarantees not to move the created array.
    --   While this is very useful sometimes, it incurs a certain performance penalty.
    getBytesPinned :: a -> ByteArray#
    getBytesPinned a
a = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
       ( \State# RealWorld
s0 -> case Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# (a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize a
a) (a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign a
a) State# RealWorld
s0 of
           (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr (MutableByteArray# RealWorld
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# RealWorld
marr Int#
0# a
a State# RealWorld
s1)
       ) of (# State# RealWorld
_, ByteArray#
r #) -> ByteArray#
r
    {-# NOINLINE getBytesPinned #-}
    -- | Load content of a data type from a primitive byte array given an offset in bytes.
    fromBytes :: Int# -- ^ Offset in bytes
              -> ByteArray# -- ^ Source array
              -> a
    -- | Read data from a mutable byte array given an offset in bytes.
    readBytes :: MutableByteArray# s -- ^ Source array
              -> Int# -- ^ Byte offset in the source array
              -> State# s -> (# State# s, a #)
    -- | Write data into a mutable byte array at a given position (offset in bytes).
    writeBytes :: MutableByteArray# s -- ^ Destination array
               -> Int# -- ^ Byte offset in the destination array
               -> a -- ^ Data to write into the array
               -> State# s -> State# s
    -- | Read data from a specified address.
    readAddr :: Addr# -> State# s -> (# State# s, a #)
    -- | Write data to a specified address.
    writeAddr :: a -> Addr# -> State# s -> State# s
    -- | Size of a data type in bytes.
    --   It should be a multiple of @byteAlign@ for indexing functions to operate
    --   correctly.
    --
    --   Implementation of this function must not inspect the argument value;
    --   a caller may provide @undefined@ in place of the argument.
    byteSize :: a -> Int#
    -- | Alignment of a data type in bytes.
    --   @byteOffset@ should be multiple of this value.
    --
    --   Implementation of this function must not inspect the argument value;
    --   a caller may provide @undefined@ in place of the argument.
    byteAlign :: a -> Int#
    -- | Offset of the data in a byte array used to store the data,
    --   measured in bytes.
    --   Should be used together with @getBytes@ function.
    --   Unless in case of special data types represented by ByteArrays,
    --   it is equal to zero.
    --
    --   Implementation of this function may inspect the argument value;
    --   a caller must not provide @undefined@ in place of the argument.
    byteOffset :: a -> Int#
    byteOffset a
_ = Int#
0#
    {-# INLINE byteOffset #-}

    -- | Offset of a data record within the data type in bytes.
    --
    --   Implementation of this function must not inspect the argument value;
    --   a caller may provide @undefined@ in place of the argument.
    --
    --   The default (generic) implementation of this fucntion looks for the
    --   leftmost occurrence of a given field name (in case of multiple constructors).
    --   If a field with the given name is not found, it returns @-1@,
    --   but this is not possible thanks to @Elem name (PrimFields a)@ constraint.
    byteFieldOffset :: (Elem name (PrimFields a), KnownSymbol name)
                    => Proxy# name -> a -> Int#

    -- | Index array given an element offset
    --   (which is @byteSize a@ and should be a multiple of @byteAlign a@).
    indexArray :: ByteArray# -> Int# -> a
    indexArray ByteArray#
ba Int#
i = Int# -> ByteArray# -> a
forall a. PrimBytes a => Int# -> ByteArray# -> a
fromBytes (Int#
i Int# -> Int# -> Int#
*# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @a a
forall a. HasCallStack => a
undefined) ByteArray#
ba
    {-# INLINE indexArray #-}

    -- | Read a mutable array given an element offset
    --   (which is @byteSize a@ and should be a multiple of @byteAlign a@).
    readArray  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    readArray MutableByteArray# s
ba Int#
i = MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readBytes MutableByteArray# s
ba (Int#
i Int# -> Int# -> Int#
*# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @a a
forall a. HasCallStack => a
undefined)
    {-# INLINE readArray #-}

    -- | Write a mutable array given an element offset
    --   (which is @byteSize a@ and should be a multiple of @byteAlign a@).
    writeArray :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
    writeArray MutableByteArray# s
ba Int#
i = MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# s
ba (Int#
i Int# -> Int# -> Int#
*# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @a a
forall a. HasCallStack => a
undefined)
    {-# INLINE writeArray #-}


    default fromBytes :: (Generic a, GPrimBytes (Rep a))
                      => Int# -> ByteArray# -> a
    fromBytes Int#
i ByteArray#
arr = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Proxy# Any -> Word# -> Int# -> Int# -> ByteArray# -> Rep a Any
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# Int#
i ByteArray#
arr)
    {-# INLINE fromBytes #-}

    default readBytes :: (Generic a, GPrimBytes (Rep a))
                      => MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    readBytes MutableByteArray# s
mba Int#
i State# s
s = case Proxy# Any
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, Rep a Any #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# MutableByteArray# s
mba Int#
i State# s
s of
      (# State# s
s', Rep a Any
x #) -> (# State# s
s', Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
x #)
    {-# INLINE readBytes #-}

    default writeBytes :: (Generic a, GPrimBytes (Rep a))
                       => MutableByteArray# s -> Int# -> a -> State# s -> State# s
    writeBytes MutableByteArray# s
mba Int#
i = Proxy# Any
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> Rep a Any
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# MutableByteArray# s
mba Int#
i (Rep a Any -> State# s -> State# s)
-> (a -> Rep a Any) -> a -> State# s -> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
    {-# INLINE writeBytes #-}

    default readAddr :: (Generic a, GPrimBytes (Rep a))
                      => Addr# -> State# s -> (# State# s, a #)
    readAddr Addr#
a State# s
s = case Proxy# Any
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, Rep a Any #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# Addr#
a State# s
s of
      (# State# s
s', Rep a Any
x #) -> (# State# s
s', Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
x #)
    {-# INLINE readAddr #-}

    default writeAddr :: (Generic a, GPrimBytes (Rep a))
                       => a -> Addr# -> State# s -> State# s
    writeAddr = Proxy# Any
-> Word# -> Int# -> Rep a Any -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# (Rep a Any -> Addr# -> State# s -> State# s)
-> (a -> Rep a Any) -> a -> Addr# -> State# s -> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
    {-# INLINE writeAddr #-}

    default byteSize :: (Generic a, GPrimBytes (Rep a))
                     => a -> Int#
    byteSize a
a = Proxy# Any -> Word# -> Int# -> Rep a Any -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a) Int# -> Int# -> Int#
`roundUpInt` a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign a
a
    {-# INLINE byteSize #-}

    default byteAlign :: (Generic a, GPrimBytes (Rep a))
                     => a -> Int#
    byteAlign a
a = Proxy# Any -> Rep a Any -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# Any
forall k (a :: k). Proxy# a
proxy# (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a)
    {-# INLINE byteAlign #-}

    default byteFieldOffset :: ( Generic a, GPrimBytes (Rep a)
                               , KnownSymbol name)
                            => Proxy# name -> a -> Int#
    byteFieldOffset Proxy# name
p a
a = Proxy# Any -> Word# -> Int# -> Proxy# name -> Rep a Any -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset Proxy# Any
forall k (a :: k). Proxy# a
proxy# Word#
0## Int#
0# Proxy# name
p (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a)
    {-# INLINE byteFieldOffset #-}

-- | A wrapper on `byteSize`
bSizeOf :: (PrimBytes a, Num b) => a -> b
bSizeOf :: a -> b
bSizeOf a
a = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize a
a))

-- | A wrapper on `byteAlign`
bAlignOf :: (PrimBytes a, Num b) => a -> b
bAlignOf :: a -> b
bAlignOf a
a = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign a
a))

-- | A wrapper on `byteFieldOffset`.
bFieldOffsetOf :: forall (name :: Symbol) (a :: Type) (b :: Type)
                . ( PrimBytes a, Elem name (PrimFields a)
                  , KnownSymbol name, Num b)
               => a -> b
bFieldOffsetOf :: a -> b
bFieldOffsetOf a
a = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (Proxy# name -> a -> Int#
forall a (name :: Symbol).
(PrimBytes a, Elem name (PrimFields a), KnownSymbol name) =>
Proxy# name -> a -> Int#
byteFieldOffset (Proxy# name
forall k (a :: k). Proxy# a
proxy# :: Proxy# name) a
a))

-- | Same as `Foreign.Storable.peekElemOff`: peek an element @a@ by the offset
--   measured in @byteSize a@.
--
--   Note: the size of the element must be a multiple of its alignment for
--         a correct operation of this function.
bPeekElemOff :: forall (a :: Type) . PrimBytes a => Ptr a -> Int -> IO a
bPeekElemOff :: Ptr a -> Int -> IO a
bPeekElemOff (Ptr Addr#
addr) (I# Int#
i)
  = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (Addr# -> State# RealWorld -> (# State# RealWorld, a #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr (Int#
i Int# -> Int# -> Int#
*# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @a a
forall a. HasCallStack => a
undefined)))

-- | Same as `Foreign.Storable.pokeElemOff`: poke an element @a@ by the offset
--   measured in @byteSize a@.
--
--   Note: the size of the element must be a multiple of its alignment for
--         a correct operation of this function.
bPokeElemOff :: forall (a :: Type) . PrimBytes a => Ptr a -> Int -> a -> IO ()
bPokeElemOff :: Ptr a -> Int -> a -> IO ()
bPokeElemOff (Ptr Addr#
addr) (I# Int#
i) a
a
  = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# a -> Addr# -> State# RealWorld -> State# RealWorld
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr a
a (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr (Int#
i Int# -> Int# -> Int#
*# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize a
a)) State# RealWorld
s, () #))

-- | Same as `Foreign.Storable.peekByteOff`: peek an element @a@ by the offset
--   measured in bytes.
--
--   Note: you'd better be sure the address is a multiple of
--         the data alignment (`Foreign.Storable.peek`).
bPeekByteOff :: forall (a :: Type) (b :: Type) . PrimBytes a => Ptr b -> Int -> IO a
bPeekByteOff :: Ptr b -> Int -> IO a
bPeekByteOff (Ptr Addr#
addr) (I# Int#
i)
  = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (Addr# -> State# RealWorld -> (# State# RealWorld, a #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
i))

-- | Same as `Foreign.Storable.pokeByteOff`: poke an element @a@ by the offset
--   measured in bytes.
--
--   Note: you'd better be sure the address is a multiple of
--         the data alignment (`Foreign.Storable.peek`).
bPokeByteOff :: forall (a :: Type) (b :: Type) . PrimBytes a => Ptr b -> Int -> a -> IO ()
bPokeByteOff :: Ptr b -> Int -> a -> IO ()
bPokeByteOff (Ptr Addr#
addr) (I# Int#
i) a
a
  = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# a -> Addr# -> State# RealWorld -> State# RealWorld
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr a
a (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
i) State# RealWorld
s, () #))

-- | Same as `Foreign.Storable.peek`: read a data from a pointer.
--
--   Note: you'd better be sure the address is a multiple of
--         the data alignment (`Foreign.Storable.peek`).
bPeek :: forall (a :: Type) . PrimBytes a => Ptr a -> IO a
bPeek :: Ptr a -> IO a
bPeek (Ptr Addr#
addr) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (Addr# -> State# RealWorld -> (# State# RealWorld, a #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr Addr#
addr)

-- | Same as `Foreign.Storable.poke`: write a data to a pointer.
--
--   Note: you'd better be sure the address is a multiple of
--         the data alignment (`Foreign.Storable.peek`).
bPoke :: forall (a :: Type) . PrimBytes a => Ptr a -> a -> IO ()
bPoke :: Ptr a -> a -> IO ()
bPoke (Ptr Addr#
addr) a
a = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# a -> Addr# -> State# RealWorld -> State# RealWorld
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr a
a Addr#
addr State# RealWorld
s, () #))

-- | Derive a list of data selectors from the data representation @Rep a@.
type family GPrimFields (rep :: Type -> Type) :: [Symbol] where
    GPrimFields (M1 D _ f) = GPrimFields f
    GPrimFields (M1 C _ f) = GPrimFields f
    GPrimFields (M1 S ('MetaSel ('Just n) _ _ _) _) = '[n]
    GPrimFields (f :*: g) = Concat (GPrimFields f) (GPrimFields g)
    GPrimFields _ = '[]

{- | Deriving `PrimBytes` using generics

This implementation relies on two assumptions, which are probably true
in the GHC implementation of derived generics and __is not checked here__:

1. @Rep a@ is a sum-of-products.
     This means the struct offset is always @4@ for the parts of the sum type,
     and a constructor tag is always at position @0@ in the struct.

2. The @Rep a@ tree is balanced.
     Thus, I can implement a simple tag encoding:
     each bit in a tag corresponds to a nesting level.
     That is, maximum possible nesting level is 31 and minimum is 0.

Therefore, the general logic for the sum type is summarized as follows:
   reserve 4 bytes for the tag and try to pack alternatives as good as possible.

If a data type has only one constructor (@Rep a@ contains no @:+:@),
then the tag is not added.


Every function in @GPrimBytes@ has the first Proxy# argument;
it is simply used to enforce type parameter and allows easy @coerce@ implementations
for @Meta@ wrapper types.

All functions except @gbyteAlign@ have the second and third arguments:
tag mask (@Word#@) and current struct size (@Int#@);
both start with zero at the top of the @Rep a@ hierarchy.

  The tag mask is used by the sum constructors to find out where to write a bit value
  to encode left or right branch.

  The current struct size is the size (in bytes) of all elements to the left of
  the current one (before alignment).

 -}
class GPrimBytes f where
    gfromBytes :: Proxy# p
               -> Word# -- ^ Constructor tag position (mask)
               -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
               -> Int# -> ByteArray# -> f p
    greadBytes :: Proxy# p
               -> Word# -- ^ Constructor tag position (mask)
               -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
               -> MutableByteArray# s -> Int#  -> State# s -> (# State# s, f p #)
    gwriteBytes :: Proxy# p
                -> Word# -- ^ Constructor tag position (mask)
                -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
                -> MutableByteArray# s -> Int# -> f p -> State# s -> State# s
    greadAddr :: Proxy# p
              -> Word# -- ^ Constructor tag position (mask)
              -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
              -> Addr# -> State# s -> (# State# s, f p #)
    gwriteAddr :: Proxy# p
               -> Word# -- ^ Constructor tag position (mask)
               -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
               -> f p -> Addr# -> State# s -> State# s
    -- | Cumulative size of a Rep structure
    gbyteSize :: Proxy# p
              -> Word# -- ^ Constructor tag position (mask)
              -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
              -> f p -> Int#
    gbyteAlign :: Proxy# p
               -> f p -> Int#
    -- | Gives an offset of the current piece of a Rep structure
    gbyteFieldOffset :: KnownSymbol name
                     => Proxy# p
                     -> Word# -- ^ Constructor tag position (mask)
                     -> Int# -- ^ Left neighbour cumulative size (current offset before alignment)
                     -> Proxy# name -> f p -> Int#
    gbyteFieldOffset Proxy# p
_ Word#
_ Int#
_ Proxy# name
_ f p
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE gbyteFieldOffset #-}

instance GPrimBytes V1 where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> V1 p
gfromBytes Proxy# p
_ Word#
_ Int#
_ Int#
_ ByteArray#
_ = V1 p
forall a. HasCallStack => a
undefined
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, V1 p #)
greadBytes Proxy# p
_ Word#
_ Int#
_ MutableByteArray# s
_ Int#
_ State# s
s = (# State# s
s, V1 p
forall a. HasCallStack => a
undefined #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> V1 p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
_ MutableByteArray# s
_ Int#
_ V1 p
_ State# s
s = State# s
s
    greadAddr :: Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, V1 p #)
greadAddr Proxy# p
_ Word#
_ Int#
_ Addr#
_ State# s
s = (# State# s
s, V1 p
forall a. HasCallStack => a
undefined #)
    gwriteAddr :: Proxy# p -> Word# -> Int# -> V1 p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
_ V1 p
_ Addr#
_ State# s
s = State# s
s
    gbyteSize :: Proxy# p -> Word# -> Int# -> V1 p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps V1 p
_ = Int#
ps
    gbyteAlign :: Proxy# p -> V1 p -> Int#
gbyteAlign Proxy# p
_ V1 p
_ = Int#
1#

instance GPrimBytes U1 where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> U1 p
gfromBytes Proxy# p
_ Word#
_ Int#
_ Int#
_ ByteArray#
_ = U1 p
forall k (p :: k). U1 p
U1
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, U1 p #)
greadBytes Proxy# p
_ Word#
_ Int#
_ MutableByteArray# s
_ Int#
_ State# s
s = (# State# s
s, U1 p
forall k (p :: k). U1 p
U1 #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> U1 p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
_ MutableByteArray# s
_ Int#
_ U1 p
_ State# s
s = State# s
s
    greadAddr :: Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, U1 p #)
greadAddr Proxy# p
_ Word#
_ Int#
_ Addr#
_ State# s
s = (# State# s
s, U1 p
forall k (p :: k). U1 p
U1 #)
    gwriteAddr :: Proxy# p -> Word# -> Int# -> U1 p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
_ U1 p
_ Addr#
_ State# s
s = State# s
s
    gbyteSize :: Proxy# p -> Word# -> Int# -> U1 p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps U1 p
_ = Int#
ps
    gbyteAlign :: Proxy# p -> U1 p -> Int#
gbyteAlign Proxy# p
_ U1 p
_ = Int#
1#

getGOff :: forall a . PrimBytes a
        => Int# --  parent cumulative size
        -> Int# --  original offset
        -> Int# --  new offset
getGOff :: Int# -> Int# -> Int#
getGOff Int#
ps Int#
i = Int#
i Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps (a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @a a
forall a. HasCallStack => a
undefined)

instance PrimBytes a => GPrimBytes (K1 i a) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> K1 i a p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
i ByteArray#
ba = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (Int# -> ByteArray# -> a
forall a. PrimBytes a => Int# -> ByteArray# -> a
fromBytes (Int# -> Int# -> Int#
forall a. PrimBytes a => Int# -> Int# -> Int#
getGOff @a Int#
ps Int#
i) ByteArray#
ba)
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, K1 i a p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
i = (State# s -> (# State# s, a #))
-> State# s -> (# State# s, K1 i a p #)
coerce (MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readBytes @a MutableByteArray# s
mba (Int# -> Int# -> Int#
forall a. PrimBytes a => Int# -> Int# -> Int#
getGOff @a Int#
ps Int#
i))
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> K1 i a p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
i = (a -> State# s -> State# s) -> K1 i a p -> State# s -> State# s
coerce (MutableByteArray# s -> Int# -> a -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes @a MutableByteArray# s
mba (Int# -> Int# -> Int#
forall a. PrimBytes a => Int# -> Int# -> Int#
getGOff @a Int#
ps Int#
i))
    greadAddr :: Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, K1 i a p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
addr = (State# s -> (# State# s, a #))
-> State# s -> (# State# s, K1 i a p #)
coerce (Addr# -> State# s -> (# State# s, a #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr @a (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr (Int# -> Int# -> Int#
forall a. PrimBytes a => Int# -> Int# -> Int#
getGOff @a Int#
ps Int#
0#)))
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> K1 i a p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps K1 i a p
ka Addr#
addr = a -> Addr# -> State# s -> State# s
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr (K1 i a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 K1 i a p
ka) (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr (Int# -> Int# -> Int#
forall a. PrimBytes a => Int# -> Int# -> Int#
getGOff @a Int#
ps Int#
0#))
    gbyteSize :: Proxy# p -> Word# -> Int# -> K1 i a p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps ~(K1 a
a) = Int# -> Int# -> Int#
roundUpInt Int#
ps (a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign a
a) Int# -> Int# -> Int#
+# a -> Int#
forall a. PrimBytes a => a -> Int#
byteSize a
a
    gbyteAlign :: Proxy# p -> K1 i a p -> Int#
gbyteAlign Proxy# p
_ = (a -> Int#) -> K1 i a p -> Int#
coerce (PrimBytes a => a -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @a)

instance {-# OVERLAPPING #-}
         (GPrimBytes f, KnownSymbol sn)
      => GPrimBytes (M1 S ('MetaSel ('Just sn) a b c) f) where
    gfromBytes :: Proxy# p
-> Word#
-> Int#
-> Int#
-> ByteArray#
-> M1 S ('MetaSel ('Just sn) a b c) f p
gfromBytes Proxy# p
p = (Word# -> Int# -> Int# -> ByteArray# -> f p)
-> Word#
-> Int#
-> Int#
-> ByteArray#
-> M1 S ('MetaSel ('Just sn) a b c) f p
coerce (Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes @f Proxy# p
p)
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, M1 S ('MetaSel ('Just sn) a b c) f p #)
greadBytes Proxy# p
p = (Word#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> State# s
 -> (# State# s, f p #))
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, M1 S ('MetaSel ('Just sn) a b c) f p #)
coerce (Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes @f Proxy# p
p)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> M1 S ('MetaSel ('Just sn) a b c) f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p = (Word#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> f p
 -> State# s
 -> State# s)
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> M1 S ('MetaSel ('Just sn) a b c) f p
-> State# s
-> State# s
coerce (Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes @f Proxy# p
p)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, M1 S ('MetaSel ('Just sn) a b c) f p #)
greadAddr Proxy# p
p = (Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #))
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, M1 S ('MetaSel ('Just sn) a b c) f p #)
coerce (Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr @f Proxy# p
p)
    gwriteAddr :: Proxy# p
-> Word#
-> Int#
-> M1 S ('MetaSel ('Just sn) a b c) f p
-> Addr#
-> State# s
-> State# s
gwriteAddr Proxy# p
p = (Word# -> Int# -> f p -> Addr# -> State# s -> State# s)
-> Word#
-> Int#
-> M1 S ('MetaSel ('Just sn) a b c) f p
-> Addr#
-> State# s
-> State# s
coerce (Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr @f Proxy# p
p)
    gbyteSize :: Proxy# p
-> Word# -> Int# -> M1 S ('MetaSel ('Just sn) a b c) f p -> Int#
gbyteSize Proxy# p
p = (Word# -> Int# -> f p -> Int#)
-> Word# -> Int# -> M1 S ('MetaSel ('Just sn) a b c) f p -> Int#
coerce (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize @f Proxy# p
p)
    gbyteAlign :: Proxy# p -> M1 S ('MetaSel ('Just sn) a b c) f p -> Int#
gbyteAlign Proxy# p
p = (f p -> Int#) -> M1 S ('MetaSel ('Just sn) a b c) f p -> Int#
coerce (Proxy# p -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign @f Proxy# p
p)
    gbyteFieldOffset :: Proxy# p
-> Word#
-> Int#
-> Proxy# name
-> M1 S ('MetaSel ('Just sn) a b c) f p
-> Int#
gbyteFieldOffset Proxy# p
p Word#
_ Int#
off (Proxy# name
_ :: Proxy# n) M1 S ('MetaSel ('Just sn) a b c) f p
ma
      | Just name :~: sn
Refl <- Proxy name -> Proxy sn -> Maybe (name :~: sn)
forall (a :: Symbol) (b :: Symbol).
(KnownSymbol a, KnownSymbol b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameSymbol (Proxy name
forall a. HasCallStack => a
undefined :: Proxy n) (Proxy sn
forall a. HasCallStack => a
undefined :: Proxy sn)
        = Int#
off Int# -> Int# -> Int#
`roundUpInt` Proxy# p -> M1 S ('MetaSel ('Just sn) a b c) f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p M1 S ('MetaSel ('Just sn) a b c) f p
ma
      | Bool
otherwise
        = Int# -> Int#
negateInt# Int#
1#

instance GPrimBytes f => GPrimBytes (M1 i c f) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> M1 i c f p
gfromBytes Proxy# p
p = (Word# -> Int# -> Int# -> ByteArray# -> f p)
-> Word# -> Int# -> Int# -> ByteArray# -> M1 i c f p
coerce (Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes @f Proxy# p
p)
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, M1 i c f p #)
greadBytes Proxy# p
p = (Word#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> State# s
 -> (# State# s, f p #))
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, M1 i c f p #)
coerce (Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes @f Proxy# p
p)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> M1 i c f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p = (Word#
 -> Int#
 -> MutableByteArray# s
 -> Int#
 -> f p
 -> State# s
 -> State# s)
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> M1 i c f p
-> State# s
-> State# s
coerce (Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes @f Proxy# p
p)
    greadAddr :: Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, M1 i c f p #)
greadAddr Proxy# p
p = (Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #))
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, M1 i c f p #)
coerce (Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr @f Proxy# p
p)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> M1 i c f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p = (Word# -> Int# -> f p -> Addr# -> State# s -> State# s)
-> Word# -> Int# -> M1 i c f p -> Addr# -> State# s -> State# s
coerce (Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr @f Proxy# p
p)
    gbyteSize :: Proxy# p -> Word# -> Int# -> M1 i c f p -> Int#
gbyteSize Proxy# p
p = (Word# -> Int# -> f p -> Int#)
-> Word# -> Int# -> M1 i c f p -> Int#
coerce (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize @f Proxy# p
p)
    gbyteAlign :: Proxy# p -> M1 i c f p -> Int#
gbyteAlign Proxy# p
p = (f p -> Int#) -> M1 i c f p -> Int#
coerce (Proxy# p -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign @f Proxy# p
p)
    gbyteFieldOffset :: Proxy# p -> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
gbyteFieldOffset Proxy# p
p = (Word# -> Int# -> Proxy# name -> f p -> Int#)
-> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
forall k (name :: k) (p :: k).
(Word# -> Int# -> Proxy# name -> f p -> Int#)
-> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
coerce' (Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset @f Proxy# p
p)
      where
        coerce' :: (Word# -> Int# -> Proxy# name -> f p -> Int#)
                -> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
        coerce' :: (Word# -> Int# -> Proxy# name -> f p -> Int#)
-> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
coerce' = (Word# -> Int# -> Proxy# name -> f p -> Int#)
-> Word# -> Int# -> Proxy# name -> M1 i c f p -> Int#
coerce

instance (GPrimBytes f, GPrimBytes g) => GPrimBytes (f :*: g) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> (:*:) f g p
gfromBytes Proxy# p
p Word#
t Int#
ps Int#
i ByteArray#
ba = f p
x f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y
      where
        x :: f p
x = Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes Proxy# p
p Word#
t Int#
ps Int#
i ByteArray#
ba
        y :: g p
y = Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> g p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) Int#
i ByteArray#
ba
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, (:*:) f g p #)
greadBytes Proxy# p
p Word#
t Int#
ps MutableByteArray# s
mba Int#
i State# s
s0
      | (# State# s
s1, f p
x #) <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes Proxy# p
p Word#
t Int#
ps MutableByteArray# s
mba Int#
i State# s
s0
      , (# State# s
s2, g p
y #) <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, g p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) MutableByteArray# s
mba Int#
i State# s
s1
        = (# State# s
s2, f p
x f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> (:*:) f g p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
t Int#
ps MutableByteArray# s
mba Int#
off (f p
x :*: g p
y) State# s
s0
      | State# s
s1 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
t Int#
ps MutableByteArray# s
mba Int#
off f p
x State# s
s0
      , State# s
s2 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> g p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) MutableByteArray# s
mba Int#
off g p
y State# s
s1
        = State# s
s2
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, (:*:) f g p #)
greadAddr Proxy# p
p Word#
t Int#
ps Addr#
addr State# s
s0
      | (# State# s
s1, f p
x #) <- Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr Proxy# p
p Word#
t Int#
ps Addr#
addr State# s
s0
      , (# State# s
s2, g p
y #) <- Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, g p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) Addr#
addr State# s
s1
        = (# State# s
s2, f p
x f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> (:*:) f g p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
t Int#
ps (f p
x :*: g p
y) Addr#
addr State# s
s0
      | State# s
s1 <- Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
t Int#
ps f p
x Addr#
addr State# s
s0
      , State# s
s2 <- Proxy# p -> Word# -> Int# -> g p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) g p
y Addr#
addr State# s
s1
        = State# s
s2
    gbyteSize :: Proxy# p -> Word# -> Int# -> (:*:) f g p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps ~(f p
x :*: g p
y) = Proxy# p -> Word# -> Int# -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x) g p
y
    gbyteAlign :: Proxy# p -> (:*:) f g p -> Int#
gbyteAlign Proxy# p
p ~(f p
x :*: g p
y) = Proxy# p -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p f p
x Int# -> Int# -> Int#
`maxInt` Proxy# p -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p g p
y
    gbyteFieldOffset :: Proxy# p -> Word# -> Int# -> Proxy# name -> (:*:) f g p -> Int#
gbyteFieldOffset Proxy# p
p Word#
t Int#
ps Proxy# name
n ~(f p
x :*: g p
y)
      | Int#
offX <- Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset Proxy# p
p Word#
t Int#
ps Proxy# name
n f p
x
      , Int#
bsX  <- Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
t Int#
ps f p
x
      , Int#
offY <- Proxy# p -> Word# -> Int# -> Proxy# name -> g p -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset Proxy# p
p Word#
t Int#
bsX Proxy# name
n g p
y
      = if Int# -> Bool
isTrue# (Int#
offX Int# -> Int# -> Int#
<# Int#
0#) then Int#
offY else Int#
offX

instance (GPrimBytes f, GPrimBytes g) => GPrimBytes (f :+: g) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> (:+:) f g p
gfromBytes Proxy# p
p Word#
t Int#
_ Int#
off ByteArray#
ba
      | Word#
c <- ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ByteArray#
ba Int#
off
        = if Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# (Word# -> Word# -> Word#
and# Word#
c Word#
t1) Word#
0##)
          then f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes Proxy# p
p Word#
t1 Int#
4# Int#
off ByteArray#
ba)
          else g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> g p
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> f p
gfromBytes Proxy# p
p Word#
t1 Int#
4# Int#
off ByteArray#
ba)
      where
        t1 :: Word#
t1 = Word# -> Word#
upTag Word#
t
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, (:+:) f g p #)
greadBytes Proxy# p
p Word#
t Int#
_ MutableByteArray# s
mba Int#
off State# s
s0
      | (# State# s
s1, Word#
c #) <- MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off State# s
s0
        = if Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# (Word# -> Word# -> Word#
and# Word#
c Word#
t1) Word#
0##)
          then case Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes Proxy# p
p Word#
t1 Int#
4# MutableByteArray# s
mba Int#
off State# s
s1 of
            (# State# s
s2, f p
x #) -> (# State# s
s2, f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x #)
          else case Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, g p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, f p #)
greadBytes Proxy# p
p Word#
t1 Int#
4# MutableByteArray# s
mba Int#
off State# s
s1 of
            (# State# s
s2, g p
y #) -> (# State# s
s2, g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
y #)
      where
        t1 :: Word#
t1 = Word# -> Word#
upTag Word#
t
    -- if this is the uppermost sum, overwrite the tag.
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> (:+:) f g p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
0## Int#
_ MutableByteArray# s
mba Int#
off (L1 f p
x) State# s
s0
      | State# s
s1 <- MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off Word#
0## State# s
s0
      , State# s
s2 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
1## Int#
4# MutableByteArray# s
mba Int#
off f p
x State# s
s1 = State# s
s2
    gwriteBytes Proxy# p
p Word#
0## Int#
_ MutableByteArray# s
mba Int#
off (R1 g p
y) State# s
s0
      | State# s
s1 <- MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off Word#
1## State# s
s0
      , State# s
s2 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> g p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
1## Int#
4# MutableByteArray# s
mba Int#
off g p
y State# s
s1 = State# s
s2
    -- here I know that I have written zero to the corresponding bit already
    gwriteBytes Proxy# p
p Word#
t Int#
_ MutableByteArray# s
mba Int#
off (L1 f p
x) State# s
s0
      | State# s
s1 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
4# MutableByteArray# s
mba Int#
off f p
x State# s
s0 = State# s
s1
    -- otherwise, carefully write a single corresponding bit
    gwriteBytes Proxy# p
p Word#
t Int#
_ MutableByteArray# s
mba Int#
off (R1 g p
y) State# s
s0
      | (# State# s
s1, Word#
c #) <- MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off State# s
s0
      , State# s
s2 <- MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off (Word# -> Word# -> Word#
or# Word#
c Word#
t1) State# s
s1
      , State# s
s3 <- Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> g p
-> State# s
-> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> f p
-> State# s
-> State# s
gwriteBytes Proxy# p
p Word#
t1 Int#
4# MutableByteArray# s
mba Int#
off g p
y State# s
s2 = State# s
s3
      where
        t1 :: Word#
t1 = Word# -> Word#
upTag Word#
t
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, (:+:) f g p #)
greadAddr Proxy# p
p Word#
t Int#
_ Addr#
addr State# s
s0
      | (# State# s
s1, Word#
c #) <- Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord32OffAddr# Addr#
addr Int#
0# State# s
s0
        = if Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# (Word# -> Word# -> Word#
and# Word#
c Word#
t1) Word#
0##)
          then case Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr Proxy# p
p Word#
t1 Int#
4# Addr#
addr State# s
s1 of
            (# State# s
s2, f p
x #) -> (# State# s
s2, f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x #)
          else case Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, g p #)
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, f p #)
greadAddr Proxy# p
p Word#
t1 Int#
4# Addr#
addr State# s
s1 of
            (# State# s
s2, g p
y #) -> (# State# s
s2, g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
y #)
      where
        t1 :: Word#
t1 = Word# -> Word#
upTag Word#
t
    -- if this is the uppermost sum, overwrite the tag.
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> (:+:) f g p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
0## Int#
_ (L1 f p
x) Addr#
addr State# s
s0
      | State# s
s1 <- Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord32OffAddr# Addr#
addr Int#
0# Word#
0## State# s
s0
      , State# s
s2 <- Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
1## Int#
4# f p
x Addr#
addr State# s
s1 = State# s
s2
    gwriteAddr Proxy# p
p Word#
0## Int#
_ (R1 g p
y) Addr#
addr State# s
s0
      | State# s
s1 <- Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord32OffAddr# Addr#
addr Int#
0# Word#
1## State# s
s0
      , State# s
s2 <- Proxy# p -> Word# -> Int# -> g p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
1## Int#
4# g p
y Addr#
addr State# s
s1 = State# s
s2
    -- here I know that I have written zero to the corresponding bit already
    gwriteAddr Proxy# p
p Word#
t Int#
_ (L1 f p
x) Addr#
addr State# s
s0
      | State# s
s1 <- Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
4# f p
x Addr#
addr State# s
s0 = State# s
s1
    -- otherwise, carefully write a single corresponding bit
    gwriteAddr Proxy# p
p Word#
t Int#
_ (R1 g p
y) Addr#
addr State# s
s0
      | (# State# s
s1, Word#
c #) <- Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord32OffAddr# Addr#
addr Int#
0# State# s
s0
      , State# s
s2 <- Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord32OffAddr# Addr#
addr Int#
0# (Word# -> Word# -> Word#
or# Word#
c Word#
t1) State# s
s1
      , State# s
s3 <- Proxy# p -> Word# -> Int# -> g p -> Addr# -> State# s -> State# s
forall k (f :: k -> *) (p :: k) s.
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
p Word#
t1 Int#
4# g p
y Addr#
addr State# s
s2 = State# s
s3
      where
        t1 :: Word#
t1 = Word# -> Word#
upTag Word#
t
    gbyteSize :: Proxy# p -> Word# -> Int# -> (:+:) f g p -> Int#
gbyteSize Proxy# p
p Word#
0## Int#
ps (:+:) f g p
xy
      = Int# -> Int# -> Int#
maxInt
        (Int# -> Int# -> Int#
roundUpInt Int#
4# (Proxy# p -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p f p
x) Int# -> Int# -> Int#
+# Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
1## Int#
ps f p
x)
        (Int# -> Int# -> Int#
roundUpInt Int#
4# (Proxy# p -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p g p
y) Int# -> Int# -> Int#
+# Proxy# p -> Word# -> Int# -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p Word#
1## Int#
ps g p
y)
      where
        x :: f p
x = (:+:) f g p -> f p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @f (:+:) f g p
xy
        y :: g p
y = (:+:) f g p -> g p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @g (:+:) f g p
xy
    gbyteSize Proxy# p
p Word#
t Int#
ps (:+:) f g p
xy
      = Int# -> Int# -> Int#
maxInt
        (Proxy# p -> Word# -> Int# -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
ps ((:+:) f g p -> f p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @f (:+:) f g p
xy))
        (Proxy# p -> Word# -> Int# -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> Word# -> Int# -> f p -> Int#
gbyteSize Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
ps ((:+:) f g p -> g p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @g (:+:) f g p
xy))
    gbyteAlign :: Proxy# p -> (:+:) f g p -> Int#
gbyteAlign Proxy# p
p (:+:) f g p
xy = Int#
4# Int# -> Int# -> Int#
`maxInt`
        Int# -> Int# -> Int#
maxInt (Proxy# p -> f p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p ((:+:) f g p -> f p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @f (:+:) f g p
xy))
               (Proxy# p -> g p -> Int#
forall k (f :: k -> *) (p :: k).
GPrimBytes f =>
Proxy# p -> f p -> Int#
gbyteAlign Proxy# p
p ((:+:) f g p -> g p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @g (:+:) f g p
xy))
    -- check both branches if any of them contain the field.
    -- If there are more than one branches containing the field, the left one
    -- is preferred.
    gbyteFieldOffset :: Proxy# p -> Word# -> Int# -> Proxy# name -> (:+:) f g p -> Int#
gbyteFieldOffset Proxy# p
p Word#
t Int#
ps Proxy# name
n (:+:) f g p
xy
      | Int#
offX <- Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
ps Proxy# name
n ((:+:) f g p -> f p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @f (:+:) f g p
xy)
      , Int#
offY <- Proxy# p -> Word# -> Int# -> Proxy# name -> g p -> Int#
forall k (f :: k -> *) (name :: Symbol) (p :: k).
(GPrimBytes f, KnownSymbol name) =>
Proxy# p -> Word# -> Int# -> Proxy# name -> f p -> Int#
gbyteFieldOffset Proxy# p
p (Word# -> Word#
upTag Word#
t) Int#
ps Proxy# name
n ((:+:) f g p -> g p
forall k (p :: k -> *) (q :: k -> *) (a :: k). q a -> p a
undef1 @g (:+:) f g p
xy)
      = if Int# -> Bool
isTrue# (Int#
offX Int# -> Int# -> Int#
<# Int#
0#) then Int#
offY else Int#
offX

upTag :: Word# -> Word#
upTag :: Word# -> Word#
upTag Word#
0## = Word#
1##
upTag Word#
t   = Word# -> Int# -> Word#
uncheckedShiftL# Word#
t Int#
1#
{-# INLINE upTag #-}


maxInt :: Int# -> Int# -> Int#
maxInt :: Int# -> Int# -> Int#
maxInt Int#
a Int#
b = if Int# -> Bool
isTrue# (Int#
a Int# -> Int# -> Int#
># Int#
b) then Int#
a else Int#
b
{-# INLINE maxInt #-}

-- | Round up the first numer to a multiple of the second.
--
--   NB: this function is only used with alignment as the second number,
--       which is always a power of 2.
roundUpInt :: Int# -> Int# -> Int#
roundUpInt :: Int# -> Int# -> Int#
roundUpInt Int#
a Int#
b = (Int#
a Int# -> Int# -> Int#
+# Int#
b Int# -> Int# -> Int#
-# Int#
1#) Int# -> Int# -> Int#
`andI#` Int# -> Int#
negateInt# Int#
b
{-# INLINE roundUpInt #-}
-- It's pity that the assertion would not work due to kind of the result
-- not being Type.
-- assert (isTrue# (eqWord# (popCnt# (int2Word# b)) 1##))
--
-- The version above is optimized for second number being power of two (align)
-- The baseline implementation would be as follows:
-- roundUpInt a b = case remInt# a b of
--   0# -> a
  -- q  -> a +# b -# q

undef1 :: forall p q a . q a -> p a
undef1 :: q a -> p a
undef1 = p a -> q a -> p a
forall a b. a -> b -> a
const p a
forall a. HasCallStack => a
undefined
{-# INLINE undef1 #-}



#if SIZEOF_HSWORD == 4
#define OFFSHIFT_W 2
#else
#define OFFSHIFT_W 3
#endif

instance GPrimBytes (URec Word) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec Word p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Word# -> URec Word p
forall k (p :: k). Word# -> URec Word p
UWord (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec Word p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD#) s of
          (# State# s
s1, Word#
r #) -> (# State# s
s1, Word# -> URec Word p
forall k (p :: k). Word# -> URec Word p
UWord Word#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec Word p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec Word p
x
      = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD#) (uWord# x)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, URec Word p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWordOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD#)) 0# s of
          (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> URec Word p
forall k (p :: k). Word# -> URec Word p
UWord Word#
x #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> URec Word p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec Word p
x Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWordOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD#)) 0# (uWord# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec Word p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec Word p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSWORD# +# SIZEOF_HSWORD#
    gbyteAlign :: Proxy# p -> URec Word p -> Int#
gbyteAlign Proxy# p
_ URec Word p
_ = ALIGNMENT_HSWORD#

#if SIZEOF_HSINT == 4
#define OFFSHIFT_I 2
#else
#define OFFSHIFT_I 3
#endif

instance GPrimBytes (URec Int) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec Int p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Int# -> URec Int p
forall k (p :: k). Int# -> URec Int p
UInt (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec Int p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT#) s of
          (# State# s
s1, Int#
r #) -> (# State# s
s1, Int# -> URec Int p
forall k (p :: k). Int# -> URec Int p
UInt Int#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec Int p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec Int p
x
      = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT#) (uInt# x)
    greadAddr :: Proxy# p
-> Word# -> Int# -> Addr# -> State# s -> (# State# s, URec Int p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readIntOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT#)) 0# s of
          (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> URec Int p
forall k (p :: k). Int# -> URec Int p
UInt Int#
x #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> URec Int p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec Int p
x Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeIntOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT#)) 0# (uInt# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec Int p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec Int p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSINT# +# SIZEOF_HSINT#
    gbyteAlign :: Proxy# p -> URec Int p -> Int#
gbyteAlign Proxy# p
_ URec Int p
_ = ALIGNMENT_HSINT#

#if SIZEOF_HSFLOAT == 4
#define OFFSHIFT_F 2
#else
#define OFFSHIFT_F 3
#endif

instance GPrimBytes (URec Float) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec Float p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Float# -> URec Float p
forall k (p :: k). Float# -> URec Float p
UFloat (ByteArray# -> Int# -> Float#
indexWord8ArrayAsFloat# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec Float p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readWord8ArrayAsFloat# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT#) s of
          (# State# s
s1, Float#
r #) -> (# State# s
s1, Float# -> URec Float p
forall k (p :: k). Float# -> URec Float p
UFloat Float#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec Float p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec Float p
x
      = MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeWord8ArrayAsFloat# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT#) (uFloat# x)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, URec Float p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Float# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Float# #)
readFloatOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT#)) 0# s of
          (# State# s
s', Float#
x #) -> (# State# s
s', Float# -> URec Float p
forall k (p :: k). Float# -> URec Float p
UFloat Float#
x #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> URec Float p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec Float p
x Addr#
a
      = Addr# -> Int# -> Float# -> State# s -> State# s
forall d. Addr# -> Int# -> Float# -> State# d -> State# d
writeFloatOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT#)) 0# (uFloat# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec Float p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec Float p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSFLOAT# +# SIZEOF_HSFLOAT#
    gbyteAlign :: Proxy# p -> URec Float p -> Int#
gbyteAlign Proxy# p
_ URec Float p
_ = ALIGNMENT_HSFLOAT#

#if SIZEOF_HSDOUBLE == 4
#define OFFSHIFT_D 2
#else
#define OFFSHIFT_D 3
#endif

instance GPrimBytes (URec Double) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec Double p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Double# -> URec Double p
forall k (p :: k). Double# -> URec Double p
UDouble (ByteArray# -> Int# -> Double#
indexWord8ArrayAsDouble# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec Double p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readWord8ArrayAsDouble# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE#) s of
          (# State# s
s1, Double#
r #) -> (# State# s
s1, Double# -> URec Double p
forall k (p :: k). Double# -> URec Double p
UDouble Double#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec Double p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec Double p
x
      = MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeWord8ArrayAsDouble# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE#) (uDouble# x)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, URec Double p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Double# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Double# #)
readDoubleOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE#)) 0# s of
          (# State# s
s', Double#
x #) -> (# State# s
s', Double# -> URec Double p
forall k (p :: k). Double# -> URec Double p
UDouble Double#
x #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> URec Double p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec Double p
x Addr#
a
      = Addr# -> Int# -> Double# -> State# s -> State# s
forall d. Addr# -> Int# -> Double# -> State# d -> State# d
writeDoubleOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE#)) 0# (uDouble# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec Double p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec Double p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSDOUBLE# +# SIZEOF_HSDOUBLE#
    gbyteAlign :: Proxy# p -> URec Double p -> Int#
gbyteAlign Proxy# p
_ URec Double p
_ = ALIGNMENT_HSDOUBLE#

-- I believe Char is always 31 bit, but checking this does not hurt
#if SIZEOF_HSCHAR == 2
#define OFFSHIFT_C 1
#elif SIZEOF_HSCHAR == 4
#define OFFSHIFT_C 2
#else
#define OFFSHIFT_C 3
#endif

instance GPrimBytes (URec Char) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec Char p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Char# -> URec Char p
forall k (p :: k). Char# -> URec Char p
UChar (ByteArray# -> Int# -> Char#
indexWord8ArrayAsWideChar# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec Char p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWord8ArrayAsWideChar# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR#) s of
          (# State# s
s1, Char#
r #) -> (# State# s
s1, Char# -> URec Char p
forall k (p :: k). Char# -> URec Char p
UChar Char#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec Char p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec Char p
x
      = MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWord8ArrayAsWideChar# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR#) (uChar# x)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, URec Char p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Char# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Char# #)
readWideCharOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR#)) 0# s of
          (# State# s
s', Char#
x #) -> (# State# s
s', Char# -> URec Char p
forall k (p :: k). Char# -> URec Char p
UChar Char#
x #)
    gwriteAddr :: Proxy# p
-> Word# -> Int# -> URec Char p -> Addr# -> State# s -> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec Char p
x Addr#
a
      = Addr# -> Int# -> Char# -> State# s -> State# s
forall d. Addr# -> Int# -> Char# -> State# d -> State# d
writeWideCharOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR#)) 0# (uChar# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec Char p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec Char p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSCHAR# +# SIZEOF_HSCHAR#
    gbyteAlign :: Proxy# p -> URec Char p -> Int#
gbyteAlign Proxy# p
_ URec Char p
_ = ALIGNMENT_HSCHAR#

#if SIZEOF_HSPTR == 4
#define OFFSHIFT_P 2
#else
#define OFFSHIFT_P 3
#endif

instance GPrimBytes (URec (Ptr ())) where
    gfromBytes :: Proxy# p -> Word# -> Int# -> Int# -> ByteArray# -> URec (Ptr ()) p
gfromBytes Proxy# p
_ Word#
_ Int#
ps Int#
off ByteArray#
ba
      = Addr# -> URec (Ptr ()) p
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr (ByteArray# -> Int# -> Addr#
indexWord8ArrayAsAddr# ByteArray#
ba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR#))
    greadBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, URec (Ptr ()) p #)
greadBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readWord8ArrayAsAddr# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR#) s of
          (# State# s
s1, Addr#
r #) -> (# State# s
s1, Addr# -> URec (Ptr ()) p
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
r #)
    gwriteBytes :: Proxy# p
-> Word#
-> Int#
-> MutableByteArray# s
-> Int#
-> URec (Ptr ()) p
-> State# s
-> State# s
gwriteBytes Proxy# p
_ Word#
_ Int#
ps MutableByteArray# s
mba Int#
off URec (Ptr ()) p
x
      = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeWord8ArrayAsAddr# MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR#) (uAddr# x)
    greadAddr :: Proxy# p
-> Word#
-> Int#
-> Addr#
-> State# s
-> (# State# s, URec (Ptr ()) p #)
greadAddr Proxy# p
_ Word#
_ Int#
ps Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Addr# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Addr# #)
readAddrOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR#)) 0# s of
          (# State# s
s', Addr#
x #) -> (# State# s
s', Addr# -> URec (Ptr ()) p
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
x #)
    gwriteAddr :: Proxy# p
-> Word#
-> Int#
-> URec (Ptr ()) p
-> Addr#
-> State# s
-> State# s
gwriteAddr Proxy# p
_ Word#
_ Int#
ps URec (Ptr ()) p
x Addr#
a
      = Addr# -> Int# -> Addr# -> State# s -> State# s
forall d. Addr# -> Int# -> Addr# -> State# d -> State# d
writeAddrOffAddr# (Addr# -> Int# -> Addr#
plusAddr# Addr#
a (Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR#)) 0# (uAddr# x)
    gbyteSize :: Proxy# p -> Word# -> Int# -> URec (Ptr ()) p -> Int#
gbyteSize Proxy# p
_ Word#
_ Int#
ps URec (Ptr ()) p
_ = Int# -> Int# -> Int#
roundUpInt Int#
ps ALIGNMENT_HSPTR# +# SIZEOF_HSPTR#
    gbyteAlign :: Proxy# p -> URec (Ptr ()) p -> Int#
gbyteAlign Proxy# p
_ URec (Ptr ()) p
_ = ALIGNMENT_HSPTR#




--------------------------------------------------------------------------------
-- Basic instances
--------------------------------------------------------------------------------


instance PrimBytes Word where
    type PrimFields Word = '[]
    getBytes :: Word -> ByteArray#
getBytes (W# Word#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSWORD# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# RealWorld
marr Int#
0# Word#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Word
fromBytes Int#
off ByteArray#
ba
      = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Word#
r #) -> (# State# s
s', Word# -> Word
W# Word#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Word -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (W# Word#
x)
      = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord# MutableByteArray# s
mba Int#
off Word#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Word #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWordOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word
W# Word#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Word -> Addr# -> State# s -> State# s
writeAddr (W# Word#
x) Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWordOffAddr# Addr#
a Int#
0# Word#
x
    {-# INLINE writeAddr #-}
    byteSize :: Word -> Int#
byteSize Word
_ = SIZEOF_HSWORD#
    {-# INLINE byteSize #-}
    byteAlign :: Word -> Int#
byteAlign Word
_ = ALIGNMENT_HSWORD#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Word -> Int#
byteFieldOffset Proxy# name
_ Word
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Word
indexArray ByteArray#
ba Int#
i = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word
W# Word#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Word -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (W# Word#
x) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mba Int#
i Word#
x
    {-# INLINE writeArray #-}


instance PrimBytes Int where
    type PrimFields Int = '[]
    getBytes :: Int -> ByteArray#
getBytes (I# Int#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSINT# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
marr Int#
0# Int#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Int
fromBytes Int#
off ByteArray#
ba
      = Int# -> Int
I# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Int#
r #) -> (# State# s
s', Int# -> Int
I# Int#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (I# Int#
x)
      = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt# MutableByteArray# s
mba Int#
off Int#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Int #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readIntOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int
I# Int#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Int -> Addr# -> State# s -> State# s
writeAddr (I# Int#
x) Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeIntOffAddr# Addr#
a Int#
0# Int#
x
    {-# INLINE writeAddr #-}
    byteSize :: Int -> Int#
byteSize Int
_ = SIZEOF_HSINT#
    {-# INLINE byteSize #-}
    byteAlign :: Int -> Int#
byteAlign Int
_ = ALIGNMENT_HSINT#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Int -> Int#
byteFieldOffset Proxy# name
_ Int
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Int
indexArray ByteArray#
ba Int#
i = Int# -> Int
I# (ByteArray# -> Int# -> Int#
indexIntArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readIntArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int
I# Int#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (I# Int#
x) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# s
mba Int#
i Int#
x
    {-# INLINE writeArray #-}

instance PrimBytes Float where
    type PrimFields Float = '[]
    getBytes :: Float -> ByteArray#
getBytes (F# Float#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSFLOAT# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Float# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# RealWorld
marr Int#
0# Float#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Float
fromBytes Int#
off ByteArray#
ba
      = Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexWord8ArrayAsFloat# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Float #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readWord8ArrayAsFloat# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Float#
r #) -> (# State# s
s', Float# -> Float
F# Float#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Float -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (F# Float#
x)
      = MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeWord8ArrayAsFloat# MutableByteArray# s
mba Int#
off Float#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Float #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Float# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Float# #)
readFloatOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Float#
x #) -> (# State# s
s', Float# -> Float
F# Float#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Float -> Addr# -> State# s -> State# s
writeAddr (F# Float#
x) Addr#
a
      = Addr# -> Int# -> Float# -> State# s -> State# s
forall d. Addr# -> Int# -> Float# -> State# d -> State# d
writeFloatOffAddr# Addr#
a Int#
0# Float#
x
    {-# INLINE writeAddr #-}
    byteSize :: Float -> Int#
byteSize Float
_ = SIZEOF_HSFLOAT#
    {-# INLINE byteSize #-}
    byteAlign :: Float -> Int#
byteAlign Float
_ = ALIGNMENT_HSFLOAT#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Float -> Int#
byteFieldOffset Proxy# name
_ Float
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Float
indexArray ByteArray#
ba Int#
i = Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexFloatArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Float #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readFloatArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Float#
x #) -> (# State# s
s', Float# -> Float
F# Float#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Float -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (F# Float#
x) = MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeFloatArray# MutableByteArray# s
mba Int#
i Float#
x
    {-# INLINE writeArray #-}

instance PrimBytes Double where
    type PrimFields Double = '[]
    getBytes :: Double -> ByteArray#
getBytes (D# Double#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSDOUBLE# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Double# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeDoubleArray# MutableByteArray# RealWorld
marr Int#
0# Double#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Double
fromBytes Int#
off ByteArray#
ba
      = Double# -> Double
D# (ByteArray# -> Int# -> Double#
indexWord8ArrayAsDouble# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Double #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readWord8ArrayAsDouble# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Double#
r #) -> (# State# s
s', Double# -> Double
D# Double#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Double -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (D# Double#
x)
      = MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeWord8ArrayAsDouble# MutableByteArray# s
mba Int#
off Double#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Double #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Double# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Double# #)
readDoubleOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Double#
x #) -> (# State# s
s', Double# -> Double
D# Double#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Double -> Addr# -> State# s -> State# s
writeAddr (D# Double#
x) Addr#
a
      = Addr# -> Int# -> Double# -> State# s -> State# s
forall d. Addr# -> Int# -> Double# -> State# d -> State# d
writeDoubleOffAddr# Addr#
a Int#
0# Double#
x
    {-# INLINE writeAddr #-}
    byteSize :: Double -> Int#
byteSize Double
_ = SIZEOF_HSDOUBLE#
    {-# INLINE byteSize #-}
    byteAlign :: Double -> Int#
byteAlign Double
_ = ALIGNMENT_HSDOUBLE#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Double -> Int#
byteFieldOffset Proxy# name
_ Double
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Double
indexArray ByteArray#
ba Int#
i = Double# -> Double
D# (ByteArray# -> Int# -> Double#
indexDoubleArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Double #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readDoubleArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Double#
x #) -> (# State# s
s', Double# -> Double
D# Double#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Double -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (D# Double#
x) = MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeDoubleArray# MutableByteArray# s
mba Int#
i Double#
x
    {-# INLINE writeArray #-}

instance PrimBytes (Ptr a) where
    type PrimFields (Ptr a) = '[]
    getBytes :: Ptr a -> ByteArray#
getBytes (Ptr Addr#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSPTR# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Addr# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# RealWorld
marr Int#
0# Addr#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Ptr a
fromBytes Int#
off ByteArray#
ba
      = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Int# -> Addr#
indexWord8ArrayAsAddr# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readWord8ArrayAsAddr# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Addr#
r #) -> (# State# s
s', Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (Ptr Addr#
x)
      = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeWord8ArrayAsAddr# MutableByteArray# s
mba Int#
off Addr#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Ptr a #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Addr# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Addr# #)
readAddrOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Addr#
x #) -> (# State# s
s', Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Ptr a -> Addr# -> State# s -> State# s
writeAddr (Ptr Addr#
x) Addr#
a
      = Addr# -> Int# -> Addr# -> State# s -> State# s
forall d. Addr# -> Int# -> Addr# -> State# d -> State# d
writeAddrOffAddr# Addr#
a Int#
0# Addr#
x
    {-# INLINE writeAddr #-}
    byteSize :: Ptr a -> Int#
byteSize Ptr a
_ = SIZEOF_HSPTR#
    {-# INLINE byteSize #-}
    byteAlign :: Ptr a -> Int#
byteAlign Ptr a
_ = ALIGNMENT_HSPTR#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Ptr a -> Int#
byteFieldOffset Proxy# name
_ Ptr a
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Ptr a
indexArray ByteArray#
ba Int#
i = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Int# -> Addr#
indexAddrArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readAddrArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Addr#
x #) -> (# State# s
s', Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (Ptr Addr#
x) = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# s
mba Int#
i Addr#
x
    {-# INLINE writeArray #-}

instance PrimBytes (FunPtr a) where
    type PrimFields (FunPtr a) = '[]
    getBytes :: FunPtr a -> ByteArray#
getBytes (FunPtr Addr#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSFUNPTR# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Addr# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# RealWorld
marr Int#
0# Addr#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> FunPtr a
fromBytes Int#
off ByteArray#
ba
      = Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr (ByteArray# -> Int# -> Addr#
indexWord8ArrayAsAddr# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, FunPtr a #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readWord8ArrayAsAddr# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Addr#
r #) -> (# State# s
s', Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr Addr#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> FunPtr a -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (FunPtr Addr#
x)
      = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeWord8ArrayAsAddr# MutableByteArray# s
mba Int#
off Addr#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, FunPtr a #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Addr# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Addr# #)
readAddrOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Addr#
x #) -> (# State# s
s', Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr Addr#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: FunPtr a -> Addr# -> State# s -> State# s
writeAddr (FunPtr Addr#
x) Addr#
a
      = Addr# -> Int# -> Addr# -> State# s -> State# s
forall d. Addr# -> Int# -> Addr# -> State# d -> State# d
writeAddrOffAddr# Addr#
a Int#
0# Addr#
x
    {-# INLINE writeAddr #-}
    byteSize :: FunPtr a -> Int#
byteSize FunPtr a
_ = SIZEOF_HSFUNPTR#
    {-# INLINE byteSize #-}
    byteAlign :: FunPtr a -> Int#
byteAlign FunPtr a
_ = ALIGNMENT_HSFUNPTR#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> FunPtr a -> Int#
byteFieldOffset Proxy# name
_ FunPtr a
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> FunPtr a
indexArray ByteArray#
ba Int#
i = Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr (ByteArray# -> Int# -> Addr#
indexAddrArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, FunPtr a #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readAddrArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Addr#
x #) -> (# State# s
s', Addr# -> FunPtr a
forall a. Addr# -> FunPtr a
FunPtr Addr#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> FunPtr a -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (FunPtr Addr#
x) = MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeAddrArray# MutableByteArray# s
mba Int#
i Addr#
x
    {-# INLINE writeArray #-}

instance PrimBytes (StablePtr a) where
    type PrimFields (StablePtr a) = '[]
    getBytes :: StablePtr a -> ByteArray#
getBytes (StablePtr StablePtr# a
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSSTABLEPTR# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> StablePtr# a -> State# RealWorld -> State# RealWorld
forall d a.
MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeStablePtrArray# MutableByteArray# RealWorld
marr Int#
0# StablePtr# a
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> StablePtr a
fromBytes Int#
off ByteArray#
ba
      = StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (ByteArray# -> Int# -> StablePtr# a
forall a. ByteArray# -> Int# -> StablePtr# a
indexWord8ArrayAsStablePtr# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr a #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr# a #)
forall d a.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, StablePtr# a #)
readWord8ArrayAsStablePtr# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', StablePtr# a
r #) -> (# State# s
s', StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr StablePtr# a
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> StablePtr a -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (StablePtr StablePtr# a
x)
      = MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
forall d a.
MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeWord8ArrayAsStablePtr# MutableByteArray# s
mba Int#
off StablePtr# a
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, StablePtr a #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
forall d a.
Addr# -> Int# -> State# d -> (# State# d, StablePtr# a #)
readStablePtrOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', StablePtr# a
x #) -> (# State# s
s', StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr StablePtr# a
x #)
    {-# INLINE readAddr #-}
    writeAddr :: StablePtr a -> Addr# -> State# s -> State# s
writeAddr (StablePtr StablePtr# a
x) Addr#
a
      = Addr# -> Int# -> StablePtr# a -> State# s -> State# s
forall a d. Addr# -> Int# -> StablePtr# a -> State# d -> State# d
writeStablePtrOffAddr# Addr#
a Int#
0# StablePtr# a
x
    {-# INLINE writeAddr #-}
    byteSize :: StablePtr a -> Int#
byteSize StablePtr a
_ = SIZEOF_HSSTABLEPTR#
    {-# INLINE byteSize #-}
    byteAlign :: StablePtr a -> Int#
byteAlign StablePtr a
_ = ALIGNMENT_HSSTABLEPTR#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> StablePtr a -> Int#
byteFieldOffset Proxy# name
_ StablePtr a
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> StablePtr a
indexArray ByteArray#
ba Int#
i = StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr (ByteArray# -> Int# -> StablePtr# a
forall a. ByteArray# -> Int# -> StablePtr# a
indexStablePtrArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr a #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s
-> Int# -> State# s -> (# State# s, StablePtr# a #)
forall d a.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, StablePtr# a #)
readStablePtrArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', StablePtr# a
x #) -> (# State# s
s', StablePtr# a -> StablePtr a
forall a. StablePtr# a -> StablePtr a
StablePtr StablePtr# a
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> StablePtr a -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (StablePtr StablePtr# a
x) = MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
forall d a.
MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeStablePtrArray# MutableByteArray# s
mba Int#
i StablePtr# a
x
    {-# INLINE writeArray #-}

instance PrimBytes Int8 where
    type PrimFields Int8 = '[]
    getBytes :: Int8 -> ByteArray#
getBytes (I8# Int#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_INT8# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# RealWorld
marr Int#
0# Int#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Int8
fromBytes Int#
off ByteArray#
ba = ByteArray# -> Int# -> Int8
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
ba Int#
off
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
readBytes = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readArray
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
writeBytes = MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Int8 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readInt8OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int8
I8# Int#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Int8 -> Addr# -> State# s -> State# s
writeAddr (I8# Int#
x) Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeInt8OffAddr# Addr#
a Int#
0# Int#
x
    {-# INLINE writeAddr #-}
    byteSize :: Int8 -> Int#
byteSize Int8
_ = SIZEOF_INT8#
    {-# INLINE byteSize #-}
    byteAlign :: Int8 -> Int#
byteAlign Int8
_ = ALIGNMENT_INT8#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Int8 -> Int#
byteFieldOffset Proxy# name
_ Int8
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Int8
indexArray ByteArray#
ba Int#
i = Int# -> Int8
I8# (ByteArray# -> Int# -> Int#
indexInt8Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt8Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int8
I8# Int#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (I8# Int#
x) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# s
mba Int#
i Int#
x
    {-# INLINE writeArray #-}

instance PrimBytes Int16 where
    type PrimFields Int16 = '[]
    getBytes :: Int16 -> ByteArray#
getBytes (I16# Int#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_INT16# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt16Array# MutableByteArray# RealWorld
marr Int#
0# Int#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Int16
fromBytes Int#
off ByteArray#
ba
      = Int# -> Int16
I16# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt16# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt16# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Int#
r #) -> (# State# s
s', Int# -> Int16
I16# Int#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (I16# Int#
x)
      = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt16# MutableByteArray# s
mba Int#
off Int#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Int16 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readInt16OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int16
I16# Int#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Int16 -> Addr# -> State# s -> State# s
writeAddr (I16# Int#
x) Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeInt16OffAddr# Addr#
a Int#
0# Int#
x
    {-# INLINE writeAddr #-}
    byteSize :: Int16 -> Int#
byteSize Int16
_ = SIZEOF_INT16#
    {-# INLINE byteSize #-}
    byteAlign :: Int16 -> Int#
byteAlign Int16
_ = ALIGNMENT_INT16#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Int16 -> Int#
byteFieldOffset Proxy# name
_ Int16
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Int16
indexArray ByteArray#
ba Int#
i = Int# -> Int16
I16# (ByteArray# -> Int# -> Int#
indexInt16Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt16Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int16
I16# Int#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (I16# Int#
x) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt16Array# MutableByteArray# s
mba Int#
i Int#
x
    {-# INLINE writeArray #-}

instance PrimBytes Int32 where
    type PrimFields Int32 = '[]
    getBytes :: Int32 -> ByteArray#
getBytes (I32# Int#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_INT32# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt32Array# MutableByteArray# RealWorld
marr Int#
0# Int#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Int32
fromBytes Int#
off ByteArray#
ba
      = Int# -> Int32
I32# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt32# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt32# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Int#
r #) -> (# State# s
s', Int# -> Int32
I32# Int#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (I32# Int#
x)
      = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt32# MutableByteArray# s
mba Int#
off Int#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Int32 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readInt32OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int32
I32# Int#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Int32 -> Addr# -> State# s -> State# s
writeAddr (I32# Int#
x) Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeInt32OffAddr# Addr#
a Int#
0# Int#
x
    {-# INLINE writeAddr #-}
    byteSize :: Int32 -> Int#
byteSize Int32
_ = SIZEOF_INT32#
    {-# INLINE byteSize #-}
    byteAlign :: Int32 -> Int#
byteAlign Int32
_ = ALIGNMENT_INT32#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Int32 -> Int#
byteFieldOffset Proxy# name
_ Int32
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Int32
indexArray ByteArray#
ba Int#
i = Int# -> Int32
I32# (ByteArray# -> Int# -> Int#
indexInt32Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt32Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int32
I32# Int#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (I32# Int#
x) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt32Array# MutableByteArray# s
mba Int#
i Int#
x
    {-# INLINE writeArray #-}

instance PrimBytes Int64 where
    type PrimFields Int64 = '[]
    getBytes :: Int64 -> ByteArray#
getBytes (I64# Int#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_INT64# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt64Array# MutableByteArray# RealWorld
marr Int#
0# Int#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Int64
fromBytes Int#
off ByteArray#
ba
      = Int# -> Int64
I64# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt64# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt64# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Int#
r #) -> (# State# s
s', Int# -> Int64
I64# Int#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (I64# Int#
x)
      = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt64# MutableByteArray# s
mba Int#
off Int#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Int64 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Int# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Int# #)
readInt64OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int64
I64# Int#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Int64 -> Addr# -> State# s -> State# s
writeAddr (I64# Int#
x) Addr#
a
      = Addr# -> Int# -> Int# -> State# s -> State# s
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeInt64OffAddr# Addr#
a Int#
0# Int#
x
    {-# INLINE writeAddr #-}
    byteSize :: Int64 -> Int#
byteSize Int64
_ = SIZEOF_INT64#
    {-# INLINE byteSize #-}
    byteAlign :: Int64 -> Int#
byteAlign Int64
_ = ALIGNMENT_INT64#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Int64 -> Int#
byteFieldOffset Proxy# name
_ Int64
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Int64
indexArray ByteArray#
ba Int#
i = Int# -> Int64
I64# (ByteArray# -> Int# -> Int#
indexInt64Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt64Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Int#
x #) -> (# State# s
s', Int# -> Int64
I64# Int#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (I64# Int#
x) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt64Array# MutableByteArray# s
mba Int#
i Int#
x
    {-# INLINE writeArray #-}

instance PrimBytes Word8 where
    type PrimFields Word8 = '[]
    getBytes :: Word8 -> ByteArray#
getBytes (W8# Word#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_WORD8# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# RealWorld
marr Int#
0# Word#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Word8
fromBytes Int#
off ByteArray#
ba = ByteArray# -> Int# -> Word8
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray ByteArray#
ba Int#
off
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
readBytes = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readArray
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
writeBytes = MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Word8 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word8
W8# Word#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Word8 -> Addr# -> State# s -> State# s
writeAddr (W8# Word#
x) Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord8OffAddr# Addr#
a Int#
0# Word#
x
    {-# INLINE writeAddr #-}
    byteSize :: Word8 -> Int#
byteSize Word8
_ = SIZEOF_WORD8#
    {-# INLINE byteSize #-}
    byteAlign :: Word8 -> Int#
byteAlign Word8
_ = ALIGNMENT_WORD8#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Word8 -> Int#
byteFieldOffset Proxy# name
_ Word8
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Word8
indexArray ByteArray#
ba Int#
i = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word8
W8# Word#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (W8# Word#
x) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
i Word#
x
    {-# INLINE writeArray #-}

instance PrimBytes Word16 where
    type PrimFields Word16 = '[]
    getBytes :: Word16 -> ByteArray#
getBytes (W16# Word#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_WORD16# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord16Array# MutableByteArray# RealWorld
marr Int#
0# Word#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Word16
fromBytes Int#
off ByteArray#
ba
      = Word# -> Word16
W16# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord16# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord16# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Word#
r #) -> (# State# s
s', Word# -> Word16
W16# Word#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (W16# Word#
x)
      = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord16# MutableByteArray# s
mba Int#
off Word#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Word16 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord16OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word16
W16# Word#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Word16 -> Addr# -> State# s -> State# s
writeAddr (W16# Word#
x) Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord16OffAddr# Addr#
a Int#
0# Word#
x
    {-# INLINE writeAddr #-}
    byteSize :: Word16 -> Int#
byteSize Word16
_ = SIZEOF_WORD16#
    {-# INLINE byteSize #-}
    byteAlign :: Word16 -> Int#
byteAlign Word16
_ = ALIGNMENT_WORD16#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Word16 -> Int#
byteFieldOffset Proxy# name
_ Word16
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Word16
indexArray ByteArray#
ba Int#
i = Word# -> Word16
W16# (ByteArray# -> Int# -> Word#
indexWord16Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord16Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word16
W16# Word#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (W16# Word#
x) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord16Array# MutableByteArray# s
mba Int#
i Word#
x
    {-# INLINE writeArray #-}

instance PrimBytes Word32 where
    type PrimFields Word32 = '[]
    getBytes :: Word32 -> ByteArray#
getBytes (W32# Word#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_WORD32# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord32Array# MutableByteArray# RealWorld
marr Int#
0# Word#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Word32
fromBytes Int#
off ByteArray#
ba
      = Word# -> Word32
W32# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Word#
r #) -> (# State# s
s', Word# -> Word32
W32# Word#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (W32# Word#
x)
      = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba Int#
off Word#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Word32 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord32OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word32
W32# Word#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Word32 -> Addr# -> State# s -> State# s
writeAddr (W32# Word#
x) Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord32OffAddr# Addr#
a Int#
0# Word#
x
    {-# INLINE writeAddr #-}
    byteSize :: Word32 -> Int#
byteSize Word32
_ = SIZEOF_WORD32#
    {-# INLINE byteSize #-}
    byteAlign :: Word32 -> Int#
byteAlign Word32
_ = ALIGNMENT_WORD32#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Word32 -> Int#
byteFieldOffset Proxy# name
_ Word32
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Word32
indexArray ByteArray#
ba Int#
i = Word# -> Word32
W32# (ByteArray# -> Int# -> Word#
indexWord32Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord32Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word32
W32# Word#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (W32# Word#
x) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord32Array# MutableByteArray# s
mba Int#
i Word#
x
    {-# INLINE writeArray #-}

instance PrimBytes Word64 where
    type PrimFields Word64 = '[]
    getBytes :: Word64 -> ByteArray#
getBytes (W64# Word#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_WORD64# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# RealWorld
marr Int#
0# Word#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Word64
fromBytes Int#
off ByteArray#
ba
      = Word# -> Word64
W64# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord64# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord64# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Word#
r #) -> (# State# s
s', Word# -> Word64
W64# Word#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (W64# Word#
x)
      = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba Int#
off Word#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Word64 #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord64OffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word64
W64# Word#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Word64 -> Addr# -> State# s -> State# s
writeAddr (W64# Word#
x) Addr#
a
      = Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWord64OffAddr# Addr#
a Int#
0# Word#
x
    {-# INLINE writeAddr #-}
    byteSize :: Word64 -> Int#
byteSize Word64
_ = SIZEOF_WORD64#
    {-# INLINE byteSize #-}
    byteAlign :: Word64 -> Int#
byteAlign Word64
_ = ALIGNMENT_WORD64#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Word64 -> Int#
byteFieldOffset Proxy# name
_ Word64
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Word64
indexArray ByteArray#
ba Int#
i = Word# -> Word64
W64# (ByteArray# -> Int# -> Word#
indexWord64Array# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord64Array# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Word#
x #) -> (# State# s
s', Word# -> Word64
W64# Word#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (W64# Word#
x) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord64Array# MutableByteArray# s
mba Int#
i Word#
x
    {-# INLINE writeArray #-}

instance PrimBytes Char where
    type PrimFields Char = '[]
    getBytes :: Char -> ByteArray#
getBytes (C# Char#
x) = case (State# RealWorld -> (# State# RealWorld, ByteArray# #))
-> (# State# RealWorld, ByteArray# #)
forall o. (State# RealWorld -> o) -> o
runRW#
      ( \State# RealWorld
s0 -> case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# SIZEOF_HSCHAR# s0 of
         (# State# RealWorld
s1, MutableByteArray# RealWorld
marr #) -> case MutableByteArray# RealWorld
-> Int# -> Char# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWideCharArray# MutableByteArray# RealWorld
marr Int#
0# Char#
x State# RealWorld
s1 of
             State# RealWorld
s2 -> MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
marr State# RealWorld
s2
      ) of (# State# RealWorld
_, ByteArray#
a #) -> ByteArray#
a
    {-# NOINLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Char
fromBytes Int#
off ByteArray#
ba
      = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexWord8ArrayAsWideChar# ByteArray#
ba Int#
off)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Char #)
readBytes MutableByteArray# s
mba Int#
off State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWord8ArrayAsWideChar# MutableByteArray# s
mba Int#
off State# s
s of (# State# s
s', Char#
r #) -> (# State# s
s', Char# -> Char
C# Char#
r #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Char -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off (C# Char#
x)
      = MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWord8ArrayAsWideChar# MutableByteArray# s
mba Int#
off Char#
x
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Char #)
readAddr Addr#
a State# s
s
      = case Addr# -> Int# -> State# s -> (# State# s, Char# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Char# #)
readWideCharOffAddr# Addr#
a Int#
0# State# s
s of (# State# s
s', Char#
x #) -> (# State# s
s', Char# -> Char
C# Char#
x #)
    {-# INLINE readAddr #-}
    writeAddr :: Char -> Addr# -> State# s -> State# s
writeAddr (C# Char#
x) Addr#
a
      = Addr# -> Int# -> Char# -> State# s -> State# s
forall d. Addr# -> Int# -> Char# -> State# d -> State# d
writeWideCharOffAddr# Addr#
a Int#
0# Char#
x
    {-# INLINE writeAddr #-}
    byteSize :: Char -> Int#
byteSize Char
_ = SIZEOF_HSCHAR#
    {-# INLINE byteSize #-}
    byteAlign :: Char -> Int#
byteAlign Char
_ = ALIGNMENT_HSCHAR#
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Char -> Int#
byteFieldOffset Proxy# name
_ Char
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Char
indexArray ByteArray#
ba Int#
i = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexWideCharArray# ByteArray#
ba Int#
i)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Char #)
readArray MutableByteArray# s
mba Int#
i State# s
s
      = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWideCharArray# MutableByteArray# s
mba Int#
i State# s
s of (# State# s
s', Char#
x #) -> (# State# s
s', Char# -> Char
C# Char#
x #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Char -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
i (C# Char#
x) = MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWideCharArray# MutableByteArray# s
mba Int#
i Char#
x
    {-# INLINE writeArray #-}

instance PrimBytes (Idx (x :: k)) where
    type PrimFields (Idx x) = '[]
    getBytes :: Idx x -> ByteArray#
getBytes = (Word -> ByteArray#) -> Idx x -> ByteArray#
unsafeCoerce# (PrimBytes Word => Word -> ByteArray#
forall a. PrimBytes a => a -> ByteArray#
getBytes @Word)
    {-# INLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Idx x
fromBytes = (Int# -> ByteArray# -> Word) -> Int# -> ByteArray# -> Idx x
unsafeCoerce# (PrimBytes Word => Int# -> ByteArray# -> Word
forall a. PrimBytes a => Int# -> ByteArray# -> a
fromBytes @Word)
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Idx x #)
readBytes = (MutableByteArray# Any
 -> Int# -> State# Any -> (# State# Any, Word #))
-> MutableByteArray# s -> Int# -> State# s -> (# State# s, Idx x #)
unsafeCoerce# (forall s.
PrimBytes Word =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readBytes @Word)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Idx x -> State# s -> State# s
writeBytes = (MutableByteArray# Any -> Int# -> Word -> State# Any -> State# Any)
-> MutableByteArray# s -> Int# -> Idx x -> State# s -> State# s
unsafeCoerce# (forall s.
PrimBytes Word =>
MutableByteArray# s -> Int# -> Word -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes @Word)
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Idx x #)
readAddr = (Addr# -> State# Any -> (# State# Any, Word #))
-> Addr# -> State# s -> (# State# s, Idx x #)
unsafeCoerce# (forall s.
PrimBytes Word =>
Addr# -> State# s -> (# State# s, Word #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr @Word)
    {-# INLINE readAddr #-}
    writeAddr :: Idx x -> Addr# -> State# s -> State# s
writeAddr = (Word -> Addr# -> State# Any -> State# Any)
-> Idx x -> Addr# -> State# s -> State# s
unsafeCoerce# (forall s. PrimBytes Word => Word -> Addr# -> State# s -> State# s
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr @Word)
    {-# INLINE writeAddr #-}
    byteSize :: Idx x -> Int#
byteSize = (Word -> Int#) -> Idx x -> Int#
unsafeCoerce# (PrimBytes Word => Word -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @Word)
    {-# INLINE byteSize #-}
    byteAlign :: Idx x -> Int#
byteAlign = (Word -> Int#) -> Idx x -> Int#
unsafeCoerce# (PrimBytes Word => Word -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @Word)
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Idx x -> Int#
byteFieldOffset Proxy# name
b = (Word -> Int#) -> Idx x -> Int#
unsafeCoerce# (Proxy# name -> Word -> Int#
forall a (name :: Symbol).
(PrimBytes a, Elem name (PrimFields a), KnownSymbol name) =>
Proxy# name -> a -> Int#
byteFieldOffset @Word Proxy# name
b)
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Idx x
indexArray = (ByteArray# -> Int# -> Word) -> ByteArray# -> Int# -> Idx x
unsafeCoerce# (PrimBytes Word => ByteArray# -> Int# -> Word
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray @Word)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Idx x #)
readArray = (MutableByteArray# Any
 -> Int# -> State# Any -> (# State# Any, Word #))
-> MutableByteArray# s -> Int# -> State# s -> (# State# s, Idx x #)
unsafeCoerce# (forall s.
PrimBytes Word =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readArray @Word)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Idx x -> State# s -> State# s
writeArray = (MutableByteArray# Any -> Int# -> Word -> State# Any -> State# Any)
-> MutableByteArray# s -> Int# -> Idx x -> State# s -> State# s
unsafeCoerce# (forall s.
PrimBytes Word =>
MutableByteArray# s -> Int# -> Word -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray @Word)
    {-# INLINE writeArray #-}

deriving instance PrimBytes CChar
deriving instance PrimBytes CSChar
deriving instance PrimBytes CUChar
deriving instance PrimBytes CShort
deriving instance PrimBytes CUShort
deriving instance PrimBytes CInt
deriving instance PrimBytes CUInt
deriving instance PrimBytes CLong
deriving instance PrimBytes CULong
deriving instance PrimBytes CPtrdiff
deriving instance PrimBytes CSize
deriving instance PrimBytes CWchar
deriving instance PrimBytes CSigAtomic
deriving instance PrimBytes CLLong
deriving instance PrimBytes CULLong
deriving instance PrimBytes CBool
deriving instance PrimBytes CIntPtr
deriving instance PrimBytes CUIntPtr
deriving instance PrimBytes CIntMax
deriving instance PrimBytes CUIntMax
deriving instance PrimBytes CClock
deriving instance PrimBytes CTime
deriving instance PrimBytes CUSeconds
deriving instance PrimBytes CSUSeconds
deriving instance PrimBytes CFloat
deriving instance PrimBytes CDouble

anyList :: forall (k :: Type) (xs :: [k])
        . RepresentableList xs => [Any]
anyList :: [Any]
anyList = TypeList xs -> [Any]
unsafeCoerce# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
{-# INLINE anyList #-}

instance RepresentableList xs => PrimBytes (Idxs (xs :: [k])) where
    type PrimFields (Idxs xs) = '[]
    fromBytes :: Int# -> ByteArray# -> Idxs xs
fromBytes Int#
off ByteArray#
ba = [Word] -> Idxs xs
unsafeCoerce# (Int# -> [Any] -> [Word]
go Int#
off (RepresentableList xs => [Any]
forall k (xs :: [k]). RepresentableList xs => [Any]
anyList @_ @xs))
      where
        go :: Int# -> [Any] -> [Word]
go Int#
_ []       = []
        go Int#
i (Any
_ : [Any]
ls) = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ByteArray#
ba Int#
i) Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Int# -> [Any] -> [Word]
go (Int#
i Int# -> Int# -> Int#
+# SIZEOF_HSWORD#) ls
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Idxs xs #)
readBytes MutableByteArray# s
mba = (Int# -> State# s -> (# State# s, [Word] #))
-> Int# -> State# s -> (# State# s, Idxs xs #)
unsafeCoerce# ([Any] -> Int# -> State# s -> (# State# s, [Word] #)
go (RepresentableList xs => [Any]
forall k (xs :: [k]). RepresentableList xs => [Any]
anyList @_ @xs))
      where
        go :: [Any] -> Int# -> State# s -> (# State# s, [Word] #)
go [] Int#
_ State# s
s0 = (# State# s
s0, [] #)
        go (Any
_ : [Any]
ls) Int#
i State# s
s0
          | (# State# s
s1, Word#
w  #) <- MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord# MutableByteArray# s
mba Int#
i State# s
s0
          , (# State# s
s2, [Word]
ws #) <- [Any] -> Int# -> State# s -> (# State# s, [Word] #)
go [Any]
ls (Int#
i Int# -> Int# -> Int#
+# SIZEOF_HSWORD#) s1
            = (# State# s
s2, Word# -> Word
W# Word#
w Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
ws #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Idxs xs -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off = Int# -> [Word] -> State# s -> State# s
go Int#
off ([Word] -> State# s -> State# s)
-> (Idxs xs -> [Word]) -> Idxs xs -> State# s -> State# s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idxs xs -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs
      where
        go :: Int# -> [Word] -> State# s -> State# s
go Int#
_ [] State# s
s         = State# s
s
        go Int#
i (W# Word#
x :[Word]
xs) State# s
s = Int# -> [Word] -> State# s -> State# s
go (Int#
i Int# -> Int# -> Int#
+# SIZEOF_HSWORD#) xs (writeWord8ArrayAsWord# mba i x s)
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Idxs xs #)
readAddr Addr#
addr = (State# Any -> (# State# Any, [Word] #))
-> State# s -> (# State# s, Idxs xs #)
unsafeCoerce# (Addr# -> [Any] -> State# Any -> (# State# Any, [Word] #)
forall s. Addr# -> [Any] -> State# s -> (# State# s, [Word] #)
go Addr#
addr (RepresentableList xs => [Any]
forall k (xs :: [k]). RepresentableList xs => [Any]
anyList @_ @xs))
      where
        go :: forall s . Addr# -> [Any] -> State# s -> (# State# s, [Word] #)
        go :: Addr# -> [Any] -> State# s -> (# State# s, [Word] #)
go Addr#
_ [] State# s
s0 = (# State# s
s0, [] #)
        go Addr#
i (Any
_ : [Any]
ls) State# s
s0
          | (# State# s
s1, Word#
w #)  <- Addr# -> Int# -> State# s -> (# State# s, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWordOffAddr# Addr#
i Int#
0# State# s
s0
          , (# State# s
s2, [Word]
xs #) <- Addr# -> [Any] -> State# s -> (# State# s, [Word] #)
forall s. Addr# -> [Any] -> State# s -> (# State# s, [Word] #)
go (Addr# -> Int# -> Addr#
plusAddr# Addr#
i SIZEOF_HSWORD#) ls s1
            = (# State# s
s2, Word# -> Word
W# Word#
w Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
xs #)
    {-# INLINE readAddr #-}
    writeAddr :: Idxs xs -> Addr# -> State# s -> State# s
writeAddr Idxs xs
is Addr#
addr
        = Addr# -> [Word] -> State# s -> State# s
forall s. Addr# -> [Word] -> State# s -> State# s
go Addr#
addr (Idxs xs -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs xs
is)
      where
        go :: forall s . Addr# -> [Word] -> State# s -> State# s
        go :: Addr# -> [Word] -> State# s -> State# s
go Addr#
_ [] State# s
s         = State# s
s
        go Addr#
i (W# Word#
x :[Word]
xs) State# s
s = Addr# -> [Word] -> State# s -> State# s
forall s. Addr# -> [Word] -> State# s -> State# s
go (Addr# -> Int# -> Addr#
plusAddr# Addr#
i SIZEOF_HSWORD#) xs
                               (Addr# -> Int# -> Word# -> State# s -> State# s
forall d. Addr# -> Int# -> Word# -> State# d -> State# d
writeWordOffAddr# Addr#
i Int#
0# Word#
x State# s
s)
    {-# INLINE writeAddr #-}
    byteSize :: Idxs xs -> Int#
byteSize Idxs xs
_ = case Dim (Length xs) -> Word
forall k (x :: k). Dim x -> Word
dimVal (RepresentableList xs => Dim (Length xs)
forall k (xs :: [k]). RepresentableList xs => Dim (Length xs)
order' @xs) of
      W# Word#
n -> Idx Any -> Int#
forall a. PrimBytes a => a -> Int#
byteSize (forall k (x :: k). Idx x
forall a. HasCallStack => a
undefined :: Idx x) Int# -> Int# -> Int#
*# Word# -> Int#
word2Int# Word#
n
    {-# INLINE byteSize #-}
    byteAlign :: Idxs xs -> Int#
byteAlign Idxs xs
_ = Idx Any -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign (forall k (x :: k). Idx x
forall a. HasCallStack => a
undefined :: Idx x)
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Idxs xs -> Int#
byteFieldOffset Proxy# name
_ Idxs xs
_ = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Idxs xs
indexArray ByteArray#
ba Int#
off
      | n :: Word
n@(W# Word#
n#) <- Dim (Length xs) -> Word
forall k (x :: k). Dim x -> Word
dimVal (RepresentableList xs => Dim (Length xs)
forall k (xs :: [k]). RepresentableList xs => Dim (Length xs)
order' @xs)
        = [Word] -> Idxs xs
unsafeCoerce# (Int# -> Word -> [Word]
go (Int#
off Int# -> Int# -> Int#
*# Word# -> Int#
word2Int# Word#
n#) Word
n)
      where
        go :: Int# -> Word -> [Word]
go Int#
_ Word
0 = []
        go Int#
i Word
n = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
ba Int#
i) Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: Int# -> Word -> [Word]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Idxs xs #)
readArray MutableByteArray# s
mba Int#
off State# s
s
      | n :: Word
n@(W# Word#
n#) <- Dim (Length xs) -> Word
forall k (x :: k). Dim x -> Word
dimVal (RepresentableList xs => Dim (Length xs)
forall k (xs :: [k]). RepresentableList xs => Dim (Length xs)
order' @xs)
        = (# State# s, [Word] #) -> (# State# s, Idxs xs #)
unsafeCoerce# (Int# -> Word -> State# s -> (# State# s, [Word] #)
go (Int#
off Int# -> Int# -> Int#
*# Word# -> Int#
word2Int# Word#
n#) Word
n State# s
s)
      where
        go :: Int# -> Word -> State# s -> (# State# s, [Word] #)
go Int#
_ Word
0 State# s
s0 = (# State# s
s0, [] #)
        go Int#
i Word
n State# s
s0
          | (# State# s
s1, Word#
w #)  <- MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mba Int#
i State# s
s0
          , (# State# s
s2, [Word]
xs #) <- Int# -> Word -> State# s -> (# State# s, [Word] #)
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) State# s
s1
            = (# State# s
s2, Word# -> Word
W# Word#
w Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: [Word]
xs #)
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Idxs xs -> State# s -> State# s
writeArray MutableByteArray# s
mba Int#
off Idxs xs
is
      | W# Word#
n# <- Dim (Length xs) -> Word
forall k (x :: k). Dim x -> Word
dimVal (RepresentableList xs => Dim (Length xs)
forall k (xs :: [k]). RepresentableList xs => Dim (Length xs)
order' @xs)
        = Int# -> [Word] -> State# s -> State# s
go (Int#
off Int# -> Int# -> Int#
*# Word# -> Int#
word2Int# Word#
n#) (Idxs xs -> [Word]
forall k (ds :: [k]). Idxs ds -> [Word]
listIdxs Idxs xs
is)
      where
        go :: Int# -> [Word] -> State# s -> State# s
go Int#
_ [] State# s
s         = State# s
s
        go Int#
i (W# Word#
x :[Word]
xs) State# s
s = Int# -> [Word] -> State# s -> State# s
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [Word]
xs (MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mba Int#
i Word#
x State# s
s)
    {-# INLINE writeArray #-}

type family TupleFields (n :: Nat) (xs :: [Type]) :: [Symbol] where
    TupleFields _ '[] = '[]
    TupleFields n (_ ': xs) = ShowNat n ': TupleFields (n + 1) xs

instance ( RepresentableList xs
         , L.All PrimBytes xs
         ) => PrimBytes (TL.Tuple xs) where
    type PrimFields (TL.Tuple xs) = TupleFields 1 xs
    getBytes :: Tuple xs -> ByteArray#
getBytes   = (Tuple xs -> ByteArray#) -> Tuple xs -> ByteArray#
unsafeCoerce# (PrimBytes (Tuple xs) => Tuple xs -> ByteArray#
forall a. PrimBytes a => a -> ByteArray#
getBytes @(TS.Tuple xs))
    {-# INLINE getBytes #-}
    fromBytes :: Int# -> ByteArray# -> Tuple xs
fromBytes  = (Int# -> ByteArray# -> Tuple xs) -> Int# -> ByteArray# -> Tuple xs
unsafeCoerce# (PrimBytes (Tuple xs) => Int# -> ByteArray# -> Tuple xs
forall a. PrimBytes a => Int# -> ByteArray# -> a
fromBytes @(TS.Tuple xs))
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Tuple xs #)
readBytes  = (MutableByteArray# Any
 -> Int# -> State# Any -> (# State# Any, Tuple xs #))
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, Tuple xs #)
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, Tuple xs #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readBytes @(TS.Tuple xs))
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
writeBytes = (MutableByteArray# Any
 -> Int# -> Tuple xs -> State# Any -> State# Any)
-> MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes @(TS.Tuple xs))
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Tuple xs #)
readAddr   = (Addr# -> State# Any -> (# State# Any, Tuple xs #))
-> Addr# -> State# s -> (# State# s, Tuple xs #)
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
Addr# -> State# s -> (# State# s, Tuple xs #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr  @(TS.Tuple xs))
    {-# INLINE readAddr  #-}
    writeAddr :: Tuple xs -> Addr# -> State# s -> State# s
writeAddr  = (Tuple xs -> Addr# -> State# Any -> State# Any)
-> Tuple xs -> Addr# -> State# s -> State# s
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
Tuple xs -> Addr# -> State# s -> State# s
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr  @(TS.Tuple xs))
    {-# INLINE writeAddr  #-}
    byteSize :: Tuple xs -> Int#
byteSize   = (Tuple xs -> Int#) -> Tuple xs -> Int#
unsafeCoerce# (PrimBytes (Tuple xs) => Tuple xs -> Int#
forall a. PrimBytes a => a -> Int#
byteSize @(TS.Tuple xs))
    {-# INLINE byteSize #-}
    byteAlign :: Tuple xs -> Int#
byteAlign  = (Tuple xs -> Int#) -> Tuple xs -> Int#
unsafeCoerce# (PrimBytes (Tuple xs) => Tuple xs -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign @(TS.Tuple xs))
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Tuple xs -> Int#
byteFieldOffset Proxy# name
p = (Tuple xs -> Int#) -> Tuple xs -> Int#
unsafeCoerce# (Proxy# name -> Tuple xs -> Int#
forall a (name :: Symbol).
(PrimBytes a, Elem name (PrimFields a), KnownSymbol name) =>
Proxy# name -> a -> Int#
byteFieldOffset @(TS.Tuple xs) Proxy# name
p)
    {-# INLINE byteFieldOffset #-}
    indexArray :: ByteArray# -> Int# -> Tuple xs
indexArray = (ByteArray# -> Int# -> Tuple xs) -> ByteArray# -> Int# -> Tuple xs
unsafeCoerce# (PrimBytes (Tuple xs) => ByteArray# -> Int# -> Tuple xs
forall a. PrimBytes a => ByteArray# -> Int# -> a
indexArray @(TS.Tuple xs))
    {-# INLINE indexArray #-}
    readArray :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Tuple xs #)
readArray  = (MutableByteArray# Any
 -> Int# -> State# Any -> (# State# Any, Tuple xs #))
-> MutableByteArray# s
-> Int#
-> State# s
-> (# State# s, Tuple xs #)
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, Tuple xs #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readArray @(TS.Tuple xs))
    {-# INLINE readArray #-}
    writeArray :: MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
writeArray = (MutableByteArray# Any
 -> Int# -> Tuple xs -> State# Any -> State# Any)
-> MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
unsafeCoerce# (forall s.
PrimBytes (Tuple xs) =>
MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeArray @(TS.Tuple xs))
    {-# INLINE writeArray #-}

instance ( RepresentableList xs
         , L.All PrimBytes xs
         ) => PrimBytes (TS.Tuple xs) where
    type PrimFields (TS.Tuple xs) = TupleFields 1 xs
    fromBytes :: Int# -> ByteArray# -> Tuple xs
fromBytes Int#
off ByteArray#
ba = Int# -> TypeList xs -> Tuple xs
forall (ds :: [*]).
All PrimBytes ds =>
Int# -> TypeList ds -> Tuple ds
go Int#
0# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      where
        go :: L.All PrimBytes ds
           => Int# -> TypeList ds -> TS.Tuple ds
        go :: Int# -> TypeList ds -> Tuple ds
go Int#
_ TypeList ds
Empty = Tuple ds
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
Empty
        go Int#
n (Proxy y
t :* ts :: TypedList Proxy ys
ts@TypedList Proxy ys
TypeList)
          | y
x <- Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
t
          , Int#
n' <- Int# -> Int# -> Int#
roundUpInt Int#
n (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x)
          = y -> Id y
forall a. a -> Id a
TS.Id (Int# -> ByteArray# -> y
forall a. PrimBytes a => Int# -> ByteArray# -> a
fromBytes (Int#
off Int# -> Int# -> Int#
+# Int#
n') ByteArray#
ba) Id y -> TypedList Id ys -> Tuple ds
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Int# -> TypedList Proxy ys -> TypedList Id ys
forall (ds :: [*]).
All PrimBytes ds =>
Int# -> TypeList ds -> Tuple ds
go (Int#
n' Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Proxy ys
ts
    {-# INLINE fromBytes #-}
    readBytes :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Tuple xs #)
readBytes MutableByteArray# s
mb Int#
off = MutableByteArray# s
-> Int# -> TypeList xs -> State# s -> (# State# s, Tuple xs #)
forall (ds :: [*]) s.
All PrimBytes ds =>
MutableByteArray# s
-> Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go MutableByteArray# s
mb Int#
0# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      where
        go :: L.All PrimBytes ds
           => MutableByteArray# s
           -> Int# -> TypeList ds -> State# s -> (# State# s, TS.Tuple ds #)
        go :: MutableByteArray# s
-> Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go MutableByteArray# s
_ Int#
_ TypeList ds
Empty State# s
s0 = (# State# s
s0, Tuple ds
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
Empty #)
        go MutableByteArray# s
mba Int#
n (Proxy y
t :* ts :: TypedList Proxy ys
ts@TypedList Proxy ys
TypeList) State# s
s0
          | y
x <- Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
t
          , Int#
n' <- Int# -> Int# -> Int#
roundUpInt Int#
n (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x)
          = case MutableByteArray# s -> Int# -> State# s -> (# State# s, y #)
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readBytes MutableByteArray# s
mba (Int#
off Int# -> Int# -> Int#
+# Int#
n') State# s
s0 of
              (# State# s
s1, y
r #) -> case MutableByteArray# s
-> Int#
-> TypedList Proxy ys
-> State# s
-> (# State# s, Tuple ys #)
forall (ds :: [*]) s.
All PrimBytes ds =>
MutableByteArray# s
-> Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go MutableByteArray# s
mba (Int#
n' Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Proxy ys
ts State# s
s1 of
                (# State# s
s2, Tuple ys
rs #) -> (# State# s
s2, y -> Id y
forall a. a -> Id a
TS.Id y
r Id y -> Tuple ys -> Tuple ds
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Tuple ys
rs #)
    {-# INLINE readBytes #-}
    writeBytes :: MutableByteArray# s -> Int# -> Tuple xs -> State# s -> State# s
writeBytes MutableByteArray# s
mba Int#
off Tuple xs
tup = MutableByteArray# s
-> Int# -> Tuple xs -> TypeList xs -> State# s -> State# s
forall (ds :: [*]) s.
All PrimBytes ds =>
MutableByteArray# s
-> Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go MutableByteArray# s
mba Int#
0# Tuple xs
tup (Tuple xs -> TypeList xs
forall k (f :: k -> *) (xs :: [k]). TypedList f xs -> TypeList xs
types Tuple xs
tup)
      where
        go :: L.All PrimBytes ds => MutableByteArray# s
           -> Int# -> TS.Tuple ds -> TypeList ds -> State# s -> State# s
        go :: MutableByteArray# s
-> Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go MutableByteArray# s
mb Int#
n (TS.Id y
x :* TypedList Id ys
xs) (Proxy y
_ :* ts :: TypedList Proxy ys
ts@TypedList Proxy ys
TypeList) State# s
s
          | Int#
n' <- Int# -> Int# -> Int#
roundUpInt Int#
n (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x)
          = MutableByteArray# s
-> Int# -> TypedList Id ys -> TypeList ys -> State# s -> State# s
forall (ds :: [*]) s.
All PrimBytes ds =>
MutableByteArray# s
-> Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go MutableByteArray# s
mb (Int#
n' Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Id ys
xs TypeList ys
TypedList Proxy ys
ts (MutableByteArray# s -> Int# -> y -> State# s -> State# s
forall a s.
PrimBytes a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeBytes MutableByteArray# s
mb (Int#
off Int# -> Int# -> Int#
+# Int#
n') y
x State# s
s)
        go MutableByteArray# s
_ Int#
_ Tuple ds
_ TypeList ds
_ State# s
s = State# s
s
    {-# INLINE writeBytes #-}
    readAddr :: Addr# -> State# s -> (# State# s, Tuple xs #)
readAddr Addr#
addr = Int# -> TypeList xs -> State# s -> (# State# s, Tuple xs #)
forall (ds :: [*]) s.
All PrimBytes ds =>
Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go Int#
0# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      where
        go :: L.All PrimBytes ds
           => Int# -> TypeList ds -> State# s -> (# State# s, TS.Tuple ds #)
        go :: Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go Int#
_ TypeList ds
Empty State# s
s0 = (# State# s
s0, Tuple ds
forall k (f :: k -> *) (xs :: [k]). (xs ~ '[]) => TypedList f xs
Empty #)
        go Int#
n (Proxy y
t :* ts :: TypedList Proxy ys
ts@TypedList Proxy ys
TypeList) State# s
s0
          | y
x <- Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
t
          , Int#
n' <- Int# -> Int# -> Int#
roundUpInt Int#
n (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x)
          = case Addr# -> State# s -> (# State# s, y #)
forall a s. PrimBytes a => Addr# -> State# s -> (# State# s, a #)
readAddr (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
n') State# s
s0 of
              (# State# s
s1, y
r #) -> case Int# -> TypedList Proxy ys -> State# s -> (# State# s, Tuple ys #)
forall (ds :: [*]) s.
All PrimBytes ds =>
Int# -> TypeList ds -> State# s -> (# State# s, Tuple ds #)
go (Int#
n' Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Proxy ys
ts State# s
s1 of
                (# State# s
s2, Tuple ys
rs #) -> (# State# s
s2, y -> Id y
forall a. a -> Id a
TS.Id y
r Id y -> Tuple ys -> Tuple ds
forall k (f :: k -> *) (xs :: [k]) (y :: k) (ys :: [k]).
(xs ~ (y : ys)) =>
f y -> TypedList f ys -> TypedList f xs
:* Tuple ys
rs #)
    {-# INLINE readAddr #-}
    writeAddr :: Tuple xs -> Addr# -> State# s -> State# s
writeAddr Tuple xs
tup Addr#
addr = Int# -> Tuple xs -> TypeList xs -> State# s -> State# s
forall (ds :: [*]) s.
All PrimBytes ds =>
Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go Int#
0# Tuple xs
tup (Tuple xs -> TypeList xs
forall k (f :: k -> *) (xs :: [k]). TypedList f xs -> TypeList xs
types Tuple xs
tup)
      where
        go :: L.All PrimBytes ds
           => Int# -> TS.Tuple ds -> TypeList ds -> State# s -> State# s
        go :: Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go Int#
n (TS.Id y
x :* TypedList Id ys
xs) (Proxy y
_ :* ts :: TypedList Proxy ys
ts@TypedList Proxy ys
TypeList) State# s
s
          | Int#
n' <- Int# -> Int# -> Int#
roundUpInt Int#
n (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x)
          = Int# -> TypedList Id ys -> TypeList ys -> State# s -> State# s
forall (ds :: [*]) s.
All PrimBytes ds =>
Int# -> Tuple ds -> TypeList ds -> State# s -> State# s
go (Int#
n' Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Id ys
xs TypeList ys
TypedList Proxy ys
ts (y -> Addr# -> State# s -> State# s
forall a s. PrimBytes a => a -> Addr# -> State# s -> State# s
writeAddr y
x (Addr# -> Int# -> Addr#
plusAddr# Addr#
addr Int#
n') State# s
s)
        go Int#
_ Tuple ds
_ TypeList ds
_ State# s
s = State# s
s
    {-# INLINE writeAddr #-}
    byteSize :: Tuple xs -> Int#
byteSize Tuple xs
_ = Int# -> Int# -> TypeList xs -> Int#
forall (ys :: [*]).
All PrimBytes ys =>
Int# -> Int# -> TypeList ys -> Int#
go Int#
0# Int#
1# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      where
        go :: L.All PrimBytes ys => Int# -> Int# -> TypeList ys -> Int#
        go :: Int# -> Int# -> TypeList ys -> Int#
go Int#
s Int#
a TypeList ys
Empty     = Int#
s Int# -> Int# -> Int#
`roundUpInt` Int#
a
        go Int#
s Int#
a (Proxy y
p :* TypedList Proxy ys
ps) = let x :: y
x = Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
p
                               xa :: Int#
xa = y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x
                           in  Int# -> Int# -> TypedList Proxy ys -> Int#
forall (ys :: [*]).
All PrimBytes ys =>
Int# -> Int# -> TypeList ys -> Int#
go ( Int# -> Int# -> Int#
roundUpInt Int#
s Int#
xa Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x)
                                  ( Int# -> Int# -> Int#
maxInt Int#
a Int#
xa ) TypedList Proxy ys
ps
    {-# INLINE byteSize #-}
    byteAlign :: Tuple xs -> Int#
byteAlign Tuple xs
_ = TypeList xs -> Int#
forall (ys :: [*]). All PrimBytes ys => TypeList ys -> Int#
go (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      where
        go :: L.All PrimBytes ys => TypeList ys -> Int#
        go :: TypeList ys -> Int#
go TypeList ys
Empty     = Int#
0#
        go (Proxy y
p :* TypedList Proxy ys
ps) = Int# -> Int# -> Int#
maxInt (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign (Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
p)) (TypedList Proxy ys -> Int#
forall (ys :: [*]). All PrimBytes ys => TypeList ys -> Int#
go TypedList Proxy ys
ps)
    {-# INLINE byteAlign #-}
    byteFieldOffset :: Proxy# name -> Tuple xs -> Int#
byteFieldOffset Proxy# name
name Tuple xs
_
      | Just Word
n <- String -> Maybe Word
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Word) -> String -> Maybe Word
forall a b. (a -> b) -> a -> b
$ Proxy# name -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' Proxy# name
name
        = Word -> Int# -> TypeList xs -> Int#
forall (ys :: [*]).
All PrimBytes ys =>
Word -> Int# -> TypeList ys -> Int#
go (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) Int#
0# (RepresentableList xs => TypeList xs
forall k (xs :: [k]). RepresentableList xs => TypeList xs
tList @xs)
      | Bool
otherwise = Int# -> Int#
negateInt# Int#
1#
      where
        go :: L.All PrimBytes ys => Word -> Int# -> TypeList ys -> Int#
        go :: Word -> Int# -> TypeList ys -> Int#
go Word
0 Int#
s (Proxy y
p :* TypedList Proxy ys
_)  = Int#
s Int# -> Int# -> Int#
`roundUpInt` y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign (Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
p)
        go Word
n Int#
s (Proxy y
p :* TypedList Proxy ys
ps) = let x :: y
x = Proxy y -> y
forall p. Proxy p -> p
undefP Proxy y
p
                           in  Word -> Int# -> TypedList Proxy ys -> Int#
forall (ys :: [*]).
All PrimBytes ys =>
Word -> Int# -> TypeList ys -> Int#
go (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) ( Int# -> Int# -> Int#
roundUpInt Int#
s (y -> Int#
forall a. PrimBytes a => a -> Int#
byteAlign y
x) Int# -> Int# -> Int#
+# y -> Int#
forall a. PrimBytes a => a -> Int#
byteSize y
x) TypedList Proxy ys
ps
        go Word
_ Int#
_ TypeList ys
Empty     = Int# -> Int#
negateInt# Int#
1#
    {-# INLINE byteFieldOffset #-}


undefP :: Proxy p -> p
undefP :: Proxy p -> p
undefP = p -> Proxy p -> p
forall a b. a -> b -> a
const p
forall a. HasCallStack => a
undefined
{-# INLINE undefP #-}


instance PrimBytes ()
instance PrimBytes a => PrimBytes (Maybe a)
instance ( PrimBytes a, PrimBytes b ) => PrimBytes (Either a b)
instance ( PrimBytes a, PrimBytes b )
      => PrimBytes (a, b)
instance ( PrimBytes a, PrimBytes b, PrimBytes c )
      => PrimBytes (a, b, c)
instance ( PrimBytes a, PrimBytes b, PrimBytes c, PrimBytes d )
      => PrimBytes (a, b, c, d)
instance ( PrimBytes a, PrimBytes b, PrimBytes c, PrimBytes d, PrimBytes e )
      => PrimBytes (a, b, c, d, e)
instance ( PrimBytes a, PrimBytes b, PrimBytes c, PrimBytes d, PrimBytes e
         , PrimBytes f )
      => PrimBytes (a, b, c, d, e, f)
instance ( PrimBytes a, PrimBytes b, PrimBytes c, PrimBytes d, PrimBytes e
         , PrimBytes f, PrimBytes g )
      => PrimBytes (a, b, c, d, e, f, g)


-- | Find out which basic GHC type it is at runtime.
--   It is used for @DataFrame@ backend specialization:
--   by matching a @PrimTag a@ against its constructors, you can figure out
--   a specific implementation of @Backend a ds@
--     (e.g. whether this is a specialized float array, or a generic polymorphic array).
--   For non-basic types it defaults to `PTagOther`.
data PrimTag a where
    PTagFloat  :: PrimTag Float
    PTagDouble :: PrimTag Double
    PTagInt    :: PrimTag Int
    PTagInt8   :: PrimTag Int8
    PTagInt16  :: PrimTag Int16
    PTagInt32  :: PrimTag Int32
    PTagInt64  :: PrimTag Int64
    PTagWord   :: PrimTag Word
    PTagWord8  :: PrimTag Word8
    PTagWord16 :: PrimTag Word16
    PTagWord32 :: PrimTag Word32
    PTagWord64 :: PrimTag Word64
    PTagChar   :: PrimTag Char
    PTagPtr    :: PrimTag (Ptr a)
    PTagOther  :: PrimTag a

deriving instance Show (PrimTag a)


-- | Find out which basic GHC type it is at runtime.
class PrimTagged a where
    -- | This function allows to find out a type by comparing its tag
    primTag' :: a -> PrimTag a

-- | This function allows to find out a type by comparing its tag.
--   This is needed for backend specialization, to infer array instances.
--   For non-basic types it defaults to `PTagOther`.
primTag :: PrimBytes a => a -> PrimTag a
primTag :: a -> PrimTag a
primTag = a -> PrimTag a
forall a. PrimTagged a => a -> PrimTag a
primTag'
{-# INLINE primTag #-}

instance {-# OVERLAPPABLE #-} PrimTagged a where
    primTag' :: a -> PrimTag a
primTag' = PrimTag a -> a -> PrimTag a
forall a b. a -> b -> a
const PrimTag a
forall a. PrimTag a
PTagOther
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Float where
    primTag' :: Float -> PrimTag Float
primTag' = PrimTag Float -> Float -> PrimTag Float
forall a b. a -> b -> a
const PrimTag Float
PTagFloat
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Double where
    primTag' :: Double -> PrimTag Double
primTag' = PrimTag Double -> Double -> PrimTag Double
forall a b. a -> b -> a
const PrimTag Double
PTagDouble
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Int where
    primTag' :: Int -> PrimTag Int
primTag' = PrimTag Int -> Int -> PrimTag Int
forall a b. a -> b -> a
const PrimTag Int
PTagInt
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Int8 where
    primTag' :: Int8 -> PrimTag Int8
primTag' = PrimTag Int8 -> Int8 -> PrimTag Int8
forall a b. a -> b -> a
const PrimTag Int8
PTagInt8
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Int16 where
    primTag' :: Int16 -> PrimTag Int16
primTag' = PrimTag Int16 -> Int16 -> PrimTag Int16
forall a b. a -> b -> a
const PrimTag Int16
PTagInt16
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Int32 where
    primTag' :: Int32 -> PrimTag Int32
primTag' = PrimTag Int32 -> Int32 -> PrimTag Int32
forall a b. a -> b -> a
const PrimTag Int32
PTagInt32
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Int64 where
    primTag' :: Int64 -> PrimTag Int64
primTag' = PrimTag Int64 -> Int64 -> PrimTag Int64
forall a b. a -> b -> a
const PrimTag Int64
PTagInt64
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Word where
    primTag' :: Word -> PrimTag Word
primTag' = PrimTag Word -> Word -> PrimTag Word
forall a b. a -> b -> a
const PrimTag Word
PTagWord
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Word8 where
    primTag' :: Word8 -> PrimTag Word8
primTag' = PrimTag Word8 -> Word8 -> PrimTag Word8
forall a b. a -> b -> a
const PrimTag Word8
PTagWord8
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Word16 where
    primTag' :: Word16 -> PrimTag Word16
primTag' = PrimTag Word16 -> Word16 -> PrimTag Word16
forall a b. a -> b -> a
const PrimTag Word16
PTagWord16
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Word32 where
    primTag' :: Word32 -> PrimTag Word32
primTag' = PrimTag Word32 -> Word32 -> PrimTag Word32
forall a b. a -> b -> a
const PrimTag Word32
PTagWord32
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Word64 where
    primTag' :: Word64 -> PrimTag Word64
primTag' = PrimTag Word64 -> Word64 -> PrimTag Word64
forall a b. a -> b -> a
const PrimTag Word64
PTagWord64
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged Char where
    primTag' :: Char -> PrimTag Char
primTag' = PrimTag Char -> Char -> PrimTag Char
forall a b. a -> b -> a
const PrimTag Char
PTagChar
    {-# INLINE primTag' #-}

instance {-# OVERLAPPING #-} PrimTagged (Ptr a) where
    primTag' :: Ptr a -> PrimTag (Ptr a)
primTag' = PrimTag (Ptr a) -> Ptr a -> PrimTag (Ptr a)
forall a b. a -> b -> a
const PrimTag (Ptr a)
forall a. PrimTag (Ptr a)
PTagPtr
    {-# INLINE primTag' #-}



#if !(MIN_VERSION_base(4,12,0))
-- these functions were introduced in base-4.12.0

writeWord8ArrayAsWideChar# :: MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWord8ArrayAsWideChar# mba off = writeWideCharArray# mba (uncheckedIShiftRL# off OFFSHIFT_C#)
{-# INLINE writeWord8ArrayAsWideChar# #-}

writeWord8ArrayAsAddr# :: MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
writeWord8ArrayAsAddr# mba off = writeAddrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE writeWord8ArrayAsAddr# #-}

writeWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> StablePtr# a -> State# d -> State# d
writeWord8ArrayAsStablePtr# mba off = writeStablePtrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE writeWord8ArrayAsStablePtr# #-}

writeWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeWord8ArrayAsFloat# mba off = writeFloatArray# mba (uncheckedIShiftRL# off OFFSHIFT_F#)
{-# INLINE writeWord8ArrayAsFloat# #-}

writeWord8ArrayAsDouble# :: MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeWord8ArrayAsDouble# mba off = writeDoubleArray# mba (uncheckedIShiftRL# off OFFSHIFT_D#)
{-# INLINE writeWord8ArrayAsDouble# #-}

writeWord8ArrayAsInt16# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt16# mba off = writeInt16Array# mba (uncheckedIShiftRL# off 1#)
{-# INLINE writeWord8ArrayAsInt16# #-}

writeWord8ArrayAsInt32# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt32# mba off = writeInt32Array# mba (uncheckedIShiftRL# off 2#)
{-# INLINE writeWord8ArrayAsInt32# #-}

writeWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt64# mba off = writeInt64Array# mba (uncheckedIShiftRL# off 3#)
{-# INLINE writeWord8ArrayAsInt64# #-}

writeWord8ArrayAsInt# :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt# mba off = writeIntArray# mba (uncheckedIShiftRL# off OFFSHIFT_I#)
{-# INLINE writeWord8ArrayAsInt# #-}

writeWord8ArrayAsWord16# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord16# mba off = writeWord16Array# mba (uncheckedIShiftRL# off 1#)
{-# INLINE writeWord8ArrayAsWord16# #-}

writeWord8ArrayAsWord32# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# mba off = writeWord32Array# mba (uncheckedIShiftRL# off 2#)
{-# INLINE writeWord8ArrayAsWord32# #-}

writeWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord64# mba off = writeWord64Array# mba (uncheckedIShiftRL# off 3#)
{-# INLINE writeWord8ArrayAsWord64# #-}

writeWord8ArrayAsWord# :: MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord# mba off = writeWordArray# mba (uncheckedIShiftRL# off OFFSHIFT_W#)
{-# INLINE writeWord8ArrayAsWord# #-}

readWord8ArrayAsWideChar# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWord8ArrayAsWideChar# mba off = readWideCharArray# mba (uncheckedIShiftRL# off OFFSHIFT_C#)
{-# INLINE readWord8ArrayAsWideChar# #-}

readWord8ArrayAsAddr# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
readWord8ArrayAsAddr# mba off = readAddrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE readWord8ArrayAsAddr# #-}

readWord8ArrayAsStablePtr# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, StablePtr# a #)
readWord8ArrayAsStablePtr# mba off = readStablePtrArray# mba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE readWord8ArrayAsStablePtr# #-}

readWord8ArrayAsFloat# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readWord8ArrayAsFloat# mba off = readFloatArray# mba (uncheckedIShiftRL# off OFFSHIFT_F#)
{-# INLINE readWord8ArrayAsFloat# #-}

readWord8ArrayAsDouble# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readWord8ArrayAsDouble# mba off = readDoubleArray# mba (uncheckedIShiftRL# off OFFSHIFT_D#)
{-# INLINE readWord8ArrayAsDouble# #-}

readWord8ArrayAsInt16# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt16# mba off = readInt16Array# mba (uncheckedIShiftRL# off 1#)
{-# INLINE readWord8ArrayAsInt16# #-}

readWord8ArrayAsInt32# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt32# mba off = readInt32Array# mba (uncheckedIShiftRL# off 2#)
{-# INLINE readWord8ArrayAsInt32# #-}

readWord8ArrayAsInt64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt64# mba off = readInt64Array# mba (uncheckedIShiftRL# off 3#)
{-# INLINE readWord8ArrayAsInt64# #-}

readWord8ArrayAsInt# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt# mba off = readIntArray# mba (uncheckedIShiftRL# off OFFSHIFT_I#)
{-# INLINE readWord8ArrayAsInt# #-}

readWord8ArrayAsWord16# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord16# mba off = readWord16Array# mba (uncheckedIShiftRL# off 1#)
{-# INLINE readWord8ArrayAsWord16# #-}

readWord8ArrayAsWord32# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# mba off = readWord32Array# mba (uncheckedIShiftRL# off 2#)
{-# INLINE readWord8ArrayAsWord32# #-}

readWord8ArrayAsWord64# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord64# mba off = readWord64Array# mba (uncheckedIShiftRL# off 3#)
{-# INLINE readWord8ArrayAsWord64# #-}

readWord8ArrayAsWord# :: MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord# mba off = readWordArray# mba (uncheckedIShiftRL# off OFFSHIFT_W#)
{-# INLINE readWord8ArrayAsWord# #-}

indexWord8ArrayAsWideChar# :: ByteArray# -> Int# -> Char#
indexWord8ArrayAsWideChar# ba off = indexWideCharArray# ba (uncheckedIShiftRL# off OFFSHIFT_C#)
{-# INLINE indexWord8ArrayAsWideChar# #-}

indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr#
indexWord8ArrayAsAddr# ba off = indexAddrArray# ba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE indexWord8ArrayAsAddr# #-}

indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a
indexWord8ArrayAsStablePtr# ba off = indexStablePtrArray# ba (uncheckedIShiftRL# off OFFSHIFT_P#)
{-# INLINE indexWord8ArrayAsStablePtr# #-}

indexWord8ArrayAsFloat# :: ByteArray# -> Int# -> Float#
indexWord8ArrayAsFloat# ba off = indexFloatArray# ba (uncheckedIShiftRL# off OFFSHIFT_F#)
{-# INLINE indexWord8ArrayAsFloat# #-}

indexWord8ArrayAsDouble# :: ByteArray# -> Int# -> Double#
indexWord8ArrayAsDouble# ba off = indexDoubleArray# ba (uncheckedIShiftRL# off OFFSHIFT_D#)
{-# INLINE indexWord8ArrayAsDouble# #-}

indexWord8ArrayAsInt16# :: ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt16# ba off = indexInt16Array# ba (uncheckedIShiftRL# off 1#)
{-# INLINE indexWord8ArrayAsInt16# #-}

indexWord8ArrayAsInt32# :: ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt32# ba off = indexInt32Array# ba (uncheckedIShiftRL# off 2#)
{-# INLINE indexWord8ArrayAsInt32# #-}

indexWord8ArrayAsInt64# :: ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt64# ba off = indexInt64Array# ba (uncheckedIShiftRL# off 3#)
{-# INLINE indexWord8ArrayAsInt64# #-}

indexWord8ArrayAsInt# :: ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt# ba off = indexIntArray# ba (uncheckedIShiftRL# off OFFSHIFT_I#)
{-# INLINE indexWord8ArrayAsInt# #-}

indexWord8ArrayAsWord16# :: ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord16# ba off = indexWord16Array# ba (uncheckedIShiftRL# off 1#)
{-# INLINE indexWord8ArrayAsWord16# #-}

indexWord8ArrayAsWord32# :: ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ba off = indexWord32Array# ba (uncheckedIShiftRL# off 2#)
{-# INLINE indexWord8ArrayAsWord32# #-}

indexWord8ArrayAsWord64# :: ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord64# ba off = indexWord64Array# ba (uncheckedIShiftRL# off 3#)
{-# INLINE indexWord8ArrayAsWord64# #-}

indexWord8ArrayAsWord# :: ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ba off = indexWordArray# ba (uncheckedIShiftRL# off OFFSHIFT_W#)
{-# INLINE indexWord8ArrayAsWord# #-}

#endif