{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE ApplicativeDo              #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# OPTIONS_GHC -Wno-error=deprecations #-}
{-|
Module: Capnp.Untyped
Description: Utilities for reading capnproto messages with no schema.

The types and functions in this module know about things like structs and
lists, but are not schema aware.

Each of the data types exported by this module is parametrized over the
mutability of the message it contains (see "Capnp.Message").
-}
module Capnp.Untyped
    (
    -- * Type-level descriptions of wire representations.
      Repr(..)
    , PtrRepr(..)
    , ListRepr(..)
    , NormalListRepr(..)
    , DataSz(..)

    -- * Mapping representations to value types.
    , Untyped
    , UntypedData
    , UntypedPtr
    , UntypedSomePtr
    , UntypedList
    , UntypedSomeList
    , IgnoreMut(..)
    , MaybePtr(..)
    , Unwrapped

    -- * Relating the representations of lists & their elements.
    , Element(..)
    , ListItem(..)
    , ElemRepr
    , ListReprFor

    -- * Working with pointers
    , IsPtrRepr(..)
    , IsListPtrRepr(..)

    -- * Allocating values
    , Allocate(..)
    , AllocateNormalList(..)

    , Ptr(..), List(..), Struct, ListOf, Cap
    , structByteCount
    , structWordCount
    , structPtrCount
    , structListByteCount
    , structListWordCount
    , structListPtrCount
    , getData, getPtr
    , setData, setPtr
    , copyStruct
    , copyPtr
    , copyList
    , copyCap
    , copyListOf
    , getClient
    , get, index
    , setIndex
    , take
    , rootPtr
    , setRoot
    , rawBytes
    , ReadCtx
    , RWCtx
    , HasMessage(..), MessageDefault(..)
    , allocStruct
    , allocCompositeList
    , allocList0
    , allocList1
    , allocList8
    , allocList16
    , allocList32
    , allocList64
    , allocListPtr
    , appendCap

    , TraverseMsg(..)
    )
  where

import Prelude hiding (length, take)

import Data.Bits
import Data.Word

import Control.Exception.Safe    (impureThrow)
import Control.Monad             (forM_, unless)
import Control.Monad.Catch       (MonadCatch, MonadThrow(throwM))
import Control.Monad.Catch.Pure  (CatchT(runCatchT))
import Control.Monad.Primitive   (PrimMonad(..))
import Control.Monad.ST          (RealWorld)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.Kind                 (Type)

import qualified Data.ByteString     as BS
import qualified Language.Haskell.TH as TH

import Capnp.Address        (OffsetError(..), WordAddr(..), pointerFrom)
import Capnp.Bits
    ( BitCount(..)
    , ByteCount(..)
    , Word1(..)
    , WordCount(..)
    , bitsToBytesCeil
    , bytesToWordsCeil
    , replaceBits
    , wordsToBytes
    )
import Capnp.Mutability     (MaybeMutable(..), Mutability(..))
import Capnp.TraversalLimit (LimitT, MonadLimit(invoice))

import qualified Capnp.Errors  as E
import qualified Capnp.Message as M
import qualified Capnp.Pointer as P

-------------------------------------------------------------------------------
-- Untyped refernces to values in a message.
-------------------------------------------------------------------------------

-- | A an absolute pointer to a value (of arbitrary type) in a message.
-- Note that there is no variant for far pointers, which don't make sense
-- with absolute addressing.
data Ptr mut
    = PtrCap (Cap mut)
    | PtrList (List mut)
    | PtrStruct (Struct mut)

-- | A list of values (of arbitrary type) in a message.
data List mut
    = List0 (ListOf ('Data 'Sz0) mut)
    | List1 (ListOf ('Data 'Sz1) mut)
    | List8 (ListOf ('Data 'Sz8) mut)
    | List16 (ListOf ('Data 'Sz16) mut)
    | List32 (ListOf ('Data 'Sz32) mut)
    | List64 (ListOf ('Data 'Sz64) mut)
    | ListPtr (ListOf ('Ptr 'Nothing) mut)
    | ListStruct (ListOf ('Ptr ('Just 'Struct)) mut)

-- | A "normal" (non-composite) list.
data NormalList mut = NormalList
    { NormalList mut -> WordPtr mut
nPtr :: {-# UNPACK #-} !(M.WordPtr mut)
    , NormalList mut -> Int
nLen :: !Int
    }

data StructList mut = StructList
    { StructList mut -> Struct mut
slFirst :: Struct mut
    -- ^ First element. data/ptr sizes are the same for
    -- all elements.
    , StructList mut -> Int
slLen   :: !Int
    -- ^ Number of elements
    }

-- | A list of values with representation 'r' in a message.
newtype ListOf r mut = ListOf (ListRepOf r mut)

type family ListRepOf (r :: Repr) :: Mutability -> * where
    ListRepOf ('Ptr ('Just 'Struct)) = StructList
    ListRepOf r = NormalList

-- | @'ListItem' r@ indicates that @r@ is a representation for elements of some list
-- type. Not every representation is covered; instances exist only for @r@ where
-- @'ElemRepr' ('ListReprFor' r) ~ r@.
class Element r => ListItem (r :: Repr) where
    -- | Returns the length of a list
    length :: ListOf r mut -> Int

    -- underlying implementations of index, setIndex and take, but
    -- without bounds checking. Don't call these directly.
    unsafeIndex :: ReadCtx m mut => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
    unsafeSetIndex
        :: (RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s)))
        => a -> Int -> ListOf r ('Mut s) -> m ()
    unsafeTake :: Int -> ListOf r mut -> ListOf r mut

    checkListOf :: ReadCtx m mut => ListOf r mut -> m ()

    default length :: (ListRepOf r ~ NormalList) => ListOf r mut -> Int
    length (ListOf ListRepOf r mut
nlist) = NormalList mut -> Int
forall (mut :: Mutability). NormalList mut -> Int
nLen ListRepOf r mut
NormalList mut
nlist
    {-# INLINE length #-}

    default unsafeIndex ::
        forall m mut.
        ( ReadCtx m mut
        , Integral (Unwrapped (Untyped r mut))
        , ListRepOf r ~ NormalList
        , FiniteBits (Unwrapped (Untyped r mut))
        ) => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
    unsafeIndex Int
i (ListOf ListRepOf r mut
nlist) =
        Int -> NormalList mut -> m (Unwrapped (Untyped r mut))
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, FiniteBits a, Integral a) =>
Int -> NormalList mut -> m a
unsafeIndexBits @(Unwrapped (Untyped r mut)) Int
i ListRepOf r mut
NormalList mut
nlist
    {-# INLINE unsafeIndex #-}

    default unsafeSetIndex ::
        forall m s a.
        ( RWCtx m s
        , a ~ Unwrapped (Untyped r ('Mut s))
        , ListRepOf r ~ NormalList
        , Integral a
        , Bounded a
        , FiniteBits a
        ) => a -> Int -> ListOf r ('Mut s) -> m ()
    unsafeSetIndex a
value Int
i (ListOf ListRepOf r ('Mut s)
nlist) =
        Unwrapped (Untyped r ('Mut s))
-> Int -> NormalList ('Mut s) -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, FiniteBits a, Integral a) =>
a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits @(Unwrapped (Untyped r ('Mut s))) a
Unwrapped (Untyped r ('Mut s))
value Int
i ListRepOf r ('Mut s)
NormalList ('Mut s)
nlist
    {-# INLINE unsafeSetIndex #-}

    default unsafeTake :: ListRepOf r ~ NormalList => Int -> ListOf r mut -> ListOf r mut
    unsafeTake Int
count (ListOf NormalList{..}) = ListRepOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList{ nLen :: Int
nLen = Int
count, WordPtr mut
nPtr :: WordPtr mut
nPtr :: WordPtr mut
.. }
    {-# INLINE unsafeTake #-}

    default checkListOf ::
        forall m mut.
        ( ReadCtx m mut
        , ListRepOf r ~ NormalList
        , FiniteBits (Untyped r mut)
        ) => ListOf r mut -> m ()
    checkListOf (ListOf ListRepOf r mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList
        ListRepOf r mut
NormalList mut
l
        (Int -> BitCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BitCount) -> Int -> BitCount
forall a b. (a -> b) -> a -> b
$ Untyped r mut -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Untyped r mut
forall a. HasCallStack => a
undefined :: Untyped r mut))
    {-# INLINE checkListOf #-}

unsafeIndexBits
    :: forall a m mut.
    ( ReadCtx m mut
    , FiniteBits a
    , Integral a
    ) => Int -> NormalList mut -> m a
{-# INLINE unsafeIndexBits #-}
unsafeIndexBits :: Int -> NormalList mut -> m a
unsafeIndexBits Int
i NormalList mut
nlist =
    Int -> NormalList mut -> Int -> m a
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, Integral a) =>
Int -> NormalList mut -> Int -> m a
indexNList @a Int
i NormalList mut
nlist (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a))

unsafeSetIndexBits
    :: forall a m s.
    ( RWCtx m s
    , Bounded a
    , FiniteBits a
    , Integral a
    ) => a -> Int -> NormalList ('Mut s) -> m ()
{-# INLINE unsafeSetIndexBits #-}
unsafeSetIndexBits :: a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits a
value Int
i NormalList ('Mut s)
nlist =
    Int -> NormalList ('Mut s) -> Int -> a -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex @a Int
i NormalList ('Mut s)
nlist (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
value) a
value

indexNList
    :: forall a m mut. (ReadCtx m mut, Integral a)
    => Int -> NormalList mut -> Int -> m a
{-# INLINE indexNList #-}
indexNList :: Int -> NormalList mut -> Int -> m a
indexNList Int
i (NormalList M.WordPtr{Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment :: Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{Int
WordCount
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
wordIndex :: WordCount
segIndex :: Int
..}} Int
_) Int
eltsPerWord = do
    let wordIndex' :: WordCount
wordIndex' = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
    Word64
word <- Segment mut -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment mut
pSegment WordCount
wordIndex'
    let shift :: Int
shift = (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
eltsPerWord) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift

setNIndex
    :: forall a m s. (RWCtx m s, Bounded a, Integral a)
    => Int -> NormalList ('Mut s) -> Int -> a -> m ()
{-# INLINE setNIndex #-}
setNIndex :: Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i NormalList{nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr=M.WordPtr{Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}} Int
eltsPerWord a
value = do
    let eltWordIndex :: WordCount
eltWordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
    Word64
word <- Segment ('Mut s) -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment ('Mut s)
pSegment WordCount
eltWordIndex
    let shift :: Int
shift = (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
eltsPerWord) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
    Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
pSegment WordCount
eltWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Word64 -> Int -> Word64
forall a. (Bounded a, Integral a) => a -> Word64 -> Int -> Word64
replaceBits a
value Word64
word Int
shift

setPtrIndex :: RWCtx m s => Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> P.Ptr -> m ()
{-# INLINE setPtrIndex #-}
setPtrIndex :: Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i NormalList{nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr=nPtr :: WordPtr ('Mut s)
nPtr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}} Ptr ('Mut s)
absPtr Ptr
relPtr =
    let srcPtr :: WordPtr ('Mut s)
srcPtr = WordPtr ('Mut s)
nPtr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i } }
    in WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo WordPtr ('Mut s)
srcPtr (Ptr ('Mut s) -> WordAddr
forall (msg :: Mutability). Ptr msg -> WordAddr
ptrAddr Ptr ('Mut s)
absPtr) Ptr
relPtr

instance ListItem ('Ptr ('Just 'Struct)) where
    length :: ListOf ('Ptr ('Just 'Struct)) mut -> Int
length (ListOf (StructList _ len)) = Int
len
    {-# INLINE length #-}
    unsafeIndex :: Int
-> ListOf ('Ptr ('Just 'Struct)) mut
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
unsafeIndex Int
i (ListOf (StructList (StructAt ptr@M.WordPtr{pAddr=addr@WordAt{..}} dataSz ptrSz) _)) = do
        let offset :: WordCount
offset = Int -> WordCount
WordCount (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)
        let addr' :: WordAddr
addr' = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
offset }
        Struct mut -> m (Struct mut)
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct mut -> m (Struct mut)) -> Struct mut -> m (Struct mut)
forall a b. (a -> b) -> a -> b
$ WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr' } Word16
dataSz Word16
ptrSz
    {-# INLINE unsafeIndex #-}
    unsafeSetIndex :: a -> Int -> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i ListOf ('Ptr ('Just 'Struct)) ('Mut s)
list = do
        Struct ('Mut s)
dest <- Int
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) ('Mut s)))
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeIndex Int
i ListOf ('Ptr ('Just 'Struct)) ('Mut s)
list
        Struct ('Mut s) -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
dest a
Struct ('Mut s)
value
    unsafeTake :: Int
-> ListOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
unsafeTake Int
count (ListOf (StructList s _)) = ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList Struct mut
s Int
count)
    {-# INLINE unsafeTake #-}

    checkListOf :: ListOf ('Ptr ('Just 'Struct)) mut -> m ()
checkListOf (ListOf (StructList s@(StructAt ptr _ _) len)) =
        WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
ptr (Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
* Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structSize Struct mut
s)
    {-# INLINE checkListOf #-}

instance ListItem ('Data 'Sz0)  where
    unsafeIndex :: Int
-> ListOf ('Data 'Sz0) mut
-> m (Unwrapped (Untyped ('Data 'Sz0) mut))
unsafeIndex Int
_ ListOf ('Data 'Sz0) mut
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE unsafeIndex #-}
    unsafeSetIndex :: a -> Int -> ListOf ('Data 'Sz0) ('Mut s) -> m ()
unsafeSetIndex a
_ Int
_ ListOf ('Data 'Sz0) ('Mut s)
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE unsafeSetIndex #-}
    checkListOf :: ListOf ('Data 'Sz0) mut -> m ()
checkListOf ListOf ('Data 'Sz0) mut
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE checkListOf #-}

instance ListItem ('Data 'Sz1) where
    unsafeIndex :: Int
-> ListOf ('Data 'Sz1) mut
-> m (Unwrapped (Untyped ('Data 'Sz1) mut))
unsafeIndex Int
i (ListOf ListRepOf ('Data 'Sz1) mut
nlist) = do
        Word1 Bool
val <- Int -> NormalList mut -> m Word1
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, FiniteBits a, Integral a) =>
Int -> NormalList mut -> m a
unsafeIndexBits @Word1 Int
i ListRepOf ('Data 'Sz1) mut
NormalList mut
nlist
        Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
val
    {-# INLINE unsafeIndex #-}
    unsafeSetIndex :: a -> Int -> ListOf ('Data 'Sz1) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i (ListOf ListRepOf ('Data 'Sz1) ('Mut s)
nlist) =
        Word1 -> Int -> NormalList ('Mut s) -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, FiniteBits a, Integral a) =>
a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits @Word1 (Bool -> Word1
Word1 a
Bool
value) Int
i ListRepOf ('Data 'Sz1) ('Mut s)
NormalList ('Mut s)
nlist
    {-# INLINE unsafeSetIndex #-}
    checkListOf :: ListOf ('Data 'Sz1) mut -> m ()
checkListOf (ListOf ListRepOf ('Data 'Sz1) mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList ListRepOf ('Data 'Sz1) mut
NormalList mut
l BitCount
1
    {-# INLINE checkListOf #-}

instance ListItem ('Data 'Sz8)
instance ListItem ('Data 'Sz16)
instance ListItem ('Data 'Sz32)
instance ListItem ('Data 'Sz64)

instance ListItem ('Ptr 'Nothing) where
    unsafeIndex :: Int
-> ListOf ('Ptr 'Nothing) mut
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
unsafeIndex Int
i (ListOf (NormalList ptr@M.WordPtr{pAddr=addr@WordAt{..}} _)) =
        WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i } }
    {-# INLINE unsafeIndex #-}
    unsafeSetIndex :: a -> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i list :: ListOf ('Ptr 'Nothing) ('Mut s)
list@(ListOf ListRepOf ('Ptr 'Nothing) ('Mut s)
nlist) = case a
value of
        Just p | Unwrapped (Ptr ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Ptr Unwrapped (Ptr ('Mut s))
Ptr ('Mut s)
p Message ('Mut s) -> Message ('Mut s) -> Bool
forall a. Eq a => a -> a -> Bool
/= Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s))
ListOf ('Ptr 'Nothing) ('Mut s)
list -> do
            Maybe (Ptr ('Mut s))
newPtr <- Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
copyPtr (Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s))
ListOf ('Ptr 'Nothing) ('Mut s)
list) a
Maybe (Ptr ('Mut s))
value
            Maybe (Ptr ('Mut s))
-> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s a.
(ListItem r, RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s))) =>
a -> Int -> ListOf r ('Mut s) -> m ()
unsafeSetIndex Maybe (Ptr ('Mut s))
newPtr Int
i ListOf ('Ptr 'Nothing) ('Mut s)
list
        a
Nothing ->
            Int -> NormalList ('Mut s) -> Int -> Word64 -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Int
1 (Maybe Ptr -> Word64
P.serializePtr Maybe Ptr
forall a. Maybe a
Nothing)
        Just (PtrCap (CapAt _ cap)) ->
            Int -> NormalList ('Mut s) -> Int -> Word64 -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Int
1 (Maybe Ptr -> Word64
P.serializePtr (Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Word32 -> Ptr
P.CapPtr Word32
cap)))
        Just p@(PtrList ptrList) ->
            Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Ptr ('Mut s)
p (Ptr -> m ()) -> Ptr -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> EltSpec -> Ptr
P.ListPtr Int32
0 (List ('Mut s) -> EltSpec
forall (msg :: Mutability). List msg -> EltSpec
listEltSpec List ('Mut s)
ptrList)
        Just p@(PtrStruct (StructAt _ dataSz ptrSz)) ->
            Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Ptr ('Mut s)
p (Ptr -> m ()) -> Ptr -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz
    {-# INLINABLE unsafeSetIndex #-}

    checkListOf :: ListOf ('Ptr 'Nothing) mut -> m ()
checkListOf (ListOf ListRepOf ('Ptr 'Nothing) mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList ListRepOf ('Ptr 'Nothing) mut
NormalList mut
l BitCount
64
    {-# INLINE checkListOf #-}

-- | A Capability in a message.
data Cap mut = CapAt (M.Message mut) !Word32

-- | A struct value in a message.
data Struct mut
    = StructAt
        {-# UNPACK #-} !(M.WordPtr mut) -- Start of struct
        !Word16 -- Data section size.
        !Word16 -- Pointer section size.

-- | Type (constraint) synonym for the constraints needed for most read
-- operations.
type ReadCtx m mut = (M.MonadReadMessage mut m, MonadThrow m, MonadLimit m)

-- | Synonym for ReadCtx + WriteCtx
type RWCtx m s = (ReadCtx m ('Mut s), M.WriteCtx m s)

-- | A 'Repr' describes a wire representation for a value. This is
-- mostly used at the type level (using DataKinds); types are
-- parametrized over representations.
data Repr
    = Ptr (Maybe PtrRepr)
    -- ^ Pointer type. 'Nothing' indicates an AnyPointer, 'Just' describes
    -- a more specific pointer type.
    | Data DataSz
    -- ^ Non-pointer type.
    deriving(Int -> Repr -> ShowS
[Repr] -> ShowS
Repr -> String
(Int -> Repr -> ShowS)
-> (Repr -> String) -> ([Repr] -> ShowS) -> Show Repr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repr] -> ShowS
$cshowList :: [Repr] -> ShowS
show :: Repr -> String
$cshow :: Repr -> String
showsPrec :: Int -> Repr -> ShowS
$cshowsPrec :: Int -> Repr -> ShowS
Show)

-- | Information about the representation of a pointer type
data PtrRepr
    = Cap
    -- ^ Capability pointer.
    | List (Maybe ListRepr)
    -- ^ List pointer. 'Nothing' describes an AnyList, 'Just' describes
    -- more specific list types.
    | Struct
    -- ^ A struct (or group).
    deriving(Int -> PtrRepr -> ShowS
[PtrRepr] -> ShowS
PtrRepr -> String
(Int -> PtrRepr -> ShowS)
-> (PtrRepr -> String) -> ([PtrRepr] -> ShowS) -> Show PtrRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PtrRepr] -> ShowS
$cshowList :: [PtrRepr] -> ShowS
show :: PtrRepr -> String
$cshow :: PtrRepr -> String
showsPrec :: Int -> PtrRepr -> ShowS
$cshowsPrec :: Int -> PtrRepr -> ShowS
Show)

-- | Information about the representation of a list type.
data ListRepr where
    -- | A "normal" list
    ListNormal :: NormalListRepr -> ListRepr
    ListComposite :: ListRepr
    deriving(Int -> ListRepr -> ShowS
[ListRepr] -> ShowS
ListRepr -> String
(Int -> ListRepr -> ShowS)
-> (ListRepr -> String) -> ([ListRepr] -> ShowS) -> Show ListRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRepr] -> ShowS
$cshowList :: [ListRepr] -> ShowS
show :: ListRepr -> String
$cshow :: ListRepr -> String
showsPrec :: Int -> ListRepr -> ShowS
$cshowsPrec :: Int -> ListRepr -> ShowS
Show)

-- | Information about the representation of a normal (non-composite) list.
data NormalListRepr where
    NormalListData :: DataSz -> NormalListRepr
    NormalListPtr :: NormalListRepr
    deriving(Int -> NormalListRepr -> ShowS
[NormalListRepr] -> ShowS
NormalListRepr -> String
(Int -> NormalListRepr -> ShowS)
-> (NormalListRepr -> String)
-> ([NormalListRepr] -> ShowS)
-> Show NormalListRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalListRepr] -> ShowS
$cshowList :: [NormalListRepr] -> ShowS
show :: NormalListRepr -> String
$cshow :: NormalListRepr -> String
showsPrec :: Int -> NormalListRepr -> ShowS
$cshowsPrec :: Int -> NormalListRepr -> ShowS
Show)

-- | The size of a non-pointer type. @SzN@ represents an @N@-bit value.
data DataSz = Sz0 | Sz1 | Sz8 | Sz16 | Sz32 | Sz64
    deriving(Int -> DataSz -> ShowS
[DataSz] -> ShowS
DataSz -> String
(Int -> DataSz -> ShowS)
-> (DataSz -> String) -> ([DataSz] -> ShowS) -> Show DataSz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSz] -> ShowS
$cshowList :: [DataSz] -> ShowS
show :: DataSz -> String
$cshow :: DataSz -> String
showsPrec :: Int -> DataSz -> ShowS
$cshowsPrec :: Int -> DataSz -> ShowS
Show)

-- | Wrapper for use with 'Untyped'; see docs for 'Untyped'
newtype IgnoreMut a (mut :: Mutability) = IgnoreMut a
    deriving(Int -> IgnoreMut a mut -> ShowS
[IgnoreMut a mut] -> ShowS
IgnoreMut a mut -> String
(Int -> IgnoreMut a mut -> ShowS)
-> (IgnoreMut a mut -> String)
-> ([IgnoreMut a mut] -> ShowS)
-> Show (IgnoreMut a mut)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a (mut :: Mutability).
Show a =>
Int -> IgnoreMut a mut -> ShowS
forall a (mut :: Mutability). Show a => [IgnoreMut a mut] -> ShowS
forall a (mut :: Mutability). Show a => IgnoreMut a mut -> String
showList :: [IgnoreMut a mut] -> ShowS
$cshowList :: forall a (mut :: Mutability). Show a => [IgnoreMut a mut] -> ShowS
show :: IgnoreMut a mut -> String
$cshow :: forall a (mut :: Mutability). Show a => IgnoreMut a mut -> String
showsPrec :: Int -> IgnoreMut a mut -> ShowS
$cshowsPrec :: forall a (mut :: Mutability).
Show a =>
Int -> IgnoreMut a mut -> ShowS
Show, ReadPrec [IgnoreMut a mut]
ReadPrec (IgnoreMut a mut)
Int -> ReadS (IgnoreMut a mut)
ReadS [IgnoreMut a mut]
(Int -> ReadS (IgnoreMut a mut))
-> ReadS [IgnoreMut a mut]
-> ReadPrec (IgnoreMut a mut)
-> ReadPrec [IgnoreMut a mut]
-> Read (IgnoreMut a mut)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a (mut :: Mutability). Read a => ReadPrec [IgnoreMut a mut]
forall a (mut :: Mutability). Read a => ReadPrec (IgnoreMut a mut)
forall a (mut :: Mutability).
Read a =>
Int -> ReadS (IgnoreMut a mut)
forall a (mut :: Mutability). Read a => ReadS [IgnoreMut a mut]
readListPrec :: ReadPrec [IgnoreMut a mut]
$creadListPrec :: forall a (mut :: Mutability). Read a => ReadPrec [IgnoreMut a mut]
readPrec :: ReadPrec (IgnoreMut a mut)
$creadPrec :: forall a (mut :: Mutability). Read a => ReadPrec (IgnoreMut a mut)
readList :: ReadS [IgnoreMut a mut]
$creadList :: forall a (mut :: Mutability). Read a => ReadS [IgnoreMut a mut]
readsPrec :: Int -> ReadS (IgnoreMut a mut)
$creadsPrec :: forall a (mut :: Mutability).
Read a =>
Int -> ReadS (IgnoreMut a mut)
Read, IgnoreMut a mut -> IgnoreMut a mut -> Bool
(IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> Eq (IgnoreMut a mut)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
/= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c/= :: forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
== :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c== :: forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
Eq, Eq (IgnoreMut a mut)
Eq (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Ordering)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> Ord (IgnoreMut a mut)
IgnoreMut a mut -> IgnoreMut a mut -> Bool
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a (mut :: Mutability). Ord a => Eq (IgnoreMut a mut)
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
min :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmin :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
max :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmax :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
>= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c>= :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
> :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c> :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
<= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c<= :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
< :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c< :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
compare :: IgnoreMut a mut -> IgnoreMut a mut -> Ordering
$ccompare :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
$cp1Ord :: forall a (mut :: Mutability). Ord a => Eq (IgnoreMut a mut)
Ord, Int -> IgnoreMut a mut
IgnoreMut a mut -> Int
IgnoreMut a mut -> [IgnoreMut a mut]
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
(IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut
    -> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> Enum (IgnoreMut a mut)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall a (mut :: Mutability). Enum a => Int -> IgnoreMut a mut
forall a (mut :: Mutability). Enum a => IgnoreMut a mut -> Int
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> [IgnoreMut a mut]
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromThenTo :: IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromThenTo :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromTo :: IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromTo :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromThen :: IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromThen :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFrom :: IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFrom :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> [IgnoreMut a mut]
fromEnum :: IgnoreMut a mut -> Int
$cfromEnum :: forall a (mut :: Mutability). Enum a => IgnoreMut a mut -> Int
toEnum :: Int -> IgnoreMut a mut
$ctoEnum :: forall a (mut :: Mutability). Enum a => Int -> IgnoreMut a mut
pred :: IgnoreMut a mut -> IgnoreMut a mut
$cpred :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
succ :: IgnoreMut a mut -> IgnoreMut a mut
$csucc :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
Enum, IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> Bounded (IgnoreMut a mut)
forall a. a -> a -> Bounded a
forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
maxBound :: IgnoreMut a mut
$cmaxBound :: forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
minBound :: IgnoreMut a mut
$cminBound :: forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
Bounded, Integer -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
(IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (Integer -> IgnoreMut a mut)
-> Num (IgnoreMut a mut)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall a (mut :: Mutability). Num a => Integer -> IgnoreMut a mut
forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
fromInteger :: Integer -> IgnoreMut a mut
$cfromInteger :: forall a (mut :: Mutability). Num a => Integer -> IgnoreMut a mut
signum :: IgnoreMut a mut -> IgnoreMut a mut
$csignum :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
abs :: IgnoreMut a mut -> IgnoreMut a mut
$cabs :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
negate :: IgnoreMut a mut -> IgnoreMut a mut
$cnegate :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
* :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c* :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
- :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c- :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
+ :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c+ :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
Num, Num (IgnoreMut a mut)
Ord (IgnoreMut a mut)
Num (IgnoreMut a mut)
-> Ord (IgnoreMut a mut)
-> (IgnoreMut a mut -> Rational)
-> Real (IgnoreMut a mut)
IgnoreMut a mut -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a (mut :: Mutability). Real a => Num (IgnoreMut a mut)
forall a (mut :: Mutability). Real a => Ord (IgnoreMut a mut)
forall a (mut :: Mutability). Real a => IgnoreMut a mut -> Rational
toRational :: IgnoreMut a mut -> Rational
$ctoRational :: forall a (mut :: Mutability). Real a => IgnoreMut a mut -> Rational
$cp2Real :: forall a (mut :: Mutability). Real a => Ord (IgnoreMut a mut)
$cp1Real :: forall a (mut :: Mutability). Real a => Num (IgnoreMut a mut)
Real, Enum (IgnoreMut a mut)
Real (IgnoreMut a mut)
Real (IgnoreMut a mut)
-> Enum (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut
    -> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut))
-> (IgnoreMut a mut
    -> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut))
-> (IgnoreMut a mut -> Integer)
-> Integral (IgnoreMut a mut)
IgnoreMut a mut -> Integer
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
forall a (mut :: Mutability). Integral a => Enum (IgnoreMut a mut)
forall a (mut :: Mutability). Integral a => Real (IgnoreMut a mut)
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> Integer
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
toInteger :: IgnoreMut a mut -> Integer
$ctoInteger :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> Integer
divMod :: IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
$cdivMod :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
quotRem :: IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
$cquotRem :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
mod :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmod :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
div :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cdiv :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
rem :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$crem :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
quot :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cquot :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cp2Integral :: forall a (mut :: Mutability). Integral a => Enum (IgnoreMut a mut)
$cp1Integral :: forall a (mut :: Mutability). Integral a => Real (IgnoreMut a mut)
Integral, Eq (IgnoreMut a mut)
IgnoreMut a mut
Eq (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> IgnoreMut a mut
-> (Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> Bool)
-> (IgnoreMut a mut -> Maybe Int)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> Bits (IgnoreMut a mut)
Int -> IgnoreMut a mut
IgnoreMut a mut -> Bool
IgnoreMut a mut -> Int
IgnoreMut a mut -> Maybe Int
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> Int -> Bool
IgnoreMut a mut -> Int -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a (mut :: Mutability). Bits a => Eq (IgnoreMut a mut)
forall a (mut :: Mutability). Bits a => IgnoreMut a mut
forall a (mut :: Mutability). Bits a => Int -> IgnoreMut a mut
forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Bool
forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Maybe Int
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> Bool
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
popCount :: IgnoreMut a mut -> Int
$cpopCount :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
rotateR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotateR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
rotateL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotateL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
unsafeShiftR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cunsafeShiftR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shiftR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshiftR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
unsafeShiftL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cunsafeShiftL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shiftL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshiftL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
isSigned :: IgnoreMut a mut -> Bool
$cisSigned :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Bool
bitSize :: IgnoreMut a mut -> Int
$cbitSize :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
bitSizeMaybe :: IgnoreMut a mut -> Maybe Int
$cbitSizeMaybe :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Maybe Int
testBit :: IgnoreMut a mut -> Int -> Bool
$ctestBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> Bool
complementBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$ccomplementBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
clearBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cclearBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
setBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$csetBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
bit :: Int -> IgnoreMut a mut
$cbit :: forall a (mut :: Mutability). Bits a => Int -> IgnoreMut a mut
zeroBits :: IgnoreMut a mut
$czeroBits :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut
rotate :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotate :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shift :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshift :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
complement :: IgnoreMut a mut -> IgnoreMut a mut
$ccomplement :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut
xor :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cxor :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
.|. :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c.|. :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
.&. :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c.&. :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cp1Bits :: forall a (mut :: Mutability). Bits a => Eq (IgnoreMut a mut)
Bits, Bits (IgnoreMut a mut)
Bits (IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Int)
-> FiniteBits (IgnoreMut a mut)
IgnoreMut a mut -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
forall a (mut :: Mutability).
FiniteBits a =>
Bits (IgnoreMut a mut)
forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
countTrailingZeros :: IgnoreMut a mut -> Int
$ccountTrailingZeros :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
countLeadingZeros :: IgnoreMut a mut -> Int
$ccountLeadingZeros :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
finiteBitSize :: IgnoreMut a mut -> Int
$cfiniteBitSize :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
$cp1FiniteBits :: forall a (mut :: Mutability).
FiniteBits a =>
Bits (IgnoreMut a mut)
FiniteBits)

-- | Wrapper for use with 'Untyped'; see docs for 'Untyped'.
newtype MaybePtr (mut :: Mutability) = MaybePtr (Maybe (Ptr mut))

-- | Normalizes types returned by 'Untyped'; see docs for 'Untyped'.
type family Unwrapped a where
    Unwrapped (IgnoreMut a mut) = a
    Unwrapped (MaybePtr mut) = Maybe (Ptr mut)
    Unwrapped a = a

-- | @Untyped r mut@ is an untyped value with representation @r@ stored in
-- a message with mutability @mut@.
--
-- Note that the return tyep of this type family has kind
-- @'Mutability' -> 'Type'@. This is important, as it allows us
-- to define instances on @'Untyped' r@, and use @'Untyped' r@
-- in constraints.
--
-- This introduces some awkwardnesses though -- we really want
-- this to be @(Maybe (Ptr mut))@ for @'Ptr 'Nothing@, and
-- Int types/Bool/() for @'Data sz@. But we can't because these
-- are the wrong kind.
--
-- So, we hack around this by introducing two newtypes, 'IgnoreMut'
-- and 'MaybePtr', and a type family 'Unwrapped', which lets us
-- use @'Unwrapped' ('Untyped' r mut)@ as the type we really want
-- in some places, though we can't curry it then.
--
-- All this is super super awkward, but this is a low level
-- mostly-internal API; most users will intract with this through
-- the Raw type in "Capnp.Repr", which hides all of this...
type family Untyped (r :: Repr) :: Mutability -> Type where
    Untyped ('Data sz) = IgnoreMut (UntypedData sz)
    Untyped ('Ptr ptr) = UntypedPtr ptr

-- | @UntypedData sz@ is an untyped value with size @sz@.
type family UntypedData (sz :: DataSz) :: Type where
    UntypedData 'Sz0 = ()
    UntypedData 'Sz1 = Bool
    UntypedData 'Sz8 = Word8
    UntypedData 'Sz16 = Word16
    UntypedData 'Sz32 = Word32
    UntypedData 'Sz64 = Word64

-- | Like 'Untyped', but for pointers only.
type family UntypedPtr (r :: Maybe PtrRepr) :: Mutability -> Type where
    UntypedPtr 'Nothing = MaybePtr
    UntypedPtr ('Just r) = UntypedSomePtr r

-- | Like 'UntypedPtr', but doesn't allow AnyPointers.
type family UntypedSomePtr (r :: PtrRepr) :: Mutability -> Type where
    UntypedSomePtr 'Struct = Struct
    UntypedSomePtr 'Cap = Cap
    UntypedSomePtr ('List r) = UntypedList r

-- | Like 'Untyped', but for lists only.
type family UntypedList (r :: Maybe ListRepr) :: Mutability ->  Type where
    UntypedList 'Nothing = List
    UntypedList ('Just r) = UntypedSomeList r

-- | Like 'UntypedList', but doesn't allow AnyLists.
type family UntypedSomeList (r :: ListRepr) :: Mutability -> Type where
    UntypedSomeList r = ListOf (ElemRepr r)

-- | @ElemRepr r@ is the representation of elements of lists with
-- representation @r@.
type family ElemRepr (rl :: ListRepr) :: Repr where
    ElemRepr 'ListComposite = 'Ptr ('Just 'Struct)
    ElemRepr ('ListNormal 'NormalListPtr) = 'Ptr 'Nothing
    ElemRepr ('ListNormal ('NormalListData sz)) = 'Data sz

-- | @ListReprFor e@ is the representation of lists with elements
-- whose representation is @e@.
type family ListReprFor (e :: Repr) :: ListRepr where
    ListReprFor ('Data sz) = 'ListNormal ('NormalListData sz)
    ListReprFor ('Ptr ('Just 'Struct)) = 'ListComposite
    ListReprFor ('Ptr a) = 'ListNormal 'NormalListPtr

-- | 'Element' supports converting between values of representation
-- @'ElemRepr' ('ListReprFor' r)@ and values of representation @r@.
--
-- At a glance, you might expect this to just be a no-op, but it is actually
-- *not* always the case that @'ElemRepr' ('ListReprFor' r) ~ r@; in the
-- case of pointer types, @'ListReprFor' r@ can contain arbitrary pointers,
-- so information is lost, and it is possible for the list to contain pointers
-- of the incorrect type. In this case, 'fromElement' will throw an error.
--
-- 'toElement' is more trivial.
class Element (r :: Repr) where
    fromElement
        :: forall m mut. ReadCtx m mut
        => M.Message mut
        -> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
        -> m (Unwrapped (Untyped r mut))
    toElement :: Unwrapped (Untyped r mut) -> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)

-- | Operations on types with pointer representations.
class IsPtrRepr (r :: Maybe PtrRepr) where
    toPtr :: Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
    -- ^ Convert an untyped value of this representation to an AnyPointer.
    fromPtr :: ReadCtx m mut => M.Message mut -> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
    -- ^ Extract a value with this representation from an AnyPointer, failing
    -- if the pointer is the wrong type for this representation.

-- | Operations on types with list representations.
class IsListPtrRepr (r :: ListRepr) where
    rToList :: UntypedSomeList r mut -> List mut
    -- ^ Convert an untyped value of this representation to an AnyList.
    rFromList :: ReadCtx m mut => List mut -> m (UntypedSomeList r mut)
    -- ^ Extract a value with this representation from an AnyList, failing
    -- if the list is the wrong type for this representation.
    rFromListMsg :: ReadCtx m mut => M.Message mut -> m (UntypedSomeList r mut)
    -- ^ Create a zero-length value with this representation, living in the
    -- provided message.

-- helper function for throwing SchemaViolationError "expected ..."
expected :: MonadThrow m => String -> m a
expected :: String -> m a
expected String
msg = Error -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m a) -> Error -> m a
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg


-------------------------------------------------------------------------------
-- 'Element' instances
-------------------------------------------------------------------------------

instance Element ('Data sz) where
    fromElement :: Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
-> m (Unwrapped (Untyped ('Data sz) mut))
fromElement Message mut
_ = Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
-> m (Unwrapped (Untyped ('Data sz) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    toElement :: Unwrapped (Untyped ('Data sz) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
toElement = Unwrapped (Untyped ('Data sz) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
forall a. a -> a
id
    {-# INLINE fromElement #-}
    {-# INLINE toElement #-}
instance Element ('Ptr ('Just 'Struct)) where
    fromElement :: Message mut
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
fromElement Message mut
_ = Unwrapped
  (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    toElement :: Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
toElement = Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
forall a. a -> a
id
    {-# INLINE fromElement #-}
    {-# INLINE toElement #-}
instance Element ('Ptr 'Nothing) where
    fromElement :: Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
fromElement Message mut
_ = Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    toElement :: Unwrapped (Untyped ('Ptr 'Nothing) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
toElement = Unwrapped (Untyped ('Ptr 'Nothing) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
forall a. a -> a
id
    {-# INLINE fromElement #-}
    {-# INLINE toElement #-}
instance Element ('Ptr ('Just 'Cap)) where
    fromElement :: Message mut
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Cap)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
fromElement = forall (m :: * -> *) (mut :: Mutability).
(IsPtrRepr ('Just 'Cap), ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
forall (r :: Maybe PtrRepr) (m :: * -> *) (mut :: Mutability).
(IsPtrRepr r, ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
fromPtr @('Just 'Cap)
    toElement :: Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Cap)))) mut)
toElement = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut))
-> (Cap mut -> Ptr mut) -> Cap mut -> Maybe (Ptr mut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap
    {-# INLINE fromElement #-}
    {-# INLINE toElement #-}
instance IsPtrRepr ('Just ('List a)) => Element ('Ptr ('Just ('List a))) where
    fromElement :: Message mut
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just ('List a))))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List a))) mut))
fromElement = forall (m :: * -> *) (mut :: Mutability).
(IsPtrRepr ('Just ('List a)), ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List a))) mut))
forall (r :: Maybe PtrRepr) (m :: * -> *) (mut :: Mutability).
(IsPtrRepr r, ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
fromPtr @('Just ('List a))
    toElement :: Unwrapped (Untyped ('Ptr ('Just ('List a))) mut)
-> Unwrapped
     (Untyped (ElemRepr (ListReprFor ('Ptr ('Just ('List a))))) mut)
toElement = forall (mut :: Mutability).
IsPtrRepr ('Just ('List a)) =>
Unwrapped (Untyped ('Ptr ('Just ('List a))) mut) -> Maybe (Ptr mut)
forall (r :: Maybe PtrRepr) (mut :: Mutability).
IsPtrRepr r =>
Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
toPtr @('Just ('List a))
    {-# INLINE fromElement #-}
    {-# INLINE toElement #-}

-------------------------------------------------------------------------------
-- 'IsPtrRepr' instances
-------------------------------------------------------------------------------

instance IsPtrRepr 'Nothing where
    toPtr :: Unwrapped (Untyped ('Ptr 'Nothing) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr 'Nothing) mut)
p = Maybe (Ptr mut)
Unwrapped (Untyped ('Ptr 'Nothing) mut)
p
    fromPtr :: Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
fromPtr Message mut
_ = Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE toPtr #-}
    {-# INLINE fromPtr #-}
instance IsPtrRepr ('Just 'Struct) where
    toPtr :: Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
s = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
Struct mut
s)
    fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing            = Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
    fromPtr Message mut
_ (Just (PtrStruct Struct mut
s)) = Struct mut -> m (Struct mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct mut
s
    fromPtr Message mut
_ Maybe (Ptr mut)
_                    = String -> m (Struct mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to struct"
    {-# INLINE toPtr #-}
    {-# INLINE fromPtr #-}
instance IsPtrRepr ('Just 'Cap) where
    toPtr :: Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
c = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
Cap mut
c)
    fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
fromPtr Message mut
_ Maybe (Ptr mut)
Nothing           = String -> m (Cap mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
    fromPtr Message mut
_ (Just (PtrCap Cap mut
c)) = Cap mut -> m (Cap mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cap mut
c
    fromPtr Message mut
_ Maybe (Ptr mut)
_                 = String -> m (Cap mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
    {-# INLINE toPtr #-}
    {-# INLINE fromPtr #-}
instance IsPtrRepr ('Just ('List 'Nothing)) where
    toPtr :: Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
-> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
l = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
List mut
l)
    fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut))
fromPtr Message mut
_ Maybe (Ptr mut)
Nothing            = String -> m (List mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
    fromPtr Message mut
_ (Just (PtrList List mut
l)) = List mut -> m (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure List mut
l
    fromPtr Message mut
_ (Just Ptr mut
_)           = String -> m (List mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
    {-# INLINE toPtr #-}
    {-# INLINE fromPtr #-}
instance IsListPtrRepr r => IsPtrRepr ('Just ('List ('Just r))) where
    toPtr :: Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
-> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
l = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (UntypedSomeList r mut -> List mut
forall (r :: ListRepr) (mut :: Mutability).
IsListPtrRepr r =>
UntypedSomeList r mut -> List mut
rToList @r UntypedSomeList r mut
Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
l))
    fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing          = Message mut -> m (UntypedSomeList r mut)
forall (r :: ListRepr) (m :: * -> *) (mut :: Mutability).
(IsListPtrRepr r, ReadCtx m mut) =>
Message mut -> m (UntypedSomeList r mut)
rFromListMsg @r Message mut
msg
    fromPtr Message mut
_ (Just (PtrList List mut
l)) = List mut -> m (UntypedSomeList r mut)
forall (r :: ListRepr) (m :: * -> *) (mut :: Mutability).
(IsListPtrRepr r, ReadCtx m mut) =>
List mut -> m (UntypedSomeList r mut)
rFromList @r List mut
l
    fromPtr Message mut
_ (Just Ptr mut
_)           = String -> m (ListOf (ElemRepr r) mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
    {-# INLINE toPtr #-}
    {-# INLINE fromPtr #-}

-- | N.B. this should mostly be considered an implementation detail, but
-- it is exposed because it is used by generated code.
--
-- 'TraverseMsg' is similar to 'Traversable' from the prelude, but
-- the intent is that rather than conceptually being a "container",
-- the instance is a value backed by a message, and the point of the
-- type class is to be able to apply transformations to the underlying
-- message.
--
-- We don't just use 'Traversable' for this for two reasons:
--
-- 1. While algebraically it makes sense, it would be very unintuitive to
--    e.g. have the 'Traversable' instance for 'List' not traverse over the
--    *elements* of the list.
-- 2. For the instance for WordPtr, we actually need a stronger constraint than
--    Applicative in order for the implementation to type check. A previous
--    version of the library *did* have @tMsg :: Applicative m => ...@, but
--    performance considerations eventually forced us to open up the hood a
--    bit.
class TraverseMsg f where
    tMsg :: TraverseMsgCtx m mutA mutB => (M.Message mutA -> m (M.Message mutB)) -> f mutA -> m (f mutB)

type TraverseMsgCtx m mutA mutB =
    ( MonadThrow m
    , M.MonadReadMessage mutA m
    , M.MonadReadMessage mutB m
    )

instance TraverseMsg M.WordPtr where
    tMsg :: (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
tMsg Message mutA -> m (Message mutB)
f M.WordPtr{Message mutA
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage :: Message mutA
pMessage, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=pAddr :: WordAddr
pAddr@WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex}} = do
        Message mutB
msg' <- Message mutA -> m (Message mutB)
f Message mutA
pMessage
        Segment mutB
seg' <- Message mutB -> Int -> m (Segment mutB)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mutB
msg' Int
segIndex
        pure WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
            { pMessage :: Message mutB
pMessage = Message mutB
msg'
            , pSegment :: Segment mutB
pSegment = Segment mutB
seg'
            , WordAddr
pAddr :: WordAddr
pAddr :: WordAddr
pAddr
            }

instance TraverseMsg Ptr where
    tMsg :: (Message mutA -> m (Message mutB)) -> Ptr mutA -> m (Ptr mutB)
tMsg Message mutA -> m (Message mutB)
f = \case
        PtrCap Cap mutA
cap ->
            Cap mutB -> Ptr mutB
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Cap mutB -> Ptr mutB) -> m (Cap mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB)) -> Cap mutA -> m (Cap mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Cap mutA
cap
        PtrList List mutA
l ->
            List mutB -> Ptr mutB
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List mutB -> Ptr mutB) -> m (List mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB)) -> List mutA -> m (List mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f List mutA
l
        PtrStruct Struct mutA
s ->
            Struct mutB -> Ptr mutB
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mutB -> Ptr mutB) -> m (Struct mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Struct mutA
s

instance TraverseMsg Cap where
    tMsg :: (Message mutA -> m (Message mutB)) -> Cap mutA -> m (Cap mutB)
tMsg Message mutA -> m (Message mutB)
f (CapAt Message mutA
msg Word32
n) = Message mutB -> Word32 -> Cap mutB
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt (Message mutB -> Word32 -> Cap mutB)
-> m (Message mutB) -> m (Word32 -> Cap mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mutA -> m (Message mutB)
f Message mutA
msg m (Word32 -> Cap mutB) -> m Word32 -> m (Cap mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
n

instance TraverseMsg Struct where
    tMsg :: (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
tMsg Message mutA -> m (Message mutB)
f (StructAt WordPtr mutA
ptr Word16
dataSz Word16
ptrSz) = WordPtr mutB -> Word16 -> Word16 -> Struct mutB
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
        (WordPtr mutB -> Word16 -> Word16 -> Struct mutB)
-> m (WordPtr mutB) -> m (Word16 -> Word16 -> Struct mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f WordPtr mutA
ptr
        m (Word16 -> Word16 -> Struct mutB)
-> m Word16 -> m (Word16 -> Struct mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
dataSz
        m (Word16 -> Struct mutB) -> m Word16 -> m (Struct mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
ptrSz

instance TraverseMsg List where
    tMsg :: (Message mutA -> m (Message mutB)) -> List mutA -> m (List mutB)
tMsg Message mutA -> m (Message mutB)
f = \case
        List0      ListOf ('Data 'Sz0) mutA
l -> ListOf ('Data 'Sz0) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0      (ListOf ('Data 'Sz0) mutB -> List mutB)
-> m (ListOf ('Data 'Sz0) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz0) mutA -> m (ListOf ('Data 'Sz0) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz0) mutA
l
        List1      ListOf ('Data 'Sz1) mutA
l -> ListOf ('Data 'Sz1) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1      (ListOf ('Data 'Sz1) mutB -> List mutB)
-> m (ListOf ('Data 'Sz1) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz1) mutA -> m (ListOf ('Data 'Sz1) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz1) mutA
l
        List8      ListOf ('Data 'Sz8) mutA
l -> ListOf ('Data 'Sz8) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8      (ListOf ('Data 'Sz8) mutB -> List mutB)
-> m (ListOf ('Data 'Sz8) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz8) mutA -> m (ListOf ('Data 'Sz8) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz8) mutA
l
        List16     ListOf ('Data 'Sz16) mutA
l -> ListOf ('Data 'Sz16) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16     (ListOf ('Data 'Sz16) mutB -> List mutB)
-> m (ListOf ('Data 'Sz16) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz16) mutA -> m (ListOf ('Data 'Sz16) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz16) mutA
l
        List32     ListOf ('Data 'Sz32) mutA
l -> ListOf ('Data 'Sz32) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32     (ListOf ('Data 'Sz32) mutB -> List mutB)
-> m (ListOf ('Data 'Sz32) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz32) mutA -> m (ListOf ('Data 'Sz32) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz32) mutA
l
        List64     ListOf ('Data 'Sz64) mutA
l -> ListOf ('Data 'Sz64) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64     (ListOf ('Data 'Sz64) mutB -> List mutB)
-> m (ListOf ('Data 'Sz64) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz64) mutA -> m (ListOf ('Data 'Sz64) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz64) mutA
l
        ListPtr    ListOf ('Ptr 'Nothing) mutA
l -> ListOf ('Ptr 'Nothing) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr    (ListOf ('Ptr 'Nothing) mutB -> List mutB)
-> m (ListOf ('Ptr 'Nothing) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Ptr 'Nothing) mutA -> m (ListOf ('Ptr 'Nothing) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Ptr 'Nothing) mutA
l
        ListStruct ListOf ('Ptr ('Just 'Struct)) mutA
l -> ListOf ('Ptr ('Just 'Struct)) mutB -> List mutB
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) mutB -> List mutB)
-> m (ListOf ('Ptr ('Just 'Struct)) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Ptr ('Just 'Struct)) mutA
-> m (ListOf ('Ptr ('Just 'Struct)) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Ptr ('Just 'Struct)) mutA
l

instance TraverseMsg (ListRepOf r) => TraverseMsg (ListOf r) where
    tMsg :: (Message mutA -> m (Message mutB))
-> ListOf r mutA -> m (ListOf r mutB)
tMsg Message mutA -> m (Message mutB)
f (ListOf ListRepOf r mutA
l) = ListRepOf r mutB -> ListOf r mutB
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r mutB -> ListOf r mutB)
-> m (ListRepOf r mutB) -> m (ListOf r mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListRepOf r mutA -> m (ListRepOf r mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListRepOf r mutA
l

instance TraverseMsg NormalList where
    tMsg :: (Message mutA -> m (Message mutB))
-> NormalList mutA -> m (NormalList mutB)
tMsg Message mutA -> m (Message mutB)
f NormalList{Int
WordPtr mutA
nLen :: Int
nPtr :: WordPtr mutA
nLen :: forall (mut :: Mutability). NormalList mut -> Int
nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
..} = do
        WordPtr mutB
ptr <- (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f WordPtr mutA
nPtr
        pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList { nPtr :: WordPtr mutB
nPtr = WordPtr mutB
ptr, Int
nLen :: Int
nLen :: Int
.. }

instance TraverseMsg StructList where
    tMsg :: (Message mutA -> m (Message mutB))
-> StructList mutA -> m (StructList mutB)
tMsg Message mutA -> m (Message mutB)
f StructList{Int
Struct mutA
slLen :: Int
slFirst :: Struct mutA
slLen :: forall (mut :: Mutability). StructList mut -> Int
slFirst :: forall (mut :: Mutability). StructList mut -> Struct mut
..} = do
        Struct mutB
s <- (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
       (mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Struct mutA
slFirst
        pure StructList :: forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList { slFirst :: Struct mutB
slFirst = Struct mutB
s, Int
slLen :: Int
slLen :: Int
.. }

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

-- | Types whose storage is owned by a message..
class HasMessage (f :: Mutability -> *) where
    -- | Get the message in which the value is stored.
    message :: Unwrapped (f mut) -> M.Message mut

-- | Types which have a "default" value, but require a message
-- to construct it.
--
-- The default is usually conceptually zero-size. This is mostly useful
-- for generated code, so that it can use standard decoding techniques
-- on default values.
class HasMessage f => MessageDefault f where
    messageDefault :: ReadCtx m mut => M.Message mut -> m (Unwrapped (f mut))

instance HasMessage M.WordPtr where
    message :: Unwrapped (WordPtr mut) -> Message mut
message M.WordPtr{pMessage} = Message mut
pMessage

instance HasMessage Ptr where
    message :: Unwrapped (Ptr mut) -> Message mut
message (PtrCap cap)       = Unwrapped (Cap mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Cap Unwrapped (Cap mut)
Cap mut
cap
    message (PtrList list)     = Unwrapped (List mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @List Unwrapped (List mut)
List mut
list
    message (PtrStruct struct) = Unwrapped (Struct mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Struct Unwrapped (Struct mut)
Struct mut
struct

instance HasMessage Cap where
    message :: Unwrapped (Cap mut) -> Message mut
message (CapAt msg _) = Message mut
msg

instance HasMessage Struct where
    message :: Unwrapped (Struct mut) -> Message mut
message (StructAt ptr _ _) = Unwrapped (WordPtr mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @M.WordPtr WordPtr mut
Unwrapped (WordPtr mut)
ptr

instance MessageDefault Struct where
    messageDefault :: Message mut -> m (Unwrapped (Struct mut))
messageDefault Message mut
msg = do
        Segment mut
pSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
        pure $ WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr{pMessage :: Message mut
pMessage = Message mut
msg, Segment mut
pSegment :: Segment mut
pSegment :: Segment mut
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0} Word16
0 Word16
0

instance HasMessage List where
    message :: Unwrapped (List mut) -> Message mut
message (List0 list)      = Unwrapped (ListOf ('Data 'Sz0) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz0)) Unwrapped (ListOf ('Data 'Sz0) mut)
ListOf ('Data 'Sz0) mut
list
    message (List1 list)      = Unwrapped (ListOf ('Data 'Sz1) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz1)) Unwrapped (ListOf ('Data 'Sz1) mut)
ListOf ('Data 'Sz1) mut
list
    message (List8 list)      = Unwrapped (ListOf ('Data 'Sz8) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz8)) Unwrapped (ListOf ('Data 'Sz8) mut)
ListOf ('Data 'Sz8) mut
list
    message (List16 list)     = Unwrapped (ListOf ('Data 'Sz16) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz16)) Unwrapped (ListOf ('Data 'Sz16) mut)
ListOf ('Data 'Sz16) mut
list
    message (List32 list)     = Unwrapped (ListOf ('Data 'Sz32) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz32)) Unwrapped (ListOf ('Data 'Sz32) mut)
ListOf ('Data 'Sz32) mut
list
    message (List64 list)     = Unwrapped (ListOf ('Data 'Sz64) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz64)) Unwrapped (ListOf ('Data 'Sz64) mut)
ListOf ('Data 'Sz64) mut
list
    message (ListPtr list)    = Unwrapped (ListOf ('Ptr 'Nothing) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) mut)
ListOf ('Ptr 'Nothing) mut
list
    message (ListStruct list) = Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr ('Just 'Struct))) Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut)
ListOf ('Ptr ('Just 'Struct)) mut
list

instance HasMessage (ListOf ('Ptr ('Just 'Struct))) where
    message :: Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut) -> Message mut
message (ListOf list)    = Unwrapped (StructList mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @StructList Unwrapped (StructList mut)
ListRepOf ('Ptr ('Just 'Struct)) mut
list

instance MessageDefault (ListOf ('Ptr ('Just 'Struct))) where
    messageDefault :: Message mut -> m (Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut))
messageDefault Message mut
msg = StructList mut -> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (StructList mut -> ListOf ('Ptr ('Just 'Struct)) mut)
-> m (StructList mut) -> m (ListOf ('Ptr ('Just 'Struct)) mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (StructList mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @StructList Message mut
msg

instance {-# OVERLAPS #-} ListRepOf r ~ NormalList => HasMessage (ListOf r) where
    message :: Unwrapped (ListOf r mut) -> Message mut
message (ListOf list)    = Unwrapped (NormalList mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @NormalList Unwrapped (NormalList mut)
ListRepOf r mut
list

instance {-# OVERLAPS #-} ListRepOf r ~ NormalList => MessageDefault (ListOf r) where
    messageDefault :: Message mut -> m (Unwrapped (ListOf r mut))
messageDefault Message mut
msg = ListRepOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r mut -> ListOf r mut)
-> m (ListRepOf r mut) -> m (ListOf r mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (NormalList mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @NormalList Message mut
msg

instance HasMessage NormalList where
    message :: Unwrapped (NormalList mut) -> Message mut
message = WordPtr mut -> Message mut
forall (mut :: Mutability). WordPtr mut -> Message mut
M.pMessage (WordPtr mut -> Message mut)
-> (NormalList mut -> WordPtr mut) -> NormalList mut -> Message mut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList mut -> WordPtr mut
forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr

instance MessageDefault NormalList where
    messageDefault :: Message mut -> m (Unwrapped (NormalList mut))
messageDefault Message mut
msg = do
        Segment mut
pSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
        pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList
            { nPtr :: WordPtr mut
nPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr { pMessage :: Message mut
pMessage = Message mut
msg, Segment mut
pSegment :: Segment mut
pSegment :: Segment mut
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0 }
            , nLen :: Int
nLen = Int
0
            }

instance HasMessage StructList where
    message :: Unwrapped (StructList mut) -> Message mut
message (StructList s _) = Unwrapped (Struct mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Struct Unwrapped (Struct mut)
Struct mut
s

instance MessageDefault StructList where
    messageDefault :: Message mut -> m (Unwrapped (StructList mut))
messageDefault Message mut
msg = Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList
        (Struct mut -> Int -> StructList mut)
-> m (Struct mut) -> m (Int -> StructList mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
        m (Int -> StructList mut) -> m Int -> m (StructList mut)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0

-- | Extract a client (indepedent of the messsage) from the capability.
getClient :: ReadCtx m mut => Cap mut -> m M.Client
{-# INLINABLE getClient #-}
getClient :: Cap mut -> m Client
getClient (CapAt Message mut
msg Word32
idx) = Message mut -> Int -> m Client
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m Client
M.getCap Message mut
msg (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
idx)

-- | @get ptr@ returns the Ptr stored at @ptr@.
-- Deducts 1 from the quota for each word read (which may be multiple in the
-- case of far pointers).
get :: ReadCtx m mut => M.WordPtr mut -> m (Maybe (Ptr mut))
{-# INLINABLE get #-}
{-# SPECIALIZE get :: M.WordPtr ('Mut RealWorld) -> LimitT IO (Maybe (Ptr ('Mut RealWorld))) #-}
get :: WordPtr mut -> m (Maybe (Ptr mut))
get ptr :: WordPtr mut
ptr@M.WordPtr{Message mut
pMessage :: Message mut
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage, WordAddr
pAddr :: WordAddr
pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr} = do
    Word64
word <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
ptr
    case Word64 -> Maybe Ptr
P.parsePtr Word64
word of
        Maybe Ptr
Nothing -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ptr mut)
forall a. Maybe a
Nothing
        Just Ptr
p -> case Ptr
p of
            P.CapPtr Word32
cap -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Message mut -> Word32 -> Cap mut
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message mut
pMessage Word32
cap)
            P.StructPtr Int32
off Word16
dataSz Word16
ptrSz -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mut -> Ptr mut) -> Struct mut -> Ptr mut
forall a b. (a -> b) -> a -> b
$
                WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
pAddr Int32
off } Word16
dataSz Word16
ptrSz
            P.ListPtr Int32
off EltSpec
eltSpec -> Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> m (Ptr mut) -> m (Maybe (Ptr mut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                WordPtr mut -> EltSpec -> m (Ptr mut)
forall (f :: * -> *) (mut :: Mutability).
(MonadReadMessage mut f, MonadThrow f) =>
WordPtr mut -> EltSpec -> f (Ptr mut)
getList WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
pAddr Int32
off } EltSpec
eltSpec
            P.FarPtr Bool
twoWords Word32
offset Word32
segment -> do
                Segment mut
landingSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
pMessage (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segment)
                let addr' :: WordAddr
addr' = WordAt :: Int -> WordCount -> WordAddr
WordAt { wordIndex :: WordCount
wordIndex = Word32 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset
                                   , segIndex :: Int
segIndex = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segment
                                   }
                let landingPtr :: WordPtr mut
landingPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
                        { Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
                        , pSegment :: Segment mut
pSegment = Segment mut
landingSegment
                        , pAddr :: WordAddr
pAddr = WordAddr
addr'
                        }
                if Bool -> Bool
not Bool
twoWords
                    then do
                        -- XXX: invoice so we don't open ourselves up to DoS
                        -- in the case of a chain of far pointers -- but a
                        -- better solution would be to just reject after the
                        -- first chain since this isn't actually legal. TODO
                        -- refactor (and then get rid of the MonadLimit
                        -- constraint).
                        WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
                        WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr mut
landingPtr
                    else do
                        Word64
landingPad <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
landingPtr
                        case Word64 -> Maybe Ptr
P.parsePtr Word64
landingPad of
                            Just (P.FarPtr Bool
False Word32
off Word32
seg) -> do
                                let segIndex :: Int
segIndex = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seg
                                Segment mut
finalSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
pMessage Int
segIndex
                                Word64
tagWord <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
                                    { Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
                                    , pSegment :: Segment mut
pSegment = Segment mut
landingSegment
                                    , pAddr :: WordAddr
M.pAddr = WordAddr
addr' { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
addr' WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
                                    }
                                let finalPtr :: WordPtr mut
finalPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
                                        { Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
                                        , pSegment :: Segment mut
pSegment = Segment mut
finalSegment
                                        , pAddr :: WordAddr
pAddr = WordAt :: Int -> WordCount -> WordAddr
WordAt
                                            { wordIndex :: WordCount
wordIndex = Word32 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off
                                            , Int
segIndex :: Int
segIndex :: Int
segIndex
                                            }
                                        }
                                case Word64 -> Maybe Ptr
P.parsePtr Word64
tagWord of
                                    Just (P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz) ->
                                        Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mut -> Ptr mut) -> Struct mut -> Ptr mut
forall a b. (a -> b) -> a -> b
$
                                            WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
finalPtr Word16
dataSz Word16
ptrSz
                                    Just (P.ListPtr Int32
0 EltSpec
eltSpec) ->
                                        Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> m (Ptr mut) -> m (Maybe (Ptr mut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordPtr mut -> EltSpec -> m (Ptr mut)
forall (f :: * -> *) (mut :: Mutability).
(MonadReadMessage mut f, MonadThrow f) =>
WordPtr mut -> EltSpec -> f (Ptr mut)
getList WordPtr mut
finalPtr EltSpec
eltSpec
                                    -- TODO: I'm not sure whether far pointers to caps are
                                    -- legal; it's clear how they would work, but I don't
                                    -- see a use, and the spec is unclear. Should check
                                    -- how the reference implementation does this, copy
                                    -- that, and submit a patch to the spec.
                                    Just (P.CapPtr Word32
cap) ->
                                        Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Message mut -> Word32 -> Cap mut
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message mut
pMessage Word32
cap)
                                    Maybe Ptr
ptr -> Error -> m (Maybe (Ptr mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr mut))) -> Error -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
                                        String
"The tag word of a far pointer's " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        String
"2-word landing pad should be an intra " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        String
"segment pointer with offset 0, but " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        String
"we read " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Ptr -> String
forall a. Show a => a -> String
show Maybe Ptr
ptr
                            Maybe Ptr
ptr -> Error -> m (Maybe (Ptr mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr mut))) -> Error -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
                                String
"The first word of a far pointer's 2-word " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                String
"landing pad should be another far pointer " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                String
"(with a one-word landing pad), but we read " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                Maybe Ptr -> String
forall a. Show a => a -> String
show Maybe Ptr
ptr

  where
    getWord :: WordPtr mut -> m Word64
getWord M.WordPtr{Segment mut
pSegment :: Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} =
        Segment mut -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment mut
pSegment WordCount
wordIndex
    resolveOffset :: WordAddr -> a -> WordAddr
resolveOffset addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
..} a
off =
        WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ a -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
off WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
    getList :: WordPtr mut -> EltSpec -> f (Ptr mut)
getList ptr :: WordPtr mut
ptr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} EltSpec
eltSpec = List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List mut -> Ptr mut) -> f (List mut) -> f (Ptr mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        case EltSpec
eltSpec of
            P.EltNormal ElementSize
sz Word32
len -> List mut -> f (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List mut -> f (List mut)) -> List mut -> f (List mut)
forall a b. (a -> b) -> a -> b
$ case ElementSize
sz of
                ElementSize
P.Sz0   -> ListOf ('Data 'Sz0) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0   (ListRepOf ('Data 'Sz0) mut -> ListOf ('Data 'Sz0) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz0) mut
NormalList mut
nlist)
                ElementSize
P.Sz1   -> ListOf ('Data 'Sz1) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1   (ListRepOf ('Data 'Sz1) mut -> ListOf ('Data 'Sz1) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz1) mut
NormalList mut
nlist)
                ElementSize
P.Sz8   -> ListOf ('Data 'Sz8) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8   (ListRepOf ('Data 'Sz8) mut -> ListOf ('Data 'Sz8) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz8) mut
NormalList mut
nlist)
                ElementSize
P.Sz16  -> ListOf ('Data 'Sz16) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16  (ListRepOf ('Data 'Sz16) mut -> ListOf ('Data 'Sz16) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz16) mut
NormalList mut
nlist)
                ElementSize
P.Sz32  -> ListOf ('Data 'Sz32) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32  (ListRepOf ('Data 'Sz32) mut -> ListOf ('Data 'Sz32) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz32) mut
NormalList mut
nlist)
                ElementSize
P.Sz64  -> ListOf ('Data 'Sz64) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64  (ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz64) mut
NormalList mut
nlist)
                ElementSize
P.SzPtr -> ListOf ('Ptr 'Nothing) mut -> List mut
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr (ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Ptr 'Nothing) mut
NormalList mut
nlist)
              where
                nlist :: NormalList mut
nlist = WordPtr mut -> Int -> NormalList mut
forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList WordPtr mut
ptr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
            P.EltComposite Int32
_ -> do
                Word64
tagWord <- WordPtr mut -> f Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
ptr
                case Word64 -> Ptr
P.parsePtr' Word64
tagWord of
                    P.StructPtr Int32
numElts Word16
dataSz Word16
ptrSz ->
                        List mut -> f (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List mut -> f (List mut)) -> List mut -> f (List mut)
forall a b. (a -> b) -> a -> b
$ ListOf ('Ptr ('Just 'Struct)) mut -> List mut
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) mut -> List mut)
-> ListOf ('Ptr ('Just 'Struct)) mut -> List mut
forall a b. (a -> b) -> a -> b
$ ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr ('Just 'Struct)) mut
 -> ListOf ('Ptr ('Just 'Struct)) mut)
-> ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall a b. (a -> b) -> a -> b
$ Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList
                            (WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
                                WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 } }
                                Word16
dataSz
                                Word16
ptrSz)
                            (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
numElts)
                    Ptr
tag -> Error -> f (List mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> f (List mut)) -> Error -> f (List mut)
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
                        String
"Composite list tag was not a struct-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        String
"formatted word: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr -> String
forall a. Show a => a -> String
show Ptr
tag

-- | Return the EltSpec needed for a pointer to the given list.
listEltSpec :: List msg -> P.EltSpec
listEltSpec :: List msg -> EltSpec
listEltSpec (ListStruct list :: ListOf ('Ptr ('Just 'Struct)) msg
list@(ListOf (StructList (StructAt _ dataSz ptrSz) _))) =
    Int32 -> EltSpec
P.EltComposite (Int32 -> EltSpec) -> Int32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Ptr ('Just 'Struct)) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr ('Just 'Struct)) msg
list) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* (Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)
listEltSpec (List0 ListOf ('Data 'Sz0) msg
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz0 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz0) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) msg
list)
listEltSpec (List1 ListOf ('Data 'Sz1) msg
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz1 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz1) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz1) msg
list)
listEltSpec (List8 ListOf ('Data 'Sz8) msg
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz8 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz8) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz8) msg
list)
listEltSpec (List16 ListOf ('Data 'Sz16) msg
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz16 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz16) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz16) msg
list)
listEltSpec (List32 ListOf ('Data 'Sz32) msg
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz32 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz32) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz32) msg
list)
listEltSpec (List64 ListOf ('Data 'Sz64) msg
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz64 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz64) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz64) msg
list)
listEltSpec (ListPtr ListOf ('Ptr 'Nothing) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.SzPtr (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Ptr 'Nothing) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr 'Nothing) msg
list)

-- | Return the starting address of the list.
listAddr :: List msg -> WordAddr
listAddr :: List msg -> WordAddr
listAddr (ListStruct (ListOf (StructList (StructAt M.WordPtr{pAddr} _ _) _))) =
    -- pAddr is the address of the first element of the list, but
    -- composite lists start with a tag word:
    WordAddr
pAddr { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
pAddr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
- WordCount
1 }
listAddr (List0 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List1 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List8 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List16 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List32 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List64 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (ListPtr (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr

-- | Return the address of the pointer's target. It is illegal to call this on
-- a pointer which targets a capability.
ptrAddr :: Ptr msg -> WordAddr
ptrAddr :: Ptr msg -> WordAddr
ptrAddr (PtrCap Cap msg
_) = String -> WordAddr
forall a. HasCallStack => String -> a
error String
"ptrAddr called on a capability pointer."
ptrAddr (PtrStruct (StructAt M.WordPtr{WordAddr
pAddr :: WordAddr
pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr}Word16
_ Word16
_)) = WordAddr
pAddr
ptrAddr (PtrList List msg
list) = List msg -> WordAddr
forall (msg :: Mutability). List msg -> WordAddr
listAddr List msg
list

-- | @'setIndex value i list@ Set the @i@th element of @list@ to @value@.
setIndex
    :: (RWCtx m s, ListItem r)
    => Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
{-# INLINE setIndex #-}
{-# SPECIALIZE setIndex
    :: ListItem r
    => Unwrapped (Untyped r ('Mut RealWorld)) -> Int -> ListOf r ('Mut RealWorld) -> LimitT IO () #-}
setIndex :: Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut s))
_ Int
i ListOf r ('Mut s)
list | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
list Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i =
    Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
i, maxIndex :: Int
E.maxIndex = ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
list }
setIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
list = Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s a.
(ListItem r, RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s))) =>
a -> Int -> ListOf r ('Mut s) -> m ()
unsafeSetIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
list

-- | @'setPointerTo' msg srcLoc dstAddr relPtr@ sets the word at @srcLoc@ in @msg@ to a
-- pointer like @relPtr@, but pointing to @dstAddr@. @relPtr@ should not be a far pointer.
-- If the two addresses are in different segments, a landing pad will be allocated and
-- @srcLoc@ will contain a far pointer.
setPointerTo :: M.WriteCtx m s => M.WordPtr ('Mut s) -> WordAddr -> P.Ptr -> m ()
{-# INLINABLE setPointerTo #-}
{-# SPECIALIZE setPointerTo :: M.WordPtr ('Mut RealWorld) -> WordAddr -> P.Ptr -> LimitT IO () #-}
setPointerTo :: WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo
        M.WordPtr
            { pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage = Message ('Mut s)
msg
            , pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment=Segment ('Mut s)
srcSegment
            , pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=srcAddr :: WordAddr
srcAddr@WordAt{wordIndex :: WordAddr -> WordCount
wordIndex=WordCount
srcWordIndex}
            }
        WordAddr
dstAddr
        Ptr
relPtr
    | P.StructPtr Int32
_ Word16
0 Word16
0 <- Ptr
relPtr =
        -- We special case zero-sized structs, since (1) we don't have to
        -- really point at the correct offset, since they can "fit" anywhere,
        -- and (2) they cause problems with double-far pointers, where part
        -- of the landing pad needs to have a zero offset, but that makes it
        -- look like a null pointer... so we just avoid that case by cutting
        -- it off here.
        Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
            Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (-Int32
1) Word16
0 Word16
0
    | Bool
otherwise = case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
srcAddr WordAddr
dstAddr Ptr
relPtr of
        Right Ptr
absPtr ->
            Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just Ptr
absPtr
        Left OffsetError
OutOfRange ->
            String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: segment is too large to set the pointer."
        Left OffsetError
DifferentSegments -> do
            -- We need a far pointer; allocate a landing pad in the target segment,
            -- set it to point to the final destination, an then set the source pointer
            -- pointer to point to the landing pad.
            let WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex} = WordAddr
dstAddr
            Message ('Mut s)
-> Int -> WordCount -> m (Maybe (WordPtr ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Int -> WordCount -> m (Maybe (WordPtr ('Mut s)))
M.allocInSeg Message ('Mut s)
msg Int
segIndex WordCount
1 m (Maybe (WordPtr ('Mut s)))
-> (Maybe (WordPtr ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just M.WordPtr{pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment=Segment ('Mut s)
landingPadSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAddr
landingPadAddr} ->
                    case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
landingPadAddr WordAddr
dstAddr Ptr
relPtr of
                        Right Ptr
landingPad -> do
                            let WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex,WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex} = WordAddr
landingPadAddr
                            Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment WordCount
wordIndex (Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just Ptr
landingPad)
                            Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
                                Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
False (WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
                        Left OffsetError
DifferentSegments ->
                            String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: allocated a landing pad in the wrong segment!"
                        Left OffsetError
OutOfRange ->
                            String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: segment is too large to set the pointer."
                Maybe (WordPtr ('Mut s))
Nothing -> do
                    -- The target segment is full. We need to do a double-far pointer.
                    -- First allocate the 2-word landing pad, wherever it will fit:
                    M.WordPtr
                        { pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment = Segment ('Mut s)
landingPadSegment
                        , pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr = WordAt
                            { wordIndex :: WordAddr -> WordCount
wordIndex = WordCount
landingPadOffset
                            , segIndex :: WordAddr -> Int
segIndex = Int
landingPadSegIndex
                            }
                        } <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
2
                    -- Next, point the source pointer at the landing pad:
                    Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
                        Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
True
                            (WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
landingPadOffset)
                            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
landingPadSegIndex)
                    -- Finally, fill in the landing pad itself.
                    --
                    -- The first word is a far pointer whose offset is the
                    -- starting address of our target object:
                    Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment WordCount
landingPadOffset (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
                        let WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex, Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex} = WordAddr
dstAddr in
                        Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
False
                            (WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex)
                            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
                    -- The second word is a pointer of the right "shape"
                    -- for the target, but with a zero offset:
                    Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment (WordCount
landingPadOffset WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1) (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
                        Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ case Ptr
relPtr of
                            P.StructPtr Int32
_ Word16
nWords Word16
nPtrs -> Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
nWords Word16
nPtrs
                            P.ListPtr Int32
_ EltSpec
eltSpec -> Int32 -> EltSpec -> Ptr
P.ListPtr Int32
0 EltSpec
eltSpec
                            Ptr
_ -> Ptr
relPtr

-- | Make a copy of a capability inside the target message.
copyCap :: RWCtx m s => M.Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
{-# INLINABLE copyCap #-}
copyCap :: Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
copyCap Message ('Mut s)
dest Cap ('Mut s)
cap = Cap ('Mut s) -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
getClient Cap ('Mut s)
cap m Client -> (Client -> m (Cap ('Mut s))) -> m (Cap ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message ('Mut s) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap Message ('Mut s)
dest

-- | Make a copy of the value at the pointer, in the target message.
copyPtr :: RWCtx m s => M.Message ('Mut s) -> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
{-# INLINABLE copyPtr #-}
{-# SPECIALIZE copyPtr :: M.Message ('Mut RealWorld) -> Maybe (Ptr ('Mut RealWorld)) -> LimitT IO (Maybe (Ptr ('Mut RealWorld))) #-}
copyPtr :: Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
copyPtr Message ('Mut s)
_ Maybe (Ptr ('Mut s))
Nothing                = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
forall a. Maybe a
Nothing
copyPtr Message ('Mut s)
dest (Just (PtrCap Cap ('Mut s)
cap))    = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Cap ('Mut s) -> Ptr ('Mut s))
-> Cap ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Cap ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Cap ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
copyCap Message ('Mut s)
dest Cap ('Mut s)
cap
copyPtr Message ('Mut s)
dest (Just (PtrList List ('Mut s)
src))   = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (List ('Mut s) -> Ptr ('Mut s))
-> List ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (List ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
copyList Message ('Mut s)
dest List ('Mut s)
src
copyPtr Message ('Mut s)
dest (Just (PtrStruct Struct ('Mut s)
src)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Struct ('Mut s) -> Ptr ('Mut s))
-> Struct ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Struct ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Struct ('Mut s)
destStruct <- Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct
            Message ('Mut s)
dest
            (WordCount -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Word16) -> WordCount -> Word16
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct ('Mut s)
src)
            (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct ('Mut s)
src)
    Struct ('Mut s) -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
destStruct Struct ('Mut s)
src
    pure Struct ('Mut s)
destStruct

-- | Make a copy of the list, in the target message.
copyList :: RWCtx m s => M.Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
{-# INLINABLE copyList #-}
{-# SPECIALIZE copyList :: M.Message ('Mut RealWorld) -> List ('Mut RealWorld) -> LimitT IO (List ('Mut RealWorld)) #-}
copyList :: Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
copyList Message ('Mut s)
dest List ('Mut s)
src = case List ('Mut s)
src of
    List0 ListOf ('Data 'Sz0) ('Mut s)
src      -> ListOf ('Data 'Sz0) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0 (ListOf ('Data 'Sz0) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz0) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0 Message ('Mut s)
dest (ListOf ('Data 'Sz0) ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) ('Mut s)
src)
    List1 ListOf ('Data 'Sz1) ('Mut s)
src      -> ListOf ('Data 'Sz1) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1 (ListOf ('Data 'Sz1) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz1) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz1) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s)))
-> m (ListOf ('Data 'Sz1) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz1) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1
    List8 ListOf ('Data 'Sz8) ('Mut s)
src      -> ListOf ('Data 'Sz8) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8 (ListOf ('Data 'Sz8) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz8) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz8) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s)))
-> m (ListOf ('Data 'Sz8) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz8) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8
    List16 ListOf ('Data 'Sz16) ('Mut s)
src     -> ListOf ('Data 'Sz16) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16 (ListOf ('Data 'Sz16) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz16) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz16) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s)))
-> m (ListOf ('Data 'Sz16) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz16) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16
    List32 ListOf ('Data 'Sz32) ('Mut s)
src     -> ListOf ('Data 'Sz32) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32 (ListOf ('Data 'Sz32) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz32) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz32) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s)))
-> m (ListOf ('Data 'Sz32) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz32) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32
    List64 ListOf ('Data 'Sz64) ('Mut s)
src     -> ListOf ('Data 'Sz64) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64 (ListOf ('Data 'Sz64) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz64) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz64) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s)))
-> m (ListOf ('Data 'Sz64) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz64) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64
    ListPtr ListOf ('Ptr 'Nothing) ('Mut s)
src    -> ListOf ('Ptr 'Nothing) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr (ListOf ('Ptr 'Nothing) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Ptr 'Nothing) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Ptr 'Nothing) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s)))
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Ptr 'Nothing) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr
    ListStruct ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src -> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList <- Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList
            Message ('Mut s)
dest
            (WordCount -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Word16) -> WordCount -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> WordCount
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
            (ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> Word16
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
            (ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
        ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src
        pure ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList

copyNewListOf
    :: (ListItem r, RWCtx m s)
    => M.Message ('Mut s)
    -> ListOf r ('Mut s)
    -> (M.Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
    -> m (ListOf r ('Mut s))
{-# INLINE copyNewListOf #-}
copyNewListOf :: Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
destMsg ListOf r ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf r ('Mut s))
new = do
    ListOf r ('Mut s)
dest <- Message ('Mut s) -> Int -> m (ListOf r ('Mut s))
new Message ('Mut s)
destMsg (ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
src)
    ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut s)
dest ListOf r ('Mut s)
src
    pure ListOf r ('Mut s)
dest


-- | Make a copy of the list, in the target message.
copyListOf
    :: (ListItem r, RWCtx m s)
    => ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
{-# INLINE copyListOf #-}
copyListOf :: ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut s)
dest ListOf r ('Mut s)
src =
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
src Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Unwrapped (Untyped r ('Mut s))
value <- Int -> ListOf r ('Mut s) -> m (Unwrapped (Untyped r ('Mut s)))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i ListOf r ('Mut s)
src
        Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
dest

-- | @'copyStruct' dest src@ copies the source struct to the destination struct.
copyStruct :: RWCtx m s => Struct ('Mut s) -> Struct ('Mut s) -> m ()
{-# INLINABLE copyStruct #-}
{-# SPECIALIZE copyStruct :: Struct ('Mut RealWorld) -> Struct ('Mut RealWorld) -> LimitT IO () #-}
copyStruct :: Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
dest Struct ('Mut s)
src = do
    -- We copy both the data and pointer sections from src to dest,
    -- padding the tail of the destination section with zeros/null
    -- pointers as necessary. If the destination section is
    -- smaller than the source section, this will raise a BoundsError.
    --
    -- TODO: possible enhancement: allow the destination section to be
    -- smaller than the source section if and only if the tail of the
    -- source section is all zeros (default values).
    ListOf ('Data 'Sz64) ('Mut (PrimState m))
-> ListOf ('Data 'Sz64) ('Mut (PrimState m))
-> Unwrapped (Untyped ('Data 'Sz64) ('Mut (PrimState m)))
-> m ()
forall (r :: Repr) (m :: * -> *).
(ListItem r, PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct ('Mut s)
dest) (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct ('Mut s)
src) Unwrapped (Untyped ('Data 'Sz64) ('Mut (PrimState m)))
0
    ListOf ('Ptr 'Nothing) ('Mut (PrimState m))
-> ListOf ('Ptr 'Nothing) ('Mut (PrimState m))
-> Unwrapped (Untyped ('Ptr 'Nothing) ('Mut (PrimState m)))
-> m ()
forall (r :: Repr) (m :: * -> *).
(ListItem r, PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection  Struct ('Mut s)
dest) (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection  Struct ('Mut s)
src) Unwrapped (Untyped ('Ptr 'Nothing) ('Mut (PrimState m)))
forall a. Maybe a
Nothing
  where
    copySection :: ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection ListOf r ('Mut (PrimState m))
dest ListOf r ('Mut (PrimState m))
src Unwrapped (Untyped r ('Mut (PrimState m)))
pad = do
        -- Copy the source section to the destination section:
        ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m)) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut (PrimState m))
dest ListOf r ('Mut (PrimState m))
src
        -- Pad the remainder with zeros/default values:
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ListOf r ('Mut (PrimState m)) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut (PrimState m))
src..ListOf r ('Mut (PrimState m)) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut (PrimState m))
dest Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
            Unwrapped (Untyped r ('Mut (PrimState m)))
-> Int -> ListOf r ('Mut (PrimState m)) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut (PrimState m)))
pad Int
i ListOf r ('Mut (PrimState m))
dest


-- | @index i list@ returns the ith element in @list@. Deducts 1 from the quota
index :: (ReadCtx m mut, ListItem r) => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
{-# INLINE index #-}
{-# SPECIALIZE index :: ListItem r => Int -> ListOf r 'Const -> LimitT IO (Unwrapped (Untyped r 'Const)) #-}
{-# SPECIALIZE index :: ListItem r => Int -> ListOf r ('Mut RealWorld) -> LimitT IO (Unwrapped (Untyped r ('Mut RealWorld))) #-}
index :: Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i ListOf r mut
list
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list =
        Error -> m (Unwrapped (Untyped r mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
i, maxIndex :: Int
E.maxIndex = ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
    | Bool
otherwise = Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeIndex Int
i ListOf r mut
list

-- | Return a prefix of the list, of the given length.
{-# INLINABLE take #-}
take :: Int -> ListOf r mut -> m (ListOf r mut)
take Int
count ListOf r mut
list
    | ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count =
        Error -> m (ListOf r mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
count, maxIndex :: Int
E.maxIndex = ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
    | Bool
otherwise = ListOf r mut -> m (ListOf r mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf r mut -> m (ListOf r mut))
-> ListOf r mut -> m (ListOf r mut)
forall a b. (a -> b) -> a -> b
$ Int -> ListOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
Int -> ListOf r mut -> ListOf r mut
unsafeTake Int
count ListOf r mut
list

-- | The data section of a struct, as a list of Word64
dataSection :: Struct mut -> ListOf ('Data 'Sz64) mut
{-# INLINE dataSection #-}
dataSection :: Struct mut -> ListOf ('Data 'Sz64) mut
dataSection (StructAt WordPtr mut
ptr Word16
dataSz Word16
_) =
    ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut)
-> ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall a b. (a -> b) -> a -> b
$ WordPtr mut -> Int -> NormalList mut
forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList WordPtr mut
ptr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz)

-- | The pointer section of a struct, as a list of Ptr
ptrSection :: Struct mut -> ListOf ('Ptr 'Nothing) mut
{-# INLINE ptrSection #-}
ptrSection :: Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection (StructAt ptr :: WordPtr mut
ptr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} Word16
dataSz Word16
ptrSz) =
    ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut)
-> ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall a b. (a -> b) -> a -> b
$ NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList
        { nPtr :: WordPtr mut
nPtr = WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz } }
        , nLen :: Int
nLen = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
        }

-- | Get the size (in words) of a struct's data section.
structWordCount :: Struct mut -> WordCount
structWordCount :: Struct mut -> WordCount
structWordCount (StructAt WordPtr mut
_ptr Word16
dataSz Word16
_ptrSz) = Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz

-- | Get the size (in bytes) of a struct's data section.
structByteCount :: Struct mut -> ByteCount
structByteCount :: Struct mut -> ByteCount
structByteCount = WordCount -> ByteCount
wordsToBytes (WordCount -> ByteCount)
-> (Struct mut -> WordCount) -> Struct mut -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount

-- | Get the size of a struct's pointer section.
structPtrCount  :: Struct mut -> Word16
structPtrCount :: Struct mut -> Word16
structPtrCount (StructAt WordPtr mut
_ptr Word16
_dataSz Word16
ptrSz) = Word16
ptrSz

-- | Get the size (in words) of the data sections in a struct list.
structListWordCount :: ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount :: ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount (ListOf (StructList s _)) = Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct mut
s

-- | Get the size (in words) of the data sections in a struct list.
structListByteCount :: ListOf ('Ptr ('Just 'Struct)) mut -> ByteCount
structListByteCount :: ListOf ('Ptr ('Just 'Struct)) mut -> ByteCount
structListByteCount (ListOf (StructList s _)) = Struct mut -> ByteCount
forall (mut :: Mutability). Struct mut -> ByteCount
structByteCount Struct mut
s

-- | Get the size of the pointer sections in a struct list.
structListPtrCount  :: ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount :: ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount  (ListOf (StructList s _)) = Struct mut -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct mut
s

-- | @'getData' i struct@ gets the @i@th word from the struct's data section,
-- returning 0 if it is absent.
getData :: ReadCtx m msg => Int -> Struct msg -> m Word64
{-# INLINE getData #-}
getData :: Int -> Struct msg -> m Word64
getData Int
i Struct msg
struct
    | WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct msg -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
    | Bool
otherwise = Int
-> ListOf ('Data 'Sz64) msg
-> m (Unwrapped (Untyped ('Data 'Sz64) msg))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i (Struct msg -> ListOf ('Data 'Sz64) msg
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct msg
struct)

-- | @'getPtr' i struct@ gets the @i@th word from the struct's pointer section,
-- returning Nothing if it is absent.
getPtr :: ReadCtx m msg => Int -> Struct msg -> m (Maybe (Ptr msg))
{-# INLINE getPtr #-}
getPtr :: Int -> Struct msg -> m (Maybe (Ptr msg))
getPtr Int
i Struct msg
struct
    | Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct msg -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = do
        WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
        pure Maybe (Ptr msg)
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        Maybe (Ptr msg)
ptr <- Int
-> ListOf ('Ptr 'Nothing) msg
-> m (Unwrapped (Untyped ('Ptr 'Nothing) msg))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i (Struct msg -> ListOf ('Ptr 'Nothing) msg
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection Struct msg
struct)
        Maybe (Ptr msg) -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr msg)
ptr
        Maybe (Ptr msg) -> m ()
forall (m :: * -> *) (mut :: Mutability).
MonadLimit m =>
Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr msg)
ptr
        pure Maybe (Ptr msg)
ptr

checkPtr :: ReadCtx m mut => Maybe (Ptr mut) -> m ()
{-# INLINABLE checkPtr #-}
checkPtr :: Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr mut)
Nothing              = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkPtr (Just (PtrCap Cap mut
c))    = Cap mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m ()
checkCap Cap mut
c
checkPtr (Just (PtrList List mut
l))   = List mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
List mut -> m ()
checkList List mut
l
checkPtr (Just (PtrStruct Struct mut
s)) = Struct mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Struct mut -> m ()
checkStruct Struct mut
s

checkCap :: ReadCtx m mut => Cap mut -> m ()
{-# INLINABLE checkCap #-}
checkCap :: Cap mut -> m ()
checkCap (CapAt Message mut
_ Word32
_ ) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- No need to do anything here; an out of bounds index is just treated
    -- as null.

checkList :: ReadCtx m mut => List mut -> m ()
{-# INLINABLE checkList #-}
checkList :: List mut -> m ()
checkList (List0 ListOf ('Data 'Sz0) mut
l)      = ListOf ('Data 'Sz0) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz0) ListOf ('Data 'Sz0) mut
l
checkList (List1 ListOf ('Data 'Sz1) mut
l)      = ListOf ('Data 'Sz1) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz1) ListOf ('Data 'Sz1) mut
l
checkList (List8 ListOf ('Data 'Sz8) mut
l)      = ListOf ('Data 'Sz8) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz8) ListOf ('Data 'Sz8) mut
l
checkList (List16 ListOf ('Data 'Sz16) mut
l)     = ListOf ('Data 'Sz16) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz16) ListOf ('Data 'Sz16) mut
l
checkList (List32 ListOf ('Data 'Sz32) mut
l)     = ListOf ('Data 'Sz32) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz32) ListOf ('Data 'Sz32) mut
l
checkList (List64 ListOf ('Data 'Sz64) mut
l)     = ListOf ('Data 'Sz64) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz64) ListOf ('Data 'Sz64) mut
l
checkList (ListPtr ListOf ('Ptr 'Nothing) mut
l)    = ListOf ('Ptr 'Nothing) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Ptr 'Nothing) ListOf ('Ptr 'Nothing) mut
l
checkList (ListStruct ListOf ('Ptr ('Just 'Struct)) mut
l) = ListOf ('Ptr ('Just 'Struct)) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Ptr ('Just 'Struct)) ListOf ('Ptr ('Just 'Struct)) mut
l

checkNormalList :: ReadCtx m mut => NormalList mut -> BitCount -> m ()
{-# INLINABLE checkNormalList #-}
checkNormalList :: NormalList mut -> BitCount -> m ()
checkNormalList NormalList{WordPtr mut
nPtr :: WordPtr mut
nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr, Int
nLen :: Int
nLen :: forall (mut :: Mutability). NormalList mut -> Int
nLen} BitCount
eltSize =
    let nBits :: BitCount
nBits = Int -> BitCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nLen BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
* BitCount
eltSize
        nWords :: WordCount
nWords = ByteCount -> WordCount
bytesToWordsCeil (ByteCount -> WordCount) -> ByteCount -> WordCount
forall a b. (a -> b) -> a -> b
$ BitCount -> ByteCount
bitsToBytesCeil BitCount
nBits
    in
    WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
nPtr WordCount
nWords

checkStruct :: ReadCtx m mut => Struct mut -> m ()
{-# INLINABLE checkStruct #-}
checkStruct :: Struct mut -> m ()
checkStruct s :: Struct mut
s@(StructAt WordPtr mut
ptr Word16
_ Word16
_) =
    WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
ptr (Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structSize Struct mut
s)

checkPtrOffset :: ReadCtx m mut => M.WordPtr mut -> WordCount -> m ()
{-# INLINABLE checkPtrOffset #-}
checkPtrOffset :: WordPtr mut -> WordCount -> m ()
checkPtrOffset M.WordPtr{Segment mut
pSegment :: Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} WordCount
size = do
    WordCount
segWords <- Segment mut -> m WordCount
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> m WordCount
M.numWords Segment mut
pSegment
    let maxIndex :: Int
maxIndex = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
segWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WordCount
wordIndex WordCount -> WordCount -> Bool
forall a. Ord a => a -> a -> Bool
>= WordCount
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
index = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex, Int
maxIndex :: Int
maxIndex :: Int
maxIndex }
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
size WordCount -> WordCount -> Bool
forall a. Ord a => a -> a -> Bool
<= WordCount
segWords) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError
            { index :: Int
index = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
size) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            , Int
maxIndex :: Int
maxIndex :: Int
maxIndex
            }

structSize :: Struct mut -> WordCount
structSize :: Struct mut -> WordCount
structSize Struct mut
s = Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct mut
s WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct mut -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct mut
s)

-- | Invoice the traversal limit for all data reachable via the pointer
-- directly, i.e. without following further pointers.
--
-- The minimum possible cost is 1, and for lists will always be proportional
-- to the length of the list, even if the size of the elements is zero.
invoicePtr :: MonadLimit m => Maybe (Ptr mut) -> m ()
{-# INLINABLE invoicePtr #-}
{-# SPECIALIZE invoicePtr :: Maybe (Ptr ('Mut RealWorld)) -> LimitT IO () #-}
invoicePtr :: Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr mut)
p = WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice (WordCount -> m ()) -> WordCount -> m ()
forall a b. (a -> b) -> a -> b
$! Maybe (Ptr mut) -> WordCount
forall (mut :: Mutability). Maybe (Ptr mut) -> WordCount
ptrInvoiceSize Maybe (Ptr mut)
p

ptrInvoiceSize :: Maybe (Ptr mut) -> WordCount
{-# INLINABLE ptrInvoiceSize #-}
ptrInvoiceSize :: Maybe (Ptr mut) -> WordCount
ptrInvoiceSize = \case
    Maybe (Ptr mut)
Nothing            -> WordCount
1
    Just (PtrCap Cap mut
_)    -> WordCount
1
    Just (PtrStruct Struct mut
s) -> Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structInvoiceSize Struct mut
s
    Just (PtrList List mut
l)   -> List mut -> WordCount
forall (mut :: Mutability). List mut -> WordCount
listInvoiceSize List mut
l
listInvoiceSize :: List mut -> WordCount
{-# INLINABLE listInvoiceSize #-}
listInvoiceSize :: List mut -> WordCount
listInvoiceSize List mut
l = WordCount -> WordCount -> WordCount
forall a. Ord a => a -> a -> a
max WordCount
1 (WordCount -> WordCount) -> WordCount -> WordCount
forall a b. (a -> b) -> a -> b
$! case List mut
l of
    List0 ListOf ('Data 'Sz0) mut
l   -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz0) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) mut
l
    List1 ListOf ('Data 'Sz1) mut
l   -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz1) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz1) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64
    List8 ListOf ('Data 'Sz8) mut
l   -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz8) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz8) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
8
    List16 ListOf ('Data 'Sz16) mut
l  -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz16) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz16) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
4
    List32 ListOf ('Data 'Sz32) mut
l  -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz32) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz32) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`  Int
2
    List64 ListOf ('Data 'Sz64) mut
l  -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz64) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz64) mut
l
    ListPtr ListOf ('Ptr 'Nothing) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Ptr 'Nothing) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr 'Nothing) mut
l
    ListStruct (ListOf (StructList s len)) ->
        Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structInvoiceSize Struct mut
s WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
* Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
structInvoiceSize :: Struct mut -> WordCount
{-# INLINABLE structInvoiceSize #-}
structInvoiceSize :: Struct mut -> WordCount
structInvoiceSize (StructAt WordPtr mut
_ Word16
dataSz Word16
ptrSz) =
    WordCount -> WordCount -> WordCount
forall a. Ord a => a -> a -> a
max WordCount
1 (Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)

-- | @'setData' value i struct@ sets the @i@th word in the struct's data section
-- to @value@.
{-# INLINE setData #-}
setData :: (ReadCtx m ('Mut s), M.WriteCtx m s)
    => Word64 -> Int -> Struct ('Mut s) -> m ()
setData :: Word64 -> Int -> Struct ('Mut s) -> m ()
setData Word64
value Int
i = Unwrapped (Untyped ('Data 'Sz64) ('Mut s))
-> Int -> ListOf ('Data 'Sz64) ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Word64
Unwrapped (Untyped ('Data 'Sz64) ('Mut s))
value Int
i (ListOf ('Data 'Sz64) ('Mut s) -> m ())
-> (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s))
-> Struct ('Mut s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection

-- | @'setData' value i struct@ sets the @i@th pointer in the struct's pointer
-- section to @value@.
setPtr :: (ReadCtx m ('Mut s), M.WriteCtx m s) => Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
{-# INLINE setPtr #-}
setPtr :: Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
setPtr Maybe (Ptr ('Mut s))
value Int
i = Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
-> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Maybe (Ptr ('Mut s))
Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
value Int
i (ListOf ('Ptr 'Nothing) ('Mut s) -> m ())
-> (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s))
-> Struct ('Mut s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection

-- | 'rawBytes' returns the raw bytes corresponding to the list.
rawBytes :: ReadCtx m 'Const => ListOf ('Data 'Sz8) 'Const -> m BS.ByteString
{-# INLINABLE rawBytes #-}
-- TODO: we can get away with a more lax context than ReadCtx, maybe even make
-- this non-monadic.
rawBytes :: ListOf ('Data 'Sz8) 'Const -> m ByteString
rawBytes (ListOf (NormalList M.WordPtr{pSegment, pAddr=WordAt{wordIndex}} len)) = do
    let bytes :: ByteString
bytes = Segment 'Const -> ByteString
M.toByteString Segment 'Const
pSegment
    let ByteCount Int
byteOffset = WordCount -> ByteCount
wordsToBytes WordCount
wordIndex
    ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
byteOffset ByteString
bytes


-- | Returns the root pointer of a message.
rootPtr :: ReadCtx m mut => M.Message mut -> m (Struct mut)
{-# INLINABLE rootPtr #-}
rootPtr :: Message mut -> m (Struct mut)
rootPtr Message mut
msg = do
    Segment mut
seg <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
    Maybe (Ptr mut)
root <- WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
        { pMessage :: Message mut
pMessage = Message mut
msg
        , pSegment :: Segment mut
pSegment = Segment mut
seg
        , pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0
        }
    Maybe (Ptr mut) -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr mut)
root
    Maybe (Ptr mut) -> m ()
forall (m :: * -> *) (mut :: Mutability).
MonadLimit m =>
Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr mut)
root
    case Maybe (Ptr mut)
root of
        Just (PtrStruct Struct mut
struct) -> Struct mut -> m (Struct mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct mut
struct
        Maybe (Ptr mut)
Nothing -> Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
        Maybe (Ptr mut)
_ -> Error -> m (Struct mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Struct mut)) -> Error -> m (Struct mut)
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError
                String
"Unexpected root type; expected struct."


-- | Make the given struct the root object of its message.
setRoot :: M.WriteCtx m s => Struct ('Mut s) -> m ()
{-# INLINABLE setRoot #-}
setRoot :: Struct ('Mut s) -> m ()
setRoot (StructAt M.WordPtr{Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAddr
addr} Word16
dataSz Word16
ptrSz) = do
    Segment ('Mut s)
pSegment <- Message ('Mut s) -> Int -> m (Segment ('Mut s))
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message ('Mut s)
pMessage Int
0
    let rootPtr :: WordPtr ('Mut s)
rootPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr{Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage, Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0}
    WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo WordPtr ('Mut s)
rootPtr WordAddr
addr (Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz)


-- | An instace of @'Allocate'@ specifies how to allocate a value with a given representation.
-- This only makes sense for pointers of course, so it is defined on PtrRepr. Of the well-kinded
-- types, only @'List 'Nothing@ is missing an instance.
class Allocate (r :: PtrRepr) where
    -- | Extra information needed to allocate a value:
    --
    -- * For structs, the sizes of the sections.
    -- * For capabilities, the client to attach to the messages.
    -- * For lists, the length, and for composite lists, the struct sizes as well.
    type AllocHint r

    -- | Allocate a value of the given type.
    alloc :: RWCtx m s => M.Message ('Mut s) -> AllocHint r -> m (Unwrapped (UntypedSomePtr r ('Mut s)))

instance Allocate 'Struct where
    type AllocHint 'Struct = (Word16, Word16)
    alloc :: Message ('Mut s)
-> AllocHint 'Struct
-> m (Unwrapped (UntypedSomePtr 'Struct ('Mut s)))
alloc Message ('Mut s)
msg = (Word16 -> Word16 -> m (Struct ('Mut s)))
-> (Word16, Word16) -> m (Struct ('Mut s))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct Message ('Mut s)
msg)
instance Allocate 'Cap where
    type AllocHint 'Cap = M.Client
    alloc :: Message ('Mut s)
-> AllocHint 'Cap -> m (Unwrapped (UntypedSomePtr 'Cap ('Mut s)))
alloc = Message ('Mut s)
-> AllocHint 'Cap -> m (Unwrapped (UntypedSomePtr 'Cap ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap
instance Allocate ('List ('Just 'ListComposite)) where
    type AllocHint ('List ('Just 'ListComposite)) = (Int, AllocHint 'Struct)
    alloc :: Message ('Mut s)
-> AllocHint ('List ('Just 'ListComposite))
-> m (Unwrapped
        (UntypedSomePtr ('List ('Just 'ListComposite)) ('Mut s)))
alloc Message ('Mut s)
msg (len, (nWords, nPtrs)) = Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList Message ('Mut s)
msg Word16
nWords Word16
nPtrs Int
len
instance AllocateNormalList r => Allocate ('List ('Just ('ListNormal r))) where
    type AllocHint ('List ('Just ('ListNormal r))) = Int
    alloc :: Message ('Mut s)
-> AllocHint ('List ('Just ('ListNormal r)))
-> m (Unwrapped
        (UntypedSomePtr ('List ('Just ('ListNormal r))) ('Mut s)))
alloc = forall (m :: * -> *) s.
(AllocateNormalList r, RWCtx m s) =>
Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))
forall (r :: NormalListRepr) (m :: * -> *) s.
(AllocateNormalList r, RWCtx m s) =>
Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))
allocNormalList @r

-- | Like 'Allocate', but specialized to normal (non-composite) lists.
--
-- Instead of an 'AllocHint' type family, the hint is always an 'Int',
-- which is the number of elements.
class AllocateNormalList (r :: NormalListRepr) where
    allocNormalList
        :: RWCtx m s
        => M.Message ('Mut s) -> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))

instance AllocateNormalList ('NormalListData 'Sz0) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz0)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz0)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0
instance AllocateNormalList ('NormalListData 'Sz1) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz1)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz1)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1
instance AllocateNormalList ('NormalListData 'Sz8) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz8)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz8)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8
instance AllocateNormalList ('NormalListData 'Sz16) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz16)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz16)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16
instance AllocateNormalList ('NormalListData 'Sz32) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz32)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz32)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32
instance AllocateNormalList ('NormalListData 'Sz64) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz64)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
        ('ListNormal ('NormalListData 'Sz64)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64
instance AllocateNormalList 'NormalListPtr where allocNormalList :: Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal 'NormalListPtr) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal 'NormalListPtr) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr

-- | Allocate a struct in the message.
allocStruct :: M.WriteCtx m s => M.Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
{-# INLINABLE allocStruct #-}
allocStruct :: Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct Message ('Mut s)
msg Word16
dataSz Word16
ptrSz = do
    let totalSz :: WordCount
totalSz = Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
    WordPtr ('Mut s)
ptr <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
totalSz
    pure $ WordPtr ('Mut s) -> Word16 -> Word16 -> Struct ('Mut s)
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr ('Mut s)
ptr Word16
dataSz Word16
ptrSz

-- | Allocate a composite list.
allocCompositeList
    :: M.WriteCtx m s
    => M.Message ('Mut s) -- ^ The message to allocate in.
    -> Word16     -- ^ The size of the data section
    -> Word16     -- ^ The size of the pointer section
    -> Int        -- ^ The length of the list in elements.
    -> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
{-# INLINABLE allocCompositeList #-}
allocCompositeList :: Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList Message ('Mut s)
msg Word16
dataSz Word16
ptrSz Int
len = do
    let eltSize :: Int
eltSize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
    ptr :: WordPtr ('Mut s)
ptr@M.WordPtr{Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}
        <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg (Int -> WordCount
WordCount (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
eltSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) -- + 1 for the tag word.
    Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
pSegment WordCount
wordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr -> Word64
P.serializePtr' (Ptr -> Word64) -> Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Word16
dataSz Word16
ptrSz
    let firstStruct :: Struct ('Mut s)
firstStruct = WordPtr ('Mut s) -> Word16 -> Word16 -> Struct ('Mut s)
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
            WordPtr ('Mut s)
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 } }
            Word16
dataSz
            Word16
ptrSz
    ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf ('Ptr ('Just 'Struct)) ('Mut s)
 -> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s)))
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall a b. (a -> b) -> a -> b
$ ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
 -> ListOf ('Ptr ('Just 'Struct)) ('Mut s))
-> ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> Int -> StructList ('Mut s)
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList Struct ('Mut s)
firstStruct Int
len

-- | Allocate a list of capnproto @Void@ values.
allocList0   :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
{-# INLINABLE allocList0 #-}

-- | Allocate a list of booleans
allocList1   :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
{-# INLINABLE allocList1 #-}

-- | Allocate a list of 8-bit values.
allocList8   :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
{-# INLINABLE allocList8 #-}

-- | Allocate a list of 16-bit values.
allocList16  :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
{-# INLINABLE allocList16 #-}

-- | Allocate a list of 32-bit values.
allocList32  :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
{-# INLINABLE allocList32 #-}

-- | Allocate a list of 64-bit words.
allocList64  :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
{-# INLINABLE allocList64 #-}

-- | Allocate a list of pointers.
allocListPtr :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
{-# INLINABLE allocListPtr #-}

allocList0 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0   Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz0) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz0) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz0) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
0  Message ('Mut s)
msg Int
len
allocList1 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1   Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz1) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz1) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
1  Message ('Mut s)
msg Int
len
allocList8 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8   Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz8) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz8) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
8  Message ('Mut s)
msg Int
len
allocList16 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16  Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz16) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz16) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz16) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
16 Message ('Mut s)
msg Int
len
allocList32 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32  Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz32) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz32) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz32) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
32 Message ('Mut s)
msg Int
len
allocList64 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64  Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz64) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
64 Message ('Mut s)
msg Int
len
allocListPtr :: Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
64 Message ('Mut s)
msg Int
len

-- | Allocate a NormalList
allocNormalList'
    :: M.WriteCtx m s
    => Int                  -- ^ The number bits per element
    -> M.Message ('Mut s) -- ^ The message to allocate in
    -> Int                  -- ^ The number of elements in the list.
    -> m (NormalList ('Mut s))
{-# INLINABLE allocNormalList' #-}
allocNormalList' :: Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
bitsPerElt Message ('Mut s)
msg Int
len = do
    -- round 'len' up to the nearest word boundary.
    let totalBits :: BitCount
totalBits = Int -> BitCount
BitCount (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitsPerElt)
        totalWords :: WordCount
totalWords = ByteCount -> WordCount
bytesToWordsCeil (ByteCount -> WordCount) -> ByteCount -> WordCount
forall a b. (a -> b) -> a -> b
$ BitCount -> ByteCount
bitsToBytesCeil BitCount
totalBits
    WordPtr ('Mut s)
ptr <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
totalWords
    pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList { nPtr :: WordPtr ('Mut s)
nPtr = WordPtr ('Mut s)
ptr, nLen :: Int
nLen = Int
len }

appendCap :: M.WriteCtx m s => M.Message ('Mut s) -> M.Client -> m (Cap ('Mut s))
{-# INLINABLE appendCap #-}
appendCap :: Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap Message ('Mut s)
msg Client
client = do
    Int
i <- Message ('Mut s) -> Client -> m Int
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m Int
M.appendCap Message ('Mut s)
msg Client
client
    pure $ Message ('Mut s) -> Word32 -> Cap ('Mut s)
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message ('Mut s)
msg (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

instance MaybeMutable (ListRepOf r) => MaybeMutable (ListOf r) where
    thaw :: ListOf r 'Const -> m (ListOf r ('Mut s))
thaw         (ListOf ListRepOf r 'Const
l) = ListRepOf r ('Mut s) -> ListOf r ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r ('Mut s) -> ListOf r ('Mut s))
-> m (ListRepOf r ('Mut s)) -> m (ListOf r ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r 'Const -> m (ListRepOf r ('Mut s))
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
thaw ListRepOf r 'Const
l
    freeze :: ListOf r ('Mut s) -> m (ListOf r 'Const)
freeze       (ListOf ListRepOf r ('Mut s)
l) = ListRepOf r 'Const -> ListOf r 'Const
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r 'Const -> ListOf r 'Const)
-> m (ListRepOf r 'Const) -> m (ListOf r 'Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r ('Mut s) -> m (ListRepOf r 'Const)
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
freeze ListRepOf r ('Mut s)
l
    unsafeThaw :: ListOf r 'Const -> m (ListOf r ('Mut s))
unsafeThaw   (ListOf ListRepOf r 'Const
l) = ListRepOf r ('Mut s) -> ListOf r ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r ('Mut s) -> ListOf r ('Mut s))
-> m (ListRepOf r ('Mut s)) -> m (ListOf r ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r 'Const -> m (ListRepOf r ('Mut s))
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
unsafeThaw ListRepOf r 'Const
l
    unsafeFreeze :: ListOf r ('Mut s) -> m (ListOf r 'Const)
unsafeFreeze (ListOf ListRepOf r ('Mut s)
l) = ListRepOf r 'Const -> ListOf r 'Const
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r 'Const -> ListOf r 'Const)
-> m (ListRepOf r 'Const) -> m (ListOf r 'Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r ('Mut s) -> m (ListRepOf r 'Const)
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
unsafeFreeze ListRepOf r ('Mut s)
l


-------------------------------------------------------------------------------
-- Helpers generated MaybeMutable instances
-------------------------------------------------------------------------------

-- trivial wrapaper around CatchT, so we can add a PrimMonad instance.
newtype CatchTWrap m a = CatchTWrap { CatchTWrap m a -> CatchT m a
runCatchTWrap :: CatchT m a }
    deriving(a -> CatchTWrap m b -> CatchTWrap m a
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
(forall a b. (a -> b) -> CatchTWrap m a -> CatchTWrap m b)
-> (forall a b. a -> CatchTWrap m b -> CatchTWrap m a)
-> Functor (CatchTWrap m)
forall a b. a -> CatchTWrap m b -> CatchTWrap m a
forall a b. (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
a -> CatchTWrap m b -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CatchTWrap m b -> CatchTWrap m a
$c<$ :: forall (m :: * -> *) a b.
Monad m =>
a -> CatchTWrap m b -> CatchTWrap m a
fmap :: (a -> b) -> CatchTWrap m a -> CatchTWrap m b
$cfmap :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
Functor, Functor (CatchTWrap m)
a -> CatchTWrap m a
Functor (CatchTWrap m)
-> (forall a. a -> CatchTWrap m a)
-> (forall a b.
    CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b)
-> (forall a b c.
    (a -> b -> c)
    -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a)
-> Applicative (CatchTWrap m)
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall a. a -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a b.
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall a b c.
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall (m :: * -> *). Monad m => Functor (CatchTWrap m)
forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
*> :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
liftA2 :: (a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
<*> :: CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
pure :: a -> CatchTWrap m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (CatchTWrap m)
Applicative, Applicative (CatchTWrap m)
a -> CatchTWrap m a
Applicative (CatchTWrap m)
-> (forall a b.
    CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b)
-> (forall a. a -> CatchTWrap m a)
-> Monad (CatchTWrap m)
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a. a -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a b.
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
forall (m :: * -> *). Monad m => Applicative (CatchTWrap m)
forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CatchTWrap m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
>> :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
>>= :: CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (CatchTWrap m)
Monad, m a -> CatchTWrap m a
(forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a)
-> MonadTrans CatchTWrap
forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> CatchTWrap m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a
MonadTrans, Monad (CatchTWrap m)
e -> CatchTWrap m a
Monad (CatchTWrap m)
-> (forall e a. Exception e => e -> CatchTWrap m a)
-> MonadThrow (CatchTWrap m)
forall e a. Exception e => e -> CatchTWrap m a
forall (m :: * -> *). Monad m => Monad (CatchTWrap m)
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *) e a.
(Monad m, Exception e) =>
e -> CatchTWrap m a
throwM :: e -> CatchTWrap m a
$cthrowM :: forall (m :: * -> *) e a.
(Monad m, Exception e) =>
e -> CatchTWrap m a
$cp1MonadThrow :: forall (m :: * -> *). Monad m => Monad (CatchTWrap m)
MonadThrow, MonadThrow (CatchTWrap m)
MonadThrow (CatchTWrap m)
-> (forall e a.
    Exception e =>
    CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a)
-> MonadCatch (CatchTWrap m)
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall e a.
Exception e =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall (m :: * -> *). Monad m => MonadThrow (CatchTWrap m)
forall (m :: * -> *) e a.
(Monad m, Exception e) =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
$ccatch :: forall (m :: * -> *) e a.
(Monad m, Exception e) =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
$cp1MonadCatch :: forall (m :: * -> *). Monad m => MonadThrow (CatchTWrap m)
MonadCatch)

instance PrimMonad m => PrimMonad (CatchTWrap m) where
    type PrimState (CatchTWrap m) = PrimState m
    primitive :: (State# (PrimState (CatchTWrap m))
 -> (# State# (PrimState (CatchTWrap m)), a #))
-> CatchTWrap m a
primitive = m a -> CatchTWrap m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CatchTWrap m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> CatchTWrap m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

-- | @runCatchImpure m@ runs @m@, and if it throws, raises the
-- exception with 'impureThrow'.
runCatchImpure :: Monad m => CatchTWrap m a -> m a
{-# INLINABLE runCatchImpure #-}
runCatchImpure :: CatchTWrap m a -> m a
runCatchImpure CatchTWrap m a
m = do
    Either SomeException a
res <- CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m a -> m (Either SomeException a))
-> CatchT m a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ CatchTWrap m a -> CatchT m a
forall (m :: * -> *) a. CatchTWrap m a -> CatchT m a
runCatchTWrap CatchTWrap m a
m
    pure $ case Either SomeException a
res of
        Left SomeException
e  -> SomeException -> a
forall e a. Exception e => e -> a
impureThrow SomeException
e
        Right a
v -> a
v

-------------------------------------------------------------------------------
-- Generated MaybeMutable instances
-------------------------------------------------------------------------------

do
    let mkWrappedInstance name =
            let f = pure $ TH.ConT name in
            [d|instance MaybeMutable $f where
                thaw         = runCatchImpure . tMsg thaw
                freeze       = runCatchImpure . tMsg freeze
                unsafeThaw   = runCatchImpure . tMsg unsafeThaw
                unsafeFreeze = runCatchImpure . tMsg unsafeFreeze
            |]
    concat <$> traverse mkWrappedInstance
        [ ''Ptr
        , ''List
        , ''NormalList
        , ''Struct
        ]

do
    let mkIsListPtrRepr (r, listC, str) =
            [d| instance IsListPtrRepr $r where
                    rToList = $(pure $ TH.ConE listC)
                    rFromList $(pure $ TH.ConP listC [TH.VarP (TH.mkName "l")]) = pure l
                    rFromList _ = expected $(pure $ TH.LitE $ TH.StringL $ "pointer to " ++ str)
                    rFromListMsg = messageDefault @(Untyped ('Ptr ('Just ('List ('Just $r)))))
            |]
    concat <$> traverse mkIsListPtrRepr
        [ ( [t| 'ListNormal ('NormalListData 'Sz0) |]
          , 'List0
          , "List(Void)"
          )
        , ( [t| 'ListNormal ('NormalListData 'Sz1) |]
          , 'List1
          , "List(Bool)"
          )
        , ( [t| 'ListNormal ('NormalListData 'Sz8) |]
          , 'List8
          , "List(UInt8)"
          )
        , ( [t| 'ListNormal ('NormalListData 'Sz16) |]
          , 'List16
          , "List(UInt16)"
          )
        , ( [t| 'ListNormal ('NormalListData 'Sz32) |]
          , 'List32
          , "List(UInt32)"
          )
        , ( [t| 'ListNormal ('NormalListData 'Sz64) |]
          , 'List64
          , "List(UInt64)"
          )
        , ( [t| 'ListNormal 'NormalListPtr |]
          , 'ListPtr
          , "List(AnyPointer)"
          )
        , ( [t| 'ListComposite |]
          , 'ListStruct
          , "composite list"
          )
        ]