关于haskell：如何让ghc相信类型级加法是可交换的(实现依赖类型的反向)？


How to convince ghc that type level addition is commutative (to implement dependently typed reverse)?

这不会编译，因为 ghc 告诉我 Add 不是单射的。我如何告诉编译器 Add 是真正可交换的(也许通过告诉它 Add 是单射的)？从 hasochism 论文看来，必须以某种方式提供代理。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
{-# 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

一个人可以做到这一点，但感觉就像我的口味在幕后发生的事情太多了。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# 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))

有关原始想法，请参见 https://www.haskell.org/pipermail/haskell-cafe/2014-September/115919.html。

编辑：

@user3237465 这很有趣，更符合我的想法
(尽管经过反思，我的问题可能不是很好
制定)。

看来我有"公理"

1
2
3
type family n1 :+ n2 where
  Z :+ n2 = n2
  (S n1) :+ n2 = S (n1 + n2)

，因此可以产生像

这样的证明

1
2
3
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 (S k) 所以 n :: k
  • 因此我们需要证明 S k Z :~: S k
  • 由第二个"公理" S k Z = S (k Z)
  • 因此我们需要证明 S (k Z) :~: S k
  • plus_id_r n 给出了一个"证明"，即 (k Z) :~: k
  • 并且 Refl 给出了一个"证明"，即 m ~ n => S m :~: S n
  • 因此，我们可以使用 gcastWith 统一这些证明以给出所需的
    结果。

对于您的解决方案，您给出"公理"

1
2
3
type family n :+ m where
    Z   :+ m = m
    S n :+ m = n :+ S m

有了这些，(n Z) :~: n 的证明就行不通了。

  • 在最后一个子句中，我们再次看到 SSucc x 的类型为 SNat (S k)
  • 因此我们需要证明 S k : Z :~: S k
  • 通过第二个新"公理"，我们有 S k Z = k S Z
  • 因此我们需要证明 k S Z :~: S k
  • 所以我们有更复杂的东西要证明:-(

我可以从新的第二个"公理"中证明原始的第二个"公理"
第二个"公理"(所以我的第二个"公理"现在是引理？)。

1
2
3
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

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

到目前为止，我的推理是否正确？

PS：ghc 同意我关于为什么存在正确身份的证明不起作用的推理

1
2
3
Could not deduce ((n1 :+ 'S 'Z) ~ 'S n1)
...
or from ((n1 :+ 'Z) ~ n1)
相关讨论

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{-# 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
相关讨论

你可以稍微简化一下reverse的定义：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
{-# 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 为 S n。所以结果的类型变成了 Vec a (S n :+ m) 或者，在 beta-reduction 之后，变成了 Vec a (n :+ S m)。而

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

所以我们有一场比赛。但是现在您需要定义 elim0 :: Vec a (n :+ Z) -> Vec a n，这需要您的问题的两个证明。

Agda 中的完整代码：http://lpaste.net/117679

顺便说一句，这不是真的，无论如何你都需要证据。以下是 Agda 标准库中 reverse 的定义方式：

1
2
3
4
5
6
7
8
9
foldl : a?€ {a b} {A : Set a} (B : a?? a?’ Set b) {m} a?’
        (a?€ {n} a?’ B n a?’ A a?’ B (suc n)) a?’
        B zero a?’
        Vec A m a?’ B m
foldl b _a??_ n []       = n
foldl b _a??_ n (x a?· xs) = foldl (?? n a?’ b (suc n)) _a??_ (n a?? x) xs

reverse : a?€ {a n} {A : Set a} a?’ Vec A n a?’ Vec A n
reverse {A = A} = foldl (Vec A) (?? rev x a?’ x a?· rev) []

那是因为 foldl 携带了关于 _a??_ 行为的附加类型信息，所以你在每一步都满足类型检查器，不需要证明。

相关讨论