确保两个 (G)ADT 在 (GHC) Haskell 中具有相同的底层表示

Nat*_*ell 9 haskell ghc

在 Haskell 中,有时为了性能人们会使用unsafeCoerce(或更安全的coerce)在具有相同内部表示的类型之间进行转换。我所知道的最常见的例子是新类型列表:

newtype Identity a = Identity a

f :: [Identity a] -> [a]
f = coerce
Run Code Online (Sandbox Code Playgroud)

现在,我在我正在处理的代码库中有两个 GADT,看起来像这样精简:

data Typ where
    PredT :: Typ
    ProcT :: [Typ] -> Typ
    IntT :: Typ
    ListT :: Typ -> Typ


data HKTyp v (f :: * -> * -> *) where
    HKPredT :: HKTyp v f
    HKProcT :: [HKTyp v f] -> HKTyp v f
    HKIntT :: HKTyp v f
    HKListT :: f v (HKTyp v f) -> HKTyp v f  
Run Code Online (Sandbox Code Playgroud)

我需要这些类型不同(而不是使用后者作为前者的泛化),因为单例库(或至少模板 haskell 函数)不喜欢高级数据。现在,因为我必须将这些类型分开,我希望它们之间有一些转换函数:

newtype Id v a = Id a

promoteHK :: Typ -> HKTyp v Id
promoteHK PredT = HKPredT
promoteHK (ProcT ts) = HKProcT (fmap promoteHK ts)
promoteHK IntT = HKIntT
promoteHK (ListT x) = HKListT (Id $ promoteHK x)

demoteHK :: HKTyp v Id -> Typ
demoteHK HKPredT = PredT
demoteHK (HKProcT (Id ts)) = ProcT (fmap demoteHK ts)
demoteHK HKIntT = IntT
demoteHK (HKListT (Id x)) = HKListT x
Run Code Online (Sandbox Code Playgroud)

这些写起来很机械,但这不是问题。

虽然我在很多情况下敢肯定,GHC会内联和β-减少的应用demoteHKpromoteHK在编译时间,因此不会造成任何运行时的成本做这些转换,我真的希望能够写

f :: [Typ] -> [HKTyp v Id]
f = coerce
Run Code Online (Sandbox Code Playgroud)

避免遍历数据结构,因为这些类型非常相似,因此(我假设)应该在内存中具有相同的底层表示。

我的问题有两个方面。

  1. 这些类型实际上在 GHC 中具有相同的内存表示吗?
  2. GHC 是否对 (G)ADTs 在内存中的布局方式有强有力的保证,让您通常可以做这样的事情?

DDu*_*Dub 2

我还没有测试以下的性能,它可能足够复杂,以至于 GHC 事实上无法优化它,但它会让我们构建一个更好的工具。这个想法是使用Generics.

该计划是定义一个类型类,该类型类强制具有相同Generic结构的两种类型以及使用该类的函数。考虑以下:

{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics

class GenericCoerce a b where
  genericCoerce' :: a x -> b x

genericCoerce :: (Generic x, Generic y, GenericCoerce (Rep x) (Rep y)) => x -> y
genericCoerce = to . genericCoerce' . from
Run Code Online (Sandbox Code Playgroud)

当然,我们仍然需要定义什么使 2 Reps 可强制,但就像你的promoteHKanddemoteHK定义一样,这有点机械:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}

instance GenericCoerce V1 V1 where
  genericCoerce' = \case

instance GenericCoerce U1 U1 where
  genericCoerce' = id

instance (GenericCoerce f f', GenericCoerce g g') => GenericCoerce (f :+: g) (f' :+: g') where
  genericCoerce' (L1 x) = L1 (genericCoerce' x)
  genericCoerce' (R1 x) = R1 (genericCoerce' x)

instance (GenericCoerce f f', GenericCoerce g g') => GenericCoerce (f :*: g) (f' :*: g') where
  genericCoerce' (x :*: y) = genericCoerce' x :*: genericCoerce' y

instance GenericCoerce cs1 cs2 => GenericCoerce (M1 t m cs1) (M1 t m' cs2) where
  genericCoerce' (M1 x) = M1 (genericCoerce' x)

instance (Generic x, Generic y, GenericCoerce (Rep x) (Rep y)) => GenericCoerce (K1 t x) (K1 t y) where
  genericCoerce' (K1 x) = K1 (genericCoerce x)
Run Code Online (Sandbox Code Playgroud)

这实际上适用于非常基本的情况!考虑这样的数据类型:

data Foo = Bar | Baz
  deriving (Generic, Show)
Run Code Online (Sandbox Code Playgroud)

我们得到了我们想要的行为:

> genericCoerce @Bool @Foo True
Baz

> genericCoerce @Foo @Bool Bar
False
Run Code Online (Sandbox Code Playgroud)

然而,这种强制转换方式的问题在于,它与强制数据类型的正常Generic方式不能很好地配合。具体来说,给定类型的类型代表和包装在 newtype 包装器中的该类型的类型代表不同

一种可能的解决方案是使用(喘息)不连贯的实例。这对您来说可能太远了,但如果您同意,请考虑以下两个附加实例:

-- instances to handle newtype constructor
instance {-# INCOHERENT #-} (Generic x, Rep x ~ D1 m x', GenericCoerce x' y) => GenericCoerce (C1 m2 (S1 m3 (Rec0 x))) y where
  genericCoerce' = genericCoerce' . unM1 . from . unK1 . unM1 . unM1

instance {-# INCOHERENT #-} (Generic y, Rep y ~ D1 m y', GenericCoerce x y') => GenericCoerce x (C1 m2 (S1 m3 (Rec0 y))) where
  genericCoerce' = M1 . M1 . K1 . to . M1 . genericCoerce'
Run Code Online (Sandbox Code Playgroud)

这两个实例专门针对其中一种类型具有新类型包装器的情况。不连贯的实例被认为是危险的,如果你的强制转换中有很多嵌套类型/新类型,也许会出现问题。也就是说,在使用这两个实例的情况下,您可以很好地使用您给出的示例:

promoteHK :: Typ -> HKTyp v Id
promoteHK = genericCoerce

demoteHK :: HKTyp v Id -> Typ
demoteHK = genericCoerce
Run Code Online (Sandbox Code Playgroud)

行动中:

> promoteHK PredT
HKPredT

> promoteHK (ListT PredT)
HKListT (Id HKPredT)

> promoteHK (ListT (ListT (ListT PredT)))
HKListT (Id (HKListT (Id (HKListT (Id HKPredT)))))

> demoteHK (HKProcT [HKIntT, HKPredT])
ProcT [IntT,PredT]
Run Code Online (Sandbox Code Playgroud)

到目前为止,我还没有完全回答你的问题。您询问两个看似同构的类型是否真的在 GHC 中具有相同的内存表示形式,以及 GHC 中是否有任何保证可以让您一般做这样的事情(我假设“这样的事情”,您的意思是同构数据类型之间的强制转换) )。

据我所知,GHC 没有做出任何保证,但genericCoerce给了我们一个稍微更坚实的基础。排除不连贯的实例 hack,原始版本将genericCoerce具有幻像类型参数的数据类型转换为仅具有不同幻像参数的相同数据类型。从技术上讲,我无法保证 GHC 将以相同的方式存储相同运行时数据的多个实例,但在我看来,这是一个非常容易做出的假设。

一旦我们添加了不连贯的实例和新型包装器恶作剧,我们的基础就不那么坚实了,但它一切正常的事实是一些安慰。

genericCoerce事实上,现在我们看到确实的核心强制转换(我们正在从每种情况下刚刚被破坏的数据构建相同的数据类型),并且如果我们相信 newtype-wrapper 不连贯的实例也可以充当强制转换,那么我们可以写:

genericCoerceProbablySafe :: (Generic x, Generic y, GenericCoerce (Rep x) (Rep y)) => x -> y
genericCoerceProbablySafe = unsafeCoerce
Run Code Online (Sandbox Code Playgroud)

我们获得了比 更好的性能genericCoerce和更多的类型安全性unsafeCoerce,并且我们将您的问题简化为:“ Generic RepGHC 存储内存的方式是否准确(直到新类型包装器)?”