Coq中的Bove-Capretta方法

作为在Coq中定义一般递归函数的练习，我试图 使用特殊谓词（即所谓的Bove Capretta方法）实现列表合并函数

为此，我遵循Bertot和Castéran第15章中的

log2

函数示例中的模式。首先，我定义了一个 合并如下：

Inductive merge_acc : list nat -> list nat -> Prop :=
 | Merge1 : forall xs, merge_acc xs nil
 | Merge2 : forall ys, merge_acc nil ys 
 | Merge3 : forall x y xs ys,
      x <= y -> merge_acc xs (y :: ys) -> merge_acc (x :: xs) (y :: ys)
 | Merge4 : forall x y xs ys,
      x > y -> merge_acc (x :: xs) ys -> merge_acc (x :: xs) (y :: ys).

在这些定义之后，我尝试了以下

merge

的实现：

 Ltac inv H := inversion H ; subst ; clear H.

 Lemma merge_acc_inv3
     : forall xs ys x y,
        merge_acc (x :: xs) (y :: ys) -> 
        x <= y -> 
        merge_acc xs (y :: ys).
 Proof.
    induction xs ; destruct ys ; intros x y H Hle ; inv H ; eauto ; try omega.
 Defined.

 Lemma merge_acc_inv4
    : forall xs ys x y, 
        merge_acc (x :: xs) (y :: ys) -> 
        x > y -> 
       merge_acc (x :: xs) ys.
 Proof.
   induction xs ; destruct ys ; intros x y H Hxy ; inv H ; eauto ; try omega.
 Defined.

 Fixpoint merge_bc 
     (xs ys : list nat)(H : merge_acc xs ys) {struct H}: list nat :=
     match xs, ys with
     | nil, ys => ys
     | xs , nil => xs
     | (x :: xs) , (y :: ys) =>
        match le_gt_dec x y with
        | left _ h1 => x :: merge_bc (merge_acc_inv3 xs ys x y H h1) 
        | right _ h2 => y :: merge_bc (x :: xs) ys (merge_acc_inv4 _ _ _ _ H h2)
        end 
     end. 

但是，我收到一条错误消息，似乎与模式匹配中缺少类型细化有关：

    The term "H" has type "merge_acc xs ys" while it is expected to have type
       "merge_acc (x :: xs0) (y :: ys0)".

接下来，我尝试使用

refine

策略定义

merge

：

  Definition merge_bc : forall xs ys, merge_acc xs ys -> list nat.
     refine (fix merge_bc xs ys (H : merge_acc xs ys) {struct H}: list nat :=
        match xs as xs' return xs = xs' -> list nat with
        | nil => fun _ => ys
        | x :: xs => fun _ =>
          (match ys as ys' return ys = ys' -> list nat with
           | nil => fun _ => x :: xs
           | y :: ys => fun _ =>
             match le_gt_dec x y with
             | left _ Hle => x :: merge_bc xs (y :: ys) _
             | right _ Hgt => y :: merge_bc (x :: xs) ys _
             end
           end (eq_refl ys))
        end (eq_refl xs)).
     +
       subst.
       apply merge_acc_inv3 with (x := x).
       exact H. exact Hle.
    +
       subst.
       apply merge_acc_inv4 with (y := y).
       exact H.
       exact Hgt.
  Defined.

Coq返回以下错误消息：

 Recursive call to merge_bc has principal argument equal to
    "eq_ind_r
        (fun xs1 : list nat => merge_acc xs1 ys -> merge_acc xs0 (y :: ys0))
        (fun H : merge_acc (x :: xs0) ys => ...

我简化了一点。看来递归并不是在一个

merge_acc xs ys

的结构较小的子项

我的问题是，我做错了什么？我错过什么了吗

完整的工作示例如下所示

---

EDIT：修复Castéran的拼写。

我认为这里的问题是，您使用的

H

子项被您在

merge\u acc\u inv3

和

merge\u acc\u inv4

的定义中添加的不必要的复杂性所掩盖。不需要

感应xs

此外，在

xs

和

ys

上进行模式匹配期间，您将失去与

xs

和

ys

类型为

H

的连接。这就是我所拥有的：

• 没有

  归纳法的倒置引理

  且更易于使用（参见等式约束的使用

  xxs=x:：xs

  ）

---

Castéran的正确拼写强调的是e，而不是a。@Yves:很抱歉拼写错误。

  Lemma merge_acc_inv3
     : forall xs ys x y xxs yys,
        xxs = x :: xs -> yys = y :: ys ->
        merge_acc xxs yys ->
        x <= y ->
        merge_acc xs yys.
 Proof.
    intros xs ys x y xxs yys eqx eqy H Hle;
    subst; inv H ; eauto ; try omega.
 Defined.

 Lemma merge_acc_inv4
    : forall xs ys x y xxs yys,
      xxs = x :: xs -> yys = y :: ys ->
      merge_acc xxs yys ->
      x > y ->
     merge_acc xxs ys.
 Proof.
   intros xs ys x y xxs yys eqx eqy H Hxy ;
   subst ; inv H ; eauto ; try omega.
 Defined.

 Fixpoint merge_bc
     (xs ys : list nat)(H : merge_acc xs ys) {struct H}: list nat :=
   (match xs as us, ys as vs return xs = us -> ys = vs -> list nat with
     | nil, ys => fun _ _ => ys
     | xs , nil => fun _ _ => xs
     | (x :: xs) , (y :: ys) =>
        match le_gt_dec x y with
        | left _ h1 => fun eqx eqy =>
            let H' := merge_acc_inv3 _ _ x y _ _ eqx eqy H h1
            in x :: merge_bc _ _ H'
        | right _ h2 => fun eqx eqy =>
            let H' := merge_acc_inv4 _ _ x y _ _ eqx eqy H h2
            in y :: merge_bc _ _ H'
        end 
     end) eq_refl eq_refl.