GADT 类型推断与更高级的类型

Question

我有一些可以编译的代码：

{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs, 
             FlexibleContexts #-}

module Foo where

data Foo :: (* -> *) where
  Foo :: c m zp' -> Foo (c m zp)

f :: forall c m zp d . Foo (c m zp) -> d
f y@(Foo (x :: c m a)) = g x y

g :: c m a -> Foo (c m b) -> d
g = error ""

我在实际代码中需要做的关键是让 GHC 相信，如果 y 的类型为 Foo (c m zp) 并且 x 的类型为 c' m' zp'，那么 c' ~ c 和 m' ~ m。上面的代码实现了这一点，因为我可以调用 g.

我想以两种正交方式更改此代码，但我似乎无法弄清楚如何让 GHC 通过任何一种更改来编译代码。

第一个更改：添加 -XPolyKinds。 GHC 7.8.3 抱怨：

Foo.hs:10:11:
    Could not deduce ((~) (k2 -> k3 -> *) c1 c)
    from the context ((~) * (c m zp) (c1 m1 zp1))
      bound by a pattern with constructor
                 Foo :: forall (k :: BOX)
                               (k :: BOX)
                               (c :: k -> k -> *)
                               (m :: k)
                               (zp' :: k)
                               (zp :: k).
                        c m zp' -> Foo (c m zp),
               in an equation for ‘f’
      at Foo.hs:10:6-21
      ‘c1’ is a rigid type variable bound by
           a pattern with constructor
             Foo :: forall (k :: BOX)
                           (k :: BOX)
                           (c :: k -> k -> *)
                           (m :: k)
                           (zp' :: k)
                           (zp :: k).
                    c m zp' -> Foo (c m zp),
           in an equation for ‘f’
           at Foo.hs:10:6
      ‘c’ is a rigid type variable bound by
          the type signature for f :: Foo (c m zp) -> d
          at Foo.hs:9:13
    Expected type: c1 m1 zp'
      Actual type: c m a
    Relevant bindings include
      y :: Foo (c m zp) (bound at Foo.hs:10:3)
      f :: Foo (c m zp) -> d (bound at Foo.hs:10:1)
    In the pattern: x :: c m a
    In the pattern: Foo (x :: c m a)
    In an equation for ‘f’: f y@(Foo (x :: c m a)) = g x y

Foo.hs:10:11:
    Could not deduce ((~) k2 m1 m)
    from the context ((~) * (c m zp) (c1 m1 zp1))
    ...

第二个变化：忘掉-XPolyKinds。相反，我想使用 -XDataKinds 创建一个新种类并限制 m:

的种类

{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs, 
             FlexibleContexts, DataKinds #-}

module Foo where

data Bar

data Foo :: (* -> *) where
  Foo :: c (m :: Bar) zp' -> Foo (c m zp)

f :: forall c m zp d . Foo (c m zp) -> d
f y@(Foo (x :: c m a)) = g x y

g :: c m a -> Foo (c m b) -> d
g = error ""

我遇到了类似的错误（can't deduce (c1 ~ c)、can't deduce (m1 ~ m)）。 DataKinds 似乎与此相关：如果我将 m 限制为种类 Constraint 而不是种类 Bar，代码编译正常。

我已经给出了两个如何破解原始代码的例子，它们都使用了更高级的类型。我试过使用 case 语句而不是模式保护，我试过给 node 而不是 x 类型，我常用的技巧在这里不起作用。

我对 x 的类型在哪里结束并不挑剔 up/what 它看起来像，我只需要能够说服 GHC 如果 y 具有类型 Foo (c m zp)，那么 x 的类型是 c m zp'，对于一些不相关的类型 zp'。

Answer 1

我将原始问题大大简化为以下内容，它在没有 {-# LANGUAGE PolyKinds #-} 的情况下编译但无法通过 PolyKinds 编译。

{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs #-}
{-# LANGUAGE PolyKinds #-}

data Pair1 :: (* -> *) where
  Pair1 :: Pair1 (c a, c b)

data D p a where
    D :: p (a, b) -> D p a -> D p b

f :: forall c z. D Pair1 (c z) -> D Pair1 (c z)
f y@(D Pair1 x) |
    (_ :: D Pair1 (c z)) <- y,
    (_ :: D Pair1 (c z')) <- x = y

启用 PolyKinds 编译器错误是

Could not deduce (c1 ~ c)
from the context ((a, c z) ~ (c1 a1, c1 b))

这个错误强烈暗示了我已经怀疑的，答案取决于是否。如果多元类型应用是单射的，我们可以推导出 c1 ~ c 如下。

(a,   c z) ~ (c1 a1,   c1 b)
(a,) (c z) ~ (c1 a1,) (c1 b) {- switch to prefix notation -}
      c z  ~           c1 b  {- f a ~ g b implies a ~ b -}
      c    ~           c1    {- f a ~ g b implies f ~ g -}
      c1   ~           c     {- ~ is reflexive -}

，可是ghc不知道。为了让 ghc 推断类型应用程序是单射的，我们需要提供类型签名，以便编译器知道类型是等价的。

我没有找到足够的类型注释来说明您原来的、过度简化的问题版本。在简化处理类型的问题时，将类型简化为 Proxy 有时是过度的，因为它留下更少的地方来附加类型签名。你有个更有意义的问题。

Answer 2

添加种类签名即可解决问题。

例如，当使用-XPolyKinds时，编译以下代码：

{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs, 
             FlexibleContexts, PolyKinds #-}

module Foo where

data Foo :: (* -> *) where
  Foo :: (c :: k -> * -> *) m zp' -> Foo (c m zp)

f :: forall (c :: k -> * -> *) m zp d . Foo (c m zp) -> d
f y@(Foo x) = g x y

g :: c m a -> Foo (c m b) -> d
g = error ""

对于-XDataKinds版本，我还需要在g上签名：

{-# LANGUAGE ScopedTypeVariables, KindSignatures, GADTs, 
             FlexibleContexts, DataKinds #-}

module Foo where

data Bar

data Foo :: (* -> *) where
  Foo :: (c :: Bar -> * -> *) m zp' -> Foo (c m zp)

f :: forall (c :: Bar -> * -> *) m zp d . Foo (c m zp) -> d
f y@(Foo x) = g x y

g :: forall (c :: Bar -> * -> *) m a b d . c m a -> Foo (c m b) -> d
g = error ""

不知道为什么 DataKinds 我需要更多的签名，而且必须到处复制它们有点烦人，但它确实完成了工作。

GADT 类型推断与更高级的类型

GADT Type Inference with Higher-Kinded Types

haskell

ghc