Question

我遇到了一个需要相互递归才能解决的问题。我无法在Coq中做到这一点，但我怀疑在Agda中可能会发生这种情况，并证明使用两个相互递归的函数就是这种情况。我不确定该将该解决方案带回Coq到底应该怎么做，而Google搜索该问题并没有找到任何解决方案。

我在这里有什么选择？

为了进一步激发这个问题，这里是我要翻译成Coq的Agda证明。它证明了树行走和展平计算器之间的功能相等。

证明要求remove-from-stack和add-to-stack以相互递归的方式相互调用。

open import Data.Product
open import Data.Nat
open import Data.List
open import Data.List.Properties
open import Function

import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; cong; subst)
open Eq.≡-Reasoning

data Sinstr : Set where
  SPush : ℕ → Sinstr
  SPlus : Sinstr

data Aexp : Set where
  ANum : (n : ℕ) → Aexp
  APlus : Aexp → Aexp → Aexp

s-execute : List Sinstr → List ℕ → List ℕ
s-execute [] stack = stack
s-execute (SPush x ∷ prog) stack = s-execute prog (x ∷ stack)
s-execute (SPlus ∷ prog) (x1 ∷ x2 ∷ stack) = s-execute prog (x2 + x1 ∷ stack)
s-execute _ stack = stack

aeval : Aexp → ℕ
aeval (ANum n) = n
aeval (APlus a a₁) = aeval a + aeval a₁

s-compile : Aexp → List Sinstr
s-compile (ANum n) = [ SPush n ]
s-compile (APlus a a₁) = s-compile a ++ s-compile a₁ ++ [ SPlus ]

++-assoc⁴ : ∀ {T : Set} (a b c d : List T) → (a ++ b ++ c) ++ d ≡ a ++ b ++ c ++ d
++-assoc⁴ a b c d =
  begin
    ((a ++ b ++ c) ++ d)
  ≡⟨ ++-assoc a (b ++ c) d ⟩
    (a ++ (b ++ c) ++ d)
  ≡⟨ cong (a ++_) (++-assoc b c d) ⟩
    (a ++ b ++ c ++ d)
  ∎

remove-from-stack : ∀ {e2 stack x} e1 →
  s-execute (s-compile e1 ++ e2) stack ≡ [ x ] →
  ∃[ a ] (s-execute e2 (a ∷ stack) ≡ [ x ] × s-execute (s-compile e1) [] ≡ [ a ])

add-to-stack : ∀ {e2 stack x} e1 →
  s-execute (s-compile e1) [] ≡ [ x ] →
  s-execute (s-compile e1 ++ e2) stack ≡ s-execute e2 (x ∷ stack)

remove-from-stack (ANum n) prf = n , (prf , refl)
remove-from-stack {rest} {stack} (APlus e1 e2) prf with subst (λ l → s-execute l stack ≡ _) (++-assoc⁴ (s-compile e1) (s-compile e2) [ _ ]  rest) prf
... | []∷stack with remove-from-stack e1 []∷stack
remove-from-stack {rest} {stack} (APlus e1 e2) _ | []∷stack | a , a∷stack , e1≡a with remove-from-stack e2 a∷stack
remove-from-stack {rest} {stack} (APlus e1 e2) _ | []∷stack | a , a∷stack , e1≡a | b , b∷a∷stack , e2≡b = a + b , b∷a∷stack , e1+e1≡a+b where
  e1+e1≡a+b : _
  e1+e1≡a+b =
    begin
      s-execute (s-compile e1 ++ s-compile e2 ++ SPlus ∷ []) []
    ≡⟨ add-to-stack e1 e1≡a ⟩
      s-execute (s-compile e2 ++ SPlus ∷ []) [ a ]
    ≡⟨ add-to-stack e2 e2≡b ⟩
      s-execute (SPlus ∷ []) (b ∷ [ a ])
    ≡⟨⟩
      (a + b ∷ [])
    ∎

add-to-stack (ANum n) refl = refl
add-to-stack (APlus e1 e2) []∷[] with remove-from-stack e1 []∷[]
add-to-stack (APlus e1 e2) []∷[] | a , a∷[] , e1≡a with remove-from-stack e2 a∷[]
add-to-stack {rest} {stack} (APlus e1 e2) []∷[] | a , a∷[] , e1≡a | b , refl , e2≡b =
  begin
    s-execute ((s-compile e1 ++ s-compile e2 ++ SPlus ∷ []) ++ rest) stack
  ≡⟨ cong (λ l → s-execute l stack) (++-assoc⁴ (s-compile e1) (s-compile e2) [ _ ]  rest) ⟩
    s-execute (s-compile e1 ++ s-compile e2 ++ SPlus ∷ [] ++ rest) stack
  ≡⟨ add-to-stack e1 e1≡a ⟩
    s-execute (s-compile e2 ++ SPlus ∷ [] ++ rest) (a ∷ stack)
  ≡⟨ add-to-stack e2 e2≡b ⟩
    s-execute rest (a + b ∷ stack)
  ∎

s-compile-correct : (e : Aexp) → s-execute (s-compile e) [] ≡ [ aeval e ]
s-compile-correct (ANum n) = refl
s-compile-correct (APlus l r) =
  begin
    (s-execute (s-compile l ++ s-compile r ++ SPlus ∷ []) [])
  ≡⟨ add-to-stack l (s-compile-correct l) ⟩
    (s-execute (s-compile r ++ SPlus ∷ []) (aeval l ∷ []))
  ≡⟨ add-to-stack r (s-compile-correct r) ⟩
    (s-execute (SPlus ∷ []) (aeval r ∷ aeval l ∷ []))
  ≡⟨⟩
    (aeval l + aeval r ∷ [])
  ∎

Answer 1

正如我评论的那样，我不知道一种处理相互递归定理的通用方法，但是（根据我的浅薄经验）我不需要一组相互递归定理，除非它们包含相互递归数据类型或函数（在这种情况下，我建议使用Equations plugin）。

此答案侧重于具体问题。

这个问题与Induction Exercises的最后练习非常接近，除了在Plus指令中给定的参数太少时程序会暂停（这使问题变得更加困难）。

我们从@larsr开始定义：

Require Import Coq.Lists.List.
Import ListNotations.

Inductive Sinstr : Set := SPush (_:nat) | SPlus.
Inductive Aexp : Set := ANum (_:nat) | APlus (_ _:Aexp).

Fixpoint sexec (p:list Sinstr) (s:list nat) : list nat :=
  match (p, s) with
  | ([], stack) => stack
  | ((SPush x)::prog, stack) => sexec prog (x::stack)
  | (Splus::prog, x1::x2::stack)  =>  sexec prog (x1+x2::stack)
  | (_, stack) => stack
  end.

Fixpoint aeval (a:Aexp) : nat :=
  match a with
  | ANum n => n
  | APlus a1 a2 => aeval a2 + aeval a1
  end.

Fixpoint compile (a:Aexp) : list Sinstr :=
  match a with
  | ANum n => [SPush n]
  | APlus a1 a2 => compile a1 ++ compile a2 ++ [SPlus] 
  end.

首先，我们直接尝试归纳证明：

Theorem compile_correct_try e : sexec (compile e) [] = [aeval e].
Proof.
  induction e; intros; auto. (* base case is easy *)
  simpl.

e1, e2 : Aexp
IHe1 : sexec (compile e1) [] = [aeval e1]
IHe2 : sexec (compile e2) [] = [aeval e2]
____________________________________________
sexec (compile e1 ++ compile e2 ++ [SPlus]) [] = [aeval e2 + aeval e1]

这时我们陷入困境。我们可以做一些观察：

我们需要一个引理，涉及两个程序的连接（显然）。
我们还需要适用于任何初始堆栈的引理（因为compile e2将在堆栈[aeval e1]而非[]上运行）。

因此，我们尝试编写一般引理：

Lemma prg_concat :
  forall p1 p2 stack, sexec (p1 ++ p2) stack = sexec p2 (sexec p1 stack).

但这是完全错误的，因为如果p2被中止，p1不应该运行。然后，我们应确保p1不中止。一个人可能想定义“从头到尾”的道具，但是我们有一个显而易见的特殊情况：compile e。而且它非常适合我们的归纳情况，因为++的左操作数的格式为compile _：

sexec (compile e1 ++ compile e2 ++ [SPlus]) stack
->
sexec (compile e2 ++ [SPlus]) (sexec (compile e1) stack)
->
sexec [SPlus] (sexec (compile e2) (sexec (compile e1) stack))

相应的语句是：

Lemma compile_concat :
  forall e p s, sexec (compile e ++ p) s = sexec p (sexec (compile e) s).

但这还不够，因为不能保证最后的SPlus将成功。因此，我们将主要目标sexec (compile e) = [aeval e]纳入了引理，即，我们写了sexec (compile e) s而不是aeval e :: s。现在我们可以保证到达最后一个SPlus时，堆栈上至少有两个元素。

因此，来了拉斯的引理：

Lemma compile_ok (e:Aexp): 
  forall p s, sexec (compile e ++ p) s = sexec p (aeval e::s).
Proof.
  induction e.
  reflexivity.
  intros; simpl;
    rewrite <-? app_assoc, IHe1, IHe2; reflexivity.
Qed.

此外，here是rewrite <-? expr的文档，位于rewrite部分的末尾：

可以在每个要重写的术语之前插入方向->或<-。

在上述所有形式的重写中，可以使用以下修饰符之一立即在重写术语前加上前缀：


?：策略rewrite ?term尽可能多地（可能为零时间）执行术语的重写。此表格永远不会失败。

所以rewrite <-? app_assoc, IHe1, IHe2.的意思是重复（反向）用app_assoc重写，然后（前进）用IHe1和IHe2重写一次。

如何进行需要相互递归的定理？

1 个答案: