{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-error=deprecations #-}
module Capnp.Untyped
(
Repr(..)
, PtrRepr(..)
, ListRepr(..)
, NormalListRepr(..)
, DataSz(..)
, Untyped
, UntypedData
, UntypedPtr
, UntypedSomePtr
, UntypedList
, UntypedSomeList
, IgnoreMut(..)
, MaybePtr(..)
, Unwrapped
, Element(..)
, ListItem(..)
, ElemRepr
, ListReprFor
, IsPtrRepr(..)
, IsListPtrRepr(..)
, Allocate(..)
, AllocateNormalList(..)
, Ptr(..), List(..), Struct, ListOf, Cap
, structByteCount
, structWordCount
, structPtrCount
, structListByteCount
, structListWordCount
, structListPtrCount
, getData, getPtr
, setData, setPtr
, copyStruct
, copyPtr
, copyList
, copyCap
, copyListOf
, getClient
, get, index
, setIndex
, take
, rootPtr
, setRoot
, rawBytes
, ReadCtx
, RWCtx
, HasMessage(..), MessageDefault(..)
, allocStruct
, allocCompositeList
, allocList0
, allocList1
, allocList8
, allocList16
, allocList32
, allocList64
, allocListPtr
, appendCap
, TraverseMsg(..)
)
where
import Prelude hiding (length, take)
import Data.Bits
import Data.Word
import Control.Exception.Safe (impureThrow)
import Control.Monad (forM_, unless)
import Control.Monad.Catch (MonadCatch, MonadThrow(throwM))
import Control.Monad.Catch.Pure (CatchT(runCatchT))
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.ST (RealWorld)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.Kind (Type)
import qualified Data.ByteString as BS
import qualified Language.Haskell.TH as TH
import Capnp.Address (OffsetError(..), WordAddr(..), pointerFrom)
import Capnp.Bits
( BitCount(..)
, ByteCount(..)
, Word1(..)
, WordCount(..)
, bitsToBytesCeil
, bytesToWordsCeil
, replaceBits
, wordsToBytes
)
import Capnp.Mutability (MaybeMutable(..), Mutability(..))
import Capnp.TraversalLimit (LimitT, MonadLimit(invoice))
import qualified Capnp.Errors as E
import qualified Capnp.Message as M
import qualified Capnp.Pointer as P
data Ptr mut
= PtrCap (Cap mut)
| PtrList (List mut)
| PtrStruct (Struct mut)
data List mut
= List0 (ListOf ('Data 'Sz0) mut)
| List1 (ListOf ('Data 'Sz1) mut)
| List8 (ListOf ('Data 'Sz8) mut)
| List16 (ListOf ('Data 'Sz16) mut)
| List32 (ListOf ('Data 'Sz32) mut)
| List64 (ListOf ('Data 'Sz64) mut)
| ListPtr (ListOf ('Ptr 'Nothing) mut)
| ListStruct (ListOf ('Ptr ('Just 'Struct)) mut)
data NormalList mut = NormalList
{ NormalList mut -> WordPtr mut
nPtr :: {-# UNPACK #-} !(M.WordPtr mut)
, NormalList mut -> Int
nLen :: !Int
}
data StructList mut = StructList
{ StructList mut -> Struct mut
slFirst :: Struct mut
, StructList mut -> Int
slLen :: !Int
}
newtype ListOf r mut = ListOf (ListRepOf r mut)
type family ListRepOf (r :: Repr) :: Mutability -> * where
ListRepOf ('Ptr ('Just 'Struct)) = StructList
ListRepOf r = NormalList
class Element r => ListItem (r :: Repr) where
length :: ListOf r mut -> Int
unsafeIndex :: ReadCtx m mut => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeSetIndex
:: (RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s)))
=> a -> Int -> ListOf r ('Mut s) -> m ()
unsafeTake :: Int -> ListOf r mut -> ListOf r mut
checkListOf :: ReadCtx m mut => ListOf r mut -> m ()
default length :: (ListRepOf r ~ NormalList) => ListOf r mut -> Int
length (ListOf ListRepOf r mut
nlist) = NormalList mut -> Int
forall (mut :: Mutability). NormalList mut -> Int
nLen ListRepOf r mut
NormalList mut
nlist
{-# INLINE length #-}
default unsafeIndex ::
forall m mut.
( ReadCtx m mut
, Integral (Unwrapped (Untyped r mut))
, ListRepOf r ~ NormalList
, FiniteBits (Unwrapped (Untyped r mut))
) => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeIndex Int
i (ListOf ListRepOf r mut
nlist) =
Int -> NormalList mut -> m (Unwrapped (Untyped r mut))
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, FiniteBits a, Integral a) =>
Int -> NormalList mut -> m a
unsafeIndexBits @(Unwrapped (Untyped r mut)) Int
i ListRepOf r mut
NormalList mut
nlist
{-# INLINE unsafeIndex #-}
default unsafeSetIndex ::
forall m s a.
( RWCtx m s
, a ~ Unwrapped (Untyped r ('Mut s))
, ListRepOf r ~ NormalList
, Integral a
, Bounded a
, FiniteBits a
) => a -> Int -> ListOf r ('Mut s) -> m ()
unsafeSetIndex a
value Int
i (ListOf ListRepOf r ('Mut s)
nlist) =
Unwrapped (Untyped r ('Mut s))
-> Int -> NormalList ('Mut s) -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, FiniteBits a, Integral a) =>
a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits @(Unwrapped (Untyped r ('Mut s))) a
Unwrapped (Untyped r ('Mut s))
value Int
i ListRepOf r ('Mut s)
NormalList ('Mut s)
nlist
{-# INLINE unsafeSetIndex #-}
default unsafeTake :: ListRepOf r ~ NormalList => Int -> ListOf r mut -> ListOf r mut
unsafeTake Int
count (ListOf NormalList{..}) = ListRepOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList{ nLen :: Int
nLen = Int
count, WordPtr mut
nPtr :: WordPtr mut
nPtr :: WordPtr mut
.. }
{-# INLINE unsafeTake #-}
default checkListOf ::
forall m mut.
( ReadCtx m mut
, ListRepOf r ~ NormalList
, FiniteBits (Untyped r mut)
) => ListOf r mut -> m ()
checkListOf (ListOf ListRepOf r mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList
ListRepOf r mut
NormalList mut
l
(Int -> BitCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BitCount) -> Int -> BitCount
forall a b. (a -> b) -> a -> b
$ Untyped r mut -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Untyped r mut
forall a. HasCallStack => a
undefined :: Untyped r mut))
{-# INLINE checkListOf #-}
unsafeIndexBits
:: forall a m mut.
( ReadCtx m mut
, FiniteBits a
, Integral a
) => Int -> NormalList mut -> m a
{-# INLINE unsafeIndexBits #-}
unsafeIndexBits :: Int -> NormalList mut -> m a
unsafeIndexBits Int
i NormalList mut
nlist =
Int -> NormalList mut -> Int -> m a
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, Integral a) =>
Int -> NormalList mut -> Int -> m a
indexNList @a Int
i NormalList mut
nlist (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a))
unsafeSetIndexBits
:: forall a m s.
( RWCtx m s
, Bounded a
, FiniteBits a
, Integral a
) => a -> Int -> NormalList ('Mut s) -> m ()
{-# INLINE unsafeSetIndexBits #-}
unsafeSetIndexBits :: a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits a
value Int
i NormalList ('Mut s)
nlist =
Int -> NormalList ('Mut s) -> Int -> a -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex @a Int
i NormalList ('Mut s)
nlist (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
value) a
value
indexNList
:: forall a m mut. (ReadCtx m mut, Integral a)
=> Int -> NormalList mut -> Int -> m a
{-# INLINE indexNList #-}
indexNList :: Int -> NormalList mut -> Int -> m a
indexNList Int
i (NormalList M.WordPtr{Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment :: Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{Int
WordCount
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
wordIndex :: WordCount
segIndex :: Int
..}} Int
_) Int
eltsPerWord = do
let wordIndex' :: WordCount
wordIndex' = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
Word64
word <- Segment mut -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment mut
pSegment WordCount
wordIndex'
let shift :: Int
shift = (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
eltsPerWord) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift
setNIndex
:: forall a m s. (RWCtx m s, Bounded a, Integral a)
=> Int -> NormalList ('Mut s) -> Int -> a -> m ()
{-# INLINE setNIndex #-}
setNIndex :: Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i NormalList{nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr=M.WordPtr{Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}} Int
eltsPerWord a
value = do
let eltWordIndex :: WordCount
eltWordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
Word64
word <- Segment ('Mut s) -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment ('Mut s)
pSegment WordCount
eltWordIndex
let shift :: Int
shift = (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
eltsPerWord) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
eltsPerWord)
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
pSegment WordCount
eltWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Word64 -> Int -> Word64
forall a. (Bounded a, Integral a) => a -> Word64 -> Int -> Word64
replaceBits a
value Word64
word Int
shift
setPtrIndex :: RWCtx m s => Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> P.Ptr -> m ()
{-# INLINE setPtrIndex #-}
setPtrIndex :: Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i NormalList{nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr=nPtr :: WordPtr ('Mut s)
nPtr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}} Ptr ('Mut s)
absPtr Ptr
relPtr =
let srcPtr :: WordPtr ('Mut s)
srcPtr = WordPtr ('Mut s)
nPtr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i } }
in WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo WordPtr ('Mut s)
srcPtr (Ptr ('Mut s) -> WordAddr
forall (msg :: Mutability). Ptr msg -> WordAddr
ptrAddr Ptr ('Mut s)
absPtr) Ptr
relPtr
instance ListItem ('Ptr ('Just 'Struct)) where
length :: ListOf ('Ptr ('Just 'Struct)) mut -> Int
length (ListOf (StructList _ len)) = Int
len
{-# INLINE length #-}
unsafeIndex :: Int
-> ListOf ('Ptr ('Just 'Struct)) mut
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
unsafeIndex Int
i (ListOf (StructList (StructAt ptr@M.WordPtr{pAddr=addr@WordAt{..}} dataSz ptrSz) _)) = do
let offset :: WordCount
offset = Int -> WordCount
WordCount (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)
let addr' :: WordAddr
addr' = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
offset }
Struct mut -> m (Struct mut)
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct mut -> m (Struct mut)) -> Struct mut -> m (Struct mut)
forall a b. (a -> b) -> a -> b
$ WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr' } Word16
dataSz Word16
ptrSz
{-# INLINE unsafeIndex #-}
unsafeSetIndex :: a -> Int -> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i ListOf ('Ptr ('Just 'Struct)) ('Mut s)
list = do
Struct ('Mut s)
dest <- Int
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) ('Mut s)))
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeIndex Int
i ListOf ('Ptr ('Just 'Struct)) ('Mut s)
list
Struct ('Mut s) -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
dest a
Struct ('Mut s)
value
unsafeTake :: Int
-> ListOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
unsafeTake Int
count (ListOf (StructList s _)) = ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList Struct mut
s Int
count)
{-# INLINE unsafeTake #-}
checkListOf :: ListOf ('Ptr ('Just 'Struct)) mut -> m ()
checkListOf (ListOf (StructList s@(StructAt ptr _ _) len)) =
WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
ptr (Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
* Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structSize Struct mut
s)
{-# INLINE checkListOf #-}
instance ListItem ('Data 'Sz0) where
unsafeIndex :: Int
-> ListOf ('Data 'Sz0) mut
-> m (Unwrapped (Untyped ('Data 'Sz0) mut))
unsafeIndex Int
_ ListOf ('Data 'Sz0) mut
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE unsafeIndex #-}
unsafeSetIndex :: a -> Int -> ListOf ('Data 'Sz0) ('Mut s) -> m ()
unsafeSetIndex a
_ Int
_ ListOf ('Data 'Sz0) ('Mut s)
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE unsafeSetIndex #-}
checkListOf :: ListOf ('Data 'Sz0) mut -> m ()
checkListOf ListOf ('Data 'Sz0) mut
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE checkListOf #-}
instance ListItem ('Data 'Sz1) where
unsafeIndex :: Int
-> ListOf ('Data 'Sz1) mut
-> m (Unwrapped (Untyped ('Data 'Sz1) mut))
unsafeIndex Int
i (ListOf ListRepOf ('Data 'Sz1) mut
nlist) = do
Word1 Bool
val <- Int -> NormalList mut -> m Word1
forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut, FiniteBits a, Integral a) =>
Int -> NormalList mut -> m a
unsafeIndexBits @Word1 Int
i ListRepOf ('Data 'Sz1) mut
NormalList mut
nlist
Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
val
{-# INLINE unsafeIndex #-}
unsafeSetIndex :: a -> Int -> ListOf ('Data 'Sz1) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i (ListOf ListRepOf ('Data 'Sz1) ('Mut s)
nlist) =
Word1 -> Int -> NormalList ('Mut s) -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, FiniteBits a, Integral a) =>
a -> Int -> NormalList ('Mut s) -> m ()
unsafeSetIndexBits @Word1 (Bool -> Word1
Word1 a
Bool
value) Int
i ListRepOf ('Data 'Sz1) ('Mut s)
NormalList ('Mut s)
nlist
{-# INLINE unsafeSetIndex #-}
checkListOf :: ListOf ('Data 'Sz1) mut -> m ()
checkListOf (ListOf ListRepOf ('Data 'Sz1) mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList ListRepOf ('Data 'Sz1) mut
NormalList mut
l BitCount
1
{-# INLINE checkListOf #-}
instance ListItem ('Data 'Sz8)
instance ListItem ('Data 'Sz16)
instance ListItem ('Data 'Sz32)
instance ListItem ('Data 'Sz64)
instance ListItem ('Ptr 'Nothing) where
unsafeIndex :: Int
-> ListOf ('Ptr 'Nothing) mut
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
unsafeIndex Int
i (ListOf (NormalList ptr@M.WordPtr{pAddr=addr@WordAt{..}} _)) =
WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Int -> WordCount
WordCount Int
i } }
{-# INLINE unsafeIndex #-}
unsafeSetIndex :: a -> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
unsafeSetIndex a
value Int
i list :: ListOf ('Ptr 'Nothing) ('Mut s)
list@(ListOf ListRepOf ('Ptr 'Nothing) ('Mut s)
nlist) = case a
value of
Just p | Unwrapped (Ptr ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Ptr Unwrapped (Ptr ('Mut s))
Ptr ('Mut s)
p Message ('Mut s) -> Message ('Mut s) -> Bool
forall a. Eq a => a -> a -> Bool
/= Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s))
ListOf ('Ptr 'Nothing) ('Mut s)
list -> do
Maybe (Ptr ('Mut s))
newPtr <- Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
copyPtr (Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s))
ListOf ('Ptr 'Nothing) ('Mut s)
list) a
Maybe (Ptr ('Mut s))
value
Maybe (Ptr ('Mut s))
-> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s a.
(ListItem r, RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s))) =>
a -> Int -> ListOf r ('Mut s) -> m ()
unsafeSetIndex Maybe (Ptr ('Mut s))
newPtr Int
i ListOf ('Ptr 'Nothing) ('Mut s)
list
a
Nothing ->
Int -> NormalList ('Mut s) -> Int -> Word64 -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Int
1 (Maybe Ptr -> Word64
P.serializePtr Maybe Ptr
forall a. Maybe a
Nothing)
Just (PtrCap (CapAt _ cap)) ->
Int -> NormalList ('Mut s) -> Int -> Word64 -> m ()
forall a (m :: * -> *) s.
(RWCtx m s, Bounded a, Integral a) =>
Int -> NormalList ('Mut s) -> Int -> a -> m ()
setNIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Int
1 (Maybe Ptr -> Word64
P.serializePtr (Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Word32 -> Ptr
P.CapPtr Word32
cap)))
Just p@(PtrList ptrList) ->
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Ptr ('Mut s)
p (Ptr -> m ()) -> Ptr -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> EltSpec -> Ptr
P.ListPtr Int32
0 (List ('Mut s) -> EltSpec
forall (msg :: Mutability). List msg -> EltSpec
listEltSpec List ('Mut s)
ptrList)
Just p@(PtrStruct (StructAt _ dataSz ptrSz)) ->
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Int -> NormalList ('Mut s) -> Ptr ('Mut s) -> Ptr -> m ()
setPtrIndex Int
i ListRepOf ('Ptr 'Nothing) ('Mut s)
NormalList ('Mut s)
nlist Ptr ('Mut s)
p (Ptr -> m ()) -> Ptr -> m ()
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz
{-# INLINABLE unsafeSetIndex #-}
checkListOf :: ListOf ('Ptr 'Nothing) mut -> m ()
checkListOf (ListOf ListRepOf ('Ptr 'Nothing) mut
l) = NormalList mut -> BitCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
NormalList mut -> BitCount -> m ()
checkNormalList ListRepOf ('Ptr 'Nothing) mut
NormalList mut
l BitCount
64
{-# INLINE checkListOf #-}
data Cap mut = CapAt (M.Message mut) !Word32
data Struct mut
= StructAt
{-# UNPACK #-} !(M.WordPtr mut)
!Word16
!Word16
type ReadCtx m mut = (M.MonadReadMessage mut m, MonadThrow m, MonadLimit m)
type RWCtx m s = (ReadCtx m ('Mut s), M.WriteCtx m s)
data Repr
= Ptr (Maybe PtrRepr)
| Data DataSz
deriving(Int -> Repr -> ShowS
[Repr] -> ShowS
Repr -> String
(Int -> Repr -> ShowS)
-> (Repr -> String) -> ([Repr] -> ShowS) -> Show Repr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repr] -> ShowS
$cshowList :: [Repr] -> ShowS
show :: Repr -> String
$cshow :: Repr -> String
showsPrec :: Int -> Repr -> ShowS
$cshowsPrec :: Int -> Repr -> ShowS
Show)
data PtrRepr
= Cap
| List (Maybe ListRepr)
| Struct
deriving(Int -> PtrRepr -> ShowS
[PtrRepr] -> ShowS
PtrRepr -> String
(Int -> PtrRepr -> ShowS)
-> (PtrRepr -> String) -> ([PtrRepr] -> ShowS) -> Show PtrRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PtrRepr] -> ShowS
$cshowList :: [PtrRepr] -> ShowS
show :: PtrRepr -> String
$cshow :: PtrRepr -> String
showsPrec :: Int -> PtrRepr -> ShowS
$cshowsPrec :: Int -> PtrRepr -> ShowS
Show)
data ListRepr where
ListNormal :: NormalListRepr -> ListRepr
ListComposite :: ListRepr
deriving(Int -> ListRepr -> ShowS
[ListRepr] -> ShowS
ListRepr -> String
(Int -> ListRepr -> ShowS)
-> (ListRepr -> String) -> ([ListRepr] -> ShowS) -> Show ListRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRepr] -> ShowS
$cshowList :: [ListRepr] -> ShowS
show :: ListRepr -> String
$cshow :: ListRepr -> String
showsPrec :: Int -> ListRepr -> ShowS
$cshowsPrec :: Int -> ListRepr -> ShowS
Show)
data NormalListRepr where
NormalListData :: DataSz -> NormalListRepr
NormalListPtr :: NormalListRepr
deriving(Int -> NormalListRepr -> ShowS
[NormalListRepr] -> ShowS
NormalListRepr -> String
(Int -> NormalListRepr -> ShowS)
-> (NormalListRepr -> String)
-> ([NormalListRepr] -> ShowS)
-> Show NormalListRepr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalListRepr] -> ShowS
$cshowList :: [NormalListRepr] -> ShowS
show :: NormalListRepr -> String
$cshow :: NormalListRepr -> String
showsPrec :: Int -> NormalListRepr -> ShowS
$cshowsPrec :: Int -> NormalListRepr -> ShowS
Show)
data DataSz = Sz0 | Sz1 | Sz8 | Sz16 | Sz32 | Sz64
deriving(Int -> DataSz -> ShowS
[DataSz] -> ShowS
DataSz -> String
(Int -> DataSz -> ShowS)
-> (DataSz -> String) -> ([DataSz] -> ShowS) -> Show DataSz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSz] -> ShowS
$cshowList :: [DataSz] -> ShowS
show :: DataSz -> String
$cshow :: DataSz -> String
showsPrec :: Int -> DataSz -> ShowS
$cshowsPrec :: Int -> DataSz -> ShowS
Show)
newtype IgnoreMut a (mut :: Mutability) = IgnoreMut a
deriving(Int -> IgnoreMut a mut -> ShowS
[IgnoreMut a mut] -> ShowS
IgnoreMut a mut -> String
(Int -> IgnoreMut a mut -> ShowS)
-> (IgnoreMut a mut -> String)
-> ([IgnoreMut a mut] -> ShowS)
-> Show (IgnoreMut a mut)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a (mut :: Mutability).
Show a =>
Int -> IgnoreMut a mut -> ShowS
forall a (mut :: Mutability). Show a => [IgnoreMut a mut] -> ShowS
forall a (mut :: Mutability). Show a => IgnoreMut a mut -> String
showList :: [IgnoreMut a mut] -> ShowS
$cshowList :: forall a (mut :: Mutability). Show a => [IgnoreMut a mut] -> ShowS
show :: IgnoreMut a mut -> String
$cshow :: forall a (mut :: Mutability). Show a => IgnoreMut a mut -> String
showsPrec :: Int -> IgnoreMut a mut -> ShowS
$cshowsPrec :: forall a (mut :: Mutability).
Show a =>
Int -> IgnoreMut a mut -> ShowS
Show, ReadPrec [IgnoreMut a mut]
ReadPrec (IgnoreMut a mut)
Int -> ReadS (IgnoreMut a mut)
ReadS [IgnoreMut a mut]
(Int -> ReadS (IgnoreMut a mut))
-> ReadS [IgnoreMut a mut]
-> ReadPrec (IgnoreMut a mut)
-> ReadPrec [IgnoreMut a mut]
-> Read (IgnoreMut a mut)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a (mut :: Mutability). Read a => ReadPrec [IgnoreMut a mut]
forall a (mut :: Mutability). Read a => ReadPrec (IgnoreMut a mut)
forall a (mut :: Mutability).
Read a =>
Int -> ReadS (IgnoreMut a mut)
forall a (mut :: Mutability). Read a => ReadS [IgnoreMut a mut]
readListPrec :: ReadPrec [IgnoreMut a mut]
$creadListPrec :: forall a (mut :: Mutability). Read a => ReadPrec [IgnoreMut a mut]
readPrec :: ReadPrec (IgnoreMut a mut)
$creadPrec :: forall a (mut :: Mutability). Read a => ReadPrec (IgnoreMut a mut)
readList :: ReadS [IgnoreMut a mut]
$creadList :: forall a (mut :: Mutability). Read a => ReadS [IgnoreMut a mut]
readsPrec :: Int -> ReadS (IgnoreMut a mut)
$creadsPrec :: forall a (mut :: Mutability).
Read a =>
Int -> ReadS (IgnoreMut a mut)
Read, IgnoreMut a mut -> IgnoreMut a mut -> Bool
(IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> Eq (IgnoreMut a mut)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
/= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c/= :: forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
== :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c== :: forall a (mut :: Mutability).
Eq a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
Eq, Eq (IgnoreMut a mut)
Eq (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Ordering)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> Ord (IgnoreMut a mut)
IgnoreMut a mut -> IgnoreMut a mut -> Bool
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a (mut :: Mutability). Ord a => Eq (IgnoreMut a mut)
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
min :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmin :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
max :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmax :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
>= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c>= :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
> :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c> :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
<= :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c<= :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
< :: IgnoreMut a mut -> IgnoreMut a mut -> Bool
$c< :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Bool
compare :: IgnoreMut a mut -> IgnoreMut a mut -> Ordering
$ccompare :: forall a (mut :: Mutability).
Ord a =>
IgnoreMut a mut -> IgnoreMut a mut -> Ordering
$cp1Ord :: forall a (mut :: Mutability). Ord a => Eq (IgnoreMut a mut)
Ord, Int -> IgnoreMut a mut
IgnoreMut a mut -> Int
IgnoreMut a mut -> [IgnoreMut a mut]
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
(IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> (IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut])
-> Enum (IgnoreMut a mut)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall a (mut :: Mutability). Enum a => Int -> IgnoreMut a mut
forall a (mut :: Mutability). Enum a => IgnoreMut a mut -> Int
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> [IgnoreMut a mut]
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromThenTo :: IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromThenTo :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut
-> IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromTo :: IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromTo :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFromThen :: IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFromThen :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut -> [IgnoreMut a mut]
enumFrom :: IgnoreMut a mut -> [IgnoreMut a mut]
$cenumFrom :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> [IgnoreMut a mut]
fromEnum :: IgnoreMut a mut -> Int
$cfromEnum :: forall a (mut :: Mutability). Enum a => IgnoreMut a mut -> Int
toEnum :: Int -> IgnoreMut a mut
$ctoEnum :: forall a (mut :: Mutability). Enum a => Int -> IgnoreMut a mut
pred :: IgnoreMut a mut -> IgnoreMut a mut
$cpred :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
succ :: IgnoreMut a mut -> IgnoreMut a mut
$csucc :: forall a (mut :: Mutability).
Enum a =>
IgnoreMut a mut -> IgnoreMut a mut
Enum, IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> Bounded (IgnoreMut a mut)
forall a. a -> a -> Bounded a
forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
maxBound :: IgnoreMut a mut
$cmaxBound :: forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
minBound :: IgnoreMut a mut
$cminBound :: forall a (mut :: Mutability). Bounded a => IgnoreMut a mut
Bounded, Integer -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
(IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (Integer -> IgnoreMut a mut)
-> Num (IgnoreMut a mut)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall a (mut :: Mutability). Num a => Integer -> IgnoreMut a mut
forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
fromInteger :: Integer -> IgnoreMut a mut
$cfromInteger :: forall a (mut :: Mutability). Num a => Integer -> IgnoreMut a mut
signum :: IgnoreMut a mut -> IgnoreMut a mut
$csignum :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
abs :: IgnoreMut a mut -> IgnoreMut a mut
$cabs :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
negate :: IgnoreMut a mut -> IgnoreMut a mut
$cnegate :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut
* :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c* :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
- :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c- :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
+ :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c+ :: forall a (mut :: Mutability).
Num a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
Num, Num (IgnoreMut a mut)
Ord (IgnoreMut a mut)
Num (IgnoreMut a mut)
-> Ord (IgnoreMut a mut)
-> (IgnoreMut a mut -> Rational)
-> Real (IgnoreMut a mut)
IgnoreMut a mut -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a (mut :: Mutability). Real a => Num (IgnoreMut a mut)
forall a (mut :: Mutability). Real a => Ord (IgnoreMut a mut)
forall a (mut :: Mutability). Real a => IgnoreMut a mut -> Rational
toRational :: IgnoreMut a mut -> Rational
$ctoRational :: forall a (mut :: Mutability). Real a => IgnoreMut a mut -> Rational
$cp2Real :: forall a (mut :: Mutability). Real a => Ord (IgnoreMut a mut)
$cp1Real :: forall a (mut :: Mutability). Real a => Num (IgnoreMut a mut)
Real, Enum (IgnoreMut a mut)
Real (IgnoreMut a mut)
Real (IgnoreMut a mut)
-> Enum (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut))
-> (IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut))
-> (IgnoreMut a mut -> Integer)
-> Integral (IgnoreMut a mut)
IgnoreMut a mut -> Integer
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
forall a (mut :: Mutability). Integral a => Enum (IgnoreMut a mut)
forall a (mut :: Mutability). Integral a => Real (IgnoreMut a mut)
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> Integer
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
toInteger :: IgnoreMut a mut -> Integer
$ctoInteger :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> Integer
divMod :: IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
$cdivMod :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
quotRem :: IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
$cquotRem :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut
-> IgnoreMut a mut -> (IgnoreMut a mut, IgnoreMut a mut)
mod :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cmod :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
div :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cdiv :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
rem :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$crem :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
quot :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cquot :: forall a (mut :: Mutability).
Integral a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cp2Integral :: forall a (mut :: Mutability). Integral a => Enum (IgnoreMut a mut)
$cp1Integral :: forall a (mut :: Mutability). Integral a => Real (IgnoreMut a mut)
Integral, Eq (IgnoreMut a mut)
IgnoreMut a mut
Eq (IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> IgnoreMut a mut
-> (Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> Bool)
-> (IgnoreMut a mut -> Maybe Int)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Bool)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int -> IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> Bits (IgnoreMut a mut)
Int -> IgnoreMut a mut
IgnoreMut a mut -> Bool
IgnoreMut a mut -> Int
IgnoreMut a mut -> Maybe Int
IgnoreMut a mut -> IgnoreMut a mut
IgnoreMut a mut -> Int -> Bool
IgnoreMut a mut -> Int -> IgnoreMut a mut
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a (mut :: Mutability). Bits a => Eq (IgnoreMut a mut)
forall a (mut :: Mutability). Bits a => IgnoreMut a mut
forall a (mut :: Mutability). Bits a => Int -> IgnoreMut a mut
forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Bool
forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Maybe Int
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> Bool
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
popCount :: IgnoreMut a mut -> Int
$cpopCount :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
rotateR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotateR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
rotateL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotateL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
unsafeShiftR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cunsafeShiftR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shiftR :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshiftR :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
unsafeShiftL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cunsafeShiftL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shiftL :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshiftL :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
isSigned :: IgnoreMut a mut -> Bool
$cisSigned :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Bool
bitSize :: IgnoreMut a mut -> Int
$cbitSize :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut -> Int
bitSizeMaybe :: IgnoreMut a mut -> Maybe Int
$cbitSizeMaybe :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Maybe Int
testBit :: IgnoreMut a mut -> Int -> Bool
$ctestBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> Bool
complementBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$ccomplementBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
clearBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cclearBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
setBit :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$csetBit :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
bit :: Int -> IgnoreMut a mut
$cbit :: forall a (mut :: Mutability). Bits a => Int -> IgnoreMut a mut
zeroBits :: IgnoreMut a mut
$czeroBits :: forall a (mut :: Mutability). Bits a => IgnoreMut a mut
rotate :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$crotate :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
shift :: IgnoreMut a mut -> Int -> IgnoreMut a mut
$cshift :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> Int -> IgnoreMut a mut
complement :: IgnoreMut a mut -> IgnoreMut a mut
$ccomplement :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut
xor :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cxor :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
.|. :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c.|. :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
.&. :: IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$c.&. :: forall a (mut :: Mutability).
Bits a =>
IgnoreMut a mut -> IgnoreMut a mut -> IgnoreMut a mut
$cp1Bits :: forall a (mut :: Mutability). Bits a => Eq (IgnoreMut a mut)
Bits, Bits (IgnoreMut a mut)
Bits (IgnoreMut a mut)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Int)
-> (IgnoreMut a mut -> Int)
-> FiniteBits (IgnoreMut a mut)
IgnoreMut a mut -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
forall a (mut :: Mutability).
FiniteBits a =>
Bits (IgnoreMut a mut)
forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
countTrailingZeros :: IgnoreMut a mut -> Int
$ccountTrailingZeros :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
countLeadingZeros :: IgnoreMut a mut -> Int
$ccountLeadingZeros :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
finiteBitSize :: IgnoreMut a mut -> Int
$cfiniteBitSize :: forall a (mut :: Mutability).
FiniteBits a =>
IgnoreMut a mut -> Int
$cp1FiniteBits :: forall a (mut :: Mutability).
FiniteBits a =>
Bits (IgnoreMut a mut)
FiniteBits)
newtype MaybePtr (mut :: Mutability) = MaybePtr (Maybe (Ptr mut))
type family Unwrapped a where
Unwrapped (IgnoreMut a mut) = a
Unwrapped (MaybePtr mut) = Maybe (Ptr mut)
Unwrapped a = a
type family Untyped (r :: Repr) :: Mutability -> Type where
Untyped ('Data sz) = IgnoreMut (UntypedData sz)
Untyped ('Ptr ptr) = UntypedPtr ptr
type family UntypedData (sz :: DataSz) :: Type where
UntypedData 'Sz0 = ()
UntypedData 'Sz1 = Bool
UntypedData 'Sz8 = Word8
UntypedData 'Sz16 = Word16
UntypedData 'Sz32 = Word32
UntypedData 'Sz64 = Word64
type family UntypedPtr (r :: Maybe PtrRepr) :: Mutability -> Type where
UntypedPtr 'Nothing = MaybePtr
UntypedPtr ('Just r) = UntypedSomePtr r
type family UntypedSomePtr (r :: PtrRepr) :: Mutability -> Type where
UntypedSomePtr 'Struct = Struct
UntypedSomePtr 'Cap = Cap
UntypedSomePtr ('List r) = UntypedList r
type family UntypedList (r :: Maybe ListRepr) :: Mutability -> Type where
UntypedList 'Nothing = List
UntypedList ('Just r) = UntypedSomeList r
type family UntypedSomeList (r :: ListRepr) :: Mutability -> Type where
UntypedSomeList r = ListOf (ElemRepr r)
type family ElemRepr (rl :: ListRepr) :: Repr where
ElemRepr 'ListComposite = 'Ptr ('Just 'Struct)
ElemRepr ('ListNormal 'NormalListPtr) = 'Ptr 'Nothing
ElemRepr ('ListNormal ('NormalListData sz)) = 'Data sz
type family ListReprFor (e :: Repr) :: ListRepr where
ListReprFor ('Data sz) = 'ListNormal ('NormalListData sz)
ListReprFor ('Ptr ('Just 'Struct)) = 'ListComposite
ListReprFor ('Ptr a) = 'ListNormal 'NormalListPtr
class Element (r :: Repr) where
fromElement
:: forall m mut. ReadCtx m mut
=> M.Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
-> m (Unwrapped (Untyped r mut))
toElement :: Unwrapped (Untyped r mut) -> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
class IsPtrRepr (r :: Maybe PtrRepr) where
toPtr :: Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
fromPtr :: ReadCtx m mut => M.Message mut -> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
class IsListPtrRepr (r :: ListRepr) where
rToList :: UntypedSomeList r mut -> List mut
rFromList :: ReadCtx m mut => List mut -> m (UntypedSomeList r mut)
rFromListMsg :: ReadCtx m mut => M.Message mut -> m (UntypedSomeList r mut)
expected :: MonadThrow m => String -> m a
expected :: String -> m a
expected String
msg = Error -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m a) -> Error -> m a
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
instance Element ('Data sz) where
fromElement :: Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
-> m (Unwrapped (Untyped ('Data sz) mut))
fromElement Message mut
_ = Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
-> m (Unwrapped (Untyped ('Data sz) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
toElement :: Unwrapped (Untyped ('Data sz) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
toElement = Unwrapped (Untyped ('Data sz) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Data sz))) mut)
forall a. a -> a
id
{-# INLINE fromElement #-}
{-# INLINE toElement #-}
instance Element ('Ptr ('Just 'Struct)) where
fromElement :: Message mut
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
fromElement Message mut
_ = Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
toElement :: Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
toElement = Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Struct)))) mut)
forall a. a -> a
id
{-# INLINE fromElement #-}
{-# INLINE toElement #-}
instance Element ('Ptr 'Nothing) where
fromElement :: Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
fromElement Message mut
_ = Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
toElement :: Unwrapped (Untyped ('Ptr 'Nothing) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
toElement = Unwrapped (Untyped ('Ptr 'Nothing) mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor ('Ptr 'Nothing))) mut)
forall a. a -> a
id
{-# INLINE fromElement #-}
{-# INLINE toElement #-}
instance Element ('Ptr ('Just 'Cap)) where
fromElement :: Message mut
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Cap)))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
fromElement = forall (m :: * -> *) (mut :: Mutability).
(IsPtrRepr ('Just 'Cap), ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
forall (r :: Maybe PtrRepr) (m :: * -> *) (mut :: Mutability).
(IsPtrRepr r, ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
fromPtr @('Just 'Cap)
toElement :: Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just 'Cap)))) mut)
toElement = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut))
-> (Cap mut -> Ptr mut) -> Cap mut -> Maybe (Ptr mut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap
{-# INLINE fromElement #-}
{-# INLINE toElement #-}
instance IsPtrRepr ('Just ('List a)) => Element ('Ptr ('Just ('List a))) where
fromElement :: Message mut
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just ('List a))))) mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List a))) mut))
fromElement = forall (m :: * -> *) (mut :: Mutability).
(IsPtrRepr ('Just ('List a)), ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List a))) mut))
forall (r :: Maybe PtrRepr) (m :: * -> *) (mut :: Mutability).
(IsPtrRepr r, ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
fromPtr @('Just ('List a))
toElement :: Unwrapped (Untyped ('Ptr ('Just ('List a))) mut)
-> Unwrapped
(Untyped (ElemRepr (ListReprFor ('Ptr ('Just ('List a))))) mut)
toElement = forall (mut :: Mutability).
IsPtrRepr ('Just ('List a)) =>
Unwrapped (Untyped ('Ptr ('Just ('List a))) mut) -> Maybe (Ptr mut)
forall (r :: Maybe PtrRepr) (mut :: Mutability).
IsPtrRepr r =>
Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
toPtr @('Just ('List a))
{-# INLINE fromElement #-}
{-# INLINE toElement #-}
instance IsPtrRepr 'Nothing where
toPtr :: Unwrapped (Untyped ('Ptr 'Nothing) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr 'Nothing) mut)
p = Maybe (Ptr mut)
Unwrapped (Untyped ('Ptr 'Nothing) mut)
p
fromPtr :: Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
fromPtr Message mut
_ = Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr 'Nothing) mut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE toPtr #-}
{-# INLINE fromPtr #-}
instance IsPtrRepr ('Just 'Struct) where
toPtr :: Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
s = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut)
Struct mut
s)
fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing = Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
fromPtr Message mut
_ (Just (PtrStruct Struct mut
s)) = Struct mut -> m (Struct mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct mut
s
fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (Struct mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to struct"
{-# INLINE toPtr #-}
{-# INLINE fromPtr #-}
instance IsPtrRepr ('Just 'Cap) where
toPtr :: Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut) -> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
c = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut)
Cap mut
c)
fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Cap)) mut))
fromPtr Message mut
_ Maybe (Ptr mut)
Nothing = String -> m (Cap mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
fromPtr Message mut
_ (Just (PtrCap Cap mut
c)) = Cap mut -> m (Cap mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cap mut
c
fromPtr Message mut
_ Maybe (Ptr mut)
_ = String -> m (Cap mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to capability"
{-# INLINE toPtr #-}
{-# INLINE fromPtr #-}
instance IsPtrRepr ('Just ('List 'Nothing)) where
toPtr :: Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
-> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
l = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut)
List mut
l)
fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List 'Nothing))) mut))
fromPtr Message mut
_ Maybe (Ptr mut)
Nothing = String -> m (List mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
fromPtr Message mut
_ (Just (PtrList List mut
l)) = List mut -> m (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure List mut
l
fromPtr Message mut
_ (Just Ptr mut
_) = String -> m (List mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
{-# INLINE toPtr #-}
{-# INLINE fromPtr #-}
instance IsListPtrRepr r => IsPtrRepr ('Just ('List ('Just r))) where
toPtr :: Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
-> Maybe (Ptr mut)
toPtr Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
l = Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (UntypedSomeList r mut -> List mut
forall (r :: ListRepr) (mut :: Mutability).
IsListPtrRepr r =>
UntypedSomeList r mut -> List mut
rToList @r UntypedSomeList r mut
Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut)
l))
fromPtr :: Message mut
-> Maybe (Ptr mut)
-> m (Unwrapped (Untyped ('Ptr ('Just ('List ('Just r)))) mut))
fromPtr Message mut
msg Maybe (Ptr mut)
Nothing = Message mut -> m (UntypedSomeList r mut)
forall (r :: ListRepr) (m :: * -> *) (mut :: Mutability).
(IsListPtrRepr r, ReadCtx m mut) =>
Message mut -> m (UntypedSomeList r mut)
rFromListMsg @r Message mut
msg
fromPtr Message mut
_ (Just (PtrList List mut
l)) = List mut -> m (UntypedSomeList r mut)
forall (r :: ListRepr) (m :: * -> *) (mut :: Mutability).
(IsListPtrRepr r, ReadCtx m mut) =>
List mut -> m (UntypedSomeList r mut)
rFromList @r List mut
l
fromPtr Message mut
_ (Just Ptr mut
_) = String -> m (ListOf (ElemRepr r) mut)
forall (m :: * -> *) a. MonadThrow m => String -> m a
expected String
"pointer to list"
{-# INLINE toPtr #-}
{-# INLINE fromPtr #-}
class TraverseMsg f where
tMsg :: TraverseMsgCtx m mutA mutB => (M.Message mutA -> m (M.Message mutB)) -> f mutA -> m (f mutB)
type TraverseMsgCtx m mutA mutB =
( MonadThrow m
, M.MonadReadMessage mutA m
, M.MonadReadMessage mutB m
)
instance TraverseMsg M.WordPtr where
tMsg :: (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
tMsg Message mutA -> m (Message mutB)
f M.WordPtr{Message mutA
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage :: Message mutA
pMessage, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=pAddr :: WordAddr
pAddr@WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex}} = do
Message mutB
msg' <- Message mutA -> m (Message mutB)
f Message mutA
pMessage
Segment mutB
seg' <- Message mutB -> Int -> m (Segment mutB)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mutB
msg' Int
segIndex
pure WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
{ pMessage :: Message mutB
pMessage = Message mutB
msg'
, pSegment :: Segment mutB
pSegment = Segment mutB
seg'
, WordAddr
pAddr :: WordAddr
pAddr :: WordAddr
pAddr
}
instance TraverseMsg Ptr where
tMsg :: (Message mutA -> m (Message mutB)) -> Ptr mutA -> m (Ptr mutB)
tMsg Message mutA -> m (Message mutB)
f = \case
PtrCap Cap mutA
cap ->
Cap mutB -> Ptr mutB
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Cap mutB -> Ptr mutB) -> m (Cap mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB)) -> Cap mutA -> m (Cap mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Cap mutA
cap
PtrList List mutA
l ->
List mutB -> Ptr mutB
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List mutB -> Ptr mutB) -> m (List mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB)) -> List mutA -> m (List mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f List mutA
l
PtrStruct Struct mutA
s ->
Struct mutB -> Ptr mutB
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mutB -> Ptr mutB) -> m (Struct mutB) -> m (Ptr mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Struct mutA
s
instance TraverseMsg Cap where
tMsg :: (Message mutA -> m (Message mutB)) -> Cap mutA -> m (Cap mutB)
tMsg Message mutA -> m (Message mutB)
f (CapAt Message mutA
msg Word32
n) = Message mutB -> Word32 -> Cap mutB
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt (Message mutB -> Word32 -> Cap mutB)
-> m (Message mutB) -> m (Word32 -> Cap mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mutA -> m (Message mutB)
f Message mutA
msg m (Word32 -> Cap mutB) -> m Word32 -> m (Cap mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
n
instance TraverseMsg Struct where
tMsg :: (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
tMsg Message mutA -> m (Message mutB)
f (StructAt WordPtr mutA
ptr Word16
dataSz Word16
ptrSz) = WordPtr mutB -> Word16 -> Word16 -> Struct mutB
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
(WordPtr mutB -> Word16 -> Word16 -> Struct mutB)
-> m (WordPtr mutB) -> m (Word16 -> Word16 -> Struct mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f WordPtr mutA
ptr
m (Word16 -> Word16 -> Struct mutB)
-> m Word16 -> m (Word16 -> Struct mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
dataSz
m (Word16 -> Struct mutB) -> m Word16 -> m (Struct mutB)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
ptrSz
instance TraverseMsg List where
tMsg :: (Message mutA -> m (Message mutB)) -> List mutA -> m (List mutB)
tMsg Message mutA -> m (Message mutB)
f = \case
List0 ListOf ('Data 'Sz0) mutA
l -> ListOf ('Data 'Sz0) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0 (ListOf ('Data 'Sz0) mutB -> List mutB)
-> m (ListOf ('Data 'Sz0) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz0) mutA -> m (ListOf ('Data 'Sz0) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz0) mutA
l
List1 ListOf ('Data 'Sz1) mutA
l -> ListOf ('Data 'Sz1) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1 (ListOf ('Data 'Sz1) mutB -> List mutB)
-> m (ListOf ('Data 'Sz1) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz1) mutA -> m (ListOf ('Data 'Sz1) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz1) mutA
l
List8 ListOf ('Data 'Sz8) mutA
l -> ListOf ('Data 'Sz8) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8 (ListOf ('Data 'Sz8) mutB -> List mutB)
-> m (ListOf ('Data 'Sz8) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz8) mutA -> m (ListOf ('Data 'Sz8) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz8) mutA
l
List16 ListOf ('Data 'Sz16) mutA
l -> ListOf ('Data 'Sz16) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16 (ListOf ('Data 'Sz16) mutB -> List mutB)
-> m (ListOf ('Data 'Sz16) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz16) mutA -> m (ListOf ('Data 'Sz16) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz16) mutA
l
List32 ListOf ('Data 'Sz32) mutA
l -> ListOf ('Data 'Sz32) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32 (ListOf ('Data 'Sz32) mutB -> List mutB)
-> m (ListOf ('Data 'Sz32) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz32) mutA -> m (ListOf ('Data 'Sz32) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz32) mutA
l
List64 ListOf ('Data 'Sz64) mutA
l -> ListOf ('Data 'Sz64) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64 (ListOf ('Data 'Sz64) mutB -> List mutB)
-> m (ListOf ('Data 'Sz64) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Data 'Sz64) mutA -> m (ListOf ('Data 'Sz64) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Data 'Sz64) mutA
l
ListPtr ListOf ('Ptr 'Nothing) mutA
l -> ListOf ('Ptr 'Nothing) mutB -> List mutB
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr (ListOf ('Ptr 'Nothing) mutB -> List mutB)
-> m (ListOf ('Ptr 'Nothing) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Ptr 'Nothing) mutA -> m (ListOf ('Ptr 'Nothing) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Ptr 'Nothing) mutA
l
ListStruct ListOf ('Ptr ('Just 'Struct)) mutA
l -> ListOf ('Ptr ('Just 'Struct)) mutB -> List mutB
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) mutB -> List mutB)
-> m (ListOf ('Ptr ('Just 'Struct)) mutB) -> m (List mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListOf ('Ptr ('Just 'Struct)) mutA
-> m (ListOf ('Ptr ('Just 'Struct)) mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListOf ('Ptr ('Just 'Struct)) mutA
l
instance TraverseMsg (ListRepOf r) => TraverseMsg (ListOf r) where
tMsg :: (Message mutA -> m (Message mutB))
-> ListOf r mutA -> m (ListOf r mutB)
tMsg Message mutA -> m (Message mutB)
f (ListOf ListRepOf r mutA
l) = ListRepOf r mutB -> ListOf r mutB
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r mutB -> ListOf r mutB)
-> m (ListRepOf r mutB) -> m (ListOf r mutB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message mutA -> m (Message mutB))
-> ListRepOf r mutA -> m (ListRepOf r mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f ListRepOf r mutA
l
instance TraverseMsg NormalList where
tMsg :: (Message mutA -> m (Message mutB))
-> NormalList mutA -> m (NormalList mutB)
tMsg Message mutA -> m (Message mutB)
f NormalList{Int
WordPtr mutA
nLen :: Int
nPtr :: WordPtr mutA
nLen :: forall (mut :: Mutability). NormalList mut -> Int
nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
..} = do
WordPtr mutB
ptr <- (Message mutA -> m (Message mutB))
-> WordPtr mutA -> m (WordPtr mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f WordPtr mutA
nPtr
pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList { nPtr :: WordPtr mutB
nPtr = WordPtr mutB
ptr, Int
nLen :: Int
nLen :: Int
.. }
instance TraverseMsg StructList where
tMsg :: (Message mutA -> m (Message mutB))
-> StructList mutA -> m (StructList mutB)
tMsg Message mutA -> m (Message mutB)
f StructList{Int
Struct mutA
slLen :: Int
slFirst :: Struct mutA
slLen :: forall (mut :: Mutability). StructList mut -> Int
slFirst :: forall (mut :: Mutability). StructList mut -> Struct mut
..} = do
Struct mutB
s <- (Message mutA -> m (Message mutB))
-> Struct mutA -> m (Struct mutB)
forall (f :: Mutability -> *) (m :: * -> *) (mutA :: Mutability)
(mutB :: Mutability).
(TraverseMsg f, TraverseMsgCtx m mutA mutB) =>
(Message mutA -> m (Message mutB)) -> f mutA -> m (f mutB)
tMsg Message mutA -> m (Message mutB)
f Struct mutA
slFirst
pure StructList :: forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList { slFirst :: Struct mutB
slFirst = Struct mutB
s, Int
slLen :: Int
slLen :: Int
.. }
class HasMessage (f :: Mutability -> *) where
message :: Unwrapped (f mut) -> M.Message mut
class HasMessage f => MessageDefault f where
messageDefault :: ReadCtx m mut => M.Message mut -> m (Unwrapped (f mut))
instance HasMessage M.WordPtr where
message :: Unwrapped (WordPtr mut) -> Message mut
message M.WordPtr{pMessage} = Message mut
pMessage
instance HasMessage Ptr where
message :: Unwrapped (Ptr mut) -> Message mut
message (PtrCap cap) = Unwrapped (Cap mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Cap Unwrapped (Cap mut)
Cap mut
cap
message (PtrList list) = Unwrapped (List mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @List Unwrapped (List mut)
List mut
list
message (PtrStruct struct) = Unwrapped (Struct mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Struct Unwrapped (Struct mut)
Struct mut
struct
instance HasMessage Cap where
message :: Unwrapped (Cap mut) -> Message mut
message (CapAt msg _) = Message mut
msg
instance HasMessage Struct where
message :: Unwrapped (Struct mut) -> Message mut
message (StructAt ptr _ _) = Unwrapped (WordPtr mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @M.WordPtr WordPtr mut
Unwrapped (WordPtr mut)
ptr
instance MessageDefault Struct where
messageDefault :: Message mut -> m (Unwrapped (Struct mut))
messageDefault Message mut
msg = do
Segment mut
pSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
pure $ WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr{pMessage :: Message mut
pMessage = Message mut
msg, Segment mut
pSegment :: Segment mut
pSegment :: Segment mut
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0} Word16
0 Word16
0
instance HasMessage List where
message :: Unwrapped (List mut) -> Message mut
message (List0 list) = Unwrapped (ListOf ('Data 'Sz0) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz0)) Unwrapped (ListOf ('Data 'Sz0) mut)
ListOf ('Data 'Sz0) mut
list
message (List1 list) = Unwrapped (ListOf ('Data 'Sz1) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz1)) Unwrapped (ListOf ('Data 'Sz1) mut)
ListOf ('Data 'Sz1) mut
list
message (List8 list) = Unwrapped (ListOf ('Data 'Sz8) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz8)) Unwrapped (ListOf ('Data 'Sz8) mut)
ListOf ('Data 'Sz8) mut
list
message (List16 list) = Unwrapped (ListOf ('Data 'Sz16) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz16)) Unwrapped (ListOf ('Data 'Sz16) mut)
ListOf ('Data 'Sz16) mut
list
message (List32 list) = Unwrapped (ListOf ('Data 'Sz32) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz32)) Unwrapped (ListOf ('Data 'Sz32) mut)
ListOf ('Data 'Sz32) mut
list
message (List64 list) = Unwrapped (ListOf ('Data 'Sz64) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Data 'Sz64)) Unwrapped (ListOf ('Data 'Sz64) mut)
ListOf ('Data 'Sz64) mut
list
message (ListPtr list) = Unwrapped (ListOf ('Ptr 'Nothing) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) mut)
ListOf ('Ptr 'Nothing) mut
list
message (ListStruct list) = Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @(ListOf ('Ptr ('Just 'Struct))) Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut)
ListOf ('Ptr ('Just 'Struct)) mut
list
instance HasMessage (ListOf ('Ptr ('Just 'Struct))) where
message :: Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut) -> Message mut
message (ListOf list) = Unwrapped (StructList mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @StructList Unwrapped (StructList mut)
ListRepOf ('Ptr ('Just 'Struct)) mut
list
instance MessageDefault (ListOf ('Ptr ('Just 'Struct))) where
messageDefault :: Message mut -> m (Unwrapped (ListOf ('Ptr ('Just 'Struct)) mut))
messageDefault Message mut
msg = StructList mut -> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (StructList mut -> ListOf ('Ptr ('Just 'Struct)) mut)
-> m (StructList mut) -> m (ListOf ('Ptr ('Just 'Struct)) mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (StructList mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @StructList Message mut
msg
instance {-# OVERLAPS #-} ListRepOf r ~ NormalList => HasMessage (ListOf r) where
message :: Unwrapped (ListOf r mut) -> Message mut
message (ListOf list) = Unwrapped (NormalList mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @NormalList Unwrapped (NormalList mut)
ListRepOf r mut
list
instance {-# OVERLAPS #-} ListRepOf r ~ NormalList => MessageDefault (ListOf r) where
messageDefault :: Message mut -> m (Unwrapped (ListOf r mut))
messageDefault Message mut
msg = ListRepOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r mut -> ListOf r mut)
-> m (ListRepOf r mut) -> m (ListOf r mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (NormalList mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @NormalList Message mut
msg
instance HasMessage NormalList where
message :: Unwrapped (NormalList mut) -> Message mut
message = WordPtr mut -> Message mut
forall (mut :: Mutability). WordPtr mut -> Message mut
M.pMessage (WordPtr mut -> Message mut)
-> (NormalList mut -> WordPtr mut) -> NormalList mut -> Message mut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalList mut -> WordPtr mut
forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr
instance MessageDefault NormalList where
messageDefault :: Message mut -> m (Unwrapped (NormalList mut))
messageDefault Message mut
msg = do
Segment mut
pSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList
{ nPtr :: WordPtr mut
nPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr { pMessage :: Message mut
pMessage = Message mut
msg, Segment mut
pSegment :: Segment mut
pSegment :: Segment mut
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0 }
, nLen :: Int
nLen = Int
0
}
instance HasMessage StructList where
message :: Unwrapped (StructList mut) -> Message mut
message (StructList s _) = Unwrapped (Struct mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
message @Struct Unwrapped (Struct mut)
Struct mut
s
instance MessageDefault StructList where
messageDefault :: Message mut -> m (Unwrapped (StructList mut))
messageDefault Message mut
msg = Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList
(Struct mut -> Int -> StructList mut)
-> m (Struct mut) -> m (Int -> StructList mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
m (Int -> StructList mut) -> m Int -> m (StructList mut)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
getClient :: ReadCtx m mut => Cap mut -> m M.Client
{-# INLINABLE getClient #-}
getClient :: Cap mut -> m Client
getClient (CapAt Message mut
msg Word32
idx) = Message mut -> Int -> m Client
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m Client
M.getCap Message mut
msg (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
idx)
get :: ReadCtx m mut => M.WordPtr mut -> m (Maybe (Ptr mut))
{-# INLINABLE get #-}
{-# SPECIALIZE get :: M.WordPtr ('Mut RealWorld) -> LimitT IO (Maybe (Ptr ('Mut RealWorld))) #-}
get :: WordPtr mut -> m (Maybe (Ptr mut))
get ptr :: WordPtr mut
ptr@M.WordPtr{Message mut
pMessage :: Message mut
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage, WordAddr
pAddr :: WordAddr
pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr} = do
Word64
word <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
ptr
case Word64 -> Maybe Ptr
P.parsePtr Word64
word of
Maybe Ptr
Nothing -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ptr mut)
forall a. Maybe a
Nothing
Just Ptr
p -> case Ptr
p of
P.CapPtr Word32
cap -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Message mut -> Word32 -> Cap mut
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message mut
pMessage Word32
cap)
P.StructPtr Int32
off Word16
dataSz Word16
ptrSz -> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mut -> Ptr mut) -> Struct mut -> Ptr mut
forall a b. (a -> b) -> a -> b
$
WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
pAddr Int32
off } Word16
dataSz Word16
ptrSz
P.ListPtr Int32
off EltSpec
eltSpec -> Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> m (Ptr mut) -> m (Maybe (Ptr mut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WordPtr mut -> EltSpec -> m (Ptr mut)
forall (f :: * -> *) (mut :: Mutability).
(MonadReadMessage mut f, MonadThrow f) =>
WordPtr mut -> EltSpec -> f (Ptr mut)
getList WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr -> Int32 -> WordAddr
forall a. Integral a => WordAddr -> a -> WordAddr
resolveOffset WordAddr
pAddr Int32
off } EltSpec
eltSpec
P.FarPtr Bool
twoWords Word32
offset Word32
segment -> do
Segment mut
landingSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
pMessage (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segment)
let addr' :: WordAddr
addr' = WordAt :: Int -> WordCount -> WordAddr
WordAt { wordIndex :: WordCount
wordIndex = Word32 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset
, segIndex :: Int
segIndex = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
segment
}
let landingPtr :: WordPtr mut
landingPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
{ Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
, pSegment :: Segment mut
pSegment = Segment mut
landingSegment
, pAddr :: WordAddr
pAddr = WordAddr
addr'
}
if Bool -> Bool
not Bool
twoWords
then do
WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr mut
landingPtr
else do
Word64
landingPad <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
landingPtr
case Word64 -> Maybe Ptr
P.parsePtr Word64
landingPad of
Just (P.FarPtr Bool
False Word32
off Word32
seg) -> do
let segIndex :: Int
segIndex = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
seg
Segment mut
finalSegment <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
pMessage Int
segIndex
Word64
tagWord <- WordPtr mut -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
{ Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
, pSegment :: Segment mut
pSegment = Segment mut
landingSegment
, pAddr :: WordAddr
M.pAddr = WordAddr
addr' { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
addr' WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
}
let finalPtr :: WordPtr mut
finalPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
{ Message mut
pMessage :: Message mut
pMessage :: Message mut
pMessage
, pSegment :: Segment mut
pSegment = Segment mut
finalSegment
, pAddr :: WordAddr
pAddr = WordAt :: Int -> WordCount -> WordAddr
WordAt
{ wordIndex :: WordCount
wordIndex = Word32 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off
, Int
segIndex :: Int
segIndex :: Int
segIndex
}
}
case Word64 -> Maybe Ptr
P.parsePtr Word64
tagWord of
Just (P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz) ->
Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Struct mut -> Ptr mut
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct mut -> Ptr mut) -> Struct mut -> Ptr mut
forall a b. (a -> b) -> a -> b
$
WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr mut
finalPtr Word16
dataSz Word16
ptrSz
Just (P.ListPtr Int32
0 EltSpec
eltSpec) ->
Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> m (Ptr mut) -> m (Maybe (Ptr mut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WordPtr mut -> EltSpec -> m (Ptr mut)
forall (f :: * -> *) (mut :: Mutability).
(MonadReadMessage mut f, MonadThrow f) =>
WordPtr mut -> EltSpec -> f (Ptr mut)
getList WordPtr mut
finalPtr EltSpec
eltSpec
Just (P.CapPtr Word32
cap) ->
Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Ptr mut) -> m (Maybe (Ptr mut)))
-> Maybe (Ptr mut) -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ Ptr mut -> Maybe (Ptr mut)
forall a. a -> Maybe a
Just (Ptr mut -> Maybe (Ptr mut)) -> Ptr mut -> Maybe (Ptr mut)
forall a b. (a -> b) -> a -> b
$ Cap mut -> Ptr mut
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Message mut -> Word32 -> Cap mut
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message mut
pMessage Word32
cap)
Maybe Ptr
ptr -> Error -> m (Maybe (Ptr mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr mut))) -> Error -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
String
"The tag word of a far pointer's " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"2-word landing pad should be an intra " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"segment pointer with offset 0, but " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"we read " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Ptr -> String
forall a. Show a => a -> String
show Maybe Ptr
ptr
Maybe Ptr
ptr -> Error -> m (Maybe (Ptr mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Maybe (Ptr mut))) -> Error -> m (Maybe (Ptr mut))
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
String
"The first word of a far pointer's 2-word " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"landing pad should be another far pointer " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"(with a one-word landing pad), but we read " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Maybe Ptr -> String
forall a. Show a => a -> String
show Maybe Ptr
ptr
where
getWord :: WordPtr mut -> m Word64
getWord M.WordPtr{Segment mut
pSegment :: Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} =
Segment mut -> WordCount -> m Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> WordCount -> m Word64
M.read Segment mut
pSegment WordCount
wordIndex
resolveOffset :: WordAddr -> a -> WordAddr
resolveOffset addr :: WordAddr
addr@WordAt{Int
WordCount
wordIndex :: WordCount
segIndex :: Int
wordIndex :: WordAddr -> WordCount
segIndex :: WordAddr -> Int
..} a
off =
WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ a -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
off WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 }
getList :: WordPtr mut -> EltSpec -> f (Ptr mut)
getList ptr :: WordPtr mut
ptr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} EltSpec
eltSpec = List mut -> Ptr mut
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List mut -> Ptr mut) -> f (List mut) -> f (Ptr mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case EltSpec
eltSpec of
P.EltNormal ElementSize
sz Word32
len -> List mut -> f (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List mut -> f (List mut)) -> List mut -> f (List mut)
forall a b. (a -> b) -> a -> b
$ case ElementSize
sz of
ElementSize
P.Sz0 -> ListOf ('Data 'Sz0) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0 (ListRepOf ('Data 'Sz0) mut -> ListOf ('Data 'Sz0) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz0) mut
NormalList mut
nlist)
ElementSize
P.Sz1 -> ListOf ('Data 'Sz1) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1 (ListRepOf ('Data 'Sz1) mut -> ListOf ('Data 'Sz1) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz1) mut
NormalList mut
nlist)
ElementSize
P.Sz8 -> ListOf ('Data 'Sz8) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8 (ListRepOf ('Data 'Sz8) mut -> ListOf ('Data 'Sz8) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz8) mut
NormalList mut
nlist)
ElementSize
P.Sz16 -> ListOf ('Data 'Sz16) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16 (ListRepOf ('Data 'Sz16) mut -> ListOf ('Data 'Sz16) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz16) mut
NormalList mut
nlist)
ElementSize
P.Sz32 -> ListOf ('Data 'Sz32) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32 (ListRepOf ('Data 'Sz32) mut -> ListOf ('Data 'Sz32) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz32) mut
NormalList mut
nlist)
ElementSize
P.Sz64 -> ListOf ('Data 'Sz64) mut -> List mut
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64 (ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Data 'Sz64) mut
NormalList mut
nlist)
ElementSize
P.SzPtr -> ListOf ('Ptr 'Nothing) mut -> List mut
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr (ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf ListRepOf ('Ptr 'Nothing) mut
NormalList mut
nlist)
where
nlist :: NormalList mut
nlist = WordPtr mut -> Int -> NormalList mut
forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList WordPtr mut
ptr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
P.EltComposite Int32
_ -> do
Word64
tagWord <- WordPtr mut -> f Word64
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
WordPtr mut -> m Word64
getWord WordPtr mut
ptr
case Word64 -> Ptr
P.parsePtr' Word64
tagWord of
P.StructPtr Int32
numElts Word16
dataSz Word16
ptrSz ->
List mut -> f (List mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List mut -> f (List mut)) -> List mut -> f (List mut)
forall a b. (a -> b) -> a -> b
$ ListOf ('Ptr ('Just 'Struct)) mut -> List mut
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) mut -> List mut)
-> ListOf ('Ptr ('Just 'Struct)) mut -> List mut
forall a b. (a -> b) -> a -> b
$ ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut)
-> ListRepOf ('Ptr ('Just 'Struct)) mut
-> ListOf ('Ptr ('Just 'Struct)) mut
forall a b. (a -> b) -> a -> b
$ Struct mut -> Int -> StructList mut
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList
(WordPtr mut -> Word16 -> Word16 -> Struct mut
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 } }
Word16
dataSz
Word16
ptrSz)
(Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
numElts)
Ptr
tag -> Error -> f (List mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> f (List mut)) -> Error -> f (List mut)
forall a b. (a -> b) -> a -> b
$ String -> Error
E.InvalidDataError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
String
"Composite list tag was not a struct-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"formatted word: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr -> String
forall a. Show a => a -> String
show Ptr
tag
listEltSpec :: List msg -> P.EltSpec
listEltSpec :: List msg -> EltSpec
listEltSpec (ListStruct list :: ListOf ('Ptr ('Just 'Struct)) msg
list@(ListOf (StructList (StructAt _ dataSz ptrSz) _))) =
Int32 -> EltSpec
P.EltComposite (Int32 -> EltSpec) -> Int32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Ptr ('Just 'Struct)) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr ('Just 'Struct)) msg
list) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* (Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)
listEltSpec (List0 ListOf ('Data 'Sz0) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz0 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz0) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) msg
list)
listEltSpec (List1 ListOf ('Data 'Sz1) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz1 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz1) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz1) msg
list)
listEltSpec (List8 ListOf ('Data 'Sz8) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz8 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz8) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz8) msg
list)
listEltSpec (List16 ListOf ('Data 'Sz16) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz16 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz16) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz16) msg
list)
listEltSpec (List32 ListOf ('Data 'Sz32) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz32 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz32) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz32) msg
list)
listEltSpec (List64 ListOf ('Data 'Sz64) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.Sz64 (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Data 'Sz64) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz64) msg
list)
listEltSpec (ListPtr ListOf ('Ptr 'Nothing) msg
list) = ElementSize -> Word32 -> EltSpec
P.EltNormal ElementSize
P.SzPtr (Word32 -> EltSpec) -> Word32 -> EltSpec
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ListOf ('Ptr 'Nothing) msg -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr 'Nothing) msg
list)
listAddr :: List msg -> WordAddr
listAddr :: List msg -> WordAddr
listAddr (ListStruct (ListOf (StructList (StructAt M.WordPtr{pAddr} _ _) _))) =
WordAddr
pAddr { wordIndex :: WordCount
wordIndex = WordAddr -> WordCount
wordIndex WordAddr
pAddr WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
- WordCount
1 }
listAddr (List0 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List1 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List8 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List16 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List32 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (List64 (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
listAddr (ListPtr (ListOf NormalList{nPtr=M.WordPtr{pAddr}})) = WordAddr
pAddr
ptrAddr :: Ptr msg -> WordAddr
ptrAddr :: Ptr msg -> WordAddr
ptrAddr (PtrCap Cap msg
_) = String -> WordAddr
forall a. HasCallStack => String -> a
error String
"ptrAddr called on a capability pointer."
ptrAddr (PtrStruct (StructAt M.WordPtr{WordAddr
pAddr :: WordAddr
pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr}Word16
_ Word16
_)) = WordAddr
pAddr
ptrAddr (PtrList List msg
list) = List msg -> WordAddr
forall (msg :: Mutability). List msg -> WordAddr
listAddr List msg
list
setIndex
:: (RWCtx m s, ListItem r)
=> Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
{-# INLINE setIndex #-}
{-# SPECIALIZE setIndex
:: ListItem r
=> Unwrapped (Untyped r ('Mut RealWorld)) -> Int -> ListOf r ('Mut RealWorld) -> LimitT IO () #-}
setIndex :: Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut s))
_ Int
i ListOf r ('Mut s)
list | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
list Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i =
Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
i, maxIndex :: Int
E.maxIndex = ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
list }
setIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
list = Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s a.
(ListItem r, RWCtx m s, a ~ Unwrapped (Untyped r ('Mut s))) =>
a -> Int -> ListOf r ('Mut s) -> m ()
unsafeSetIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
list
setPointerTo :: M.WriteCtx m s => M.WordPtr ('Mut s) -> WordAddr -> P.Ptr -> m ()
{-# INLINABLE setPointerTo #-}
{-# SPECIALIZE setPointerTo :: M.WordPtr ('Mut RealWorld) -> WordAddr -> P.Ptr -> LimitT IO () #-}
setPointerTo :: WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo
M.WordPtr
{ pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage = Message ('Mut s)
msg
, pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment=Segment ('Mut s)
srcSegment
, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=srcAddr :: WordAddr
srcAddr@WordAt{wordIndex :: WordAddr -> WordCount
wordIndex=WordCount
srcWordIndex}
}
WordAddr
dstAddr
Ptr
relPtr
| P.StructPtr Int32
_ Word16
0 Word16
0 <- Ptr
relPtr =
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (-Int32
1) Word16
0 Word16
0
| Bool
otherwise = case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
srcAddr WordAddr
dstAddr Ptr
relPtr of
Right Ptr
absPtr ->
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just Ptr
absPtr
Left OffsetError
OutOfRange ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: segment is too large to set the pointer."
Left OffsetError
DifferentSegments -> do
let WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex} = WordAddr
dstAddr
Message ('Mut s)
-> Int -> WordCount -> m (Maybe (WordPtr ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Int -> WordCount -> m (Maybe (WordPtr ('Mut s)))
M.allocInSeg Message ('Mut s)
msg Int
segIndex WordCount
1 m (Maybe (WordPtr ('Mut s)))
-> (Maybe (WordPtr ('Mut s)) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just M.WordPtr{pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment=Segment ('Mut s)
landingPadSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAddr
landingPadAddr} ->
case WordAddr -> WordAddr -> Ptr -> Either OffsetError Ptr
pointerFrom WordAddr
landingPadAddr WordAddr
dstAddr Ptr
relPtr of
Right Ptr
landingPad -> do
let WordAt{Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex,WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex} = WordAddr
landingPadAddr
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment WordCount
wordIndex (Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just Ptr
landingPad)
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
False (WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
Left OffsetError
DifferentSegments ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: allocated a landing pad in the wrong segment!"
Left OffsetError
OutOfRange ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"BUG: segment is too large to set the pointer."
Maybe (WordPtr ('Mut s))
Nothing -> do
M.WordPtr
{ pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment = Segment ('Mut s)
landingPadSegment
, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr = WordAt
{ wordIndex :: WordAddr -> WordCount
wordIndex = WordCount
landingPadOffset
, segIndex :: WordAddr -> Int
segIndex = Int
landingPadSegIndex
}
} <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
2
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
srcSegment WordCount
srcWordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
True
(WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
landingPadOffset)
(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
landingPadSegIndex)
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment WordCount
landingPadOffset (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
let WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex, Int
segIndex :: Int
segIndex :: WordAddr -> Int
segIndex} = WordAddr
dstAddr in
Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ Bool -> Word32 -> Word32 -> Ptr
P.FarPtr Bool
False
(WordCount -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex)
(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segIndex)
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
landingPadSegment (WordCount
landingPadOffset WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1) (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$
Maybe Ptr -> Word64
P.serializePtr (Maybe Ptr -> Word64) -> Maybe Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Ptr -> Maybe Ptr
forall a. a -> Maybe a
Just (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ case Ptr
relPtr of
P.StructPtr Int32
_ Word16
nWords Word16
nPtrs -> Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
nWords Word16
nPtrs
P.ListPtr Int32
_ EltSpec
eltSpec -> Int32 -> EltSpec -> Ptr
P.ListPtr Int32
0 EltSpec
eltSpec
Ptr
_ -> Ptr
relPtr
copyCap :: RWCtx m s => M.Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
{-# INLINABLE copyCap #-}
copyCap :: Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
copyCap Message ('Mut s)
dest Cap ('Mut s)
cap = Cap ('Mut s) -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
getClient Cap ('Mut s)
cap m Client -> (Client -> m (Cap ('Mut s))) -> m (Cap ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message ('Mut s) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap Message ('Mut s)
dest
copyPtr :: RWCtx m s => M.Message ('Mut s) -> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
{-# INLINABLE copyPtr #-}
{-# SPECIALIZE copyPtr :: M.Message ('Mut RealWorld) -> Maybe (Ptr ('Mut RealWorld)) -> LimitT IO (Maybe (Ptr ('Mut RealWorld))) #-}
copyPtr :: Message ('Mut s)
-> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
copyPtr Message ('Mut s)
_ Maybe (Ptr ('Mut s))
Nothing = Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
forall a. Maybe a
Nothing
copyPtr Message ('Mut s)
dest (Just (PtrCap Cap ('Mut s)
cap)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Cap ('Mut s) -> Ptr ('Mut s))
-> Cap ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
PtrCap (Cap ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Cap ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> Cap ('Mut s) -> m (Cap ('Mut s))
copyCap Message ('Mut s)
dest Cap ('Mut s)
cap
copyPtr Message ('Mut s)
dest (Just (PtrList List ('Mut s)
src)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (List ('Mut s) -> Ptr ('Mut s))
-> List ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
PtrList (List ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (List ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
copyList Message ('Mut s)
dest List ('Mut s)
src
copyPtr Message ('Mut s)
dest (Just (PtrStruct Struct ('Mut s)
src)) = Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Struct ('Mut s) -> Ptr ('Mut s))
-> Struct ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Struct mut -> Ptr mut
PtrStruct (Struct ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Struct ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Struct ('Mut s)
destStruct <- Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct
Message ('Mut s)
dest
(WordCount -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Word16) -> WordCount -> Word16
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct ('Mut s)
src)
(Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct ('Mut s)
src)
Struct ('Mut s) -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
RWCtx m s =>
Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
destStruct Struct ('Mut s)
src
pure Struct ('Mut s)
destStruct
copyList :: RWCtx m s => M.Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
{-# INLINABLE copyList #-}
{-# SPECIALIZE copyList :: M.Message ('Mut RealWorld) -> List ('Mut RealWorld) -> LimitT IO (List ('Mut RealWorld)) #-}
copyList :: Message ('Mut s) -> List ('Mut s) -> m (List ('Mut s))
copyList Message ('Mut s)
dest List ('Mut s)
src = case List ('Mut s)
src of
List0 ListOf ('Data 'Sz0) ('Mut s)
src -> ListOf ('Data 'Sz0) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
List0 (ListOf ('Data 'Sz0) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz0) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0 Message ('Mut s)
dest (ListOf ('Data 'Sz0) ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) ('Mut s)
src)
List1 ListOf ('Data 'Sz1) ('Mut s)
src -> ListOf ('Data 'Sz1) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
List1 (ListOf ('Data 'Sz1) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz1) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz1) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s)))
-> m (ListOf ('Data 'Sz1) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz1) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1
List8 ListOf ('Data 'Sz8) ('Mut s)
src -> ListOf ('Data 'Sz8) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
List8 (ListOf ('Data 'Sz8) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz8) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz8) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s)))
-> m (ListOf ('Data 'Sz8) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz8) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8
List16 ListOf ('Data 'Sz16) ('Mut s)
src -> ListOf ('Data 'Sz16) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
List16 (ListOf ('Data 'Sz16) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz16) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz16) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s)))
-> m (ListOf ('Data 'Sz16) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz16) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16
List32 ListOf ('Data 'Sz32) ('Mut s)
src -> ListOf ('Data 'Sz32) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
List32 (ListOf ('Data 'Sz32) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz32) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz32) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s)))
-> m (ListOf ('Data 'Sz32) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz32) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32
List64 ListOf ('Data 'Sz64) ('Mut s)
src -> ListOf ('Data 'Sz64) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
List64 (ListOf ('Data 'Sz64) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Data 'Sz64) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Data 'Sz64) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s)))
-> m (ListOf ('Data 'Sz64) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Data 'Sz64) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64
ListPtr ListOf ('Ptr 'Nothing) ('Mut s)
src -> ListOf ('Ptr 'Nothing) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
ListPtr (ListOf ('Ptr 'Nothing) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Ptr 'Nothing) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ListOf ('Ptr 'Nothing) ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s)))
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
dest ListOf ('Ptr 'Nothing) ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr
ListStruct ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src -> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
ListStruct (ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> List ('Mut s))
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList <- Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList
Message ('Mut s)
dest
(WordCount -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Word16) -> WordCount -> Word16
forall a b. (a -> b) -> a -> b
$ ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> WordCount
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
(ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> Word16
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
(ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src)
ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList ListOf ('Ptr ('Just 'Struct)) ('Mut s)
src
pure ListOf ('Ptr ('Just 'Struct)) ('Mut s)
destList
copyNewListOf
:: (ListItem r, RWCtx m s)
=> M.Message ('Mut s)
-> ListOf r ('Mut s)
-> (M.Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
{-# INLINE copyNewListOf #-}
copyNewListOf :: Message ('Mut s)
-> ListOf r ('Mut s)
-> (Message ('Mut s) -> Int -> m (ListOf r ('Mut s)))
-> m (ListOf r ('Mut s))
copyNewListOf Message ('Mut s)
destMsg ListOf r ('Mut s)
src Message ('Mut s) -> Int -> m (ListOf r ('Mut s))
new = do
ListOf r ('Mut s)
dest <- Message ('Mut s) -> Int -> m (ListOf r ('Mut s))
new Message ('Mut s)
destMsg (ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
src)
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut s)
dest ListOf r ('Mut s)
src
pure ListOf r ('Mut s)
dest
copyListOf
:: (ListItem r, RWCtx m s)
=> ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
{-# INLINE copyListOf #-}
copyListOf :: ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut s)
dest ListOf r ('Mut s)
src =
[Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..ListOf r ('Mut s) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut s)
src Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Unwrapped (Untyped r ('Mut s))
value <- Int -> ListOf r ('Mut s) -> m (Unwrapped (Untyped r ('Mut s)))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i ListOf r ('Mut s)
src
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
dest
copyStruct :: RWCtx m s => Struct ('Mut s) -> Struct ('Mut s) -> m ()
{-# INLINABLE copyStruct #-}
{-# SPECIALIZE copyStruct :: Struct ('Mut RealWorld) -> Struct ('Mut RealWorld) -> LimitT IO () #-}
copyStruct :: Struct ('Mut s) -> Struct ('Mut s) -> m ()
copyStruct Struct ('Mut s)
dest Struct ('Mut s)
src = do
ListOf ('Data 'Sz64) ('Mut (PrimState m))
-> ListOf ('Data 'Sz64) ('Mut (PrimState m))
-> Unwrapped (Untyped ('Data 'Sz64) ('Mut (PrimState m)))
-> m ()
forall (r :: Repr) (m :: * -> *).
(ListItem r, PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct ('Mut s)
dest) (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct ('Mut s)
src) Unwrapped (Untyped ('Data 'Sz64) ('Mut (PrimState m)))
0
ListOf ('Ptr 'Nothing) ('Mut (PrimState m))
-> ListOf ('Ptr 'Nothing) ('Mut (PrimState m))
-> Unwrapped (Untyped ('Ptr 'Nothing) ('Mut (PrimState m)))
-> m ()
forall (r :: Repr) (m :: * -> *).
(ListItem r, PrimMonad m, MonadThrow m, MonadLimit m) =>
ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection Struct ('Mut s)
dest) (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection Struct ('Mut s)
src) Unwrapped (Untyped ('Ptr 'Nothing) ('Mut (PrimState m)))
forall a. Maybe a
Nothing
where
copySection :: ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m))
-> Unwrapped (Untyped r ('Mut (PrimState m)))
-> m ()
copySection ListOf r ('Mut (PrimState m))
dest ListOf r ('Mut (PrimState m))
src Unwrapped (Untyped r ('Mut (PrimState m)))
pad = do
ListOf r ('Mut (PrimState m))
-> ListOf r ('Mut (PrimState m)) -> m ()
forall (r :: Repr) (m :: * -> *) s.
(ListItem r, RWCtx m s) =>
ListOf r ('Mut s) -> ListOf r ('Mut s) -> m ()
copyListOf ListOf r ('Mut (PrimState m))
dest ListOf r ('Mut (PrimState m))
src
[Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ListOf r ('Mut (PrimState m)) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut (PrimState m))
src..ListOf r ('Mut (PrimState m)) -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r ('Mut (PrimState m))
dest Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
Unwrapped (Untyped r ('Mut (PrimState m)))
-> Int -> ListOf r ('Mut (PrimState m)) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Unwrapped (Untyped r ('Mut (PrimState m)))
pad Int
i ListOf r ('Mut (PrimState m))
dest
index :: (ReadCtx m mut, ListItem r) => Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
{-# INLINE index #-}
{-# SPECIALIZE index :: ListItem r => Int -> ListOf r 'Const -> LimitT IO (Unwrapped (Untyped r 'Const)) #-}
{-# SPECIALIZE index :: ListItem r => Int -> ListOf r ('Mut RealWorld) -> LimitT IO (Unwrapped (Untyped r ('Mut RealWorld))) #-}
index :: Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i ListOf r mut
list
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list =
Error -> m (Unwrapped (Untyped r mut))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
i, maxIndex :: Int
E.maxIndex = ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
| Bool
otherwise = Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
unsafeIndex Int
i ListOf r mut
list
{-# INLINABLE take #-}
take :: Int -> ListOf r mut -> m (ListOf r mut)
take Int
count ListOf r mut
list
| ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count =
Error -> m (ListOf r mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
E.index = Int
count, maxIndex :: Int
E.maxIndex = ListOf r mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf r mut
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
| Bool
otherwise = ListOf r mut -> m (ListOf r mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf r mut -> m (ListOf r mut))
-> ListOf r mut -> m (ListOf r mut)
forall a b. (a -> b) -> a -> b
$ Int -> ListOf r mut -> ListOf r mut
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
Int -> ListOf r mut -> ListOf r mut
unsafeTake Int
count ListOf r mut
list
dataSection :: Struct mut -> ListOf ('Data 'Sz64) mut
{-# INLINE dataSection #-}
dataSection :: Struct mut -> ListOf ('Data 'Sz64) mut
dataSection (StructAt WordPtr mut
ptr Word16
dataSz Word16
_) =
ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut)
-> ListRepOf ('Data 'Sz64) mut -> ListOf ('Data 'Sz64) mut
forall a b. (a -> b) -> a -> b
$ WordPtr mut -> Int -> NormalList mut
forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList WordPtr mut
ptr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz)
ptrSection :: Struct mut -> ListOf ('Ptr 'Nothing) mut
{-# INLINE ptrSection #-}
ptrSection :: Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection (StructAt ptr :: WordPtr mut
ptr@M.WordPtr{pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} Word16
dataSz Word16
ptrSz) =
ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut)
-> ListRepOf ('Ptr 'Nothing) mut -> ListOf ('Ptr 'Nothing) mut
forall a b. (a -> b) -> a -> b
$ NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList
{ nPtr :: WordPtr mut
nPtr = WordPtr mut
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz } }
, nLen :: Int
nLen = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
}
structWordCount :: Struct mut -> WordCount
structWordCount :: Struct mut -> WordCount
structWordCount (StructAt WordPtr mut
_ptr Word16
dataSz Word16
_ptrSz) = Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz
structByteCount :: Struct mut -> ByteCount
structByteCount :: Struct mut -> ByteCount
structByteCount = WordCount -> ByteCount
wordsToBytes (WordCount -> ByteCount)
-> (Struct mut -> WordCount) -> Struct mut -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount
structPtrCount :: Struct mut -> Word16
structPtrCount :: Struct mut -> Word16
structPtrCount (StructAt WordPtr mut
_ptr Word16
_dataSz Word16
ptrSz) = Word16
ptrSz
structListWordCount :: ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount :: ListOf ('Ptr ('Just 'Struct)) mut -> WordCount
structListWordCount (ListOf (StructList s _)) = Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct mut
s
structListByteCount :: ListOf ('Ptr ('Just 'Struct)) mut -> ByteCount
structListByteCount :: ListOf ('Ptr ('Just 'Struct)) mut -> ByteCount
structListByteCount (ListOf (StructList s _)) = Struct mut -> ByteCount
forall (mut :: Mutability). Struct mut -> ByteCount
structByteCount Struct mut
s
structListPtrCount :: ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount :: ListOf ('Ptr ('Just 'Struct)) mut -> Word16
structListPtrCount (ListOf (StructList s _)) = Struct mut -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct mut
s
getData :: ReadCtx m msg => Int -> Struct msg -> m Word64
{-# INLINE getData #-}
getData :: Int -> Struct msg -> m Word64
getData Int
i Struct msg
struct
| WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct msg -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
| Bool
otherwise = Int
-> ListOf ('Data 'Sz64) msg
-> m (Unwrapped (Untyped ('Data 'Sz64) msg))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i (Struct msg -> ListOf ('Data 'Sz64) msg
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection Struct msg
struct)
getPtr :: ReadCtx m msg => Int -> Struct msg -> m (Maybe (Ptr msg))
{-# INLINE getPtr #-}
getPtr :: Int -> Struct msg -> m (Maybe (Ptr msg))
getPtr Int
i Struct msg
struct
| Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct msg -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct msg
struct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = do
WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice WordCount
1
pure Maybe (Ptr msg)
forall a. Maybe a
Nothing
| Bool
otherwise = do
Maybe (Ptr msg)
ptr <- Int
-> ListOf ('Ptr 'Nothing) msg
-> m (Unwrapped (Untyped ('Ptr 'Nothing) msg))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
index Int
i (Struct msg -> ListOf ('Ptr 'Nothing) msg
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection Struct msg
struct)
Maybe (Ptr msg) -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr msg)
ptr
Maybe (Ptr msg) -> m ()
forall (m :: * -> *) (mut :: Mutability).
MonadLimit m =>
Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr msg)
ptr
pure Maybe (Ptr msg)
ptr
checkPtr :: ReadCtx m mut => Maybe (Ptr mut) -> m ()
{-# INLINABLE checkPtr #-}
checkPtr :: Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr mut)
Nothing = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkPtr (Just (PtrCap Cap mut
c)) = Cap mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m ()
checkCap Cap mut
c
checkPtr (Just (PtrList List mut
l)) = List mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
List mut -> m ()
checkList List mut
l
checkPtr (Just (PtrStruct Struct mut
s)) = Struct mut -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Struct mut -> m ()
checkStruct Struct mut
s
checkCap :: ReadCtx m mut => Cap mut -> m ()
{-# INLINABLE checkCap #-}
checkCap :: Cap mut -> m ()
checkCap (CapAt Message mut
_ Word32
_ ) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkList :: ReadCtx m mut => List mut -> m ()
{-# INLINABLE checkList #-}
checkList :: List mut -> m ()
checkList (List0 ListOf ('Data 'Sz0) mut
l) = ListOf ('Data 'Sz0) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz0) ListOf ('Data 'Sz0) mut
l
checkList (List1 ListOf ('Data 'Sz1) mut
l) = ListOf ('Data 'Sz1) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz1) ListOf ('Data 'Sz1) mut
l
checkList (List8 ListOf ('Data 'Sz8) mut
l) = ListOf ('Data 'Sz8) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz8) ListOf ('Data 'Sz8) mut
l
checkList (List16 ListOf ('Data 'Sz16) mut
l) = ListOf ('Data 'Sz16) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz16) ListOf ('Data 'Sz16) mut
l
checkList (List32 ListOf ('Data 'Sz32) mut
l) = ListOf ('Data 'Sz32) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz32) ListOf ('Data 'Sz32) mut
l
checkList (List64 ListOf ('Data 'Sz64) mut
l) = ListOf ('Data 'Sz64) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Data 'Sz64) ListOf ('Data 'Sz64) mut
l
checkList (ListPtr ListOf ('Ptr 'Nothing) mut
l) = ListOf ('Ptr 'Nothing) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Ptr 'Nothing) ListOf ('Ptr 'Nothing) mut
l
checkList (ListStruct ListOf ('Ptr ('Just 'Struct)) mut
l) = ListOf ('Ptr ('Just 'Struct)) mut -> m ()
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, ReadCtx m mut) =>
ListOf r mut -> m ()
checkListOf @('Ptr ('Just 'Struct)) ListOf ('Ptr ('Just 'Struct)) mut
l
checkNormalList :: ReadCtx m mut => NormalList mut -> BitCount -> m ()
{-# INLINABLE checkNormalList #-}
checkNormalList :: NormalList mut -> BitCount -> m ()
checkNormalList NormalList{WordPtr mut
nPtr :: WordPtr mut
nPtr :: forall (mut :: Mutability). NormalList mut -> WordPtr mut
nPtr, Int
nLen :: Int
nLen :: forall (mut :: Mutability). NormalList mut -> Int
nLen} BitCount
eltSize =
let nBits :: BitCount
nBits = Int -> BitCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nLen BitCount -> BitCount -> BitCount
forall a. Num a => a -> a -> a
* BitCount
eltSize
nWords :: WordCount
nWords = ByteCount -> WordCount
bytesToWordsCeil (ByteCount -> WordCount) -> ByteCount -> WordCount
forall a b. (a -> b) -> a -> b
$ BitCount -> ByteCount
bitsToBytesCeil BitCount
nBits
in
WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
nPtr WordCount
nWords
checkStruct :: ReadCtx m mut => Struct mut -> m ()
{-# INLINABLE checkStruct #-}
checkStruct :: Struct mut -> m ()
checkStruct s :: Struct mut
s@(StructAt WordPtr mut
ptr Word16
_ Word16
_) =
WordPtr mut -> WordCount -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> WordCount -> m ()
checkPtrOffset WordPtr mut
ptr (Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structSize Struct mut
s)
checkPtrOffset :: ReadCtx m mut => M.WordPtr mut -> WordCount -> m ()
{-# INLINABLE checkPtrOffset #-}
checkPtrOffset :: WordPtr mut -> WordCount -> m ()
checkPtrOffset M.WordPtr{Segment mut
pSegment :: Segment mut
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}} WordCount
size = do
WordCount
segWords <- Segment mut -> m WordCount
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> m WordCount
M.numWords Segment mut
pSegment
let maxIndex :: Int
maxIndex = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
segWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WordCount
wordIndex WordCount -> WordCount -> Bool
forall a. Ord a => a -> a -> Bool
>= WordCount
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError { index :: Int
index = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordCount
wordIndex, Int
maxIndex :: Int
maxIndex :: Int
maxIndex }
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
size WordCount -> WordCount -> Bool
forall a. Ord a => a -> a -> Bool
<= WordCount
segWords) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM BoundsError :: Int -> Int -> Error
E.BoundsError
{ index :: Int
index = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
size) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
, Int
maxIndex :: Int
maxIndex :: Int
maxIndex
}
structSize :: Struct mut -> WordCount
structSize :: Struct mut -> WordCount
structSize Struct mut
s = Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structWordCount Struct mut
s WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Struct mut -> Word16
forall (mut :: Mutability). Struct mut -> Word16
structPtrCount Struct mut
s)
invoicePtr :: MonadLimit m => Maybe (Ptr mut) -> m ()
{-# INLINABLE invoicePtr #-}
{-# SPECIALIZE invoicePtr :: Maybe (Ptr ('Mut RealWorld)) -> LimitT IO () #-}
invoicePtr :: Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr mut)
p = WordCount -> m ()
forall (m :: * -> *). MonadLimit m => WordCount -> m ()
invoice (WordCount -> m ()) -> WordCount -> m ()
forall a b. (a -> b) -> a -> b
$! Maybe (Ptr mut) -> WordCount
forall (mut :: Mutability). Maybe (Ptr mut) -> WordCount
ptrInvoiceSize Maybe (Ptr mut)
p
ptrInvoiceSize :: Maybe (Ptr mut) -> WordCount
{-# INLINABLE ptrInvoiceSize #-}
ptrInvoiceSize :: Maybe (Ptr mut) -> WordCount
ptrInvoiceSize = \case
Maybe (Ptr mut)
Nothing -> WordCount
1
Just (PtrCap Cap mut
_) -> WordCount
1
Just (PtrStruct Struct mut
s) -> Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structInvoiceSize Struct mut
s
Just (PtrList List mut
l) -> List mut -> WordCount
forall (mut :: Mutability). List mut -> WordCount
listInvoiceSize List mut
l
listInvoiceSize :: List mut -> WordCount
{-# INLINABLE listInvoiceSize #-}
listInvoiceSize :: List mut -> WordCount
listInvoiceSize List mut
l = WordCount -> WordCount -> WordCount
forall a. Ord a => a -> a -> a
max WordCount
1 (WordCount -> WordCount) -> WordCount -> WordCount
forall a b. (a -> b) -> a -> b
$! case List mut
l of
List0 ListOf ('Data 'Sz0) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz0) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz0) mut
l
List1 ListOf ('Data 'Sz1) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz1) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz1) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64
List8 ListOf ('Data 'Sz8) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz8) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz8) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
List16 ListOf ('Data 'Sz16) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz16) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz16) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
List32 ListOf ('Data 'Sz32) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz32) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz32) mut
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
List64 ListOf ('Data 'Sz64) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Data 'Sz64) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Data 'Sz64) mut
l
ListPtr ListOf ('Ptr 'Nothing) mut
l -> Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$! ListOf ('Ptr 'Nothing) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
length ListOf ('Ptr 'Nothing) mut
l
ListStruct (ListOf (StructList s len)) ->
Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
structInvoiceSize Struct mut
s WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
* Int -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
structInvoiceSize :: Struct mut -> WordCount
{-# INLINABLE structInvoiceSize #-}
structInvoiceSize :: Struct mut -> WordCount
structInvoiceSize (StructAt WordPtr mut
_ Word16
dataSz Word16
ptrSz) =
WordCount -> WordCount -> WordCount
forall a. Ord a => a -> a -> a
max WordCount
1 (Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz)
{-# INLINE setData #-}
setData :: (ReadCtx m ('Mut s), M.WriteCtx m s)
=> Word64 -> Int -> Struct ('Mut s) -> m ()
setData :: Word64 -> Int -> Struct ('Mut s) -> m ()
setData Word64
value Int
i = Unwrapped (Untyped ('Data 'Sz64) ('Mut s))
-> Int -> ListOf ('Data 'Sz64) ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Word64
Unwrapped (Untyped ('Data 'Sz64) ('Mut s))
value Int
i (ListOf ('Data 'Sz64) ('Mut s) -> m ())
-> (Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s))
-> Struct ('Mut s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (mut :: Mutability). Struct mut -> ListOf ('Data 'Sz64) mut
dataSection
setPtr :: (ReadCtx m ('Mut s), M.WriteCtx m s) => Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
{-# INLINE setPtr #-}
setPtr :: Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
setPtr Maybe (Ptr ('Mut s))
value Int
i = Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
-> Int -> ListOf ('Ptr 'Nothing) ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
setIndex Maybe (Ptr ('Mut s))
Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
value Int
i (ListOf ('Ptr 'Nothing) ('Mut s) -> m ())
-> (Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s))
-> Struct ('Mut s)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (mut :: Mutability).
Struct mut -> ListOf ('Ptr 'Nothing) mut
ptrSection
rawBytes :: ReadCtx m 'Const => ListOf ('Data 'Sz8) 'Const -> m BS.ByteString
{-# INLINABLE rawBytes #-}
rawBytes :: ListOf ('Data 'Sz8) 'Const -> m ByteString
rawBytes (ListOf (NormalList M.WordPtr{pSegment, pAddr=WordAt{wordIndex}} len)) = do
let bytes :: ByteString
bytes = Segment 'Const -> ByteString
M.toByteString Segment 'Const
pSegment
let ByteCount Int
byteOffset = WordCount -> ByteCount
wordsToBytes WordCount
wordIndex
ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
byteOffset ByteString
bytes
rootPtr :: ReadCtx m mut => M.Message mut -> m (Struct mut)
{-# INLINABLE rootPtr #-}
rootPtr :: Message mut -> m (Struct mut)
rootPtr Message mut
msg = do
Segment mut
seg <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
0
Maybe (Ptr mut)
root <- WordPtr mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
WordPtr mut -> m (Maybe (Ptr mut))
get WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr
{ pMessage :: Message mut
pMessage = Message mut
msg
, pSegment :: Segment mut
pSegment = Segment mut
seg
, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0
}
Maybe (Ptr mut) -> m ()
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Maybe (Ptr mut) -> m ()
checkPtr Maybe (Ptr mut)
root
Maybe (Ptr mut) -> m ()
forall (m :: * -> *) (mut :: Mutability).
MonadLimit m =>
Maybe (Ptr mut) -> m ()
invoicePtr Maybe (Ptr mut)
root
case Maybe (Ptr mut)
root of
Just (PtrStruct Struct mut
struct) -> Struct mut -> m (Struct mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct mut
struct
Maybe (Ptr mut)
Nothing -> Message mut -> m (Unwrapped (Struct mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
messageDefault @Struct Message mut
msg
Maybe (Ptr mut)
_ -> Error -> m (Struct mut)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Struct mut)) -> Error -> m (Struct mut)
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError
String
"Unexpected root type; expected struct."
setRoot :: M.WriteCtx m s => Struct ('Mut s) -> m ()
{-# INLINABLE setRoot #-}
setRoot :: Struct ('Mut s) -> m ()
setRoot (StructAt M.WordPtr{Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage :: forall (mut :: Mutability). WordPtr mut -> Message mut
pMessage, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=WordAddr
addr} Word16
dataSz Word16
ptrSz) = do
Segment ('Mut s)
pSegment <- Message ('Mut s) -> Int -> m (Segment ('Mut s))
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message ('Mut s)
pMessage Int
0
let rootPtr :: WordPtr ('Mut s)
rootPtr = WordPtr :: forall (mut :: Mutability).
Message mut -> Segment mut -> WordAddr -> WordPtr mut
M.WordPtr{Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage :: Message ('Mut s)
pMessage, Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment, pAddr :: WordAddr
pAddr = Int -> WordCount -> WordAddr
WordAt Int
0 WordCount
0}
WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
WordPtr ('Mut s) -> WordAddr -> Ptr -> m ()
setPointerTo WordPtr ('Mut s)
rootPtr WordAddr
addr (Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr Int32
0 Word16
dataSz Word16
ptrSz)
class Allocate (r :: PtrRepr) where
type AllocHint r
alloc :: RWCtx m s => M.Message ('Mut s) -> AllocHint r -> m (Unwrapped (UntypedSomePtr r ('Mut s)))
instance Allocate 'Struct where
type AllocHint 'Struct = (Word16, Word16)
alloc :: Message ('Mut s)
-> AllocHint 'Struct
-> m (Unwrapped (UntypedSomePtr 'Struct ('Mut s)))
alloc Message ('Mut s)
msg = (Word16 -> Word16 -> m (Struct ('Mut s)))
-> (Word16, Word16) -> m (Struct ('Mut s))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct Message ('Mut s)
msg)
instance Allocate 'Cap where
type AllocHint 'Cap = M.Client
alloc :: Message ('Mut s)
-> AllocHint 'Cap -> m (Unwrapped (UntypedSomePtr 'Cap ('Mut s)))
alloc = Message ('Mut s)
-> AllocHint 'Cap -> m (Unwrapped (UntypedSomePtr 'Cap ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap
instance Allocate ('List ('Just 'ListComposite)) where
type AllocHint ('List ('Just 'ListComposite)) = (Int, AllocHint 'Struct)
alloc :: Message ('Mut s)
-> AllocHint ('List ('Just 'ListComposite))
-> m (Unwrapped
(UntypedSomePtr ('List ('Just 'ListComposite)) ('Mut s)))
alloc Message ('Mut s)
msg (len, (nWords, nPtrs)) = Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList Message ('Mut s)
msg Word16
nWords Word16
nPtrs Int
len
instance AllocateNormalList r => Allocate ('List ('Just ('ListNormal r))) where
type AllocHint ('List ('Just ('ListNormal r))) = Int
alloc :: Message ('Mut s)
-> AllocHint ('List ('Just ('ListNormal r)))
-> m (Unwrapped
(UntypedSomePtr ('List ('Just ('ListNormal r))) ('Mut s)))
alloc = forall (m :: * -> *) s.
(AllocateNormalList r, RWCtx m s) =>
Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))
forall (r :: NormalListRepr) (m :: * -> *) s.
(AllocateNormalList r, RWCtx m s) =>
Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))
allocNormalList @r
class AllocateNormalList (r :: NormalListRepr) where
allocNormalList
:: RWCtx m s
=> M.Message ('Mut s) -> Int -> m (UntypedSomeList ('ListNormal r) ('Mut s))
instance AllocateNormalList ('NormalListData 'Sz0) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz0)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz0)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0
instance AllocateNormalList ('NormalListData 'Sz1) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz1)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz1)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1
instance AllocateNormalList ('NormalListData 'Sz8) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz8)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz8)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8
instance AllocateNormalList ('NormalListData 'Sz16) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz16)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz16)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16
instance AllocateNormalList ('NormalListData 'Sz32) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz32)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz32)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32
instance AllocateNormalList ('NormalListData 'Sz64) where allocNormalList :: Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz64)) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int
-> m (UntypedSomeList
('ListNormal ('NormalListData 'Sz64)) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64
instance AllocateNormalList 'NormalListPtr where allocNormalList :: Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal 'NormalListPtr) ('Mut s))
allocNormalList = Message ('Mut s)
-> Int -> m (UntypedSomeList ('ListNormal 'NormalListPtr) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr
allocStruct :: M.WriteCtx m s => M.Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
{-# INLINABLE allocStruct #-}
allocStruct :: Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
allocStruct Message ('Mut s)
msg Word16
dataSz Word16
ptrSz = do
let totalSz :: WordCount
totalSz = Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ Word16 -> WordCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
WordPtr ('Mut s)
ptr <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
totalSz
pure $ WordPtr ('Mut s) -> Word16 -> Word16 -> Struct ('Mut s)
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt WordPtr ('Mut s)
ptr Word16
dataSz Word16
ptrSz
allocCompositeList
:: M.WriteCtx m s
=> M.Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
{-# INLINABLE allocCompositeList #-}
allocCompositeList :: Message ('Mut s)
-> Word16
-> Word16
-> Int
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
allocCompositeList Message ('Mut s)
msg Word16
dataSz Word16
ptrSz Int
len = do
let eltSize :: Int
eltSize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dataSz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ptrSz
ptr :: WordPtr ('Mut s)
ptr@M.WordPtr{Segment ('Mut s)
pSegment :: Segment ('Mut s)
pSegment :: forall (mut :: Mutability). WordPtr mut -> Segment mut
pSegment, pAddr :: forall (mut :: Mutability). WordPtr mut -> WordAddr
pAddr=addr :: WordAddr
addr@WordAt{WordCount
wordIndex :: WordCount
wordIndex :: WordAddr -> WordCount
wordIndex}}
<- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg (Int -> WordCount
WordCount (Int -> WordCount) -> Int -> WordCount
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
eltSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Segment ('Mut s) -> WordCount -> Word64 -> m ()
forall (m :: * -> *) s.
WriteCtx m s =>
Segment ('Mut s) -> WordCount -> Word64 -> m ()
M.write Segment ('Mut s)
pSegment WordCount
wordIndex (Word64 -> m ()) -> Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr -> Word64
P.serializePtr' (Ptr -> Word64) -> Ptr -> Word64
forall a b. (a -> b) -> a -> b
$ Int32 -> Word16 -> Word16 -> Ptr
P.StructPtr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Word16
dataSz Word16
ptrSz
let firstStruct :: Struct ('Mut s)
firstStruct = WordPtr ('Mut s) -> Word16 -> Word16 -> Struct ('Mut s)
forall (mut :: Mutability).
WordPtr mut -> Word16 -> Word16 -> Struct mut
StructAt
WordPtr ('Mut s)
ptr { pAddr :: WordAddr
M.pAddr = WordAddr
addr { wordIndex :: WordCount
wordIndex = WordCount
wordIndex WordCount -> WordCount -> WordCount
forall a. Num a => a -> a -> a
+ WordCount
1 } }
Word16
dataSz
Word16
ptrSz
ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s)))
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall a b. (a -> b) -> a -> b
$ ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s))
-> ListRepOf ('Ptr ('Just 'Struct)) ('Mut s)
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> Int -> StructList ('Mut s)
forall (mut :: Mutability). Struct mut -> Int -> StructList mut
StructList Struct ('Mut s)
firstStruct Int
len
allocList0 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
{-# INLINABLE allocList0 #-}
allocList1 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
{-# INLINABLE allocList1 #-}
allocList8 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
{-# INLINABLE allocList8 #-}
allocList16 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
{-# INLINABLE allocList16 #-}
allocList32 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
{-# INLINABLE allocList32 #-}
allocList64 :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
{-# INLINABLE allocList64 #-}
allocListPtr :: M.WriteCtx m s => M.Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
{-# INLINABLE allocListPtr #-}
allocList0 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz0) ('Mut s))
allocList0 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz0) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz0) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz0) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
0 Message ('Mut s)
msg Int
len
allocList1 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
allocList1 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz1) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz1) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
1 Message ('Mut s)
msg Int
len
allocList8 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
allocList8 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz8) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz8) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
8 Message ('Mut s)
msg Int
len
allocList16 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
allocList16 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz16) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz16) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz16) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
16 Message ('Mut s)
msg Int
len
allocList32 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
allocList32 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz32) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz32) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz32) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
32 Message ('Mut s)
msg Int
len
allocList64 :: Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
allocList64 Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Data 'Sz64) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Data 'Sz64) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
64 Message ('Mut s)
msg Int
len
allocListPtr :: Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
allocListPtr Message ('Mut s)
msg Int
len = NormalList ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (NormalList ('Mut s) -> ListOf ('Ptr 'Nothing) ('Mut s))
-> m (NormalList ('Mut s)) -> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
64 Message ('Mut s)
msg Int
len
allocNormalList'
:: M.WriteCtx m s
=> Int
-> M.Message ('Mut s)
-> Int
-> m (NormalList ('Mut s))
{-# INLINABLE allocNormalList' #-}
allocNormalList' :: Int -> Message ('Mut s) -> Int -> m (NormalList ('Mut s))
allocNormalList' Int
bitsPerElt Message ('Mut s)
msg Int
len = do
let totalBits :: BitCount
totalBits = Int -> BitCount
BitCount (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bitsPerElt)
totalWords :: WordCount
totalWords = ByteCount -> WordCount
bytesToWordsCeil (ByteCount -> WordCount) -> ByteCount -> WordCount
forall a b. (a -> b) -> a -> b
$ BitCount -> ByteCount
bitsToBytesCeil BitCount
totalBits
WordPtr ('Mut s)
ptr <- Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> WordCount -> m (WordPtr ('Mut s))
M.alloc Message ('Mut s)
msg WordCount
totalWords
pure NormalList :: forall (mut :: Mutability). WordPtr mut -> Int -> NormalList mut
NormalList { nPtr :: WordPtr ('Mut s)
nPtr = WordPtr ('Mut s)
ptr, nLen :: Int
nLen = Int
len }
appendCap :: M.WriteCtx m s => M.Message ('Mut s) -> M.Client -> m (Cap ('Mut s))
{-# INLINABLE appendCap #-}
appendCap :: Message ('Mut s) -> Client -> m (Cap ('Mut s))
appendCap Message ('Mut s)
msg Client
client = do
Int
i <- Message ('Mut s) -> Client -> m Int
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m Int
M.appendCap Message ('Mut s)
msg Client
client
pure $ Message ('Mut s) -> Word32 -> Cap ('Mut s)
forall (mut :: Mutability). Message mut -> Word32 -> Cap mut
CapAt Message ('Mut s)
msg (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
instance MaybeMutable (ListRepOf r) => MaybeMutable (ListOf r) where
thaw :: ListOf r 'Const -> m (ListOf r ('Mut s))
thaw (ListOf ListRepOf r 'Const
l) = ListRepOf r ('Mut s) -> ListOf r ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r ('Mut s) -> ListOf r ('Mut s))
-> m (ListRepOf r ('Mut s)) -> m (ListOf r ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r 'Const -> m (ListRepOf r ('Mut s))
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
thaw ListRepOf r 'Const
l
freeze :: ListOf r ('Mut s) -> m (ListOf r 'Const)
freeze (ListOf ListRepOf r ('Mut s)
l) = ListRepOf r 'Const -> ListOf r 'Const
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r 'Const -> ListOf r 'Const)
-> m (ListRepOf r 'Const) -> m (ListOf r 'Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r ('Mut s) -> m (ListRepOf r 'Const)
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
freeze ListRepOf r ('Mut s)
l
unsafeThaw :: ListOf r 'Const -> m (ListOf r ('Mut s))
unsafeThaw (ListOf ListRepOf r 'Const
l) = ListRepOf r ('Mut s) -> ListOf r ('Mut s)
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r ('Mut s) -> ListOf r ('Mut s))
-> m (ListRepOf r ('Mut s)) -> m (ListOf r ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r 'Const -> m (ListRepOf r ('Mut s))
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
unsafeThaw ListRepOf r 'Const
l
unsafeFreeze :: ListOf r ('Mut s) -> m (ListOf r 'Const)
unsafeFreeze (ListOf ListRepOf r ('Mut s)
l) = ListRepOf r 'Const -> ListOf r 'Const
forall (r :: Repr) (mut :: Mutability).
ListRepOf r mut -> ListOf r mut
ListOf (ListRepOf r 'Const -> ListOf r 'Const)
-> m (ListRepOf r 'Const) -> m (ListOf r 'Const)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListRepOf r ('Mut s) -> m (ListRepOf r 'Const)
forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
unsafeFreeze ListRepOf r ('Mut s)
l
newtype CatchTWrap m a = CatchTWrap { CatchTWrap m a -> CatchT m a
runCatchTWrap :: CatchT m a }
deriving(a -> CatchTWrap m b -> CatchTWrap m a
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
(forall a b. (a -> b) -> CatchTWrap m a -> CatchTWrap m b)
-> (forall a b. a -> CatchTWrap m b -> CatchTWrap m a)
-> Functor (CatchTWrap m)
forall a b. a -> CatchTWrap m b -> CatchTWrap m a
forall a b. (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
a -> CatchTWrap m b -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CatchTWrap m b -> CatchTWrap m a
$c<$ :: forall (m :: * -> *) a b.
Monad m =>
a -> CatchTWrap m b -> CatchTWrap m a
fmap :: (a -> b) -> CatchTWrap m a -> CatchTWrap m b
$cfmap :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> CatchTWrap m a -> CatchTWrap m b
Functor, Functor (CatchTWrap m)
a -> CatchTWrap m a
Functor (CatchTWrap m)
-> (forall a. a -> CatchTWrap m a)
-> (forall a b.
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b)
-> (forall a b c.
(a -> b -> c)
-> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a)
-> Applicative (CatchTWrap m)
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall a. a -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a b.
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall a b c.
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall (m :: * -> *). Monad m => Functor (CatchTWrap m)
forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m a
*> :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
liftA2 :: (a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m c
<*> :: CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m (a -> b) -> CatchTWrap m a -> CatchTWrap m b
pure :: a -> CatchTWrap m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (CatchTWrap m)
Applicative, Applicative (CatchTWrap m)
a -> CatchTWrap m a
Applicative (CatchTWrap m)
-> (forall a b.
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b)
-> (forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b)
-> (forall a. a -> CatchTWrap m a)
-> Monad (CatchTWrap m)
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a. a -> CatchTWrap m a
forall a b. CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall a b.
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
forall (m :: * -> *). Monad m => Applicative (CatchTWrap m)
forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CatchTWrap m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CatchTWrap m a
>> :: CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> CatchTWrap m b -> CatchTWrap m b
>>= :: CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CatchTWrap m a -> (a -> CatchTWrap m b) -> CatchTWrap m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (CatchTWrap m)
Monad, m a -> CatchTWrap m a
(forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a)
-> MonadTrans CatchTWrap
forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> CatchTWrap m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> CatchTWrap m a
MonadTrans, Monad (CatchTWrap m)
e -> CatchTWrap m a
Monad (CatchTWrap m)
-> (forall e a. Exception e => e -> CatchTWrap m a)
-> MonadThrow (CatchTWrap m)
forall e a. Exception e => e -> CatchTWrap m a
forall (m :: * -> *). Monad m => Monad (CatchTWrap m)
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *) e a.
(Monad m, Exception e) =>
e -> CatchTWrap m a
throwM :: e -> CatchTWrap m a
$cthrowM :: forall (m :: * -> *) e a.
(Monad m, Exception e) =>
e -> CatchTWrap m a
$cp1MonadThrow :: forall (m :: * -> *). Monad m => Monad (CatchTWrap m)
MonadThrow, MonadThrow (CatchTWrap m)
MonadThrow (CatchTWrap m)
-> (forall e a.
Exception e =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a)
-> MonadCatch (CatchTWrap m)
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall e a.
Exception e =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall (m :: * -> *). Monad m => MonadThrow (CatchTWrap m)
forall (m :: * -> *) e a.
(Monad m, Exception e) =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
$ccatch :: forall (m :: * -> *) e a.
(Monad m, Exception e) =>
CatchTWrap m a -> (e -> CatchTWrap m a) -> CatchTWrap m a
$cp1MonadCatch :: forall (m :: * -> *). Monad m => MonadThrow (CatchTWrap m)
MonadCatch)
instance PrimMonad m => PrimMonad (CatchTWrap m) where
type PrimState (CatchTWrap m) = PrimState m
primitive :: (State# (PrimState (CatchTWrap m))
-> (# State# (PrimState (CatchTWrap m)), a #))
-> CatchTWrap m a
primitive = m a -> CatchTWrap m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CatchTWrap m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> CatchTWrap m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
runCatchImpure :: Monad m => CatchTWrap m a -> m a
{-# INLINABLE runCatchImpure #-}
runCatchImpure :: CatchTWrap m a -> m a
runCatchImpure CatchTWrap m a
m = do
Either SomeException a
res <- CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m a -> m (Either SomeException a))
-> CatchT m a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ CatchTWrap m a -> CatchT m a
forall (m :: * -> *) a. CatchTWrap m a -> CatchT m a
runCatchTWrap CatchTWrap m a
m
pure $ case Either SomeException a
res of
Left SomeException
e -> SomeException -> a
forall e a. Exception e => e -> a
impureThrow SomeException
e
Right a
v -> a
v
do
let mkWrappedInstance name =
let f = pure $ TH.ConT name in
[d|instance MaybeMutable $f where
thaw = runCatchImpure . tMsg thaw
freeze = runCatchImpure . tMsg freeze
unsafeThaw = runCatchImpure . tMsg unsafeThaw
unsafeFreeze = runCatchImpure . tMsg unsafeFreeze
|]
concat <$> traverse mkWrappedInstance
[ ''Ptr
, ''List
, ''NormalList
, ''Struct
]
do
let mkIsListPtrRepr (r, listC, str) =
[d| instance IsListPtrRepr $r where
rToList = $(pure $ TH.ConE listC)
rFromList $(pure $ TH.ConP listC [TH.VarP (TH.mkName "l")]) = pure l
rFromList _ = expected $(pure $ TH.LitE $ TH.StringL $ "pointer to " ++ str)
rFromListMsg = messageDefault @(Untyped ('Ptr ('Just ('List ('Just $r)))))
|]
concat <$> traverse mkIsListPtrRepr
[ ( [t| 'ListNormal ('NormalListData 'Sz0) |]
, 'List0
, "List(Void)"
)
, ( [t| 'ListNormal ('NormalListData 'Sz1) |]
, 'List1
, "List(Bool)"
)
, ( [t| 'ListNormal ('NormalListData 'Sz8) |]
, 'List8
, "List(UInt8)"
)
, ( [t| 'ListNormal ('NormalListData 'Sz16) |]
, 'List16
, "List(UInt16)"
)
, ( [t| 'ListNormal ('NormalListData 'Sz32) |]
, 'List32
, "List(UInt32)"
)
, ( [t| 'ListNormal ('NormalListData 'Sz64) |]
, 'List64
, "List(UInt64)"
)
, ( [t| 'ListNormal 'NormalListPtr |]
, 'ListPtr
, "List(AnyPointer)"
)
, ( [t| 'ListComposite |]
, 'ListStruct
, "composite list"
)
]