Question

我正在Haskell的一个依赖类型程序的例子中工作，我想“重写”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中找到。

我对如何表达此类引理或无法表达的任何提示或解释表示高度赞赏。

Answer 1

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

在我们的案例中（假设我们的目标是从您的要点写出hasEmpty），我们在Sing构造函数中只需要一个Cat，因为我们需要一个模式匹配证明以下功能：

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确定空列表的子列表也是空的，因此我们可以在Cat案例中使用它们hasEmpty。无论如何，下面是整个代码。

我使用Star稍微不同但等效的定义，重用Choice和Eps来构建列表结构。

{-# 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

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

1 个答案: