Haskell 中依赖类型编程的更多问题

More problems with dependently typed programming in Haskell

我正在研究 Haskell 中依赖类型程序的示例,我想 "rewrite" singletons 中定义的命题相等类型 a :~: b 的证据图书馆。

更具体地说,我有一个数据类型来表示正则表达式成员资格的证据。我的麻烦是如何处理两个正则表达式连接的证据。在我的代码中,我有一个名为 InRegExp xs e 的 GADT,它表达了 xs 是正则表达式语言 e 的事实。对于串联,我有以下构造函数:

    InCat :: InRegExp xs l -> InRegExp ys r   ->
         (zs :~: xs ++ ys) -> InRegExp zs (Cat l r)

到目前为止,还不错。现在我想为连接两个正则表达式的成员资格定义一个反转引理:

inCatInv :: InRegExp (xs ++ ys) (Cat e e') -> (InRegExp xs e , InRegExp ys e')
inCatInv (InCat p p' Refl) = (p , p')

但代码被 GHC 拒绝并显示以下错误消息:

Could not deduce (xs1 ~ xs)
   from the context ('Cat e e' ~ 'Cat l r)
      bound by a pattern with constructor
             InCat :: forall (zs :: [Nat])
                             (xs :: [Nat])
                             (l :: RegExp [Nat])
                             (ys :: [Nat])
                             (r :: RegExp [Nat]).
                      InRegExp xs l
                      -> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
           in an equation for ‘inCatInv’
  at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11-25
or from ((xs ++ ys) ~ (xs1 ++ ys1))
  bound by a pattern with constructor
             Refl :: forall (k :: BOX) (b :: k). b :~: b,
           in an equation for ‘inCatInv’
  at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:22-25
  ‘xs1’ is a rigid type variable bound by
        a pattern with constructor
          InCat :: forall (zs :: [Nat])
                          (xs :: [Nat])
                          (l :: RegExp [Nat])
                          (ys :: [Nat])
                          (r :: RegExp [Nat]).
                   InRegExp xs l
                   -> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
        in an equation for ‘inCatInv’
        at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11
  ‘xs’ is a rigid type variable bound by
       the type signature for
         inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
                     -> (InRegExp xs e, InRegExp ys e')
       at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:43:13
Expected type: InRegExp xs e
  Actual type: InRegExp xs1 l
Relevant bindings include
  p :: InRegExp xs1 l
    (bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:17)
  inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
              -> (InRegExp xs e, InRegExp ys e')
    (bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:1)
In the expression: p
In the expression: (p, p')

在 Agda 或 Idris 中,这种反演引理工作得很好。可以用 Haskell 表达这样的反演引理吗?完整代码见下面gist.

非常感谢任何关于如何表达这种引理或为什么无法表达的提示或解释。

在Haskell中编写依赖类型程序最简单的方法是先在Agda中编写,然后将(x : A) -> B替换为Sing x -> b。但是,当我们确定不需要使用值进行计算时,我们可以使用 Proxy 而不是 Sing

在我们的例子中(假设我们的目标是根据你的要点编写 hasEmpty),我们只需要在 Cat 构造函数中使用一个 Sing,因为我们需要一个模式匹配以下函数的证明:

appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil         ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {} 

appendEmpty 确定空列表的子列表也为空,因此我们可以在 hasEmptyCat 情况下使用它们。不管怎样,下面是完整的代码。

我对 Star 使用了一个略有不同但等效的定义,它重用了 ChoiceEps 来构建列表结构。

{-# language
  TemplateHaskell, UndecidableInstances, LambdaCase, EmptyCase,
  DataKinds, PolyKinds, GADTs, TypeFamilies, ScopedTypeVariables,
  TypeOperators #-}

import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Proxy

$(singletons [d|
  data Regex c
    = Sym c
    | Cat (Regex c) (Regex c)
    | Choice (Regex c) (Regex c)
    | Star (Regex c)
    | Eps
    deriving (Show)
 |])

appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil         ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {} 

data InRegex :: [c] -> Regex c -> * where
  InEps   :: InRegex '[] Eps
  InSym   :: InRegex '[c] (Sym c)
  InCat   :: Sing xs -> InRegex xs l -> InRegex ys r -> InRegex (xs :++ ys) (Cat l r)
  InLeft  :: InRegex xs l -> InRegex xs (Choice l r)
  InRight :: InRegex ys r -> InRegex ys (Choice l r)
  InStar  :: InRegex xs (Choice Eps (Cat r (Star r))) -> InRegex xs (Star r)

hasEmpty :: Sing r -> Either (InRegex '[] r) (InRegex '[] r -> Void)
hasEmpty (SSym _)   = Right (\case {})
hasEmpty (SCat l r) = case hasEmpty l of
  Left inl -> case hasEmpty r of
    Left  inr -> Left (InCat SNil inl inr)
    Right notInr -> Right
      (\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
          (Refl, Refl) -> notInr inr)
  Right notInl -> Right
    (\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
        (Refl, Refl) -> notInl inl)
hasEmpty (SChoice l r) = case hasEmpty l of
  Left inl     -> Left (InLeft inl)
  Right notInl -> case hasEmpty r of
    Left inr     -> Left (InRight inr)
    Right notInr -> Right (\case
      InLeft  inl -> notInl inl
      InRight inr -> notInr inr)
hasEmpty (SStar r) = Left (InStar (InLeft InEps))
hasEmpty SEps = Left InEps