Haskell 如何说服ghc类型级加法是可交换的（实现依赖类型的反向）？

这不会编译，因为正如ghc告诉我的，Add不是内射的。我如何告诉编译器Add是真正可交换的（也许是告诉它Add是内射的）？从哈索希主义的论文看来，人们必须以某种方式提供一个代理

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

data Nat = Z | S Nat

type family Add a b where
  Add  Z    n = n
  Add  n    Z = n
  Add (S n) k = S (Add n k)

data VecList n a where
  Nil  :: VecList Z a
  Cons :: a -> VecList n a -> VecList (S n) a

safeRev :: forall a n . VecList n a -> VecList n a
safeRev xs = safeRevAux Nil xs
  where
    safeRevAux :: VecList p a -> VecList q a -> VecList (Add p q) a
    safeRevAux acc Nil = acc
    safeRevAux acc (Cons y ys) = safeRevAux (Cons y acc) ys

一个人可以做到这一点，但它感觉太多的是正在进行的封面下为我的口味

{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

import Data.Proxy
import Data.Type.Equality

data Nat = Z | S Nat

type family n1 + n2 where
  Z + n2 = n2
  (S n1) + n2 = S (n1 + n2)

-- singleton for Nat
data SNat :: Nat -> * where
  SZero :: SNat Z
  SSucc :: SNat n -> SNat (S n)

-- inductive proof of right-identity of +
plus_id_r :: SNat n -> ((n + Z) :~: n)
plus_id_r SZero = Refl
plus_id_r (SSucc n) = gcastWith (plus_id_r n) Refl

-- inductive proof of simplification on the rhs of +
plus_succ_r :: SNat n1 -> Proxy n2 -> ((n1 + (S n2)) :~: (S (n1 + n2)))
plus_succ_r SZero _ = Refl
plus_succ_r (SSucc n1) proxy_n2 = gcastWith (plus_succ_r n1 proxy_n2) Refl

data VecList n a where
  V0  :: VecList Z a
  Cons :: a -> VecList n a -> VecList (S n) a

reverseList :: VecList n a -> VecList n a
reverseList V0 = V0
reverseList list = go SZero V0 list
  where
    go :: SNat n1 -> VecList n1  a-> VecList n2 a -> VecList (n1 + n2) a
    go snat acc V0 = gcastWith (plus_id_r snat) acc
    go snat acc (Cons h (t :: VecList n3 a)) =
      gcastWith (plus_succ_r snat (Proxy :: Proxy n3))
              (go (SSucc snat) (Cons h acc) t)

safeHead :: VecList (S n) a -> a
safeHead (Cons x _) = x

test = safeHead $ reverseList (Cons 'a' (Cons 'b' V0))

请参阅以了解原始想法

编辑：

@user3237465这是非常有趣的，而且更符合我的想法 （尽管经过深思熟虑，我的问题可能不是很好 制定）

看来我有“公理”

这样就可以产生像这样的证据

plus_id_r :: SNat n -> ((n + Z) :~: n)
plus_id_r SZero = Refl
plus_id_r (SSucc n) = gcastWith (plus_id_r n) Refl

我觉得这很简洁。我通常会这样推理

• 在上面的最后一句中，我们有SSucc n:：SNat（sk）so n:：k
• 因此我们需要证明sk+Z:~:sk
• 通过第二个“公理”S k+Z=S（k+Z）
• 因此我们需要证明S（k+Z）：~:sk
• plus_id_r n给出了（k+Z）~:k的“证明”
• Refl给出了m~n=>sm:~:sn的“证明”
• 因此，我们可以使用gcastWith统一这些证明，以给出所需的结果 结果

对于你的解决方案，你给出了“公理”

有了这些，证明（n+Z）：~:n将不起作用

• 在最后一个子句中，我们再次得到了SSucc x的类型SNat（sk）
• 因此我们需要证明sk:+Z:~:sk
• 通过第二个新的“公理”，我们得到了sk+Z=k+sz
• 因此我们需要证明k+sz:~:sk
• 所以我们有更复杂的东西要证明：-(

我可以从新的例子中证明原来的第二个“公理” 第二个“公理”（所以我的第二个“公理”现在是引理？）

所以，现在我应该能够得到原始的证明工作，但我是 不知道目前的情况如何

到目前为止，我的推理正确吗

PS:ghc同意我的推理，即为什么正确身份的证明不起作用

Could not deduce ((n1 :+ 'S 'Z) ~ 'S n1)
...
or from ((n1 :+ 'Z) ~ n1)

---

您可以稍微简化

reverse

的定义：

{-# LANGUAGE GADTs, KindSignatures, DataKinds    #-}
{-# LANGUAGE TypeFamilies, UndecidableInstances  #-}
{-# LANGUAGE TypeOperators                       #-}

data Nat = Z | S Nat

data Vec a n where
    Nil   :: Vec a Z
    (:::) :: a -> Vec a n -> Vec a (S n)

type family n :+ m where
    Z   :+ m = m
    S n :+ m = n :+ S m

elim0 :: Vec a (n :+ Z) -> Vec a n
elim0 = undefined

accrev :: Vec a n -> Vec a n
accrev = elim0 . go Nil where
    go :: Vec a m -> Vec a n -> Vec a (n :+ m)
    go acc  Nil       = acc
    go acc (x ::: xs) = go (x ::: acc) xs

（：+）

运算符是根据

（：：）

运算符定义的。在

（：：）

案例中的统一过程如下：

x:：：xs

将

n

诱导为

sn

。因此结果类型变为

veca（sn:+m）

或者，在beta减少后，

veca（n:+sm）

x ::: acc         :: Vec a (S m)
xs                :: Vec a  n
go (x ::: acc) xs :: Vec a (n :+ S m)

所以我们有一个匹配项。但是现在你需要定义

elim0:：veca（n:+Z）->veca n

，这需要你的问题的两个证明

Agda中的整个代码：

---

顺便说一句，在任何情况下都不需要证据。以下是Agda标准库中如何定义

反向
：

foldl : ∀ {a b} {A : Set a} (B : ℕ → Set b) {m} →
        (∀ {n} → B n → A → B (suc n)) →
        B zero →
        Vec A m → B m
foldl b _⊕_ n []       = n
foldl b _⊕_ n (x ∷ xs) = foldl (λ n → b (suc n)) _⊕_ (n ⊕ x) xs

reverse : ∀ {a n} {A : Set a} → Vec A n → Vec A n
reverse {A = A} = foldl (Vec A) (λ rev x → x ∷ rev) []

这是因为
foldl
包含有关
_⊕_，因此你在每一步都满足类型检查器的要求，并且不需要任何证明。
这个问题适用吗？在某种程度上，我无法获得用于反向累积版本的解决方案。编译器正确地认为Add不是内射的。你的第一个等式显示
Add Z（s Z）~sz
但第一个和第二个表示
添加（sz）Z~S（添加Z）~sz
。事实上，如果它是可交换的，它就不能是内射的。与您在示例中已经做过的相比，您希望得到什么呢？
（+）
在任何情况下都必须在某个时候编写证明。例如，是否要删除
gcast
-s？“我如何告诉编译器Add确实是可交换的？”正是您所做的。我会在Refl上进行模式匹配，而不是使用gcast，但这只是风格。即使在独立类型的语言中，使用相同的+和Nat定义，您仍然需要编写证明。非常感谢。我刚刚安装了Agda，但在以下任何位置都找不到模块函数的源：/yarr/repairs/Function.agda/yarr/repairs/Function.lagda/Library/Haskell/ghc-7.8.3/lib/agda-2.4.2.2/share/lib/prim/Function.agda/Library/Haskell/ghc-7.8.3/lib/agda-2.4.2.2/share/lib/prim/Function.lagda范围检查打开导入声明时Function@idontgetoutmuch，需要单独安装。您可以找到说明。另请参见下面的user3237465的实现：lpaste.net/118199和我的。我认为您应该接受您的答案，因为您的解决方案更好、更完整。我已经写了一篇博客文章总结了其中的大部分内容：
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Type.Equality

data Nat = Z | S Nat

type family (n :: Nat) :+ (m :: Nat) :: Nat where
    Z   :+ m = m
    S n :+ m = n :+ S m

-- Singleton for Nat
data SNat :: Nat -> * where
  SZero :: SNat Z
  SSucc :: SNat n -> SNat (S n)

succ_plus_id :: SNat n1 -> SNat n2 -> (((S n1) :+ n2) :~: (S (n1 :+ n2)))
succ_plus_id SZero _ = Refl
succ_plus_id (SSucc n) m = gcastWith (succ_plus_id n (SSucc m)) Refl

plus_id_r :: SNat n -> ((n :+ Z) :~: n)
plus_id_r SZero = Refl
plus_id_r (SSucc x) = gcastWith (plus_id_r x) (succ_plus_id x SZero)

data Vec a n where
    Nil   :: Vec a Z
    (:::) :: a -> Vec a n -> Vec a (S n)

size :: Vec a n -> SNat n
size Nil         = SZero
size (_ ::: xs)  = SSucc $ size xs

elim0 :: SNat n -> (Vec a (n :+ Z) -> Vec a n)
elim0 n x = gcastWith (plus_id_r n) x

accrev :: Vec a n -> Vec a n
accrev x = elim0 (size x) $ go Nil x where
    go :: Vec a m -> Vec a n -> Vec a (n :+ m)
    go acc  Nil       = acc
    go acc (x ::: xs) = go (x ::: acc) xs

safeHead :: Vec a (S n) -> a
safeHead (x ::: _) = x

x ::: acc         :: Vec a (S m)
xs                :: Vec a  n
go (x ::: acc) xs :: Vec a (n :+ S m)

foldl : ∀ {a b} {A : Set a} (B : ℕ → Set b) {m} →
        (∀ {n} → B n → A → B (suc n)) →
        B zero →
        Vec A m → B m
foldl b _⊕_ n []       = n
foldl b _⊕_ n (x ∷ xs) = foldl (λ n → b (suc n)) _⊕_ (n ⊕ x) xs

reverse : ∀ {a n} {A : Set a} → Vec A n → Vec A n
reverse {A = A} = foldl (Vec A) (λ rev x → x ∷ rev) []

{-# LANGUAGE GADTs                #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExplicitForAll #-}

import Data.Type.Equality

data Nat = Z | S Nat

type family (n :: Nat) :+ (m :: Nat) :: Nat where
    Z   :+ m = m
    S n :+ m = n :+ S m

-- Singleton for Nat
data SNat :: Nat -> * where
  SZero :: SNat Z
  SSucc :: SNat n -> SNat (S n)

succ_plus_id :: SNat n1 -> SNat n2 -> (((S n1) :+ n2) :~: (S (n1 :+ n2)))
succ_plus_id SZero _ = Refl
succ_plus_id (SSucc n) m = gcastWith (succ_plus_id n (SSucc m)) Refl

plus_id_r :: SNat n -> ((n :+ Z) :~: n)
plus_id_r SZero = Refl
plus_id_r (SSucc x) = gcastWith (plus_id_r x) (succ_plus_id x SZero)

data Vec a n where
    Nil   :: Vec a Z
    (:::) :: a -> Vec a n -> Vec a (S n)

size :: Vec a n -> SNat n
size Nil         = SZero
size (_ ::: xs)  = SSucc $ size xs

elim0 :: SNat n -> (Vec a (n :+ Z) -> Vec a n)
elim0 n x = gcastWith (plus_id_r n) x

accrev :: Vec a n -> Vec a n
accrev x = elim0 (size x) $ go Nil x where
    go :: Vec a m -> Vec a n -> Vec a (n :+ m)
    go acc  Nil       = acc
    go acc (x ::: xs) = go (x ::: acc) xs

safeHead :: Vec a (S n) -> a
safeHead (x ::: _) = x