用Haskell证明一个相当简单的定理

我正在尝试用Haskell中的依赖类型编程进行一些实验，但没有成功。我的想法是在有限映射上表示某种弱化性质。整个代码如下：

{-# LANGUAGE PolyKinds                #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE RankNTypes               #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE UndecidableInstances     #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ScopedTypeVariables      #-}

module Exp where

import Data.Proxy
import Data.Type.Equality
import GHC.TypeLits

 data Exp (env :: [(Symbol,*)]) (a :: *) where
   Val :: Int -> Exp env Int
   Var :: (KnownSymbol s, Lookup s env ~ 'Just a) => Proxy s -> Exp env a

 data HList (xs :: [(Symbol,*)]) where
    Nil :: HList '[]
    (:*) :: KnownSymbol s => (Proxy s, Exp ('(s,a) ': xs) a) -> HList xs -> HList ('(s,a) ': xs)

 infixr 5 :*

 type family If (b :: Bool) (l :: k) (r :: k) :: k where
    If 'True  l r = l
    If 'False l r = r

 type family Lookup (s :: Symbol) (env :: [(Symbol,*)]) :: Maybe * where
    Lookup s '[]             = 'Nothing
    Lookup s ('(t,a) ': env) = If (s == t) ('Just a) (Lookup s env)

 look :: (Lookup s xs ~ 'Just a, KnownSymbol s) => Proxy s -> HList xs -> Exp xs a
 look s ((s',p) :* rho) = case sameSymbol s s' of
                            Just Refl -> p
                            Nothing   -> look s rho

GHC抱怨调用

look s rho

没有类型

Exp xs a

，因为递归调用是在有限的

rho

环境中进行的，其条目比原始的要少。我认为解决办法是将expxsa削弱为Exp（‘（s，b）’：xs）a。下面是我试图削弱表达的方式：

weak :: (Lookup s xs ~ 'Just a
        , KnownSymbol s
        , KnownSymbol s'
        , (s == s') ~ 'False) => Exp xs a -> Exp ('(s', b) ': xs) a
weak (Val n) = Val n
weak (Var s) = Var (Proxy :: Lookup s ('(s', b) ': xs) ~ 'Just a => Proxy s)

GHC以类型歧义错误进行响应：

Could not deduce: Lookup s0 xs ~ 'Just a
  from the context: (Lookup s xs ~ 'Just a,
                     KnownSymbol s,
                     KnownSymbol s',
                     (s == s') ~ 'False)
    bound by the type signature for:
               weak :: (Lookup s xs ~ 'Just a, KnownSymbol s, KnownSymbol s',
                        (s == s') ~ 'False) =>
                       Exp xs a -> Exp ('(s', b) : xs) a

---

我知道，如果我们使用类型化的De Bruijn索引来表示变量，这种弱化可以很容易地实现。我的问题是：是否可以为名称而不是索引实现它？如果是这样，怎么做？

评论中解释了一个问题。要解决这个问题，您只需要输入更多的

sameSymbol

：

sameOrNotSymbol :: (KnownSymbol a, KnownSymbol b)
                => Proxy a -> Proxy b -> Either ((a == b) :~: 'False) (a :~: b)
sameOrNotSymbol s s' = maybe (Left $ unsafeCoerce Refl) Right $ sameSymbol s s'

然后可以将

look

定义为（假设

弱

被证明）：

您得到的歧义错误是由于约束中提到了

s

，但没有在任何地方确定。这很容易修复-只需提供一个

代理s

：

weak :: forall s s' xs a b. (KnownSymbol s
        , KnownSymbol s'
        , (s == s') ~ 'False)
     => Proxy s -> Exp xs a -> Exp ('(s', b) ': xs) a
weak s (Val n) = Val n
weak s (Var t) = ...

但在这里，我们遇到了一个更难解决的问题。如果存储在

Exp xs a

中的符号与

s'

相同-列表前面的符号会怎样？返回<代码> var t>代码>在这种情况下是不正确的，因为“代码> var var 的含义改变了：它不再表示列表中间某个地方的符号——它现在在头上。而且它的类型不正确，因为这要求

a

和

b

是同一类型。因此，此版本类型检查：

weak :: forall s s' xs a a. (KnownSymbol s
        , KnownSymbol s'
        , (s == s') ~ 'False)
     => Proxy s -> Exp xs a -> Exp ('(s', a) ': xs) a
weak s (Val n) = Val n
weak s (Var t) = case sameOrNotSymbol t (Proxy :: Proxy s') of
  Left  Refl -> Var t
  Right Refl -> Var (Proxy :: Proxy s')

但你想要的却不是。“但是我们知道存储的符号不能是

s'

，因为这种情况通过定义

look

的方式得到了明确的驳斥”——您可能会说。祝你好运，证明这一点

---

真的，只需要使用德布鲁恩索引。

我没有时间写完整的答案，所以：在

look

中，你有

查找s（'（s'，b）：xs）~只有a

。在

Nothing

分支中，当您递归地

Lookup

时，GHC不知道如何构建

Lookup s xs~只是一个
。你可以证明被排除在外的中间的定律，因为不透明的
Symbol
s没有单身伴侣，这里
nota=a->Void
。然后在
右分支中
你可以使用所说的证据，在构建较小的上下文时，消除不可能的情况。相反，尝试使用类系统对上述类型索引进行自动校对搜索
class EL x xs，其中EL:：EL x xs
和一对实例，它们试图将
x
与列表的头部匹配。您可能需要使用实现
LookupIndex
而不是
Lookup
——本质上是将您的名称转换为deBruijn索引——这可能会起作用，而且应该非常简单，并且仍然可以让您公开一个以名称为单位的公共接口。谢谢@user3237465！使用您的代码，我成功地获得了令人满意的解决方案@罗德里戈·里贝罗，你能给我看一下或者简单描述一下吗？对不起。。。我认为我所做的更改是正确的，但经过一点测试，我发现了一个缺失的bug。我在这方面还有些麻烦。无论如何，谢谢你的部分解决方案。
weak :: forall s s' xs a a. (KnownSymbol s
        , KnownSymbol s'
        , (s == s') ~ 'False)
     => Proxy s -> Exp xs a -> Exp ('(s', a) ': xs) a
weak s (Val n) = Val n
weak s (Var t) = case sameOrNotSymbol t (Proxy :: Proxy s') of
  Left  Refl -> Var t
  Right Refl -> Var (Proxy :: Proxy s')