haskell - HList 与 DataKinds，种类不可提升

Question

我有这个代码片段，它使用了大量的 GHC 扩展:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

import GHC.Exts (Constraint)

data HList :: [*] -> * where
    Nil  :: HList '[]
    Cons :: a -> HList l -> HList (a ': l)

type family All (p :: * -> Constraint) (xs :: HList [*]) :: Constraint where
    All p Nil = ()
    All p (Cons x xs) = (p x, All p xs)

GHC 提示说:

 ‘HList’ of kind ‘[*] -> *’ is not promotable
    In the kind ‘HList [*]’

为什么我无法将 HList 提升为某种类型？我使用 GHC 7.8.2 和 7.11 遇到同样的错误。

当然，使用内置的 '[] 效果很好:

type family All (p :: * -> Constraint) (xs :: [*]) :: Constraint where
    All p '[]       = ()
    All p (x ': xs) = (p x, All p xs)

我想使用自己的 HList 而不是 '[]，因为实际的 HList 支持附加，如下所示:

type family (:++:) (xs :: [*]) (ys :: [*]) where
    '[] :++:  ys = ys
     xs :++: '[] = xs
    (x ': xs) :++: ys = x ': (xs :++: ys)

data HList :: [*] -> * where
    Nil  :: HList '[]
    Cons :: a -> HList l -> HList (a ': l)
    App  :: Hlist a -> HList b -> HList (a :++: b)

编辑:主要目标是让 GHC 推断

(All p xs, All p ys) ==> All p (xs :++: ys)

这样我就可以写了

data Dict :: Constraint -> * where
    Dict :: c => Dict c

witness :: Dict (All p xs) -> Dict (All p ys) -> Dict (All p (xs :++: ys))
witness Dict Dict = Dict

我曾希望添加用于附加类型级列表的显式表示能够帮助我实现这一目标。还有其他方法可以让 GHC 相信上述内容吗？

Answer 1

我现在明白了，问题是如何编写 (All p xs, All p ys) => All p (xs :++: ys) 的证明。答案当然是通过归纳法!

我们真正想要编写的函数的类型是

allAppend :: (p :: Constraint) -> (xs :: [*]) -> (ys :: [*]) 
          -> (All p xs, All p ys) -> All p (xs :++: ys)

但 Haskell 没有依赖类型。 “伪造”依赖类型通常意味着有一个证人携带某种类型存在的证据。这让事情有些繁琐，但目前也没有其他办法。我们已经有了一个列表 xs 的见证人 - 它正是 HList xs。对于约束，我们将使用

data Dict p where Dict :: p => Dict p

然后我们可以将蕴涵写成一个简单的函数:

type (==>) a b = Dict a -> Dict b 

所以我们的类型变成:

allAppend :: Proxy p -> HList xs -> HList ys 
          -> (All p xs, All p ys) ==> (All p (xs :++: ys))

函数的主体非常简单 - 请注意 allAppend 中的每个模式如何与 :++::

定义中的每个模式相匹配

allAppend _ Nil _  Dict = Dict  
allAppend _ _  Nil Dict = Dict 
allAppend p (Cons _ xs) ys@(Cons _ _) Dict = 
  case allAppend p xs ys Dict of Dict -> Dict 

相反的蕴涵All p (xs :++: ys) => (All p xs, All p ys) 也成立。事实上，函数定义是相同的。