-- | Capnproto message canonicalization, per:
--
-- https://capnproto.org/encoding.html#canonicalization
{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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 = Struct mutIn -> Message mutIn
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message 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 (msg :: Mutability). Struct msg -> 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 (msg :: Mutability). Struct msg -> 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 (Struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message 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 (msg :: Mutability). Struct msg -> 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 (msg :: Mutability). Struct msg -> 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 mutIn ()
l -> ListOf ('Mut s) () -> List ('Mut s)
forall (mut :: Mutability). ListOf mut () -> List mut
U.List0 (ListOf ('Mut s) () -> List ('Mut s))
-> m (ListOf ('Mut s) ()) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Mut s) ())
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) ())
U.allocList0 Message ('Mut s)
msgOut (ListOf mutIn () -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn ()
l)
        U.List1 ListOf mutIn Bool
l -> ListOf ('Mut s) Bool -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Bool -> List mut
U.List1 (ListOf ('Mut s) Bool -> List ('Mut s))
-> m (ListOf ('Mut s) Bool) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Bool)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Bool)
U.allocList1 Message ('Mut s)
msgOut (ListOf mutIn Bool -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn Bool
l) m (ListOf ('Mut s) Bool)
-> (ListOf ('Mut s) Bool -> m (ListOf ('Mut s) Bool))
-> m (ListOf ('Mut s) Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn Bool
-> ListOf ('Mut s) Bool -> m (ListOf ('Mut s) Bool)
forall (m :: * -> *) s (mutIn :: Mutability) a.
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn Bool
l)
        U.List8 ListOf mutIn Word8
l -> ListOf ('Mut s) Word8 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word8 -> List mut
U.List8 (ListOf ('Mut s) Word8 -> List ('Mut s))
-> m (ListOf ('Mut s) Word8) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
U.allocList8 Message ('Mut s)
msgOut (ListOf mutIn Word8 -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn Word8
l) m (ListOf ('Mut s) Word8)
-> (ListOf ('Mut s) Word8 -> m (ListOf ('Mut s) Word8))
-> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn Word8
-> ListOf ('Mut s) Word8 -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s (mutIn :: Mutability) a.
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn Word8
l)
        U.List16 ListOf mutIn Word16
l -> ListOf ('Mut s) Word16 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word16 -> List mut
U.List16 (ListOf ('Mut s) Word16 -> List ('Mut s))
-> m (ListOf ('Mut s) Word16) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word16)
U.allocList16 Message ('Mut s)
msgOut (ListOf mutIn Word16 -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn Word16
l) m (ListOf ('Mut s) Word16)
-> (ListOf ('Mut s) Word16 -> m (ListOf ('Mut s) Word16))
-> m (ListOf ('Mut s) Word16)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn Word16
-> ListOf ('Mut s) Word16 -> m (ListOf ('Mut s) Word16)
forall (m :: * -> *) s (mutIn :: Mutability) a.
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn Word16
l)
        U.List32 ListOf mutIn Word32
l -> ListOf ('Mut s) Word32 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word32 -> List mut
U.List32 (ListOf ('Mut s) Word32 -> List ('Mut s))
-> m (ListOf ('Mut s) Word32) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word32)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word32)
U.allocList32 Message ('Mut s)
msgOut (ListOf mutIn Word32 -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn Word32
l) m (ListOf ('Mut s) Word32)
-> (ListOf ('Mut s) Word32 -> m (ListOf ('Mut s) Word32))
-> m (ListOf ('Mut s) Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn Word32
-> ListOf ('Mut s) Word32 -> m (ListOf ('Mut s) Word32)
forall (m :: * -> *) s (mutIn :: Mutability) a.
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn Word32
l)
        U.List64 ListOf mutIn Word64
l -> ListOf ('Mut s) Word64 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word64 -> List mut
U.List64 (ListOf ('Mut s) Word64 -> List ('Mut s))
-> m (ListOf ('Mut s) Word64) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word64)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word64)
U.allocList64 Message ('Mut s)
msgOut (ListOf mutIn Word64 -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn Word64
l) m (ListOf ('Mut s) Word64)
-> (ListOf ('Mut s) Word64 -> m (ListOf ('Mut s) Word64))
-> m (ListOf ('Mut s) Word64)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn Word64
-> ListOf ('Mut s) Word64 -> m (ListOf ('Mut s) Word64)
forall (m :: * -> *) s (mutIn :: Mutability) a.
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn Word64
l)
        U.ListPtr ListOf mutIn (Maybe (Ptr mutIn))
l -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s)
forall (mut :: Mutability).
ListOf mut (Maybe (Ptr mut)) -> List mut
U.ListPtr (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s)))) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message ('Mut s)
-> Int -> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Int -> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
U.allocListPtr Message ('Mut s)
msgOut (ListOf mutIn (Maybe (Ptr mutIn)) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (Maybe (Ptr mutIn))
l) m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
-> (ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
    -> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s)))))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf mutIn (Maybe (Ptr mutIn))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn (Maybe (Ptr mutIn))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
copyCanonicalPtrList ListOf mutIn (Maybe (Ptr mutIn))
l)
        U.ListStruct ListOf mutIn (Struct mutIn)
l -> ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s)
forall (mut :: Mutability). ListOf mut (Struct mut) -> List mut
U.ListStruct (ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s))
-> m (ListOf ('Mut s) (Struct ('Mut s))) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf mutIn (Struct mutIn)
-> Message ('Mut s) -> m (ListOf ('Mut s) (Struct ('Mut s)))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn (Struct mutIn)
-> Message ('Mut s) -> m (ListOf ('Mut s) (Struct ('Mut s)))
cloneCanonicalStructList ListOf mutIn (Struct mutIn)
l Message ('Mut s)
msgOut

copyCanonicalDataList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn a -> U.ListOf ('Mut s) a -> m (U.ListOf ('Mut s) a)
{-# SPECIALIZE copyCanonicalDataList
    :: U.ListOf 'Const a
    -> U.ListOf ('Mut RealWorld) a
    -> LimitT IO (U.ListOf ('Mut RealWorld) a)
    #-}
{-# SPECIALIZE copyCanonicalDataList
    :: U.ListOf ('Mut RealWorld) a
    -> U.ListOf ('Mut RealWorld) a
    -> LimitT IO (U.ListOf ('Mut RealWorld) a)
    #-}
copyCanonicalDataList :: ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn a
listIn ListOf ('Mut s) a
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 mutIn a -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn a
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
        a
value <- Int -> ListOf mutIn a -> m a
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn a
listIn
        a -> Int -> ListOf ('Mut s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex a
value Int
i ListOf ('Mut s) a
listOut
    ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) a
listOut

copyCanonicalPtrList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn (Maybe (U.Ptr mutIn))
    -> U.ListOf ('Mut s) (Maybe (U.Ptr ('Mut s)))
    -> m (U.ListOf ('Mut s) (Maybe (U.Ptr ('Mut s))))
{-# SPECIALIZE copyCanonicalPtrList
    :: U.ListOf 'Const (Maybe (U.Ptr 'Const))
    -> U.ListOf ('Mut RealWorld) (Maybe (U.Ptr ('Mut RealWorld)))
    -> LimitT IO (U.ListOf ('Mut RealWorld) (Maybe (U.Ptr ('Mut RealWorld))))
    #-}
{-# SPECIALIZE copyCanonicalPtrList
    :: U.ListOf ('Mut RealWorld) (Maybe (U.Ptr ('Mut RealWorld)))
    -> U.ListOf ('Mut RealWorld) (Maybe (U.Ptr ('Mut RealWorld)))
    -> LimitT IO (U.ListOf ('Mut RealWorld) (Maybe (U.Ptr ('Mut RealWorld))))
    #-}
copyCanonicalPtrList :: ListOf mutIn (Maybe (Ptr mutIn))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
copyCanonicalPtrList ListOf mutIn (Maybe (Ptr mutIn))
listIn ListOf ('Mut s) (Maybe (Ptr ('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 mutIn (Maybe (Ptr mutIn)) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (Maybe (Ptr 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 mutIn (Maybe (Ptr mutIn)) -> m (Maybe (Ptr mutIn))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn (Maybe (Ptr 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 (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut)
        Maybe (Ptr ('Mut s))
-> Int -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex Maybe (Ptr ('Mut s))
ptrOut Int
i ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut
    ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut

cloneCanonicalStructList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn (U.Struct mutIn)
    -> M.Message ('Mut s)
    -> m (U.ListOf ('Mut s) (U.Struct ('Mut s)))
{-# SPECIALIZE cloneCanonicalStructList
    :: U.ListOf 'Const (U.Struct 'Const)
    -> M.Message ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld)))
    #-}
{-# SPECIALIZE cloneCanonicalStructList
    :: U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld))
    -> M.Message ('Mut RealWorld)
    -> LimitT IO (U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld)))
    #-}
cloneCanonicalStructList :: ListOf mutIn (Struct mutIn)
-> Message ('Mut s) -> m (ListOf ('Mut s) (Struct ('Mut s)))
cloneCanonicalStructList ListOf mutIn (Struct mutIn)
listIn Message ('Mut s)
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- ListOf mutIn (Struct mutIn) -> m (Word16, Word16)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
ListOf mut (Struct mut) -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf mutIn (Struct mutIn)
listIn
    ListOf ('Mut s) (Struct ('Mut s))
listOut <- Message ('Mut s)
-> Word16 -> Word16 -> Int -> m (ListOf ('Mut s) (Struct ('Mut s)))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s)
-> Word16 -> Word16 -> Int -> m (ListOf ('Mut s) (Struct ('Mut s)))
U.allocCompositeList Message ('Mut s)
msgOut Word16
nWords Word16
nPtrs (ListOf mutIn (Struct mutIn) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (Struct mutIn)
listIn)
    ListOf mutIn (Struct mutIn)
-> ListOf ('Mut s) (Struct ('Mut s)) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
ListOf mutIn (Struct mutIn)
-> ListOf ('Mut s) (Struct ('Mut s)) -> m ()
copyCanonicalStructList ListOf mutIn (Struct mutIn)
listIn ListOf ('Mut s) (Struct ('Mut s))
listOut
    ListOf ('Mut s) (Struct ('Mut s))
-> m (ListOf ('Mut s) (Struct ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) (Struct ('Mut s))
listOut

copyCanonicalStructList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn (U.Struct mutIn)
    -> U.ListOf ('Mut s) (U.Struct ('Mut s))
    -> m ()
{-# SPECIALIZE copyCanonicalStructList
    :: U.ListOf 'Const (U.Struct 'Const)
    -> U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld))
    -> LimitT IO ()
    #-}
{-# SPECIALIZE copyCanonicalStructList
    :: U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld))
    -> U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld))
    -> LimitT IO ()
    #-}
copyCanonicalStructList :: ListOf mutIn (Struct mutIn)
-> ListOf ('Mut s) (Struct ('Mut s)) -> m ()
copyCanonicalStructList ListOf mutIn (Struct mutIn)
listIn ListOf ('Mut s) (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 mutIn (Struct mutIn) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (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 mutIn (Struct mutIn) -> m (Struct mutIn)
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn (Struct mutIn)
listIn
        Struct ('Mut s)
structOut <- Int -> ListOf ('Mut s) (Struct ('Mut s)) -> m (Struct ('Mut s))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf ('Mut s) (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 mut (U.Struct mut) -> m (Word16, Word16)
{-# SPECIALIZE findCanonicalListSectionCounts
    :: U.ListOf 'Const (U.Struct 'Const) -> LimitT IO (Word16, Word16)
    #-}
{-# SPECIALIZE findCanonicalListSectionCounts
    :: U.ListOf ('Mut RealWorld) (U.Struct ('Mut RealWorld)) -> LimitT IO (Word16, Word16)
    #-}
findCanonicalListSectionCounts :: ListOf mut (Struct mut) -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf mut (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 mut (Struct mut) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mut (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 mut (Struct mut) -> m (Struct mut)
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mut (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)
-}