-- | Capnproto message canonicalization, per:
--
-- https://capnproto.org/encoding.html#canonicalization
{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies     #-}
module Capnp.Canonicalize
    ( canonicalize
    ) where

-- Note [Allocation strategy]
--
-- The implementation makes use of knowledge of how we allocate values inside
-- a message; in particular, we assume objects are allocated sequentially,
-- and that if the first segment is big enough we will never allocate a second
-- segment.
--
-- If we ever make the allocator plugable, we will have to revisit this and
-- ensure that our assumptions still hold.

-- Note [Other assumptions]
--
-- This code relies on the fact that Capnp.Pointer.serializePointer does the
-- canonicalization of zero-sized struct pointers for us; see the comments there
-- for more details.

import Data.Word

import Data.Foldable    (for_)
import Data.Maybe       (isNothing)
import Data.Traversable (for)
-- import qualified Language.Haskell.TH as TH

import           Capnp.Bits           (WordCount)
import           Capnp.Message        (Mutability(..))
import qualified Capnp.Message        as M
import           Capnp.TraversalLimit (LimitT)
import qualified Capnp.Untyped        as U
import           Control.Monad.ST     (RealWorld)
-- import           Internal.BuildPure   (PureBuilder)

-- | Return a canonicalized message with a copy of the given struct as its
-- root. returns a (message, segment) pair, where the segment is the first
-- and only segment of the returned message.
--
-- In addition to the usual reasons for failure when reading a message (traversal limit,
-- malformed messages), this can fail if the message does not fit in a single segment,
-- as the canonical form requires single-segment messages.
canonicalize
   :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
   => U.Struct mutIn -> m (M.Message ('Mut s), M.Segment ('Mut s))
{-# SPECIALIZE canonicalize :: U.Struct 'Const -> LimitT IO (M.Message ('Mut RealWorld), M.Segment ('Mut RealWorld)) #-}
{-# SPECIALIZE canonicalize :: U.Struct ('Mut RealWorld) -> LimitT IO (M.Message ('Mut RealWorld), M.Segment ('Mut RealWorld)) #-}
canonicalize :: Struct mutIn -> m (Message ('Mut s), Segment ('Mut s))
canonicalize Struct mutIn
rootStructIn = do
    let msgIn :: Message mutIn
msgIn = Unwrapped (Struct mutIn) -> Message mutIn
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Struct mutIn)
Struct mutIn
rootStructIn
    -- Note [Allocation strategy]
    WordCount
words <- Message mutIn -> m WordCount
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m WordCount
totalWords Message mutIn
msgIn
    Message ('Mut s)
msgOut <- Maybe WordCount -> m (Message ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Maybe WordCount -> m (Message ('Mut s))
M.newMessage (Maybe WordCount -> m (Message ('Mut s)))
-> Maybe WordCount -> m (Message ('Mut s))
forall a b. (a -> b) -> a -> b
$ WordCount -> Maybe WordCount
forall a. a -> Maybe a
Just WordCount
words
    Struct ('Mut s)
rootStructOut <- Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
rootStructIn Message ('Mut s)
msgOut
    Struct ('Mut s) -> m ()
forall (m :: * -> *) s. WriteCtx m s => Struct ('Mut s) -> m ()
U.setRoot Struct ('Mut s)
rootStructOut
    Segment ('Mut s)
segOut <- 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)
msgOut Int
0
    (Message ('Mut s), Segment ('Mut s))
-> m (Message ('Mut s), Segment ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message ('Mut s)
msgOut, Segment ('Mut s)
segOut)

totalWords :: U.ReadCtx m mut => M.Message mut -> m WordCount
totalWords :: Message mut -> m WordCount
totalWords Message mut
msg = do
    -- Note [Allocation strategy]
    Int
segCount <- Message mut -> m Int
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Message mut -> m Int
M.numSegs Message mut
msg
    [WordCount]
sizes <- [Int] -> (Int -> m WordCount) -> m [WordCount]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
0..Int
segCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m WordCount) -> m [WordCount])
-> (Int -> m WordCount) -> m [WordCount]
forall a b. (a -> b) -> a -> b
$ \Int
i -> 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
i
        Segment mut -> m WordCount
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> m WordCount
M.numWords Segment mut
seg
    WordCount -> m WordCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordCount -> m WordCount) -> WordCount -> m WordCount
forall a b. (a -> b) -> a -> b
$ [WordCount] -> WordCount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [WordCount]
sizes

cloneCanonicalStruct
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.Struct mutIn -> M.Message ('Mut s) -> m (U.Struct ('Mut s))
{-# SPECIALIZE cloneCanonicalStruct :: U.Struct 'Const -> M.Message ('Mut RealWorld) -> LimitT IO (U.Struct ('Mut RealWorld)) #-}
{-# SPECIALIZE cloneCanonicalStruct :: U.Struct ('Mut RealWorld) -> M.Message ('Mut RealWorld) -> LimitT IO (U.Struct ('Mut RealWorld)) #-}
cloneCanonicalStruct :: Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
structIn Message ('Mut s)
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- Struct mutIn -> m (Word16, Word16)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Struct mut -> m (Word16, Word16)
findCanonicalSectionCounts Struct mutIn
structIn
    Struct ('Mut s)
structOut <- Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
U.allocStruct Message ('Mut s)
msgOut (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nWords) (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nPtrs)
    Struct mutIn -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut s)
structOut
    Struct ('Mut s) -> m (Struct ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct ('Mut s)
structOut

copyCanonicalStruct
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.Struct mutIn -> U.Struct ('Mut s) -> m ()
{-# SPECIALIZE copyCanonicalStruct :: U.Struct 'Const -> U.Struct ('Mut RealWorld) -> LimitT IO () #-}
{-# SPECIALIZE copyCanonicalStruct :: U.Struct ('Mut RealWorld) -> U.Struct ('Mut RealWorld) -> LimitT IO () #-}
copyCanonicalStruct :: Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut s)
structOut = do
    let nWords :: Int
nWords = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
U.structWordCount Struct ('Mut s)
structOut
        nPtrs :: Int
nPtrs = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct ('Mut s) -> Word16
forall (mut :: Mutability). Struct mut -> Word16
U.structPtrCount Struct ('Mut s)
structOut
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nWords 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
        Word64
word <- Int -> Struct mutIn -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
i Struct mutIn
structIn
        Word64 -> Int -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Word64 -> Int -> Struct ('Mut s) -> m ()
U.setData Word64
word Int
i Struct ('Mut s)
structOut
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nPtrs 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
        Maybe (Ptr mutIn)
ptrIn <- Int -> Struct mutIn -> m (Maybe (Ptr mutIn))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct mutIn
structIn
        Maybe (Ptr ('Mut s))
ptrOut <- Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn (Unwrapped (Struct ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Struct ('Mut s))
Struct ('Mut s)
structOut)
        Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
U.setPtr Maybe (Ptr ('Mut s))
ptrOut Int
i Struct ('Mut s)
structOut

findCanonicalSectionCounts :: U.ReadCtx m mut => U.Struct mut -> m (Word16, Word16)
{-# SPECIALIZE findCanonicalSectionCounts :: U.Struct 'Const -> LimitT IO (Word16, Word16) #-}
{-# SPECIALIZE findCanonicalSectionCounts :: U.Struct ('Mut RealWorld) -> LimitT IO (Word16, Word16) #-}
findCanonicalSectionCounts :: Struct mut -> m (Word16, Word16)
findCanonicalSectionCounts Struct mut
struct = do
    Word16
nWords <- (Word64 -> Bool) -> (Int -> m Word64) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (Int -> Struct mut -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Struct mut
struct) (WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct mut -> WordCount
forall (mut :: Mutability). Struct mut -> WordCount
U.structWordCount Struct mut
struct)
    Word16
nPtrs <- (Maybe (Ptr mut) -> Bool)
-> (Int -> m (Maybe (Ptr mut))) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount Maybe (Ptr mut) -> Bool
forall a. Maybe a -> Bool
isNothing (Int -> Struct mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
`U.getPtr` Struct mut
struct) (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct mut -> Word16
forall (mut :: Mutability). Struct mut -> Word16
U.structPtrCount Struct mut
struct)
    (Word16, Word16) -> m (Word16, Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
nWords, Word16
nPtrs)

canonicalSectionCount :: Monad m => (a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount :: (a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount a -> Bool
_ Int -> m a
_ Int
0 = Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
0
canonicalSectionCount a -> Bool
isDefault Int -> m a
getIndex Int
total = do
    a
value <- Int -> m a
getIndex (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    if a -> Bool
isDefault a
value
        then (a -> Bool) -> (Int -> m a) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount a -> Bool
isDefault Int -> m a
getIndex (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        else Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total

cloneCanonicalPtr
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => Maybe (U.Ptr mutIn) -> M.Message ('Mut s) -> m (Maybe (U.Ptr ('Mut s)))
{-# SPECIALIZE cloneCanonicalPtr :: Maybe (U.Ptr 'Const) -> M.Message ('Mut RealWorld) -> LimitT IO (Maybe (U.Ptr ('Mut RealWorld))) #-}
{-# SPECIALIZE cloneCanonicalPtr :: Maybe (U.Ptr ('Mut RealWorld)) -> M.Message ('Mut RealWorld) -> LimitT IO (Maybe (U.Ptr ('Mut RealWorld))) #-}
cloneCanonicalPtr :: Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn Message ('Mut s)
msgOut =
    case Maybe (Ptr mutIn)
ptrIn of
        Maybe (Ptr mutIn)
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
        Just (U.PtrCap Cap mutIn
cap) -> do
            Client
client <- Cap mutIn -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Cap mutIn
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
U.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) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
U.appendCap Message ('Mut s)
msgOut Client
client
        Just (U.PtrStruct Struct mutIn
struct) ->
            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
U.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
<$> Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
struct Message ('Mut s)
msgOut
        Just (U.PtrList List mutIn
list) ->
            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
U.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
<$> List mutIn -> Message ('Mut s) -> m (List ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
List mutIn -> Message ('Mut s) -> m (List ('Mut s))
cloneCanonicalList List mutIn
list Message ('Mut s)
msgOut

cloneCanonicalList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.List mutIn -> M.Message ('Mut s) -> m (U.List ('Mut s))
{-# SPECIALIZE cloneCanonicalList :: U.List 'Const -> M.Message ('Mut RealWorld) -> LimitT IO (U.List ('Mut RealWorld)) #-}
{-# SPECIALIZE cloneCanonicalList :: U.List ('Mut RealWorld) -> M.Message ('Mut RealWorld) -> LimitT IO (U.List ('Mut RealWorld)) #-}
cloneCanonicalList :: List mutIn -> Message ('Mut s) -> m (List ('Mut s))
cloneCanonicalList List mutIn
listIn Message ('Mut s)
msgOut =
    case List mutIn
listIn of
        U.List0 ListOf ('Data 'Sz0) mutIn
l -> ListOf ('Data 'Sz0) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
U.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))
U.allocList0 Message ('Mut s)
msgOut (ListOf ('Data 'Sz0) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz0) mutIn
l)
        U.List1 ListOf ('Data 'Sz1) mutIn
l -> ListOf ('Data 'Sz1) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
U.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) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz1) ('Mut s))
U.allocList1 Message ('Mut s)
msgOut (ListOf ('Data 'Sz1) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz1) mutIn
l) m (ListOf ('Data 'Sz1) ('Mut s))
-> (ListOf ('Data 'Sz1) ('Mut s)
    -> m (ListOf ('Data 'Sz1) ('Mut s)))
-> m (ListOf ('Data 'Sz1) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Data 'Sz1) mutIn
-> ListOf ('Data 'Sz1) ('Mut s) -> m (ListOf ('Data 'Sz1) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability) (r :: Repr).
(RWCtx m s, MonadReadMessage mutIn m, ListItem r,
 Unwrapped (Untyped r mutIn) ~ Unwrapped (Untyped r ('Mut s))) =>
ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf ('Data 'Sz1) mutIn
l)
        U.List8 ListOf ('Data 'Sz8) mutIn
l -> ListOf ('Data 'Sz8) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
U.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) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
U.allocList8 Message ('Mut s)
msgOut (ListOf ('Data 'Sz8) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz8) mutIn
l) m (ListOf ('Data 'Sz8) ('Mut s))
-> (ListOf ('Data 'Sz8) ('Mut s)
    -> m (ListOf ('Data 'Sz8) ('Mut s)))
-> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Data 'Sz8) mutIn
-> ListOf ('Data 'Sz8) ('Mut s) -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability) (r :: Repr).
(RWCtx m s, MonadReadMessage mutIn m, ListItem r,
 Unwrapped (Untyped r mutIn) ~ Unwrapped (Untyped r ('Mut s))) =>
ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf ('Data 'Sz8) mutIn
l)
        U.List16 ListOf ('Data 'Sz16) mutIn
l -> ListOf ('Data 'Sz16) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
U.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) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz16) ('Mut s))
U.allocList16 Message ('Mut s)
msgOut (ListOf ('Data 'Sz16) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz16) mutIn
l) m (ListOf ('Data 'Sz16) ('Mut s))
-> (ListOf ('Data 'Sz16) ('Mut s)
    -> m (ListOf ('Data 'Sz16) ('Mut s)))
-> m (ListOf ('Data 'Sz16) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Data 'Sz16) mutIn
-> ListOf ('Data 'Sz16) ('Mut s)
-> m (ListOf ('Data 'Sz16) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability) (r :: Repr).
(RWCtx m s, MonadReadMessage mutIn m, ListItem r,
 Unwrapped (Untyped r mutIn) ~ Unwrapped (Untyped r ('Mut s))) =>
ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf ('Data 'Sz16) mutIn
l)
        U.List32 ListOf ('Data 'Sz32) mutIn
l -> ListOf ('Data 'Sz32) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
U.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) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz32) ('Mut s))
U.allocList32 Message ('Mut s)
msgOut (ListOf ('Data 'Sz32) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz32) mutIn
l) m (ListOf ('Data 'Sz32) ('Mut s))
-> (ListOf ('Data 'Sz32) ('Mut s)
    -> m (ListOf ('Data 'Sz32) ('Mut s)))
-> m (ListOf ('Data 'Sz32) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Data 'Sz32) mutIn
-> ListOf ('Data 'Sz32) ('Mut s)
-> m (ListOf ('Data 'Sz32) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability) (r :: Repr).
(RWCtx m s, MonadReadMessage mutIn m, ListItem r,
 Unwrapped (Untyped r mutIn) ~ Unwrapped (Untyped r ('Mut s))) =>
ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf ('Data 'Sz32) mutIn
l)
        U.List64 ListOf ('Data 'Sz64) mutIn
l -> ListOf ('Data 'Sz64) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
U.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) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz64) ('Mut s))
U.allocList64 Message ('Mut s)
msgOut (ListOf ('Data 'Sz64) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Data 'Sz64) mutIn
l) m (ListOf ('Data 'Sz64) ('Mut s))
-> (ListOf ('Data 'Sz64) ('Mut s)
    -> m (ListOf ('Data 'Sz64) ('Mut s)))
-> m (ListOf ('Data 'Sz64) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Data 'Sz64) mutIn
-> ListOf ('Data 'Sz64) ('Mut s)
-> m (ListOf ('Data 'Sz64) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability) (r :: Repr).
(RWCtx m s, MonadReadMessage mutIn m, ListItem r,
 Unwrapped (Untyped r mutIn) ~ Unwrapped (Untyped r ('Mut s))) =>
ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf ('Data 'Sz64) mutIn
l)
        U.ListPtr ListOf ('Ptr 'Nothing) mutIn
l -> ListOf ('Ptr 'Nothing) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
U.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) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Ptr 'Nothing) ('Mut s))
U.allocListPtr Message ('Mut s)
msgOut (ListOf ('Ptr 'Nothing) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Ptr 'Nothing) mutIn
l) m (ListOf ('Ptr 'Nothing) ('Mut s))
-> (ListOf ('Ptr 'Nothing) ('Mut s)
    -> m (ListOf ('Ptr 'Nothing) ('Mut s)))
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf ('Ptr 'Nothing) mutIn
-> ListOf ('Ptr 'Nothing) ('Mut s)
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf ('Ptr 'Nothing) mutIn
-> ListOf ('Ptr 'Nothing) ('Mut s)
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
copyCanonicalPtrList ListOf ('Ptr 'Nothing) mutIn
l)
        U.ListStruct ListOf ('Ptr ('Just 'Struct)) mutIn
l -> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> List ('Mut s)
forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
U.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
<$> ListOf ('Ptr ('Just 'Struct)) mutIn
-> Message ('Mut s) -> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf ('Ptr ('Just 'Struct)) mutIn
-> Message ('Mut s) -> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
cloneCanonicalStructList ListOf ('Ptr ('Just 'Struct)) mutIn
l Message ('Mut s)
msgOut

copyCanonicalDataList ::
    ( U.RWCtx m s
    , M.MonadReadMessage mutIn m
    , U.ListItem r
    , U.Unwrapped (U.Untyped r mutIn) ~ U.Unwrapped (U.Untyped r ('Mut s))
    )
    => U.ListOf r mutIn -> U.ListOf r ('Mut s) -> m (U.ListOf r ('Mut s))
{-
{-# SPECIALIZE copyCanonicalDataList ::
    ( U.ListItem r
    , U.Unwrapped (U.Untyped r 'Const) ~ U.Unwrapped (U.Untyped r ('Mut RealWorld))
    )
    => U.ListOf r 'Const
    -> U.ListOf r ('Mut RealWorld)
    -> LimitT IO (U.ListOf r ('Mut RealWorld))
    #-}
-}
{-# SPECIALIZE copyCanonicalDataList ::
    U.ListOf ('U.Data 'U.Sz8) 'Const
    -> U.ListOf ('U.Data 'U.Sz8) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Data 'U.Sz8) ('Mut RealWorld))
    #-}
{-# SPECIALIZE copyCanonicalDataList ::
    U.ListOf ('U.Data 'U.Sz16) 'Const
    -> U.ListOf ('U.Data 'U.Sz16) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Data 'U.Sz16) ('Mut RealWorld))
    #-}
{-# SPECIALIZE copyCanonicalDataList ::
    U.ListOf ('U.Data 'U.Sz32) 'Const
    -> U.ListOf ('U.Data 'U.Sz32) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Data 'U.Sz32) ('Mut RealWorld))
    #-}
{-# SPECIALIZE copyCanonicalDataList ::
    U.ListOf ('U.Data 'U.Sz64) 'Const
    -> U.ListOf ('U.Data 'U.Sz64) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Data 'U.Sz64) ('Mut RealWorld))
    #-}
{-# SPECIALIZE copyCanonicalDataList ::
    ( U.ListItem r
    )
    => U.ListOf r ('Mut RealWorld)
    -> U.ListOf r ('Mut RealWorld)
    -> LimitT IO (U.ListOf r ('Mut RealWorld))
    #-}
copyCanonicalDataList :: ListOf r mutIn -> ListOf r ('Mut s) -> m (ListOf r ('Mut s))
copyCanonicalDataList ListOf r mutIn
listIn ListOf r ('Mut s)
listOut = do
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf r mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf r mutIn
listIn 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 mutIn -> m (Unwrapped (Untyped r mutIn))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i ListOf r mutIn
listIn
        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 ()
U.setIndex Unwrapped (Untyped r ('Mut s))
value Int
i ListOf r ('Mut s)
listOut
    ListOf r ('Mut s) -> m (ListOf r ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf r ('Mut s)
listOut

copyCanonicalPtrList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf ('U.Ptr 'Nothing) mutIn
    -> U.ListOf ('U.Ptr 'Nothing) ('Mut s)
    -> m (U.ListOf ('U.Ptr 'Nothing) ('Mut s))
{-# SPECIALIZE copyCanonicalPtrList
    :: U.ListOf ('U.Ptr 'Nothing) 'Const
    -> U.ListOf ('U.Ptr 'Nothing) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Ptr 'Nothing) ('Mut RealWorld))
    #-}
{-# SPECIALIZE copyCanonicalPtrList
    :: U.ListOf ('U.Ptr 'Nothing) ('Mut RealWorld)
    -> U.ListOf ('U.Ptr 'Nothing) ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Ptr 'Nothing) ('Mut RealWorld))
    #-}
copyCanonicalPtrList :: ListOf ('Ptr 'Nothing) mutIn
-> ListOf ('Ptr 'Nothing) ('Mut s)
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
copyCanonicalPtrList ListOf ('Ptr 'Nothing) mutIn
listIn ListOf ('Ptr 'Nothing) ('Mut s)
listOut = do
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf ('Ptr 'Nothing) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Ptr 'Nothing) mutIn
listIn 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
        Maybe (Ptr mutIn)
ptrIn <- Int
-> ListOf ('Ptr 'Nothing) mutIn
-> m (Unwrapped (Untyped ('Ptr 'Nothing) mutIn))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i ListOf ('Ptr 'Nothing) mutIn
listIn
        Maybe (Ptr ('Mut s))
ptrOut <- Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn (Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(U.ListOf ('U.Ptr 'Nothing)) Unwrapped (ListOf ('Ptr 'Nothing) ('Mut s))
ListOf ('Ptr 'Nothing) ('Mut s)
listOut)
        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 ()
U.setIndex Maybe (Ptr ('Mut s))
Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
ptrOut Int
i ListOf ('Ptr 'Nothing) ('Mut s)
listOut
    ListOf ('Ptr 'Nothing) ('Mut s)
-> m (ListOf ('Ptr 'Nothing) ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Ptr 'Nothing) ('Mut s)
listOut

cloneCanonicalStructList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf ('U.Ptr ('Just 'U.Struct)) mutIn
    -> M.Message ('Mut s)
    -> m (U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut s))
{-# SPECIALIZE cloneCanonicalStructList
    :: U.ListOf ('U.Ptr ('Just ('U.Struct))) 'Const
    -> M.Message ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld))
    #-}
{-# SPECIALIZE cloneCanonicalStructList
    :: U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld)
    -> M.Message ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld))
    #-}
cloneCanonicalStructList :: ListOf ('Ptr ('Just 'Struct)) mutIn
-> Message ('Mut s) -> m (ListOf ('Ptr ('Just 'Struct)) ('Mut s))
cloneCanonicalStructList ListOf ('Ptr ('Just 'Struct)) mutIn
listIn Message ('Mut s)
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- ListOf ('Ptr ('Just 'Struct)) mutIn -> m (Word16, Word16)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
ListOf ('Ptr ('Just 'Struct)) mut -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf ('Ptr ('Just 'Struct)) mutIn
listIn
    ListOf ('Ptr ('Just 'Struct)) ('Mut s)
listOut <- 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))
U.allocCompositeList Message ('Mut s)
msgOut Word16
nWords Word16
nPtrs (ListOf ('Ptr ('Just 'Struct)) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Ptr ('Just 'Struct)) mutIn
listIn)
    ListOf ('Ptr ('Just 'Struct)) mutIn
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf ('Ptr ('Just 'Struct)) mutIn
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
copyCanonicalStructList ListOf ('Ptr ('Just 'Struct)) mutIn
listIn ListOf ('Ptr ('Just 'Struct)) ('Mut s)
listOut
    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)
listOut

copyCanonicalStructList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf ('U.Ptr ('Just 'U.Struct)) mutIn
    -> U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut s)
    -> m ()
{-# SPECIALIZE copyCanonicalStructList
    :: U.ListOf ('U.Ptr ('Just 'U.Struct)) 'Const
    -> U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld)
    -> LimitT IO ()
    #-}
{-# SPECIALIZE copyCanonicalStructList
    :: U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld)
    -> U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld)
    -> LimitT IO ()
    #-}
copyCanonicalStructList :: ListOf ('Ptr ('Just 'Struct)) mutIn
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s) -> m ()
copyCanonicalStructList ListOf ('Ptr ('Just 'Struct)) mutIn
listIn ListOf ('Ptr ('Just 'Struct)) ('Mut s)
listOut =
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf ('Ptr ('Just 'Struct)) mutIn -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Ptr ('Just 'Struct)) mutIn
listIn 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
        Struct mutIn
structIn <- Int
-> ListOf ('Ptr ('Just 'Struct)) mutIn
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mutIn))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i ListOf ('Ptr ('Just 'Struct)) mutIn
listIn
        Struct ('Mut s)
structOut <- Int
-> ListOf ('Ptr ('Just 'Struct)) ('Mut s)
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) ('Mut s)))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i ListOf ('Ptr ('Just 'Struct)) ('Mut s)
listOut
        Struct mutIn -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut s)
structOut

findCanonicalListSectionCounts
    :: U.ReadCtx m mut
    => U.ListOf ('U.Ptr ('Just 'U.Struct)) mut -> m (Word16, Word16)
{-# SPECIALIZE findCanonicalListSectionCounts
    :: U.ListOf ('U.Ptr ('Just 'U.Struct)) 'Const -> LimitT IO (Word16, Word16)
    #-}
{-# SPECIALIZE findCanonicalListSectionCounts
    :: U.ListOf ('U.Ptr ('Just 'U.Struct)) ('Mut RealWorld) -> LimitT IO (Word16, Word16)
    #-}
findCanonicalListSectionCounts :: ListOf ('Ptr ('Just 'Struct)) mut -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf ('Ptr ('Just 'Struct)) mut
list = Int -> Word16 -> Word16 -> m (Word16, Word16)
go Int
0 Word16
0 Word16
0 where
    go :: Int -> Word16 -> Word16 -> m (Word16, Word16)
go Int
i !Word16
nWords !Word16
nPtrs
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ListOf ('Ptr ('Just 'Struct)) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length ListOf ('Ptr ('Just 'Struct)) mut
list =
            (Word16, Word16) -> m (Word16, Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
nWords, Word16
nPtrs)
        | Bool
otherwise = do
            Struct mut
struct <- Int
-> ListOf ('Ptr ('Just 'Struct)) mut
-> m (Unwrapped (Untyped ('Ptr ('Just 'Struct)) mut))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i ListOf ('Ptr ('Just 'Struct)) mut
list
            (Word16
nWords', Word16
nPtrs') <- Struct mut -> m (Word16, Word16)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Struct mut -> m (Word16, Word16)
findCanonicalSectionCounts Struct mut
struct
            Int -> Word16 -> Word16 -> m (Word16, Word16)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
nWords Word16
nWords') (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
nPtrs Word16
nPtrs')


{-
do
    -- Generate specializations for various functions above.
    --
    -- TODO: Figure out why this version doesn't seem to be taking
    -- effect; having the explicit SPECIALIZE pragmas written out
    -- literally results in a 15-20% speedup vs. trying to generate
    -- them with template haskell. But ew.
    --
    -- TODO(cleanup): find some way to group the signature & the specialization together
    -- without duplicating everything.
    let specializations :: [(TH.Name, [TH.TypeQ])]
        specializations =
            [ ( 'copyCanonicalStructList
              , each $ \mutIn mutOut m ->
                    [t| U.ListOf $mutIn (U.Struct $mutIn)
                        -> U.ListOf $mutOut (U.Struct $mutOut) -> $m ()
                    |]
              )
            , ( 'copyCanonicalDataList
              , each $ \mutIn mutOut m -> do
                    a <- pure . TH.VarT <$> TH.newName "a"
                    [t| U.ListOf $mutIn $a -> U.ListOf $mutOut $a -> $m (U.ListOf $mutOut $a) |]
              )
            , ( 'copyCanonicalPtrList
              , each $ \mutIn mutOut m ->
                    [t| U.ListOf $mutIn (Maybe (U.Ptr $mutIn))
                        -> U.ListOf $mutOut (Maybe (U.Ptr $mutOut))
                        -> $m (U.ListOf $mutOut (Maybe (U.Ptr $mutOut)))
                    |]
              )
            , ( 'cloneCanonicalPtr
              , each $ \mutIn mutOut m ->
                    [t| Maybe (U.Ptr $mutIn) -> M.Message $mutOut -> $m (Maybe (U.Ptr $mutOut)) |]
              )
            , ( 'cloneCanonicalList
              , each $ \mutIn mutOut m ->
                    [t| U.List $mutIn -> M.Message $mutOut -> $m (U.List $mutOut) |]
              )
            , ( 'cloneCanonicalStruct
              , each $ \mutIn mutOut m ->
                    [t| U.Struct $mutIn -> M.Message $mutOut -> $m (U.Struct $mutOut) |]
              )
            , ( 'copyCanonicalStruct
              , each $ \mutIn mutOut m ->
                    [t| U.Struct $mutIn -> U.Struct $mutOut -> $m () |]
              )
            ]
        each f = do
            let s = pure $ TH.VarT (TH.mkName "s")
            (m, s) <- [ ( [t| LimitT IO |], [t| RealWorld |] )
                      , ( [t| PureBuilder $s |], s )
                      ]
            mutIn <- [ [t| 'Const |], [t| 'Mut $s |] ]
            pure $ f mutIn [t| 'Mut $s |] m
{-
            map
                (\t -> f t [t| 'Mut RealWorld |] [t| LimitT IO |])
                [ [t| 'Const |], [t| 'Mut RealWorld |] ]
-}
    concat <$> for specializations (\(name, types) -> do
        for types $ \mkType -> do
            t <- mkType
            pure $ TH.PragmaD $ TH.SpecialiseP name t Nothing TH.AllPhases)
-}