{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Module: Capnp.Repr
-- Description: Type-level plumbing for wire-representations.
--
-- This module provides facilities for working with the wire
-- representations of capnproto objects at the type level. The most
-- central part of this module is the 'Repr' type.
--
-- Recommended reading: https://capnproto.org/encoding.html
module Capnp.Repr
  ( -- * Type-level descriptions of wire representations.
    Repr (..),
    PtrRepr (..),
    ListRepr (..),
    NormalListRepr (..),
    DataSz (..),

    -- * Mapping representations to value types from "Capnp.Untyped"
    Untyped,
    UntypedData,
    UntypedPtr,
    UntypedSomePtr,
    UntypedList,
    UntypedSomeList,

    -- * Mapping types to their wire representations.
    ReprFor,
    PtrReprFor,

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

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

    -- * Working with wire-encoded values
    Raw (..),

    -- * Working with lists
    List,
    length,
    index,
    setIndex,

    -- * Allocating values
    Allocate (..),

    -- * Shorthands for types
    IsStruct,
    IsCap,
    IsPtr,
  )
where

import qualified Capnp.Message as M
import Capnp.Mutability (MaybeMutable (..), Mutability (..))
import Capnp.TraversalLimit (evalLimitT)
import Capnp.Untyped
  ( Allocate (..),
    DataSz (..),
    ElemRepr,
    Element (..),
    IsListPtrRepr (..),
    IsPtrRepr (..),
    ListRepr (..),
    ListReprFor,
    MaybePtr (..),
    NormalListRepr (..),
    PtrRepr (..),
    Repr (..),
    Untyped,
    UntypedData,
    UntypedList,
    UntypedPtr,
    UntypedSomeList,
    UntypedSomePtr,
    Unwrapped,
  )
import qualified Capnp.Untyped as U
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Default (Default (..))
import Data.Int
import Data.Kind (Type)
import Data.Maybe (fromJust)
import Data.Traversable (for)
import Data.Word
import GHC.Generics (Generic)
import Prelude hiding (length)

-- | @'ReprFor' a@ denotes the Cap'n Proto wire represent of the type @a@.
type family ReprFor (a :: Type) :: Repr

type instance ReprFor () = 'Data 'Sz0

type instance ReprFor Bool = 'Data 'Sz1

type instance ReprFor Word8 = 'Data 'Sz8

type instance ReprFor Word16 = 'Data 'Sz16

type instance ReprFor Word32 = 'Data 'Sz32

type instance ReprFor Word64 = 'Data 'Sz64

type instance ReprFor Int8 = 'Data 'Sz8

type instance ReprFor Int16 = 'Data 'Sz16

type instance ReprFor Int32 = 'Data 'Sz32

type instance ReprFor Int64 = 'Data 'Sz64

type instance ReprFor Float = 'Data 'Sz32

type instance ReprFor Double = 'Data 'Sz64

type instance ReprFor (U.Struct mut) = 'Ptr ('Just 'Struct)

type instance ReprFor (U.Cap mut) = 'Ptr ('Just 'Cap)

type instance ReprFor (U.Ptr mut) = 'Ptr 'Nothing

type instance ReprFor (U.List mut) = 'Ptr ('Just ('List 'Nothing))

type instance ReprFor (U.ListOf r mut) = 'Ptr ('Just ('List ('Just (ListReprFor r))))

type instance ReprFor (List a) = 'Ptr ('Just ('List ('Just (ListReprFor (ReprFor a)))))

-- | @PtrReprFor r@ extracts the pointer represnetation in r; undefined if
-- r is not a pointer representation.
type family PtrReprFor (r :: Repr) :: Maybe PtrRepr where
  PtrReprFor ('Ptr pr) = pr

-- | A @'Raw' mut a@ is an @a@ embedded in a capnproto message with mutability
-- @mut@.
newtype Raw (a :: Type) (mut :: Mutability) = Raw {forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
fromRaw :: U.Unwrapped (Untyped (ReprFor a) mut)}

deriving instance Show (U.Unwrapped (Untyped (ReprFor a) mut)) => Show (Raw a mut)

deriving instance Read (U.Unwrapped (Untyped (ReprFor a) mut)) => Read (Raw a mut)

deriving instance Eq (U.Unwrapped (Untyped (ReprFor a) mut)) => Eq (Raw a mut)

deriving instance Generic (U.Unwrapped (Untyped (ReprFor a) mut)) => Generic (Raw a mut)

-- | A phantom type denoting capnproto lists of type @a@.
data List a

type ListElem a =
  ( U.Element (ReprFor a),
    U.ListItem (ElemRepr (ListReprFor (ReprFor a)))
  )

-- | Get the length of a capnproto list.
length :: ListElem a => Raw (List a) mut -> Int
{-# INLINE length #-}
length :: forall a (mut :: Mutability). ListElem a => Raw (List a) mut -> Int
length (Raw Unwrapped (Untyped (ReprFor (List a)) mut)
l) = forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor (List a)) mut)
l

-- | @'index' i list@ gets the @i@th element of the list.
index ::
  forall a m mut.
  ( U.ReadCtx m mut,
    U.HasMessage (U.ListOf (ElemRepr (ListReprFor (ReprFor a)))),
    ListElem a
  ) =>
  Int ->
  Raw (List a) mut ->
  m (Raw a mut)
{-# INLINE index #-}
index :: forall a (m :: * -> *) (mut :: Mutability).
(ReadCtx m mut,
 HasMessage (ListOf (ElemRepr (ListReprFor (ReprFor a)))),
 ListElem a) =>
Int -> Raw (List a) mut -> m (Raw a mut)
index Int
i (Raw Unwrapped (Untyped (ReprFor (List a)) mut)
l) =
  forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut)
elt <- forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i Unwrapped (Untyped (ReprFor (List a)) mut)
l
    forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(Element r, ReadCtx m mut) =>
Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
-> m (Unwrapped (Untyped r mut))
fromElement
      @(ReprFor a)
      @m
      @mut
      (forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(U.ListOf (ElemRepr (ListReprFor (ReprFor a)))) Unwrapped (Untyped (ReprFor (List a)) mut)
l)
      Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut)
elt

-- | @'setIndex' value i list@ sets the @i@th element of @list@ to @value@.
setIndex ::
  forall a m s.
  ( U.RWCtx m s,
    U.ListItem (ElemRepr (ListReprFor (ReprFor a))),
    U.Element (ReprFor a)
  ) =>
  Raw a ('Mut s) ->
  Int ->
  Raw (List a) ('Mut s) ->
  m ()
{-# INLINE setIndex #-}
setIndex :: forall a (m :: * -> *) s.
(RWCtx m s, ListItem (ElemRepr (ListReprFor (ReprFor a))),
 Element (ReprFor a)) =>
Raw a ('Mut s) -> Int -> Raw (List a) ('Mut s) -> m ()
setIndex (Raw Unwrapped (Untyped (ReprFor a) ('Mut s))
v) Int
i (Raw Unwrapped (Untyped (ReprFor (List a)) ('Mut s))
l) = forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
U.setIndex (forall (r :: Repr) (mut :: Mutability).
Element r =>
Unwrapped (Untyped r mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
toElement @(ReprFor a) @('Mut s) Unwrapped (Untyped (ReprFor a) ('Mut s))
v) Int
i Unwrapped (Untyped (ReprFor (List a)) ('Mut s))
l

instance U.HasMessage (Untyped (ReprFor a)) => U.HasMessage (Raw a) where
  message :: forall (mut :: Mutability). Unwrapped (Raw a mut) -> Message mut
message (Raw Unwrapped (Untyped (ReprFor a) mut)
r) = forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(Untyped (ReprFor a)) Unwrapped (Untyped (ReprFor a) mut)
r

instance U.MessageDefault (Untyped (ReprFor a)) => U.MessageDefault (Raw a) where
  messageDefault :: forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m (Unwrapped (Raw a mut))
messageDefault Message mut
msg = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
U.messageDefault @(Untyped (ReprFor a)) Message mut
msg

instance U.MessageDefault (Raw a) => Default (Raw a 'Const) where
  def :: Raw a 'Const
def = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT forall a. Bounded a => a
maxBound forall a b. (a -> b) -> a -> b
$ forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
U.messageDefault @(Raw a) Message 'Const
M.empty

instance ReprMaybeMutable (ReprFor a) => MaybeMutable (Raw a) where
  thaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Raw a 'Const -> m (Raw a ('Mut s))
thaw (Raw Unwrapped (Untyped (ReprFor a) 'Const)
v) = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: Repr) (m :: * -> *) s.
(ReprMaybeMutable r, PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped r 'Const) -> m (Unwrapped (Untyped r ('Mut s)))
rThaw @(ReprFor a) Unwrapped (Untyped (ReprFor a) 'Const)
v
  freeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Raw a ('Mut s) -> m (Raw a 'Const)
freeze (Raw Unwrapped (Untyped (ReprFor a) ('Mut s))
v) = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: Repr) (m :: * -> *) s.
(ReprMaybeMutable r, PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped r ('Mut s)) -> m (Unwrapped (Untyped r 'Const))
rFreeze @(ReprFor a) Unwrapped (Untyped (ReprFor a) ('Mut s))
v
  unsafeThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Raw a 'Const -> m (Raw a ('Mut s))
unsafeThaw (Raw Unwrapped (Untyped (ReprFor a) 'Const)
v) = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: Repr) (m :: * -> *) s.
(ReprMaybeMutable r, PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped r 'Const) -> m (Unwrapped (Untyped r ('Mut s)))
rUnsafeThaw @(ReprFor a) Unwrapped (Untyped (ReprFor a) 'Const)
v
  unsafeFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Raw a ('Mut s) -> m (Raw a 'Const)
unsafeFreeze (Raw Unwrapped (Untyped (ReprFor a) ('Mut s))
v) = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: Repr) (m :: * -> *) s.
(ReprMaybeMutable r, PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped r ('Mut s)) -> m (Unwrapped (Untyped r 'Const))
rUnsafeFreeze @(ReprFor a) Unwrapped (Untyped (ReprFor a) ('Mut s))
v
  {-# INLINE thaw #-}
  {-# INLINE freeze #-}
  {-# INLINE unsafeThaw #-}
  {-# INLINE unsafeFreeze #-}

-- | Like MaybeMutable, but defined on the repr. Helper for implementing
-- MaybeMutable (Raw a)
class ReprMaybeMutable (r :: Repr) where
  rThaw :: (PrimMonad m, PrimState m ~ s) => Unwrapped (Untyped r 'Const) -> m (Unwrapped (Untyped r ('Mut s)))
  rUnsafeThaw :: (PrimMonad m, PrimState m ~ s) => Unwrapped (Untyped r 'Const) -> m (Unwrapped (Untyped r ('Mut s)))
  rFreeze :: (PrimMonad m, PrimState m ~ s) => Unwrapped (Untyped r ('Mut s)) -> m (Unwrapped (Untyped r 'Const))
  rUnsafeFreeze :: (PrimMonad m, PrimState m ~ s) => Unwrapped (Untyped r ('Mut s)) -> m (Unwrapped (Untyped r 'Const))

instance ReprMaybeMutable ('Ptr 'Nothing) where
  rThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s)))
rThaw Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
p = do
    MaybePtr Maybe (Ptr ('Mut s))
p' <- forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
thaw (forall (mut :: Mutability). Maybe (Ptr mut) -> MaybePtr mut
MaybePtr Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
p'
  rFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
-> m (Unwrapped (Untyped ('Ptr 'Nothing) 'Const))
rFreeze Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
p = do
    MaybePtr Maybe (Ptr 'Const)
p' <- forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
freeze (forall (mut :: Mutability). Maybe (Ptr mut) -> MaybePtr mut
MaybePtr Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr 'Const)
p'
  rUnsafeThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
-> m (Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s)))
rUnsafeThaw Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
p = do
    MaybePtr Maybe (Ptr ('Mut s))
p' <- forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
unsafeThaw (forall (mut :: Mutability). Maybe (Ptr mut) -> MaybePtr mut
MaybePtr Unwrapped (Untyped ('Ptr 'Nothing) 'Const)
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
p'
  rUnsafeFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
-> m (Unwrapped (Untyped ('Ptr 'Nothing) 'Const))
rUnsafeFreeze Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
p = do
    MaybePtr Maybe (Ptr 'Const)
p' <- forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
unsafeFreeze (forall (mut :: Mutability). Maybe (Ptr mut) -> MaybePtr mut
MaybePtr Unwrapped (Untyped ('Ptr 'Nothing) ('Mut s))
p)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr 'Const)
p'

do
  let types =
        [ [t|'Just 'Struct|],
          [t|'Just 'Cap|],
          [t|'Just ('List 'Nothing)|],
          [t|'Just ('List ('Just 'ListComposite))|],
          [t|'Just ('List ('Just ('ListNormal 'NormalListPtr)))|]
        ]
  concat
    <$> for
      types
      ( \t -> do
          [d|
            instance ReprMaybeMutable ('Ptr $t) where
              rThaw = thaw
              rFreeze = freeze
              rUnsafeThaw = thaw
              rUnsafeFreeze = freeze
            |]
      )

instance ReprMaybeMutable ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz)))))) where
  rThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped
  (Untyped
     ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
     'Const)
-> m (Unwrapped
        (Untyped
           ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
           ('Mut s)))
rThaw = forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
thaw
  rFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped
  (Untyped
     ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
     ('Mut s))
-> m (Unwrapped
        (Untyped
           ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
           'Const))
rFreeze = forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
freeze
  rUnsafeThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped
  (Untyped
     ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
     'Const)
-> m (Unwrapped
        (Untyped
           ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
           ('Mut s)))
rUnsafeThaw = forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f 'Const -> m (f ('Mut s))
thaw
  rUnsafeFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped
  (Untyped
     ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
     ('Mut s))
-> m (Unwrapped
        (Untyped
           ('Ptr ('Just ('List ('Just ('ListNormal ('NormalListData sz))))))
           'Const))
rUnsafeFreeze = forall (f :: Mutability -> *) (m :: * -> *) s.
(MaybeMutable f, PrimMonad m, PrimState m ~ s) =>
f ('Mut s) -> m (f 'Const)
freeze

instance ReprMaybeMutable ('Data sz) where
  rThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Data sz) 'Const)
-> m (Unwrapped (Untyped ('Data sz) ('Mut s)))
rThaw = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  rFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Data sz) ('Mut s))
-> m (Unwrapped (Untyped ('Data sz) 'Const))
rFreeze = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  rUnsafeThaw :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Data sz) 'Const)
-> m (Unwrapped (Untyped ('Data sz) ('Mut s)))
rUnsafeThaw = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  rUnsafeFreeze :: forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
Unwrapped (Untyped ('Data sz) ('Mut s))
-> m (Unwrapped (Untyped ('Data sz) 'Const))
rUnsafeFreeze = forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Constraint that @a@ is a struct type.
type IsStruct a = ReprFor a ~ 'Ptr ('Just 'Struct)

-- | Constraint that @a@ is a capability type.
type IsCap a = ReprFor a ~ 'Ptr ('Just 'Cap)

-- | Constraint that @a@ is a pointer type.
type IsPtr a =
  ( ReprFor a ~ 'Ptr (PtrReprFor (ReprFor a)),
    -- N.B. prior to ghc 9.2.x, this next constraint wasn't necessary,
    -- because it could be inferred from the first. I(zenhack) don't
    -- fully understand what changed, but some call sites need this
    -- extra help now...
    Untyped (ReprFor a) ~ UntypedPtr (PtrReprFor (ReprFor a)),
    IsPtrRepr (PtrReprFor (ReprFor a))
  )