19

GHC 7.6.1 带有用于类型级别编程的新功能,包括数据类型提升。以那里关于类型级自然数和向量的示例为例,我希望能够在依赖于基本算术定律的向量上编写函数。

不幸的是,即使我想要的定律通常很容易通过案例分析和归纳来证明归纳自然,但我怀疑我能否说服类型检查器。举个简单的例子,对下面的朴素 reverse 函数进行类型检查需要证明n + Su Ze ~ Su n.

有什么方法可以提供该证明,还是我现在真的处于成熟的依赖类型领域?

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

data Nat = Ze | Su Nat

data Vec :: * -> Nat -> * where
  Nil  :: Vec a Ze
  Cons :: a -> Vec a n -> Vec a (Su n)

type family (m :: Nat) + (n :: Nat) :: Nat

type instance Ze + n = n
type instance (Su m + n) = Su (m + n)

append :: Vec a m -> Vec a n -> Vec a (m + n)
append Nil ys = ys
append (Cons x xs) ys = Cons x (append xs ys)

rev :: Vec a n -> Vec a n
rev Nil = Nil
rev (Cons x xs) = rev xs `append` Cons x Nil
4

1 回答 1

20

(注意:我只对任何代码进行了类型检查(并没有实际运行)。)

方法一

实际上,您可以通过将证明存储在 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 的含义,以包括对自然数的所有相等性的证明,直到并包括- 本质上类似于从归纳到强归纳时的强化过程。revConsProofn

方法二

经过一番思考,我意识到这门课有点多余;这使得这种方法特别好,因为它不需要任何额外的扩展(甚至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')
于 2012-09-16T01:33:05.003 回答