{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}
{-|
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 a Message
type (see "Capnp.Message"), used as the underlying storage.
-}
module Capnp.Untyped
    ( Ptr(..), List(..), Struct, ListOf, Cap
    , structByteCount
    , structWordCount
    , structPtrCount
    , structListByteCount
    , structListWordCount
    , structListPtrCount
    , getData, getPtr
    , setData, setPtr
    , copyStruct
    , getClient
    , get, index, length
    , 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.Monad       (forM_)
import Control.Monad.Catch (MonadThrow(throwM))

import qualified Data.ByteString as BS

import Capnp.Address (OffsetError (..), WordAddr (..), pointerFrom)
import Capnp.Bits
    ( BitCount (..)
    , ByteCount (..)
    , Word1 (..)
    , WordCount (..)
    , bitsToBytesCeil
    , bytesToWordsCeil
    , replaceBits
    , wordsToBytes
    )
import Capnp.Pointer        (ElementSize (..))
import Capnp.TraversalLimit (MonadLimit(invoice))
import Data.Mutable         (Thaw (..))

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

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

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

-- | 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 msg
    = PtrCap (Cap msg)
    | PtrList (List msg)
    | PtrStruct (Struct msg)

-- | A list of values (of arbitrary type) in a message.
data List msg
    = List0 (ListOf msg ())
    | List1 (ListOf msg Bool)
    | List8 (ListOf msg Word8)
    | List16 (ListOf msg Word16)
    | List32 (ListOf msg Word32)
    | List64 (ListOf msg Word64)
    | ListPtr (ListOf msg (Maybe (Ptr msg)))
    | ListStruct (ListOf msg (Struct msg))

-- | A "normal" (non-composite) list.
data NormalList msg = NormalList
    { NormalList msg -> msg
nMsg  :: msg
    , NormalList msg -> WordAddr
nAddr :: WordAddr
    , NormalList msg -> Int
nLen  :: Int
    }

-- | A list of values of type 'a' in a message.
data ListOf msg a where
    ListOfStruct
        :: Struct msg -- First element. data/ptr sizes are the same for
                      -- all elements.
        -> !Int       -- Number of elements
        -> ListOf msg (Struct msg)
    ListOfVoid   :: !(NormalList msg) -> ListOf msg ()
    ListOfBool   :: !(NormalList msg) -> ListOf msg Bool
    ListOfWord8  :: !(NormalList msg) -> ListOf msg Word8
    ListOfWord16 :: !(NormalList msg) -> ListOf msg Word16
    ListOfWord32 :: !(NormalList msg) -> ListOf msg Word32
    ListOfWord64 :: !(NormalList msg) -> ListOf msg Word64
    ListOfPtr    :: !(NormalList msg) -> ListOf msg (Maybe (Ptr msg))

-- | A Capability in a message.
data Cap msg = Cap msg !Word32

-- | A struct value in a message.
data Struct msg
    = Struct
        msg
        !WordAddr -- Start of struct
        !Word16 -- Data section size.
        !Word16 -- Pointer section size.

-- | 'TraverseMsg' is basically '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 because 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.
class TraverseMsg f where
    tMsg :: Applicative m => (msgA -> m msgB) -> f msgA -> m (f msgB)

instance TraverseMsg Ptr where
    tMsg :: (msgA -> m msgB) -> Ptr msgA -> m (Ptr msgB)
tMsg msgA -> m msgB
f = \case
        PtrCap Cap msgA
cap ->
            Cap msgB -> Ptr msgB
forall msg. Cap msg -> Ptr msg
PtrCap (Cap msgB -> Ptr msgB) -> m (Cap msgB) -> m (Ptr msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> Cap msgA -> m (Cap msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f Cap msgA
cap
        PtrList List msgA
l ->
            List msgB -> Ptr msgB
forall msg. List msg -> Ptr msg
PtrList (List msgB -> Ptr msgB) -> m (List msgB) -> m (Ptr msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> List msgA -> m (List msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f List msgA
l
        PtrStruct Struct msgA
s ->
            Struct msgB -> Ptr msgB
forall msg. Struct msg -> Ptr msg
PtrStruct (Struct msgB -> Ptr msgB) -> m (Struct msgB) -> m (Ptr msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> Struct msgA -> m (Struct msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f Struct msgA
s

instance TraverseMsg Cap where
    tMsg :: (msgA -> m msgB) -> Cap msgA -> m (Cap msgB)
tMsg msgA -> m msgB
f (Cap msgA
msg Word32
n) = msgB -> Word32 -> Cap msgB
forall msg. msg -> Word32 -> Cap msg
Cap (msgB -> Word32 -> Cap msgB) -> m msgB -> m (Word32 -> Cap msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msgA -> m msgB
f msgA
msg m (Word32 -> Cap msgB) -> m Word32 -> m (Cap msgB)
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 :: (msgA -> m msgB) -> Struct msgA -> m (Struct msgB)
tMsg msgA -> m msgB
f (Struct msgA
msg WordAddr
addr Word16
dataSz Word16
ptrSz) = msgB -> WordAddr -> Word16 -> Word16 -> Struct msgB
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct
        (msgB -> WordAddr -> Word16 -> Word16 -> Struct msgB)
-> m msgB -> m (WordAddr -> Word16 -> Word16 -> Struct msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msgA -> m msgB
f msgA
msg
        m (WordAddr -> Word16 -> Word16 -> Struct msgB)
-> m WordAddr -> m (Word16 -> Word16 -> Struct msgB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WordAddr -> m WordAddr
forall (f :: * -> *) a. Applicative f => a -> f a
pure WordAddr
addr
        m (Word16 -> Word16 -> Struct msgB)
-> m Word16 -> m (Word16 -> Struct msgB)
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 msgB) -> m Word16 -> m (Struct msgB)
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 :: (msgA -> m msgB) -> List msgA -> m (List msgB)
tMsg msgA -> m msgB
f = \case
        List0      ListOf msgA ()
l -> ListOf msgB () -> List msgB
forall msg. ListOf msg () -> List msg
List0      (ListOf msgB () -> List msgB)
-> (FlipList () msgB -> ListOf msgB ())
-> FlipList () msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList () msgB -> ListOf msgB ()
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList () msgB -> List msgB)
-> m (FlipList () msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> FlipList () msgA -> m (FlipList () msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA () -> FlipList () msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA ()
l)
        List1      ListOf msgA Bool
l -> ListOf msgB Bool -> List msgB
forall msg. ListOf msg Bool -> List msg
List1      (ListOf msgB Bool -> List msgB)
-> (FlipList Bool msgB -> ListOf msgB Bool)
-> FlipList Bool msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList Bool msgB -> ListOf msgB Bool
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList Bool msgB -> List msgB)
-> m (FlipList Bool msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> FlipList Bool msgA -> m (FlipList Bool msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA Bool -> FlipList Bool msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA Bool
l)
        List8      ListOf msgA Word8
l -> ListOf msgB Word8 -> List msgB
forall msg. ListOf msg Word8 -> List msg
List8      (ListOf msgB Word8 -> List msgB)
-> (FlipList Word8 msgB -> ListOf msgB Word8)
-> FlipList Word8 msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList Word8 msgB -> ListOf msgB Word8
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList Word8 msgB -> List msgB)
-> m (FlipList Word8 msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> FlipList Word8 msgA -> m (FlipList Word8 msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA Word8 -> FlipList Word8 msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA Word8
l)
        List16     ListOf msgA Word16
l -> ListOf msgB Word16 -> List msgB
forall msg. ListOf msg Word16 -> List msg
List16     (ListOf msgB Word16 -> List msgB)
-> (FlipList Word16 msgB -> ListOf msgB Word16)
-> FlipList Word16 msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList Word16 msgB -> ListOf msgB Word16
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList Word16 msgB -> List msgB)
-> m (FlipList Word16 msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB)
-> FlipList Word16 msgA -> m (FlipList Word16 msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA Word16 -> FlipList Word16 msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA Word16
l)
        List32     ListOf msgA Word32
l -> ListOf msgB Word32 -> List msgB
forall msg. ListOf msg Word32 -> List msg
List32     (ListOf msgB Word32 -> List msgB)
-> (FlipList Word32 msgB -> ListOf msgB Word32)
-> FlipList Word32 msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList Word32 msgB -> ListOf msgB Word32
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList Word32 msgB -> List msgB)
-> m (FlipList Word32 msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB)
-> FlipList Word32 msgA -> m (FlipList Word32 msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA Word32 -> FlipList Word32 msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA Word32
l)
        List64     ListOf msgA Word64
l -> ListOf msgB Word64 -> List msgB
forall msg. ListOf msg Word64 -> List msg
List64     (ListOf msgB Word64 -> List msgB)
-> (FlipList Word64 msgB -> ListOf msgB Word64)
-> FlipList Word64 msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipList Word64 msgB -> ListOf msgB Word64
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList Word64 msgB -> List msgB)
-> m (FlipList Word64 msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB)
-> FlipList Word64 msgA -> m (FlipList Word64 msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA Word64 -> FlipList Word64 msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA Word64
l)
        ListPtr    ListOf msgA (Maybe (Ptr msgA))
l -> ListOf msgB (Maybe (Ptr msgB)) -> List msgB
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
ListPtr    (ListOf msgB (Maybe (Ptr msgB)) -> List msgB)
-> (FlipListP msgB -> ListOf msgB (Maybe (Ptr msgB)))
-> FlipListP msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipListP msgB -> ListOf msgB (Maybe (Ptr msgB))
forall msg. FlipListP msg -> ListOf msg (Maybe (Ptr msg))
unflipP (FlipListP msgB -> List msgB)
-> m (FlipListP msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> FlipListP msgA -> m (FlipListP msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA (Maybe (Ptr msgA)) -> FlipListP msgA
forall msg. ListOf msg (Maybe (Ptr msg)) -> FlipListP msg
FlipListP ListOf msgA (Maybe (Ptr msgA))
l)
        ListStruct ListOf msgA (Struct msgA)
l -> ListOf msgB (Struct msgB) -> List msgB
forall msg. ListOf msg (Struct msg) -> List msg
ListStruct (ListOf msgB (Struct msgB) -> List msgB)
-> (FlipListS msgB -> ListOf msgB (Struct msgB))
-> FlipListS msgB
-> List msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlipListS msgB -> ListOf msgB (Struct msgB)
forall msg. FlipListS msg -> ListOf msg (Struct msg)
unflipS (FlipListS msgB -> List msgB)
-> m (FlipListS msgB) -> m (List msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> FlipListS msgA -> m (FlipListS msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f (ListOf msgA (Struct msgA) -> FlipListS msgA
forall msg. ListOf msg (Struct msg) -> FlipListS msg
FlipListS ListOf msgA (Struct msgA)
l)

instance TraverseMsg NormalList where
    tMsg :: (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
tMsg msgA -> m msgB
f NormalList{msgA
Int
WordAddr
nLen :: Int
nAddr :: WordAddr
nMsg :: msgA
nLen :: forall msg. NormalList msg -> Int
nAddr :: forall msg. NormalList msg -> WordAddr
nMsg :: forall msg. NormalList msg -> msg
..} = do
        msgB
msg <- msgA -> m msgB
f msgA
nMsg
        pure NormalList :: forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList { nMsg :: msgB
nMsg = msgB
msg, Int
WordAddr
nLen :: Int
nAddr :: WordAddr
nLen :: Int
nAddr :: WordAddr
.. }

-------------------------------------------------------------------------------
-- newtype wrappers for the purpose of implementing 'TraverseMsg'; these adjust
-- the shape of 'ListOf' so that we can define an instance. We need a couple
-- different wrappers depending on the shape of the element type.
-------------------------------------------------------------------------------

-- 'FlipList' wraps a @ListOf msg a@ where 'a' is of kind @*@.
newtype FlipList  a msg = FlipList  { FlipList a msg -> ListOf msg a
unflip  :: ListOf msg a                 }

-- 'FlipListS' wraps a @ListOf msg (Struct msg)@. We can't use 'FlipList' for
-- our instances, because we need both instances of the 'msg' parameter to stay
-- equal.
newtype FlipListS   msg = FlipListS { FlipListS msg -> ListOf msg (Struct msg)
unflipS :: ListOf msg (Struct msg)      }

-- 'FlipListP' wraps a @ListOf msg (Maybe (Ptr msg))@. Pointers can't use
-- 'FlipList' for the same reason as structs.
newtype FlipListP   msg = FlipListP { FlipListP msg -> ListOf msg (Maybe (Ptr msg))
unflipP :: ListOf msg (Maybe (Ptr msg)) }

-------------------------------------------------------------------------------
-- 'TraverseMsg' instances for 'FlipList'
-------------------------------------------------------------------------------

instance TraverseMsg (FlipList ()) where
    tMsg :: (msgA -> m msgB) -> FlipList () msgA -> m (FlipList () msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfVoid   NormalList msgA
nlist)) = ListOf msgB () -> FlipList () msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB () -> FlipList () msgB)
-> (NormalList msgB -> ListOf msgB ())
-> NormalList msgB
-> FlipList () msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB ()
forall msg. NormalList msg -> ListOf msg ()
ListOfVoid (NormalList msgB -> FlipList () msgB)
-> m (NormalList msgB) -> m (FlipList () msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg (FlipList Bool) where
    tMsg :: (msgA -> m msgB) -> FlipList Bool msgA -> m (FlipList Bool msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfBool   NormalList msgA
nlist)) = ListOf msgB Bool -> FlipList Bool msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB Bool -> FlipList Bool msgB)
-> (NormalList msgB -> ListOf msgB Bool)
-> NormalList msgB
-> FlipList Bool msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB Bool
forall msg. NormalList msg -> ListOf msg Bool
ListOfBool   (NormalList msgB -> FlipList Bool msgB)
-> m (NormalList msgB) -> m (FlipList Bool msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg (FlipList Word8) where
    tMsg :: (msgA -> m msgB) -> FlipList Word8 msgA -> m (FlipList Word8 msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfWord8  NormalList msgA
nlist)) = ListOf msgB Word8 -> FlipList Word8 msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB Word8 -> FlipList Word8 msgB)
-> (NormalList msgB -> ListOf msgB Word8)
-> NormalList msgB
-> FlipList Word8 msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB Word8
forall msg. NormalList msg -> ListOf msg Word8
ListOfWord8  (NormalList msgB -> FlipList Word8 msgB)
-> m (NormalList msgB) -> m (FlipList Word8 msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg (FlipList Word16) where
    tMsg :: (msgA -> m msgB)
-> FlipList Word16 msgA -> m (FlipList Word16 msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfWord16 NormalList msgA
nlist)) = ListOf msgB Word16 -> FlipList Word16 msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB Word16 -> FlipList Word16 msgB)
-> (NormalList msgB -> ListOf msgB Word16)
-> NormalList msgB
-> FlipList Word16 msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB Word16
forall msg. NormalList msg -> ListOf msg Word16
ListOfWord16 (NormalList msgB -> FlipList Word16 msgB)
-> m (NormalList msgB) -> m (FlipList Word16 msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg (FlipList Word32) where
    tMsg :: (msgA -> m msgB)
-> FlipList Word32 msgA -> m (FlipList Word32 msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfWord32 NormalList msgA
nlist)) = ListOf msgB Word32 -> FlipList Word32 msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB Word32 -> FlipList Word32 msgB)
-> (NormalList msgB -> ListOf msgB Word32)
-> NormalList msgB
-> FlipList Word32 msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB Word32
forall msg. NormalList msg -> ListOf msg Word32
ListOfWord32 (NormalList msgB -> FlipList Word32 msgB)
-> m (NormalList msgB) -> m (FlipList Word32 msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg (FlipList Word64) where
    tMsg :: (msgA -> m msgB)
-> FlipList Word64 msgA -> m (FlipList Word64 msgB)
tMsg msgA -> m msgB
f (FlipList (ListOfWord64 NormalList msgA
nlist)) = ListOf msgB Word64 -> FlipList Word64 msgB
forall a msg. ListOf msg a -> FlipList a msg
FlipList (ListOf msgB Word64 -> FlipList Word64 msgB)
-> (NormalList msgB -> ListOf msgB Word64)
-> NormalList msgB
-> FlipList Word64 msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64 (NormalList msgB -> FlipList Word64 msgB)
-> m (NormalList msgB) -> m (FlipList Word64 msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

-------------------------------------------------------------------------------
-- 'TraverseMsg' instances for struct and pointer lists.
-------------------------------------------------------------------------------

instance TraverseMsg FlipListP where
    tMsg :: (msgA -> m msgB) -> FlipListP msgA -> m (FlipListP msgB)
tMsg msgA -> m msgB
f (FlipListP (ListOfPtr NormalList msgA
nlist))   = ListOf msgB (Maybe (Ptr msgB)) -> FlipListP msgB
forall msg. ListOf msg (Maybe (Ptr msg)) -> FlipListP msg
FlipListP (ListOf msgB (Maybe (Ptr msgB)) -> FlipListP msgB)
-> (NormalList msgB -> ListOf msgB (Maybe (Ptr msgB)))
-> NormalList msgB
-> FlipListP msgB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList msgB -> ListOf msgB (Maybe (Ptr msgB))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr   (NormalList msgB -> FlipListP msgB)
-> m (NormalList msgB) -> m (FlipListP msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> NormalList msgA -> m (NormalList msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f NormalList msgA
nlist

instance TraverseMsg FlipListS where
    tMsg :: (msgA -> m msgB) -> FlipListS msgA -> m (FlipListS msgB)
tMsg msgA -> m msgB
f (FlipListS (ListOfStruct Struct msgA
tag Int
size)) =
        ListOf msgB (Struct msgB) -> FlipListS msgB
forall msg. ListOf msg (Struct msg) -> FlipListS msg
FlipListS (ListOf msgB (Struct msgB) -> FlipListS msgB)
-> m (ListOf msgB (Struct msgB)) -> m (FlipListS msgB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Struct msgB -> Int -> ListOf msgB (Struct msgB)
forall msg. Struct msg -> Int -> ListOf msg (Struct msg)
ListOfStruct (Struct msgB -> Int -> ListOf msgB (Struct msgB))
-> m (Struct msgB) -> m (Int -> ListOf msgB (Struct msgB))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msgB) -> Struct msgA -> m (Struct msgB)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msgB
f Struct msgA
tag m (Int -> ListOf msgB (Struct msgB))
-> m Int -> m (ListOf msgB (Struct msgB))
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
size)

-- helpers for applying tMsg to a @ListOf@.
tFlip  :: (TraverseMsg (FlipList a), Applicative m) => (msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlipS :: Applicative m => (msgA -> m msg) -> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipP :: Applicative m => (msgA -> m msg) -> ListOf msgA (Maybe (Ptr msgA)) -> m (ListOf msg (Maybe (Ptr msg)))
tFlip :: (msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip  msgA -> m msg
f ListOf msgA a
list  = FlipList a msg -> ListOf msg a
forall a msg. FlipList a msg -> ListOf msg a
unflip  (FlipList a msg -> ListOf msg a)
-> m (FlipList a msg) -> m (ListOf msg a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msg) -> FlipList a msgA -> m (FlipList a msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msg
f (ListOf msgA a -> FlipList a msgA
forall a msg. ListOf msg a -> FlipList a msg
FlipList  ListOf msgA a
list)
tFlipS :: (msgA -> m msg)
-> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipS msgA -> m msg
f ListOf msgA (Struct msgA)
list  = FlipListS msg -> ListOf msg (Struct msg)
forall msg. FlipListS msg -> ListOf msg (Struct msg)
unflipS (FlipListS msg -> ListOf msg (Struct msg))
-> m (FlipListS msg) -> m (ListOf msg (Struct msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msg) -> FlipListS msgA -> m (FlipListS msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msg
f (ListOf msgA (Struct msgA) -> FlipListS msgA
forall msg. ListOf msg (Struct msg) -> FlipListS msg
FlipListS ListOf msgA (Struct msgA)
list)
tFlipP :: (msgA -> m msg)
-> ListOf msgA (Maybe (Ptr msgA))
-> m (ListOf msg (Maybe (Ptr msg)))
tFlipP msgA -> m msg
f ListOf msgA (Maybe (Ptr msgA))
list  = FlipListP msg -> ListOf msg (Maybe (Ptr msg))
forall msg. FlipListP msg -> ListOf msg (Maybe (Ptr msg))
unflipP (FlipListP msg -> ListOf msg (Maybe (Ptr msg)))
-> m (FlipListP msg) -> m (ListOf msg (Maybe (Ptr msg)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (msgA -> m msg) -> FlipListP msgA -> m (FlipListP msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msgA -> m msg
f (ListOf msgA (Maybe (Ptr msgA)) -> FlipListP msgA
forall msg. ListOf msg (Maybe (Ptr msg)) -> FlipListP msg
FlipListP ListOf msgA (Maybe (Ptr msgA))
list)

-------------------------------------------------------------------------------
-- Boilerplate 'Thaw' instances.
--
-- These all just call the underlying methods on the message, using 'TraverseMsg'.
-------------------------------------------------------------------------------

instance Thaw a => Thaw (Maybe a) where
    type Mutable s (Maybe a) = Maybe (Mutable s a)

    thaw :: Maybe a -> m (Mutable s (Maybe a))
thaw         = (a -> m (Mutable s a)) -> Maybe a -> m (Maybe (Mutable s a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (Mutable s a)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (Maybe a) -> m (Maybe a)
freeze       = (Mutable s a -> m a) -> Maybe (Mutable s a) -> m (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Mutable s a -> m a
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: Maybe a -> m (Mutable s (Maybe a))
unsafeThaw   = (a -> m (Mutable s a)) -> Maybe a -> m (Maybe (Mutable s a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (Mutable s a)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (Maybe a) -> m (Maybe a)
unsafeFreeze = (Mutable s a -> m a) -> Maybe (Mutable s a) -> m (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Mutable s a -> m a
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (Ptr msg) where
    type Mutable s (Ptr msg) = Ptr (Mutable s msg)

    thaw :: Ptr msg -> m (Mutable s (Ptr msg))
thaw         = (msg -> m (Mutable s msg)) -> Ptr msg -> m (Ptr (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (Ptr msg) -> m (Ptr msg)
freeze       = (Mutable s msg -> m msg) -> Ptr (Mutable s msg) -> m (Ptr msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: Ptr msg -> m (Mutable s (Ptr msg))
unsafeThaw   = (msg -> m (Mutable s msg)) -> Ptr msg -> m (Ptr (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (Ptr msg) -> m (Ptr msg)
unsafeFreeze = (Mutable s msg -> m msg) -> Ptr (Mutable s msg) -> m (Ptr msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (List msg) where
    type Mutable s (List msg) = List (Mutable s msg)

    thaw :: List msg -> m (Mutable s (List msg))
thaw         = (msg -> m (Mutable s msg)) -> List msg -> m (List (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (List msg) -> m (List msg)
freeze       = (Mutable s msg -> m msg) -> List (Mutable s msg) -> m (List msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: List msg -> m (Mutable s (List msg))
unsafeThaw   = (msg -> m (Mutable s msg)) -> List msg -> m (List (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (List msg) -> m (List msg)
unsafeFreeze = (Mutable s msg -> m msg) -> List (Mutable s msg) -> m (List msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (NormalList msg) where
    type Mutable s (NormalList msg) = NormalList (Mutable s msg)

    thaw :: NormalList msg -> m (Mutable s (NormalList msg))
thaw         = (msg -> m (Mutable s msg))
-> NormalList msg -> m (NormalList (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (NormalList msg) -> m (NormalList msg)
freeze       = (Mutable s msg -> m msg)
-> NormalList (Mutable s msg) -> m (NormalList msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: NormalList msg -> m (Mutable s (NormalList msg))
unsafeThaw   = (msg -> m (Mutable s msg))
-> NormalList msg -> m (NormalList (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (NormalList msg) -> m (NormalList msg)
unsafeFreeze = (Mutable s msg -> m msg)
-> NormalList (Mutable s msg) -> m (NormalList msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg ()) where
    type Mutable s (ListOf msg ()) = ListOf (Mutable s msg) ()

    thaw :: ListOf msg () -> m (Mutable s (ListOf msg ()))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg () -> m (ListOf (Mutable s msg) ())
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg ()) -> m (ListOf msg ())
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) () -> m (ListOf msg ())
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg () -> m (Mutable s (ListOf msg ()))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg () -> m (ListOf (Mutable s msg) ())
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg ()) -> m (ListOf msg ())
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) () -> m (ListOf msg ())
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg Bool) where
    type Mutable s (ListOf msg Bool) = ListOf (Mutable s msg) Bool

    thaw :: ListOf msg Bool -> m (Mutable s (ListOf msg Bool))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg Bool -> m (ListOf (Mutable s msg) Bool)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg Bool) -> m (ListOf msg Bool)
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Bool -> m (ListOf msg Bool)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg Bool -> m (Mutable s (ListOf msg Bool))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg Bool -> m (ListOf (Mutable s msg) Bool)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg Bool) -> m (ListOf msg Bool)
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Bool -> m (ListOf msg Bool)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg Word8) where
    type Mutable s (ListOf msg Word8) = ListOf (Mutable s msg) Word8

    thaw :: ListOf msg Word8 -> m (Mutable s (ListOf msg Word8))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg Word8 -> m (ListOf (Mutable s msg) Word8)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg Word8) -> m (ListOf msg Word8)
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word8 -> m (ListOf msg Word8)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg Word8 -> m (Mutable s (ListOf msg Word8))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg Word8 -> m (ListOf (Mutable s msg) Word8)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg Word8) -> m (ListOf msg Word8)
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word8 -> m (ListOf msg Word8)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg Word16) where
    type Mutable s (ListOf msg Word16) = ListOf (Mutable s msg) Word16

    thaw :: ListOf msg Word16 -> m (Mutable s (ListOf msg Word16))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg Word16 -> m (ListOf (Mutable s msg) Word16)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg Word16) -> m (ListOf msg Word16)
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word16 -> m (ListOf msg Word16)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg Word16 -> m (Mutable s (ListOf msg Word16))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg Word16 -> m (ListOf (Mutable s msg) Word16)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg Word16) -> m (ListOf msg Word16)
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word16 -> m (ListOf msg Word16)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg Word32) where
    type Mutable s (ListOf msg Word32) = ListOf (Mutable s msg) Word32

    thaw :: ListOf msg Word32 -> m (Mutable s (ListOf msg Word32))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg Word32 -> m (ListOf (Mutable s msg) Word32)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg Word32) -> m (ListOf msg Word32)
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word32 -> m (ListOf msg Word32)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg Word32 -> m (Mutable s (ListOf msg Word32))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg Word32 -> m (ListOf (Mutable s msg) Word32)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg Word32) -> m (ListOf msg Word32)
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word32 -> m (ListOf msg Word32)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg Word64) where
    type Mutable s (ListOf msg Word64) = ListOf (Mutable s msg) Word64

    thaw :: ListOf msg Word64 -> m (Mutable s (ListOf msg Word64))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg Word64 -> m (ListOf (Mutable s msg) Word64)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg Word64) -> m (ListOf msg Word64)
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word64 -> m (ListOf msg Word64)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg Word64 -> m (Mutable s (ListOf msg Word64))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg Word64 -> m (ListOf (Mutable s msg) Word64)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg Word64) -> m (ListOf msg Word64)
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) Word64 -> m (ListOf msg Word64)
forall a (m :: * -> *) msgA msg.
(TraverseMsg (FlipList a), Applicative m) =>
(msgA -> m msg) -> ListOf msgA a -> m (ListOf msg a)
tFlip Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg (Struct msg)) where
    type Mutable s (ListOf msg (Struct msg)) = ListOf (Mutable s msg) (Struct (Mutable s msg))

    thaw :: ListOf msg (Struct msg) -> m (Mutable s (ListOf msg (Struct msg)))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg (Struct msg)
-> m (ListOf (Mutable s msg) (Struct (Mutable s msg)))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipS msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg (Struct msg)) -> m (ListOf msg (Struct msg))
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) (Struct (Mutable s msg))
-> m (ListOf msg (Struct msg))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipS Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg (Struct msg) -> m (Mutable s (ListOf msg (Struct msg)))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg (Struct msg)
-> m (ListOf (Mutable s msg) (Struct (Mutable s msg)))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipS msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg (Struct msg)) -> m (ListOf msg (Struct msg))
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) (Struct (Mutable s msg))
-> m (ListOf msg (Struct msg))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Struct msgA) -> m (ListOf msg (Struct msg))
tFlipS Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (ListOf msg (Maybe (Ptr msg))) where
    type Mutable s (ListOf msg (Maybe (Ptr msg))) =
        ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg)))

    thaw :: ListOf msg (Maybe (Ptr msg))
-> m (Mutable s (ListOf msg (Maybe (Ptr msg))))
thaw         = (msg -> m (Mutable s msg))
-> ListOf msg (Maybe (Ptr msg))
-> m (ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg))))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Maybe (Ptr msgA))
-> m (ListOf msg (Maybe (Ptr msg)))
tFlipP msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (ListOf msg (Maybe (Ptr msg)))
-> m (ListOf msg (Maybe (Ptr msg)))
freeze       = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg)))
-> m (ListOf msg (Maybe (Ptr msg)))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Maybe (Ptr msgA))
-> m (ListOf msg (Maybe (Ptr msg)))
tFlipP Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: ListOf msg (Maybe (Ptr msg))
-> m (Mutable s (ListOf msg (Maybe (Ptr msg))))
unsafeThaw   = (msg -> m (Mutable s msg))
-> ListOf msg (Maybe (Ptr msg))
-> m (ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg))))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Maybe (Ptr msgA))
-> m (ListOf msg (Maybe (Ptr msg)))
tFlipP msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (ListOf msg (Maybe (Ptr msg)))
-> m (ListOf msg (Maybe (Ptr msg)))
unsafeFreeze = (Mutable s msg -> m msg)
-> ListOf (Mutable s msg) (Maybe (Ptr (Mutable s msg)))
-> m (ListOf msg (Maybe (Ptr msg)))
forall (m :: * -> *) msgA msg.
Applicative m =>
(msgA -> m msg)
-> ListOf msgA (Maybe (Ptr msgA))
-> m (ListOf msg (Maybe (Ptr msg)))
tFlipP Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

instance Thaw msg => Thaw (Struct msg) where
    type Mutable s (Struct msg) = Struct (Mutable s msg)

    thaw :: Struct msg -> m (Mutable s (Struct msg))
thaw         = (msg -> m (Mutable s msg))
-> Struct msg -> m (Struct (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
thaw
    freeze :: Mutable s (Struct msg) -> m (Struct msg)
freeze       = (Mutable s msg -> m msg)
-> Struct (Mutable s msg) -> m (Struct msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    unsafeThaw :: Struct msg -> m (Mutable s (Struct msg))
unsafeThaw   = (msg -> m (Mutable s msg))
-> Struct msg -> m (Struct (Mutable s msg))
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg msg -> m (Mutable s msg)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
a -> m (Mutable s a)
unsafeThaw
    unsafeFreeze :: Mutable s (Struct msg) -> m (Struct msg)
unsafeFreeze = (Mutable s msg -> m msg)
-> Struct (Mutable s msg) -> m (Struct msg)
forall (f :: * -> *) (m :: * -> *) msgA msgB.
(TraverseMsg f, Applicative m) =>
(msgA -> m msgB) -> f msgA -> m (f msgB)
tMsg Mutable s msg -> m msg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
unsafeFreeze

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

-- | Types @a@ whose storage is owned by a message..
class HasMessage a where
    -- | The type of the messages containing @a@s.
    type InMessage a

    -- | Get the message in which the @a@ is stored.
    message :: a -> InMessage a

-- | 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 a => MessageDefault a where
    messageDefault :: InMessage a -> a

instance HasMessage (Ptr msg) where
    type InMessage (Ptr msg) = msg

    message :: Ptr msg -> InMessage (Ptr msg)
message (PtrCap Cap msg
cap)       = Cap msg -> InMessage (Cap msg)
forall a. HasMessage a => a -> InMessage a
message Cap msg
cap
    message (PtrList List msg
list)     = List msg -> InMessage (List msg)
forall a. HasMessage a => a -> InMessage a
message List msg
list
    message (PtrStruct Struct msg
struct) = Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
message Struct msg
struct

instance HasMessage (Cap msg) where
    type InMessage (Cap msg) = msg

    message :: Cap msg -> InMessage (Cap msg)
message (Cap msg
msg Word32
_) = msg
InMessage (Cap msg)
msg

instance HasMessage (Struct msg) where
    type InMessage (Struct msg) = msg

    message :: Struct msg -> InMessage (Struct msg)
message (Struct msg
msg WordAddr
_ Word16
_ Word16
_) = msg
InMessage (Struct msg)
msg

instance MessageDefault (Struct msg) where
    messageDefault :: InMessage (Struct msg) -> Struct msg
messageDefault InMessage (Struct msg)
msg = msg -> WordAddr -> Word16 -> Word16 -> Struct msg
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct msg
InMessage (Struct msg)
msg (Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0) Word16
0 Word16
0

instance HasMessage (List msg) where
    type InMessage (List msg) = msg

    message :: List msg -> InMessage (List msg)
message (List0 ListOf msg ()
list)      = ListOf msg () -> InMessage (ListOf msg ())
forall a. HasMessage a => a -> InMessage a
message ListOf msg ()
list
    message (List1 ListOf msg Bool
list)      = ListOf msg Bool -> InMessage (ListOf msg Bool)
forall a. HasMessage a => a -> InMessage a
message ListOf msg Bool
list
    message (List8 ListOf msg Word8
list)      = ListOf msg Word8 -> InMessage (ListOf msg Word8)
forall a. HasMessage a => a -> InMessage a
message ListOf msg Word8
list
    message (List16 ListOf msg Word16
list)     = ListOf msg Word16 -> InMessage (ListOf msg Word16)
forall a. HasMessage a => a -> InMessage a
message ListOf msg Word16
list
    message (List32 ListOf msg Word32
list)     = ListOf msg Word32 -> InMessage (ListOf msg Word32)
forall a. HasMessage a => a -> InMessage a
message ListOf msg Word32
list
    message (List64 ListOf msg Word64
list)     = ListOf msg Word64 -> InMessage (ListOf msg Word64)
forall a. HasMessage a => a -> InMessage a
message ListOf msg Word64
list
    message (ListPtr ListOf msg (Maybe (Ptr msg))
list)    = ListOf msg (Maybe (Ptr msg))
-> InMessage (ListOf msg (Maybe (Ptr msg)))
forall a. HasMessage a => a -> InMessage a
message ListOf msg (Maybe (Ptr msg))
list
    message (ListStruct ListOf msg (Struct msg)
list) = ListOf msg (Struct msg) -> InMessage (ListOf msg (Struct msg))
forall a. HasMessage a => a -> InMessage a
message ListOf msg (Struct msg)
list

instance HasMessage (ListOf msg a) where
    type InMessage (ListOf msg a) = msg

    message :: ListOf msg a -> InMessage (ListOf msg a)
message (ListOfStruct Struct msg
tag Int
_) = Struct msg -> InMessage (Struct msg)
forall a. HasMessage a => a -> InMessage a
message Struct msg
tag
    message (ListOfVoid NormalList msg
list)    = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfBool NormalList msg
list)    = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfWord8 NormalList msg
list)   = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfWord16 NormalList msg
list)  = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfWord32 NormalList msg
list)  = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfWord64 NormalList msg
list)  = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list
    message (ListOfPtr NormalList msg
list)     = NormalList msg -> InMessage (NormalList msg)
forall a. HasMessage a => a -> InMessage a
message NormalList msg
list

instance MessageDefault (ListOf msg ()) where
    messageDefault :: InMessage (ListOf msg ()) -> ListOf msg ()
messageDefault InMessage (ListOf msg ())
msg = NormalList msg -> ListOf msg ()
forall msg. NormalList msg -> ListOf msg ()
ListOfVoid (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg ())
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg (Struct msg)) where
    messageDefault :: InMessage (ListOf msg (Struct msg)) -> ListOf msg (Struct msg)
messageDefault InMessage (ListOf msg (Struct msg))
msg = Struct msg -> Int -> ListOf msg (Struct msg)
forall msg. Struct msg -> Int -> ListOf msg (Struct msg)
ListOfStruct (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (Struct msg)
InMessage (ListOf msg (Struct msg))
msg) Int
0
instance MessageDefault (ListOf msg Bool) where
    messageDefault :: InMessage (ListOf msg Bool) -> ListOf msg Bool
messageDefault InMessage (ListOf msg Bool)
msg = NormalList msg -> ListOf msg Bool
forall msg. NormalList msg -> ListOf msg Bool
ListOfBool (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg Bool)
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg Word8) where
    messageDefault :: InMessage (ListOf msg Word8) -> ListOf msg Word8
messageDefault InMessage (ListOf msg Word8)
msg = NormalList msg -> ListOf msg Word8
forall msg. NormalList msg -> ListOf msg Word8
ListOfWord8 (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg Word8)
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg Word16) where
    messageDefault :: InMessage (ListOf msg Word16) -> ListOf msg Word16
messageDefault InMessage (ListOf msg Word16)
msg = NormalList msg -> ListOf msg Word16
forall msg. NormalList msg -> ListOf msg Word16
ListOfWord16 (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg Word16)
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg Word32) where
    messageDefault :: InMessage (ListOf msg Word32) -> ListOf msg Word32
messageDefault InMessage (ListOf msg Word32)
msg = NormalList msg -> ListOf msg Word32
forall msg. NormalList msg -> ListOf msg Word32
ListOfWord32 (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg Word32)
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg Word64) where
    messageDefault :: InMessage (ListOf msg Word64) -> ListOf msg Word64
messageDefault InMessage (ListOf msg Word64)
msg = NormalList msg -> ListOf msg Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64 (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg Word64)
InMessage (NormalList msg)
msg)
instance MessageDefault (ListOf msg (Maybe (Ptr msg))) where
    messageDefault :: InMessage (ListOf msg (Maybe (Ptr msg)))
-> ListOf msg (Maybe (Ptr msg))
messageDefault InMessage (ListOf msg (Maybe (Ptr msg)))
msg = NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr (InMessage (NormalList msg) -> NormalList msg
forall a. MessageDefault a => InMessage a -> a
messageDefault InMessage (ListOf msg (Maybe (Ptr msg)))
InMessage (NormalList msg)
msg)

instance HasMessage (NormalList msg) where
    type InMessage (NormalList msg) = msg

    message :: NormalList msg -> InMessage (NormalList msg)
message = NormalList msg -> InMessage (NormalList msg)
forall msg. NormalList msg -> msg
nMsg

instance MessageDefault (NormalList msg) where
    messageDefault :: InMessage (NormalList msg) -> NormalList msg
messageDefault InMessage (NormalList msg)
msg = msg -> WordAddr -> Int -> NormalList msg
forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList msg
InMessage (NormalList msg)
msg (Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0) Int
0

getClient :: ReadCtx m msg => Cap msg -> m M.Client
getClient :: Cap msg -> m Client
getClient (Cap msg
msg Word32
idx) = msg -> Int -> m Client
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> Int -> m Client
M.getCap msg
msg (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
idx)

-- | @get msg addr@ returns the Ptr stored at @addr@ in @msg@.
-- Deducts 1 from the quota for each word read (which may be multiple in the
-- case of far pointers).
get :: ReadCtx m msg => msg -> WordAddr -> m (Maybe (Ptr msg))
get :: msg -> WordAddr -> m (Maybe (Ptr msg))
get msg
msg WordAddr
addr = do
    Word64
word <- msg -> WordAddr -> m Word64
forall (f :: * -> *) msg.
(MonadLimit f, MonadThrow f, Message f msg) =>
msg -> WordAddr -> f Word64
getWord msg
msg WordAddr
addr
    case Word64 -> Maybe Ptr
P.parsePtr Word64
word of
        Maybe Ptr
Nothing -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ptr msg)
forall a. Maybe a
Nothing
        Just Ptr
p -> case Ptr
p of
            P.CapPtr Word32
cap -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr msg) -> m (Maybe (Ptr msg)))
-> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> Ptr msg -> Maybe (Ptr msg)
forall a b. (a -> b) -> a -> b
$ Cap msg -> Ptr msg
forall msg. Cap msg -> Ptr msg
PtrCap (msg -> Word32 -> Cap msg
forall msg. msg -> Word32 -> Cap msg
Cap msg
msg Word32
cap)
            P.StructPtr Int32
off Word16
dataSz Word16
ptrSz -> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr msg) -> m (Maybe (Ptr msg)))
-> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> Ptr msg -> Maybe (Ptr msg)
forall a b. (a -> b) -> a -> b
$ Struct msg -> Ptr msg
forall msg. Struct msg -> Ptr msg
PtrStruct (Struct msg -> Ptr msg) -> Struct msg -> Ptr msg
forall a b. (a -> b) -> a -> b
$
                msg -> WordAddr -> Word16 -> Word16 -> Struct msg
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct msg
msg (WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
addr Int32
off) Word16
dataSz Word16
ptrSz
            P.ListPtr Int32
off EltSpec
eltSpec -> Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> m (Ptr msg) -> m (Maybe (Ptr msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordAddr -> EltSpec -> m (Ptr msg)
getList (WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
addr Int32
off) EltSpec
eltSpec
            P.FarPtr Bool
twoWords Word32
offset Word32
segment -> do
                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
                                   }
                if Bool -> Bool
not Bool
twoWords
                    then msg -> WordAddr -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
msg -> WordAddr -> m (Maybe (Ptr msg))
get msg
msg WordAddr
addr'
                    else do
                        Word64
landingPad <- msg -> WordAddr -> m Word64
forall (f :: * -> *) msg.
(MonadLimit f, MonadThrow f, Message f msg) =>
msg -> WordAddr -> f Word64
getWord msg
msg WordAddr
addr'
                        case Word64 -> Maybe Ptr
P.parsePtr Word64
landingPad of
                            Just (P.FarPtr Bool
False Word32
off Word32
seg) -> do
                                Word64
tagWord <- msg -> WordAddr -> m Word64
forall (f :: * -> *) msg.
(MonadLimit f, MonadThrow f, Message f msg) =>
msg -> WordAddr -> f Word64
getWord
                                            msg
msg
                                            WordAddr
addr' { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
addr' WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
                                let finalAddr :: WordAddr
finalAddr = WordAt :: Int -> WordCount -> WordAddr
WordAt { wordIndex :: WordCount
wordIndex = Word32 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off
                                                       , segIndex :: Int
segIndex = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seg
                                                       }
                                case Word64 -> Maybe Ptr
P.parsePtr Word64
tagWord of
                                    Just (P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz) ->
                                        Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr msg) -> m (Maybe (Ptr msg)))
-> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> Ptr msg -> Maybe (Ptr msg)
forall a b. (a -> b) -> a -> b
$ Struct msg -> Ptr msg
forall msg. Struct msg -> Ptr msg
PtrStruct (Struct msg -> Ptr msg) -> Struct msg -> Ptr msg
forall a b. (a -> b) -> a -> b
$
                                            msg -> WordAddr -> Word16 -> Word16 -> Struct msg
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct msg
msg WordAddr
finalAddr Word16
dataSz Word16
ptrSz
                                    Just (P.ListPtr Int32
0 EltSpec
eltSpec) ->
                                        Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> m (Ptr msg) -> m (Maybe (Ptr msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordAddr -> EltSpec -> m (Ptr msg)
getList WordAddr
finalAddr 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 msg) -> m (Maybe (Ptr msg))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr msg) -> m (Maybe (Ptr msg)))
-> Maybe (Ptr msg) -> m (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ Ptr msg -> Maybe (Ptr msg)
forall a. a -> Maybe a
Just (Ptr msg -> Maybe (Ptr msg)) -> Ptr msg -> Maybe (Ptr msg)
forall a b. (a -> b) -> a -> b
$ Cap msg -> Ptr msg
forall msg. Cap msg -> Ptr msg
PtrCap (msg -> Word32 -> Cap msg
forall msg. msg -> Word32 -> Cap msg
Cap msg
msg Word32
cap)
                                    Maybe Ptr
ptr -> Error -> m (Maybe (Ptr msg))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr msg))) -> Error -> m (Maybe (Ptr msg))
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        String
"2-word landing pad should be an intra " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        String
"segment pointer with offset 0, but " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        String
"we read " String -> String -> String
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 msg))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr msg))) -> Error -> m (Maybe (Ptr msg))
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
                                String
"landing pad should be another far pointer " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                String
"(with a one-word landing pad), but we read " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                Maybe Ptr -> String
forall a. Show a => a -> String
show Maybe Ptr
ptr

  where
    getWord :: msg -> WordAddr -> f Word64
getWord msg
msg WordAddr
addr = WordCount -> f ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1 f () -> f Word64 -> f Word64
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> msg -> WordAddr -> f Word64
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> WordAddr -> m Word64
M.getWord msg
msg WordAddr
addr
    resolveOffset :: WordAddr -> a -> WordAddr
resolveOffset addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} 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 :: WordAddr -> EltSpec -> m (Ptr msg)
getList addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} EltSpec
eltSpec = List msg -> Ptr msg
forall msg. List msg -> Ptr msg
PtrList (List msg -> Ptr msg) -> m (List msg) -> m (Ptr msg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        case EltSpec
eltSpec of
            P.EltNormal ElementSize
sz Word32
len -> List msg -> m (List msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List msg -> m (List msg)) -> List msg -> m (List msg)
forall a b. (a -> b) -> a -> b
$ case ElementSize
sz of
                ElementSize
Sz0   -> ListOf msg () -> List msg
forall msg. ListOf msg () -> List msg
List0  (NormalList msg -> ListOf msg ()
forall msg. NormalList msg -> ListOf msg ()
ListOfVoid    NormalList msg
nlist)
                ElementSize
Sz1   -> ListOf msg Bool -> List msg
forall msg. ListOf msg Bool -> List msg
List1  (NormalList msg -> ListOf msg Bool
forall msg. NormalList msg -> ListOf msg Bool
ListOfBool    NormalList msg
nlist)
                ElementSize
Sz8   -> ListOf msg Word8 -> List msg
forall msg. ListOf msg Word8 -> List msg
List8  (NormalList msg -> ListOf msg Word8
forall msg. NormalList msg -> ListOf msg Word8
ListOfWord8   NormalList msg
nlist)
                ElementSize
Sz16  -> ListOf msg Word16 -> List msg
forall msg. ListOf msg Word16 -> List msg
List16 (NormalList msg -> ListOf msg Word16
forall msg. NormalList msg -> ListOf msg Word16
ListOfWord16  NormalList msg
nlist)
                ElementSize
Sz32  -> ListOf msg Word32 -> List msg
forall msg. ListOf msg Word32 -> List msg
List32 (NormalList msg -> ListOf msg Word32
forall msg. NormalList msg -> ListOf msg Word32
ListOfWord32  NormalList msg
nlist)
                ElementSize
Sz64  -> ListOf msg Word64 -> List msg
forall msg. ListOf msg Word64 -> List msg
List64 (NormalList msg -> ListOf msg Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64  NormalList msg
nlist)
                ElementSize
SzPtr -> ListOf msg (Maybe (Ptr msg)) -> List msg
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
ListPtr (NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr NormalList msg
nlist)
              where
                nlist :: NormalList msg
nlist = msg -> WordAddr -> Int -> NormalList msg
forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList msg
msg WordAddr
addr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
            P.EltComposite Int32
_ -> do
                Word64
tagWord <- msg -> WordAddr -> m Word64
forall (f :: * -> *) msg.
(MonadLimit f, MonadThrow f, Message f msg) =>
msg -> WordAddr -> f Word64
getWord msg
msg WordAddr
addr
                case Word64 -> Ptr
P.parsePtr' Word64
tagWord of
                    P.StructPtr Int32
numElts Word16
dataSz Word16
ptrSz ->
                        List msg -> m (List msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List msg -> m (List msg)) -> List msg -> m (List msg)
forall a b. (a -> b) -> a -> b
$ ListOf msg (Struct msg) -> List msg
forall msg. ListOf msg (Struct msg) -> List msg
ListStruct (ListOf msg (Struct msg) -> List msg)
-> ListOf msg (Struct msg) -> List msg
forall a b. (a -> b) -> a -> b
$ Struct msg -> Int -> ListOf msg (Struct msg)
forall msg. Struct msg -> Int -> ListOf msg (Struct msg)
ListOfStruct
                            (msg -> WordAddr -> Word16 -> Word16 -> Struct msg
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct msg
msg
                                    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 -> m (List msg)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (List msg)) -> Error -> m (List msg)
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 -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
"formatted word: " String -> String -> String
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 msg (Struct msg)
list@(ListOfStruct (Struct msg
_ WordAddr
_ Word16
dataSz Word16
ptrSz) Int
_)) =
    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 msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg (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 msg ()
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg () -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg ()
list)
listEltSpec (List1 ListOf msg Bool
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg Bool -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg Bool
list)
listEltSpec (List8 ListOf msg Word8
list)   = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg Word8 -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg Word8
list)
listEltSpec (List16 ListOf msg Word16
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg Word16 -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg Word16
list)
listEltSpec (List32 ListOf msg Word32
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg Word32 -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg Word32
list)
listEltSpec (List64 ListOf msg Word64
list)  = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg Word64 -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg Word64
list)
listEltSpec (ListPtr ListOf msg (Maybe (Ptr msg))
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
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 msg (Maybe (Ptr msg)) -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg (Maybe (Ptr msg))
list)

-- | Return the starting address of the list.
listAddr :: List msg -> WordAddr
listAddr :: List msg -> WordAddr
listAddr (ListStruct (ListOfStruct (Struct msg
_ WordAddr
addr Word16
_ Word16
_) Int
_)) =
    -- addr is the address of the first element of the list, but
    -- composite lists start with a tag word:
    WordAddr
addr { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
addr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
- WordCount
1 }
listAddr (List0 (ListOfVoid NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (List1 (ListOfBool NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (List8 (ListOfWord8 NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (List16 (ListOfWord16 NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (List32 (ListOfWord32 NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (List64 (ListOfWord64 NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr
listAddr (ListPtr (ListOfPtr NormalList{WordAddr
nAddr :: WordAddr
nAddr :: forall msg. NormalList msg -> WordAddr
nAddr})) = WordAddr
nAddr

-- | 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 (Struct msg
_ WordAddr
addr Word16
_ Word16
_)) = WordAddr
addr
ptrAddr (PtrList List msg
list) = List msg -> WordAddr
forall msg. List msg -> WordAddr
listAddr List msg
list

-- | @'setIndex value i list@ Set the @i@th element of @list@ to @value@.
setIndex :: RWCtx m s => a -> Int -> ListOf (M.MutMsg s) a -> m ()
setIndex :: a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex a
_ Int
i ListOf (MutMsg s) a
list | ListOf (MutMsg s) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) a
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 (MutMsg s) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) a
list }
setIndex a
value Int
i ListOf (MutMsg s) a
list = case ListOf (MutMsg s) a
list of
    ListOfVoid NormalList (MutMsg s)
_       -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ListOfBool NormalList (MutMsg s)
nlist   -> NormalList (MutMsg s) -> Int -> Word1 -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
64 (Bool -> Word1
Word1 a
Bool
value)
    ListOfWord8 NormalList (MutMsg s)
nlist  -> NormalList (MutMsg s) -> Int -> a -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
8 a
value
    ListOfWord16 NormalList (MutMsg s)
nlist -> NormalList (MutMsg s) -> Int -> a -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
4 a
value
    ListOfWord32 NormalList (MutMsg s)
nlist -> NormalList (MutMsg s) -> Int -> a -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
2 a
value
    ListOfWord64 NormalList (MutMsg s)
nlist -> NormalList (MutMsg s) -> Int -> a -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
1 a
value
    ListOfPtr NormalList (MutMsg s)
nlist -> case a
value of
        Just p | Ptr (MutMsg s) -> InMessage (Ptr (MutMsg s))
forall a. HasMessage a => a -> InMessage a
message Ptr (MutMsg s)
p MutMsg s -> MutMsg s -> Bool
forall a. Eq a => a -> a -> Bool
/= ListOf (MutMsg s) a -> InMessage (ListOf (MutMsg s) a)
forall a. HasMessage a => a -> InMessage a
message ListOf (MutMsg s) a
list -> do
            Maybe (Ptr (MutMsg s))
newPtr <- MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (m :: * -> *) s.
RWCtx m s =>
MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
copyPtr (ListOf (MutMsg s) a -> InMessage (ListOf (MutMsg s) a)
forall a. HasMessage a => a -> InMessage a
message ListOf (MutMsg s) a
list) a
Maybe (Ptr (MutMsg s))
value
            Maybe (Ptr (MutMsg s))
-> Int -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex Maybe (Ptr (MutMsg s))
newPtr Int
i ListOf (MutMsg s) a
ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
list
        a
Nothing                -> NormalList (MutMsg s) -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg s)
nlist Int
1 (Maybe Ptr -> Word64
P.serializePtr Maybe Ptr
forall a. Maybe a
Nothing)
        Just (PtrCap (Cap _ cap))    -> NormalList (MutMsg s) -> Int -> Word64 -> m ()
forall (m :: * -> *) s a.
(ReadCtx m (MutMsg s), WriteCtx m s, Bounded a, Integral a) =>
NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList (MutMsg 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)     ->
            NormalList (MutMsg s) -> Ptr (MutMsg s) -> Ptr -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
NormalList (MutMsg s) -> Ptr (MutMsg s) -> Ptr -> m ()
setPtrIndex NormalList (MutMsg s)
nlist Ptr (MutMsg s)
p (Ptr -> m ()) -> Ptr -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> EltSpec -> Ptr
P.ListPtr Int32
0 (List (MutMsg s) -> EltSpec
forall msg. List msg -> EltSpec
listEltSpec List (MutMsg s)
ptrList)
        Just p@(PtrStruct (Struct _ _ dataSz ptrSz)) ->
            NormalList (MutMsg s) -> Ptr (MutMsg s) -> Ptr -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
NormalList (MutMsg s) -> Ptr (MutMsg s) -> Ptr -> m ()
setPtrIndex NormalList (MutMsg s)
nlist Ptr (MutMsg 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
    list :: ListOf (MutMsg s) a
list@(ListOfStruct Struct (MutMsg s)
_ Int
_) -> do
        a
dest <- Int -> ListOf (MutMsg s) a -> m a
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
index Int
i ListOf (MutMsg s) a
list
        Struct (MutMsg s) -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct (MutMsg s) -> Struct (MutMsg s) -> m ()
copyStruct a
Struct (MutMsg s)
dest a
Struct (MutMsg s)
value
  where
    setNIndex :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s, Bounded a, Integral a) => NormalList (M.MutMsg s) -> Int -> a -> m ()
    setNIndex :: NormalList (MutMsg s) -> Int -> a -> m ()
setNIndex NormalList{nAddr :: forall msg. NormalList msg -> WordAddr
nAddr=nAddr :: WordAddr
nAddr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..},Int
MutMsg s
nLen :: Int
nMsg :: MutMsg s
nLen :: forall msg. NormalList msg -> Int
nMsg :: forall msg. NormalList msg -> msg
..} Int
eltsPerWord a
value = do
        let wordAddr :: WordAddr
wordAddr = WordAddr
nAddr { 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 <- MutMsg s -> WordAddr -> m Word64
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> WordAddr -> m Word64
M.getWord MutMsg s
nMsg WordAddr
wordAddr
        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)
        MutMsg s -> WordAddr -> Word64 -> m ()
forall (m :: * -> *) s.
(WriteCtx m s, MonadThrow m) =>
MutMsg s -> WordAddr -> Word64 -> m ()
M.setWord MutMsg s
nMsg WordAddr
wordAddr (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 :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) => NormalList (M.MutMsg s) -> Ptr (M.MutMsg s) -> P.Ptr -> m ()
    setPtrIndex :: NormalList (MutMsg s) -> Ptr (MutMsg s) -> Ptr -> m ()
setPtrIndex NormalList{Int
WordAddr
MutMsg s
nLen :: Int
nAddr :: WordAddr
nMsg :: MutMsg s
nLen :: forall msg. NormalList msg -> Int
nAddr :: forall msg. NormalList msg -> WordAddr
nMsg :: forall msg. NormalList msg -> msg
..} Ptr (MutMsg s)
absPtr Ptr
relPtr =
        let srcAddr :: WordAddr
srcAddr = WordAddr
nAddr { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
nAddr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i }
        in MutMsg s -> WordAddr -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> WordAddr -> WordAddr -> Ptr -> m ()
setPointerTo MutMsg s
nMsg WordAddr
srcAddr (Ptr (MutMsg s) -> WordAddr
forall msg. Ptr msg -> WordAddr
ptrAddr Ptr (MutMsg s)
absPtr) Ptr
relPtr

-- | @'setPointerTo' msg srcAddr dstAddr relPtr@ sets the word at @srcAddr@ 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
-- @dstAddr@ will contain a far pointer.
setPointerTo :: M.WriteCtx m s => M.MutMsg s -> WordAddr -> WordAddr -> P.Ptr -> m ()
setPointerTo :: MutMsg s -> WordAddr -> WordAddr -> Ptr -> m ()
setPointerTo MutMsg s
msg WordAddr
srcAddr WordAddr
dstAddr Ptr
relPtr =
    case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
srcAddr WordAddr
dstAddr Ptr
relPtr of
        Right Ptr
absPtr ->
            MutMsg s -> WordAddr -> Word64 -> m ()
forall (m :: * -> *) s.
(WriteCtx m s, MonadThrow m) =>
MutMsg s -> WordAddr -> Word64 -> m ()
M.setWord MutMsg s
msg WordAddr
srcAddr (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
            WordAddr
landingPadAddr <- MutMsg s -> Int -> WordCount -> m WordAddr
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> WordCount -> m WordAddr
M.allocInSeg MutMsg s
msg Int
segIndex WordCount
1
            case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
landingPadAddr WordAddr
dstAddr Ptr
relPtr of
                Right Ptr
landingPad -> do
                    MutMsg s -> WordAddr -> Word64 -> m ()
forall (m :: * -> *) s.
(WriteCtx m s, MonadThrow m) =>
MutMsg s -> WordAddr -> Word64 -> m ()
M.setWord MutMsg s
msg WordAddr
landingPadAddr (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)
                    let WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex,WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex} = WordAddr
landingPadAddr
                    MutMsg s -> WordAddr -> Word64 -> m ()
forall (m :: * -> *) s.
(WriteCtx m s, MonadThrow m) =>
MutMsg s -> WordAddr -> Word64 -> m ()
M.setWord MutMsg s
msg WordAddr
srcAddr (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."

copyCap :: RWCtx m s => M.MutMsg s -> Cap (M.MutMsg s) -> m (Cap (M.MutMsg s))
copyCap :: MutMsg s -> Cap (MutMsg s) -> m (Cap (MutMsg s))
copyCap MutMsg s
dest Cap (MutMsg s)
cap = Cap (MutMsg s) -> m Client
forall (m :: * -> *) msg. ReadCtx m msg => Cap msg -> m Client
getClient Cap (MutMsg s)
cap m Client -> (Client -> m (Cap (MutMsg s))) -> m (Cap (MutMsg s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutMsg s -> Client -> m (Cap (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Client -> m (Cap (MutMsg s))
appendCap MutMsg s
dest

copyPtr :: RWCtx m s => M.MutMsg s -> Maybe (Ptr (M.MutMsg s)) -> m (Maybe (Ptr (M.MutMsg s)))
copyPtr :: MutMsg s -> Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
copyPtr MutMsg s
_ Maybe (Ptr (MutMsg s))
Nothing                = Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr (MutMsg s))
forall a. Maybe a
Nothing
copyPtr MutMsg s
dest (Just (PtrCap Cap (MutMsg s)
cap))    = Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Cap (MutMsg s) -> Ptr (MutMsg s))
-> Cap (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap (MutMsg s) -> Ptr (MutMsg s)
forall msg. Cap msg -> Ptr msg
PtrCap (Cap (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Cap (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Cap (MutMsg s) -> m (Cap (MutMsg s))
forall (m :: * -> *) s.
RWCtx m s =>
MutMsg s -> Cap (MutMsg s) -> m (Cap (MutMsg s))
copyCap MutMsg s
dest Cap (MutMsg s)
cap
copyPtr MutMsg s
dest (Just (PtrList List (MutMsg s)
src))   = Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (List (MutMsg s) -> Ptr (MutMsg s))
-> List (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (MutMsg s) -> Ptr (MutMsg s)
forall msg. List msg -> Ptr msg
PtrList (List (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (List (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> List (MutMsg s) -> m (List (MutMsg s))
forall (m :: * -> *) s.
RWCtx m s =>
MutMsg s -> List (MutMsg s) -> m (List (MutMsg s))
copyList MutMsg s
dest List (MutMsg s)
src
copyPtr MutMsg s
dest (Just (PtrStruct Struct (MutMsg s)
src)) = Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Struct (MutMsg s) -> Ptr (MutMsg s))
-> Struct (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (MutMsg s) -> Ptr (MutMsg s)
forall msg. Struct msg -> Ptr msg
PtrStruct (Struct (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Struct (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Struct (MutMsg s)
destStruct <- MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
allocStruct
            MutMsg 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 (MutMsg s) -> WordCount
forall msg. Struct msg -> WordCount
structWordCount Struct (MutMsg 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 (MutMsg s) -> Word16
forall msg. Struct msg -> Word16
structPtrCount Struct (MutMsg s)
src)
    Struct (MutMsg s) -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct (MutMsg s) -> Struct (MutMsg s) -> m ()
copyStruct Struct (MutMsg s)
destStruct Struct (MutMsg s)
src
    pure Struct (MutMsg s)
destStruct

copyList :: RWCtx m s => M.MutMsg s -> List (M.MutMsg s) -> m (List (M.MutMsg s))
copyList :: MutMsg s -> List (MutMsg s) -> m (List (MutMsg s))
copyList MutMsg s
dest List (MutMsg s)
src = case List (MutMsg s)
src of
    List0 ListOf (MutMsg s) ()
src      -> ListOf (MutMsg s) () -> List (MutMsg s)
forall msg. ListOf msg () -> List msg
List0 (ListOf (MutMsg s) () -> List (MutMsg s))
-> m (ListOf (MutMsg s) ()) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) ())
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) ())
allocList0 MutMsg s
dest (ListOf (MutMsg s) () -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) ()
src)
    List1 ListOf (MutMsg s) Bool
src      -> ListOf (MutMsg s) Bool -> List (MutMsg s)
forall msg. ListOf msg Bool -> List msg
List1 (ListOf (MutMsg s) Bool -> List (MutMsg s))
-> m (ListOf (MutMsg s) Bool) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) Bool
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) Bool))
-> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) Bool
src MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
allocList1
    List8 ListOf (MutMsg s) Word8
src      -> ListOf (MutMsg s) Word8 -> List (MutMsg s)
forall msg. ListOf msg Word8 -> List msg
List8 (ListOf (MutMsg s) Word8 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word8) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) Word8
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word8))
-> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) Word8
src MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
allocList8
    List16 ListOf (MutMsg s) Word16
src     -> ListOf (MutMsg s) Word16 -> List (MutMsg s)
forall msg. ListOf msg Word16 -> List msg
List16 (ListOf (MutMsg s) Word16 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) Word16
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word16))
-> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) Word16
src MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
allocList16
    List32 ListOf (MutMsg s) Word32
src     -> ListOf (MutMsg s) Word32 -> List (MutMsg s)
forall msg. ListOf msg Word32 -> List msg
List32 (ListOf (MutMsg s) Word32 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) Word32
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word32))
-> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) Word32
src MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
allocList32
    List64 ListOf (MutMsg s) Word64
src     -> ListOf (MutMsg s) Word64 -> List (MutMsg s)
forall msg. ListOf msg Word64 -> List msg
List64 (ListOf (MutMsg s) Word64 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) Word64
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word64))
-> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) Word64
src MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
allocList64
    ListPtr ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
src    -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> List (MutMsg s)
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
ListPtr (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> List (MutMsg s))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s
-> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> (MutMsg s
    -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s a.
RWCtx m s =>
MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
dest ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
src MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
allocListPtr
    ListStruct ListOf (MutMsg s) (Struct (MutMsg s))
src -> ListOf (MutMsg s) (Struct (MutMsg s)) -> List (MutMsg s)
forall msg. ListOf msg (Struct msg) -> List msg
ListStruct (ListOf (MutMsg s) (Struct (MutMsg s)) -> List (MutMsg s))
-> m (ListOf (MutMsg s) (Struct (MutMsg s))) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        ListOf (MutMsg s) (Struct (MutMsg s))
destList <- MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
allocCompositeList
            MutMsg 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 (MutMsg s) (Struct (MutMsg s)) -> WordCount
forall msg. ListOf msg (Struct msg) -> WordCount
structListWordCount ListOf (MutMsg s) (Struct (MutMsg s))
src)
            (ListOf (MutMsg s) (Struct (MutMsg s)) -> Word16
forall msg. ListOf msg (Struct msg) -> Word16
structListPtrCount  ListOf (MutMsg s) (Struct (MutMsg s))
src)
            (ListOf (MutMsg s) (Struct (MutMsg s)) -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) (Struct (MutMsg s))
src)
        ListOf (MutMsg s) (Struct (MutMsg s))
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
ListOf (MutMsg s) a -> ListOf (MutMsg s) a -> m ()
copyListOf ListOf (MutMsg s) (Struct (MutMsg s))
destList ListOf (MutMsg s) (Struct (MutMsg s))
src
        pure ListOf (MutMsg s) (Struct (MutMsg s))
destList

copyNewListOf
    :: RWCtx m s
    => M.MutMsg s
    -> ListOf (M.MutMsg s) a
    -> (M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) a))
    -> m (ListOf (M.MutMsg s) a)
copyNewListOf :: MutMsg s
-> ListOf (MutMsg s) a
-> (MutMsg s -> Int -> m (ListOf (MutMsg s) a))
-> m (ListOf (MutMsg s) a)
copyNewListOf MutMsg s
destMsg ListOf (MutMsg s) a
src MutMsg s -> Int -> m (ListOf (MutMsg s) a)
new = do
    ListOf (MutMsg s) a
dest <- MutMsg s -> Int -> m (ListOf (MutMsg s) a)
new MutMsg s
destMsg (ListOf (MutMsg s) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) a
src)
    ListOf (MutMsg s) a -> ListOf (MutMsg s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
ListOf (MutMsg s) a -> ListOf (MutMsg s) a -> m ()
copyListOf ListOf (MutMsg s) a
dest ListOf (MutMsg s) a
src
    pure ListOf (MutMsg s) a
dest


copyListOf :: RWCtx m s => ListOf (M.MutMsg s) a -> ListOf (M.MutMsg s) a -> m ()
copyListOf :: ListOf (MutMsg s) a -> ListOf (MutMsg s) a -> m ()
copyListOf ListOf (MutMsg s) a
dest ListOf (MutMsg s) a
src =
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf (MutMsg s) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg s) a
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
        a
value <- Int -> ListOf (MutMsg s) a -> m a
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
index Int
i ListOf (MutMsg s) a
src
        a -> Int -> ListOf (MutMsg s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex a
value Int
i ListOf (MutMsg s) a
dest

-- | @'copyStruct' dest src@ copies the source struct to the destination struct.
copyStruct :: RWCtx m s => Struct (M.MutMsg s) -> Struct (M.MutMsg s) -> m ()
copyStruct :: Struct (MutMsg s) -> Struct (MutMsg s) -> m ()
copyStruct Struct (MutMsg s)
dest Struct (MutMsg 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 (MutMsg (PrimState m)) Word64
-> ListOf (MutMsg (PrimState m)) Word64 -> Word64 -> m ()
forall (m :: * -> *) a.
(PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf (MutMsg (PrimState m)) a
-> ListOf (MutMsg (PrimState m)) a -> a -> m ()
copySection (Struct (MutMsg s) -> ListOf (MutMsg s) Word64
forall msg. Struct msg -> ListOf msg Word64
dataSection Struct (MutMsg s)
dest) (Struct (MutMsg s) -> ListOf (MutMsg s) Word64
forall msg. Struct msg -> ListOf msg Word64
dataSection Struct (MutMsg s)
src) Word64
0
    ListOf (MutMsg (PrimState m)) (Maybe (Ptr (MutMsg s)))
-> ListOf (MutMsg (PrimState m)) (Maybe (Ptr (MutMsg s)))
-> Maybe (Ptr (MutMsg s))
-> m ()
forall (m :: * -> *) a.
(PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf (MutMsg (PrimState m)) a
-> ListOf (MutMsg (PrimState m)) a -> a -> m ()
copySection (Struct (MutMsg s) -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
forall msg. Struct msg -> ListOf msg (Maybe (Ptr msg))
ptrSection  Struct (MutMsg s)
dest) (Struct (MutMsg s) -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
forall msg. Struct msg -> ListOf msg (Maybe (Ptr msg))
ptrSection  Struct (MutMsg s)
src) Maybe (Ptr (MutMsg s))
forall a. Maybe a
Nothing
  where
    copySection :: ListOf (MutMsg (PrimState m)) a
-> ListOf (MutMsg (PrimState m)) a -> a -> m ()
copySection ListOf (MutMsg (PrimState m)) a
dest ListOf (MutMsg (PrimState m)) a
src a
pad = do
        -- Copy the source section to the destination section:
        ListOf (MutMsg (PrimState m)) a
-> ListOf (MutMsg (PrimState m)) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
ListOf (MutMsg s) a -> ListOf (MutMsg s) a -> m ()
copyListOf ListOf (MutMsg (PrimState m)) a
dest ListOf (MutMsg (PrimState m)) a
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 (MutMsg (PrimState m)) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg (PrimState m)) a
src..ListOf (MutMsg (PrimState m)) a -> Int
forall msg a. ListOf msg a -> Int
length ListOf (MutMsg (PrimState m)) a
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 ->
            a -> Int -> ListOf (MutMsg (PrimState m)) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex a
pad Int
i ListOf (MutMsg (PrimState m)) a
dest


-- | @index i list@ returns the ith element in @list@. Deducts 1 from the quota
index :: ReadCtx m msg => Int -> ListOf msg a -> m a
index :: Int -> ListOf msg a -> m a
index Int
i ListOf msg a
list = WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1 m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ListOf msg a -> m a
forall (m :: * -> *) msg a. ReadCtx m msg => ListOf msg a -> m a
index' ListOf msg a
list
  where
    index' :: ReadCtx m msg => ListOf msg a -> m a
    index' :: ListOf msg a -> m a
index' (ListOfVoid NormalList msg
nlist)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = Error -> m a
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 = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
    index' (ListOfStruct (Struct msg
msg addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Word16
dataSz Word16
ptrSz) Int
len)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = 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 msg -> m (Struct msg)
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct msg -> m (Struct msg)) -> Struct msg -> m (Struct msg)
forall a b. (a -> b) -> a -> b
$ msg -> WordAddr -> Word16 -> Word16 -> Struct msg
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct msg
msg WordAddr
addr' Word16
dataSz Word16
ptrSz
        | Bool
otherwise = Error -> m a
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 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}
    index' (ListOfBool   NormalList msg
nlist) = do
        Word1 Bool
val <- NormalList msg -> Int -> m Word1
forall (m :: * -> *) msg a.
(ReadCtx m msg, Integral a) =>
NormalList msg -> Int -> m a
indexNList NormalList msg
nlist Int
64
        Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
val
    index' (ListOfWord8  NormalList msg
nlist) = NormalList msg -> Int -> m a
forall (m :: * -> *) msg a.
(ReadCtx m msg, Integral a) =>
NormalList msg -> Int -> m a
indexNList NormalList msg
nlist Int
8
    index' (ListOfWord16 NormalList msg
nlist) = NormalList msg -> Int -> m a
forall (m :: * -> *) msg a.
(ReadCtx m msg, Integral a) =>
NormalList msg -> Int -> m a
indexNList NormalList msg
nlist Int
4
    index' (ListOfWord32 NormalList msg
nlist) = NormalList msg -> Int -> m a
forall (m :: * -> *) msg a.
(ReadCtx m msg, Integral a) =>
NormalList msg -> Int -> m a
indexNList NormalList msg
nlist Int
2
    index' (ListOfWord64 (NormalList msg
msg addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Int
len))
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = msg -> WordAddr -> m Word64
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> WordAddr -> m Word64
M.getWord msg
msg WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i }
        | Bool
otherwise = Error -> m a
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 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}
    index' (ListOfPtr (NormalList msg
msg addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Int
len))
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = msg -> WordAddr -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
msg -> WordAddr -> m (Maybe (Ptr msg))
get msg
msg WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i }
        | Bool
otherwise = Error -> m a
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 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}
    indexNList :: (ReadCtx m msg, Integral a) => NormalList msg -> Int -> m a
    indexNList :: NormalList msg -> Int -> m a
indexNList (NormalList msg
msg addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Int
len) Int
eltsPerWord
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = 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 <- msg -> WordAddr -> m Word64
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> WordAddr -> m Word64
M.getWord msg
msg WordAddr
addr { wordIndex :: WordCount
wordIndex = 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
        | Bool
otherwise = Error -> m a
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 = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }

-- | Returns the length of a list
length :: ListOf msg a -> Int
length :: ListOf msg a -> Int
length (ListOfStruct Struct msg
_ Int
len) = Int
len
length (ListOfVoid   NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfBool   NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfWord8  NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfWord16 NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfWord32 NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfWord64 NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist
length (ListOfPtr    NormalList msg
nlist) = NormalList msg -> Int
forall msg. NormalList msg -> Int
nLen NormalList msg
nlist

-- | Return a prefix of the list, of the given length.
take :: MonadThrow m => Int -> ListOf msg a -> m (ListOf msg a)
take :: Int -> ListOf msg a -> m (ListOf msg a)
take Int
count ListOf msg a
list
    | ListOf msg a -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg a
list Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count =
        Error -> m (ListOf msg a)
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 msg a -> Int
forall msg a. ListOf msg a -> Int
length ListOf msg a
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
    | Bool
otherwise = ListOf msg a -> m (ListOf msg a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf msg a -> m (ListOf msg a))
-> ListOf msg a -> m (ListOf msg a)
forall a b. (a -> b) -> a -> b
$ ListOf msg a -> ListOf msg a
go ListOf msg a
list
  where
    go :: ListOf msg a -> ListOf msg a
go (ListOfStruct Struct msg
tag Int
_) = Struct msg -> Int -> ListOf msg (Struct msg)
forall msg. Struct msg -> Int -> ListOf msg (Struct msg)
ListOfStruct Struct msg
tag Int
count
    go (ListOfVoid NormalList msg
nlist)   = NormalList msg -> ListOf msg ()
forall msg. NormalList msg -> ListOf msg ()
ListOfVoid (NormalList msg -> ListOf msg ())
-> NormalList msg -> ListOf msg ()
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfBool NormalList msg
nlist)   = NormalList msg -> ListOf msg Bool
forall msg. NormalList msg -> ListOf msg Bool
ListOfBool (NormalList msg -> ListOf msg Bool)
-> NormalList msg -> ListOf msg Bool
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfWord8 NormalList msg
nlist)  = NormalList msg -> ListOf msg Word8
forall msg. NormalList msg -> ListOf msg Word8
ListOfWord8 (NormalList msg -> ListOf msg Word8)
-> NormalList msg -> ListOf msg Word8
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfWord16 NormalList msg
nlist) = NormalList msg -> ListOf msg Word16
forall msg. NormalList msg -> ListOf msg Word16
ListOfWord16 (NormalList msg -> ListOf msg Word16)
-> NormalList msg -> ListOf msg Word16
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfWord32 NormalList msg
nlist) = NormalList msg -> ListOf msg Word32
forall msg. NormalList msg -> ListOf msg Word32
ListOfWord32 (NormalList msg -> ListOf msg Word32)
-> NormalList msg -> ListOf msg Word32
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfWord64 NormalList msg
nlist) = NormalList msg -> ListOf msg Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64 (NormalList msg -> ListOf msg Word64)
-> NormalList msg -> ListOf msg Word64
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist
    go (ListOfPtr NormalList msg
nlist)    = NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr (NormalList msg -> ListOf msg (Maybe (Ptr msg)))
-> NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ NormalList msg -> NormalList msg
forall msg. NormalList msg -> NormalList msg
nTake NormalList msg
nlist

    nTake :: NormalList msg -> NormalList msg
    nTake :: NormalList msg -> NormalList msg
nTake NormalList{msg
Int
WordAddr
nLen :: Int
nAddr :: WordAddr
nMsg :: msg
nLen :: forall msg. NormalList msg -> Int
nAddr :: forall msg. NormalList msg -> WordAddr
nMsg :: forall msg. NormalList msg -> msg
..} = NormalList :: forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList { nLen :: Int
nLen = Int
count, msg
WordAddr
nAddr :: WordAddr
nMsg :: msg
nAddr :: WordAddr
nMsg :: msg
.. }

-- | The data section of a struct, as a list of Word64
dataSection :: Struct msg -> ListOf msg Word64
dataSection :: Struct msg -> ListOf msg Word64
dataSection (Struct msg
msg WordAddr
addr Word16
dataSz Word16
_) =
    NormalList msg -> ListOf msg Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64 (NormalList msg -> ListOf msg Word64)
-> NormalList msg -> ListOf msg Word64
forall a b. (a -> b) -> a -> b
$ msg -> WordAddr -> Int -> NormalList msg
forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList msg
msg WordAddr
addr (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 msg -> ListOf msg (Maybe (Ptr msg))
ptrSection :: Struct msg -> ListOf msg (Maybe (Ptr msg))
ptrSection (Struct msg
msg addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Word16
dataSz Word16
ptrSz) =
    NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr (NormalList msg -> ListOf msg (Maybe (Ptr msg)))
-> NormalList msg -> ListOf msg (Maybe (Ptr msg))
forall a b. (a -> b) -> a -> b
$ msg -> WordAddr -> Int -> NormalList msg
forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList
        msg
msg
        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 }
        (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 msg -> WordCount
structWordCount :: Struct msg -> WordCount
structWordCount (Struct msg
_msg WordAddr
_addr 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 msg -> ByteCount
structByteCount :: Struct msg -> ByteCount
structByteCount = WordCount -> ByteCount
wordsToBytes (WordCount -> ByteCount)
-> (Struct msg -> WordCount) -> Struct msg -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct msg -> WordCount
forall msg. Struct msg -> WordCount
structWordCount

-- | Get the size of a struct's pointer section.
structPtrCount  :: Struct msg -> Word16
structPtrCount :: Struct msg -> Word16
structPtrCount (Struct msg
_msg WordAddr
_addr Word16
_dataSz Word16
ptrSz) = Word16
ptrSz

-- | Get the size (in words) of the data sections in a struct list.
structListWordCount :: ListOf msg (Struct msg) -> WordCount
structListWordCount :: ListOf msg (Struct msg) -> WordCount
structListWordCount (ListOfStruct Struct msg
s Int
_) = Struct msg -> WordCount
forall msg. Struct msg -> WordCount
structWordCount Struct msg
s

-- | Get the size (in words) of the data sections in a struct list.
structListByteCount :: ListOf msg (Struct msg) -> ByteCount
structListByteCount :: ListOf msg (Struct msg) -> ByteCount
structListByteCount (ListOfStruct Struct msg
s Int
_) = Struct msg -> ByteCount
forall msg. Struct msg -> ByteCount
structByteCount Struct msg
s

-- | Get the size of the pointer sections in a struct list.
structListPtrCount  :: ListOf msg (Struct msg) -> Word16
structListPtrCount :: ListOf msg (Struct msg) -> Word16
structListPtrCount  (ListOfStruct Struct msg
s Int
_) = Struct msg -> Word16
forall msg. Struct msg -> Word16
structPtrCount Struct msg
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
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 msg. Struct msg -> WordCount
structWordCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Word64
0 Word64 -> m () -> m Word64
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
    | Bool
otherwise = Int -> ListOf msg Word64 -> m Word64
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
index Int
i (Struct msg -> ListOf msg Word64
forall msg. Struct msg -> ListOf msg Word64
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))
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 msg. Struct msg -> Word16
structPtrCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Maybe (Ptr msg)
forall a. Maybe a
Nothing Maybe (Ptr msg) -> m () -> m (Maybe (Ptr msg))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
    | Bool
otherwise = Int -> ListOf msg (Maybe (Ptr msg)) -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
index Int
i (Struct msg -> ListOf msg (Maybe (Ptr msg))
forall msg. Struct msg -> ListOf msg (Maybe (Ptr msg))
ptrSection Struct msg
struct)

-- | @'setData' value i struct@ sets the @i@th word in the struct's data section
-- to @value@.
setData :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s)
    => Word64 -> Int -> Struct (M.MutMsg s) -> m ()
setData :: Word64 -> Int -> Struct (MutMsg s) -> m ()
setData Word64
value Int
i = Word64 -> Int -> ListOf (MutMsg s) Word64 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex Word64
value Int
i (ListOf (MutMsg s) Word64 -> m ())
-> (Struct (MutMsg s) -> ListOf (MutMsg s) Word64)
-> Struct (MutMsg s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (MutMsg s) -> ListOf (MutMsg s) Word64
forall msg. Struct msg -> ListOf msg Word64
dataSection

-- | @'setData' value i struct@ sets the @i@th pointer in the struct's pointer
-- section to @value@.
setPtr :: (ReadCtx m (M.MutMsg s), M.WriteCtx m s) => Maybe (Ptr (M.MutMsg s)) -> Int -> Struct (M.MutMsg s) -> m ()
setPtr :: Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
setPtr Maybe (Ptr (MutMsg s))
value Int
i = Maybe (Ptr (MutMsg s))
-> Int -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
setIndex Maybe (Ptr (MutMsg s))
value Int
i (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ())
-> (Struct (MutMsg s)
    -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> Struct (MutMsg s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (MutMsg s) -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
forall msg. Struct msg -> ListOf msg (Maybe (Ptr msg))
ptrSection

-- | 'rawBytes' returns the raw bytes corresponding to the list.
rawBytes :: ReadCtx m msg => ListOf msg Word8 -> m BS.ByteString
rawBytes :: ListOf msg Word8 -> m ByteString
rawBytes (ListOfWord8 (NormalList msg
msg WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
segIndex :: WordAddr -> Int
wordIndex :: WordAddr -> WordCount
..} Int
len)) = do
    WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice (WordCount -> m ()) -> WordCount -> m ()
forall a b. (a -> b) -> a -> b
$ WordCount -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> WordCount) -> WordCount -> WordCount
forall a b. (a -> b) -> a -> b
$ ByteCount -> WordCount
bytesToWordsCeil (Int -> ByteCount
ByteCount Int
len)
    ByteString
bytes <- msg -> Int -> m (Segment msg)
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> Int -> m (Segment msg)
M.getSegment msg
msg Int
segIndex m (Segment msg) -> (Segment msg -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Segment msg -> m ByteString
forall (m :: * -> *) msg.
Message m msg =>
Segment msg -> m ByteString
M.toByteString
    let ByteCount Int
byteOffset = WordCount -> ByteCount
wordsToBytes WordCount
wordIndex
    pure $ 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 msg => msg -> m (Struct msg)
rootPtr :: msg -> m (Struct msg)
rootPtr msg
msg = do
    Maybe (Ptr msg)
root <- msg -> WordAddr -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
msg -> WordAddr -> m (Maybe (Ptr msg))
get msg
msg (Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0)
    case Maybe (Ptr msg)
root of
        Just (PtrStruct Struct msg
struct) -> Struct msg -> m (Struct msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct msg
struct
        Maybe (Ptr msg)
Nothing -> Struct msg -> m (Struct msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InMessage (Struct msg) -> Struct msg
forall a. MessageDefault a => InMessage a -> a
messageDefault msg
InMessage (Struct msg)
msg)
        Maybe (Ptr msg)
_ -> Error -> m (Struct msg)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Struct msg)) -> Error -> m (Struct msg)
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 (M.MutMsg s) -> m ()
setRoot :: Struct (MutMsg s) -> m ()
setRoot (Struct MutMsg s
msg WordAddr
addr Word16
dataSz Word16
ptrSz) =
    MutMsg s -> WordAddr -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> WordAddr -> WordAddr -> Ptr -> m ()
setPointerTo MutMsg s
msg (Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0) WordAddr
addr (Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz)

-- | Allocate a struct in the message.
allocStruct :: M.WriteCtx m s => M.MutMsg s -> Word16 -> Word16 -> m (Struct (M.MutMsg s))
allocStruct :: MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
allocStruct MutMsg 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
    WordAddr
addr <- MutMsg s -> WordCount -> m WordAddr
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> WordCount -> m WordAddr
M.alloc MutMsg s
msg WordCount
totalSz
    pure $ MutMsg s -> WordAddr -> Word16 -> Word16 -> Struct (MutMsg s)
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct MutMsg s
msg WordAddr
addr Word16
dataSz Word16
ptrSz

-- | Allocate a composite list.
allocCompositeList
    :: M.WriteCtx m s
    => M.MutMsg 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 (M.MutMsg s) (Struct (M.MutMsg s)))
allocCompositeList :: MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
allocCompositeList MutMsg 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
    WordAddr
addr <- MutMsg s -> WordCount -> m WordAddr
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> WordCount -> m WordAddr
M.alloc MutMsg 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.
    MutMsg s -> WordAddr -> Word64 -> m ()
forall (m :: * -> *) s.
(WriteCtx m s, MonadThrow m) =>
MutMsg s -> WordAddr -> Word64 -> m ()
M.setWord MutMsg s
msg WordAddr
addr (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 (MutMsg s)
firstStruct = MutMsg s -> WordAddr -> Word16 -> Word16 -> Struct (MutMsg s)
forall msg. msg -> WordAddr -> Word16 -> Word16 -> Struct msg
Struct
            MutMsg s
msg
            WordAddr
addr { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
addr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
            Word16
dataSz
            Word16
ptrSz
    ListOf (MutMsg s) (Struct (MutMsg s))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf (MutMsg s) (Struct (MutMsg s))
 -> m (ListOf (MutMsg s) (Struct (MutMsg s))))
-> ListOf (MutMsg s) (Struct (MutMsg s))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall a b. (a -> b) -> a -> b
$ Struct (MutMsg s) -> Int -> ListOf (MutMsg s) (Struct (MutMsg s))
forall msg. Struct msg -> Int -> ListOf msg (Struct msg)
ListOfStruct Struct (MutMsg s)
firstStruct Int
len

-- | Allocate a list of capnproto @Void@ values.
allocList0   :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) ())

-- | Allocate a list of booleans
allocList1   :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Bool)

-- | Allocate a list of 8-bit values.
allocList8   :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word8)

-- | Allocate a list of 16-bit values.
allocList16  :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word16)

-- | Allocate a list of 32-bit values.
allocList32  :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word32)

-- | Allocate a list of 64-bit words.
allocList64  :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) Word64)

-- | Allocate a list of pointers.
allocListPtr :: M.WriteCtx m s => M.MutMsg s -> Int -> m (ListOf (M.MutMsg s) (Maybe (Ptr (M.MutMsg s))))

allocList0 :: MutMsg s -> Int -> m (ListOf (MutMsg s) ())
allocList0   MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) ()
forall msg. NormalList msg -> ListOf msg ()
ListOfVoid   (NormalList (MutMsg s) -> ListOf (MutMsg s) ())
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
0  MutMsg s
msg Int
len
allocList1 :: MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
allocList1   MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) Bool
forall msg. NormalList msg -> ListOf msg Bool
ListOfBool   (NormalList (MutMsg s) -> ListOf (MutMsg s) Bool)
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
1  MutMsg s
msg Int
len
allocList8 :: MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
allocList8   MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) Word8
forall msg. NormalList msg -> ListOf msg Word8
ListOfWord8  (NormalList (MutMsg s) -> ListOf (MutMsg s) Word8)
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
8  MutMsg s
msg Int
len
allocList16 :: MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
allocList16  MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) Word16
forall msg. NormalList msg -> ListOf msg Word16
ListOfWord16 (NormalList (MutMsg s) -> ListOf (MutMsg s) Word16)
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
16 MutMsg s
msg Int
len
allocList32 :: MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
allocList32  MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) Word32
forall msg. NormalList msg -> ListOf msg Word32
ListOfWord32 (NormalList (MutMsg s) -> ListOf (MutMsg s) Word32)
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
32 MutMsg s
msg Int
len
allocList64 :: MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
allocList64  MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) Word64
forall msg. NormalList msg -> ListOf msg Word64
ListOfWord64 (NormalList (MutMsg s) -> ListOf (MutMsg s) Word64)
-> m (NormalList (MutMsg s)) -> m (ListOf (MutMsg s) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
64 MutMsg s
msg Int
len
allocListPtr :: MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
allocListPtr MutMsg s
msg Int
len = NormalList (MutMsg s) -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
forall msg. NormalList msg -> ListOf msg (Maybe (Ptr msg))
ListOfPtr    (NormalList (MutMsg s)
 -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> m (NormalList (MutMsg s))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
64 MutMsg s
msg Int
len

-- | Allocate a NormalList
allocNormalList
    :: M.WriteCtx m s
    => Int        -- ^ The number of elements per 64-bit word
    -> M.MutMsg s -- ^ The message to allocate in
    -> Int        -- ^ The number of bits per element
    -> m (NormalList (M.MutMsg s))
allocNormalList :: Int -> MutMsg s -> Int -> m (NormalList (MutMsg s))
allocNormalList Int
bitsPerElt MutMsg 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
    WordAddr
addr <- MutMsg s -> WordCount -> m WordAddr
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> WordCount -> m WordAddr
M.alloc MutMsg s
msg WordCount
totalWords
    pure NormalList :: forall msg. msg -> WordAddr -> Int -> NormalList msg
NormalList
        { nMsg :: MutMsg s
nMsg = MutMsg s
msg
        , nAddr :: WordAddr
nAddr = WordAddr
addr
        , nLen :: Int
nLen = Int
len
        }

appendCap :: M.WriteCtx m s => M.MutMsg s -> M.Client -> m (Cap (M.MutMsg s))
appendCap :: MutMsg s -> Client -> m (Cap (MutMsg s))
appendCap MutMsg s
msg Client
client = do
    Int
i <- MutMsg s -> Client -> m Int
forall (m :: * -> *) s. WriteCtx m s => MutMsg s -> Client -> m Int
M.appendCap MutMsg s
msg Client
client
    pure $ MutMsg s -> Word32 -> Cap (MutMsg s)
forall msg. msg -> Word32 -> Cap msg
Cap MutMsg s
msg (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)