(注意:我只对任何代码进行了类型检查(并没有实际运行)。)
方法一
实际上,您可以通过将证明存储在 GADT 中来对其进行操作。您需要打开ScopedTypeVariables
此方法才能正常工作。
data Proof n where
NilProof :: Proof Ze
ConsProof :: (n + Su Ze) ~ Su n => Proof n -> Proof (Su n)
class PlusOneIsSucc n where proof :: Proof n
instance PlusOneIsSucc Ze where proof = NilProof
instance PlusOneIsSucc n => PlusOneIsSucc (Su n) where
proof = case proof :: Proof n of
NilProof -> ConsProof proof
ConsProof _ -> ConsProof proof
rev :: PlusOneIsSucc n => Vec a n -> Vec a n
rev = go proof where
go :: Proof n -> Vec a n -> Vec a n
go NilProof Nil = Nil
go (ConsProof p) (Cons x xs) = go p xs `append` Cons x Nil
实际上,也许是上述类型的有趣动机Proof
,我最初只是
data Proof n where Proof :: (n + Su Ze) ~ Su n => Proof n
但是,这不起作用:GHC 正确地抱怨说,仅仅因为我们知道(Su n)+1 = Su (Su n)
并不意味着我们知道,这是我们在这种情况下n+1 = Su n
进行递归调用需要知道的。因此,我不得不扩展 a 的含义,以包括对自然数的所有相等性的证明,直到并包括- 本质上类似于从归纳到强归纳时的强化过程。rev
Cons
Proof
n
方法二
经过一番思考,我意识到这门课有点多余;这使得这种方法特别好,因为它不需要任何额外的扩展(甚至ScopedTypeVariables
),并且不会对Vec
.
data Proof n where
NilProof :: Proof Ze
ConsProof :: (n + Su Ze) ~ Su n => Proof n -> Proof (Su n)
proofFor :: Vec a n -> Proof n
proofFor Nil = NilProof
proofFor (Cons x xs) = let rec = proofFor xs in case rec of
NilProof -> ConsProof rec
ConsProof _ -> ConsProof rec
rev :: Vec a n -> Vec a n
rev xs = go (proofFor xs) xs where
go :: Proof n -> Vec a n -> Vec a n
go NilProof Nil = Nil
go (ConsProof p) (Cons x xs) = go p xs `append` Cons x Nil
方法 3
或者,如果您将rev
位的实现转换为将最后一个元素转换为列表的反向初始段,那么代码看起来会更简单一些。(这种方法也不需要额外的扩展。)
class Rev n where
initLast :: Vec a (Su n) -> (a, Vec a n)
rev :: Vec a n -> Vec a n
instance Rev Ze where
initLast (Cons x xs) = (x, xs)
rev x = x
instance Rev n => Rev (Su n) where
initLast (Cons x xs) = case initLast xs of
(x', xs') -> (x', Cons x xs')
rev as = case initLast as of
(a, as') -> Cons a (rev as')
方法 4
就像方法 3,但再次观察到类型类不是必需的。
initLast :: Vec a (Su n) -> (a, Vec a n)
initLast (Cons x xs) = case xs of
Nil -> (x, Nil)
Cons {} -> case initLast xs of
(x', xs') -> (x', Cons x xs')
rev :: Vec a n -> Vec a n
rev Nil = Nil
rev xs@(Cons {}) = case initLast xs of
(x, xs') -> Cons x (rev xs')