用Isabelle简化器重写非等价关系

我想使用简化器来替换不是等式的子项。我将通过一个例子来说明这一点，而不是对我的问题的一般定义：

假设我有一个简单的编程语言和一个霍尔逻辑。假设我们有if，while和sequence操作。另外，我们还有

表示法

，它给出了一个程序的表示法，还有

hoare P c Q

。以下是Isabelle/HOL中的签名示例：

(* A simple language and Hoare logic *)
typedecl program
typedecl memory
consts
  seq :: "program ⇒ program ⇒ program" (infixl ";" 10) (* c;d: run c, then run d *)
  ifthen :: "(memory ⇒ bool) ⇒ program ⇒ program" (* ifthen e c: run c if e(current_mem)=true *)
  while :: "(memory ⇒ bool) ⇒ program ⇒ program" (* while e c: run c while e(current_mem)=true *)
  denotation :: "program ⇒ memory ⇒ memory"  (* denotation c m: memory after running c, when starting with memory m *)
  hoare :: "(memory ⇒ bool) ⇒ program ⇒ (memory ⇒ bool) ⇒ bool" 
      (* hoare P c Q: if P(current_mem), then after running c, we have Q(current_mem) *)

现在，

（a；b）；c=a；（b；c）

（这些是不同的程序），但它认为它们在外延上是等价的，即，

外延（（a；b）；c））=外延（a；（b；c））

这意味着，我应该能够重写

a；（b；c）

至

（a；b）；c

在霍尔三元组中。例如，我希望能够证明

lemma "hoare P (while e (a;b;c)) Q ==> hoare P (while e (a;(b;c))) Q"

只需使用Simplier（

by simp

），即可获得合适的简化规则

从逻辑上讲，相关规则将是：

lemma "denotation (a;(b;c)) = denotation ((a;b);c)"
lemma "denotation a = denotation b ==> hoare P a Q = hoare P b Q"
lemma "denotation a = denotation b ==> denotation (while e a) = denotation (while e b)"
lemma "denotation a = denotation b ==> denotation (ifthen e a) = denotation (ifthen e b)"
lemma "denotation a = denotation a' ==> denotation b = denotation b' ==> denotation (a;b) = denotation (a';b')"

不幸的是，似乎没有直接的方法将这些规则告诉简化者。（更一般地说，我们想告诉同余规则中的简化者，下面的重写必须通过一个特定的等价关系，即本例中的指称等价来完成。）

我已经找到了这个问题的部分解决方案（见下面我自己的答案），但这个解决方案看起来像一个黑客（我不知道它有多稳定），我想知道是否有一个好的方法来解决这个问题

---

我不介意在这个过程中使用一些ML代码（例如，编写一个simproc），但我希望避免为了重写Hoare元组而重新实现整个简化程序。

有关一种似乎可行的方法，请参阅随附的Isabelle/HOL理论。其思想是使用条件simp规则来模拟cong规则

例如，一致性规则

lemma l1 [cong]: "f a = f b ==> g a = g b"

也是有效的条件simp规则

lemma l2 [simp]: "f a = f b ==> g a = g b"

当Isabelle应用simp规则时，b将被一个原理图变量替换，简化器将重写“fa=f？b”，这将用b的简化来实例化？b

然而，引理

l2

将使简化器循环，因为它可以应用于它自己的rhs。所以我们可以写一条规则

lemma l3 [simp]: "f_simp a = f_done b ==> g_simp a = g_done b"

其中

g_simp

和

g_done

被定义为等于

g

，但将阻止简化程序在循环中应用规则

下面的理论文件中有一个完整的工作示例

问题是： -这是一个黑客。我不知道在什么情况下它可能会崩溃或者与其他东西不兼容 -

apply simp

可能会部分重写，因此必须再次调用它才能完成重写。（参见理论中的最后一个引理。）

---

Isabelle的简化器不支持对任意等价关系进行重写。幸运的是，您的重写看起来相当简单，因此在simproc中实现重写可能是值得的。我的想法是：

编写一个simproc，它以

hoare p c Q

的形式触发。调用时，它设置了一个目标，形式为

hoare P c Q==？rhs

和 应用声明

%c的规则。hoare P c Q

只关心其参数的等价类，而不关心具体元素。然后，应用重写规则作为介绍规则，直到所述目标得到解决。这应该将

？rhs

实例化为

hoare P c'Q

的形式。测试

c

和

c'

是否等同于α-β-eta-。如果是，simproc将以

NONE

失败，否则它将返回已验证的等式

下面是一组引理，我将用它们作为开始：

definition fun_equiv :: "('a ⇒ 'b) ⇒ 'a ⇒ 'a ⇒ bool"
where "fun_equiv f x y ⟷ f x = f y"

lemma fun_equiv_refl: "fun_equiv f x x" by(simp add: fun_equiv_def)

lemma hoare_cong_start: (* start rule *)
  "fun_equiv denotation c c' ⟹ hoare P c Q == hoare P' c' Q'"
sorry

lemma while_cong: "fun_equiv denotation c c' ⟹ fun_equiv denotation (while b c) (while b c')" sorry

lemma seq_cong: "⟦ fun_equiv denotation a a'; fun_equiv denotation b b' ⟧ ⟹ fun_equiv denotation (a ; b) (a' ; b')" sorry

lemma if_cong: "fun_equiv denotation c c' ⟹ fun_equiv denotation (ifthen b c) (ifthen b c')" sorry

lemma seq_assoc: "fun_equiv denotation (a ; (b ; c)) (a; b; c)" sorry

lemma ifthen_true: "fun_equiv denotation (ifthen (λm. True) c) c" sorry

lemmas hoare_intros =
  -- ‹rewrites come first, congruences later, reflexivity last›
  ifthen_true seq_assoc
  while_cong if_cong seq_cong
  fun_equiv_refl

由于这是simplifier中的simproc，您可以假设调用中的命令已经是正常形式的w.r.t.simpset。在您的示例中，测试

%m。m=m

已简化为

%\。正确

。因此，simproc可以专注于实现hoare规则的重写

simproc调用的单个步骤应执行类似以下Isar代码段的操作：

schematic_lemma "hoare (λm. P x) (while P (c;(d;e);ifthen (λm. True) (f;g;c))) (λm. True) == ?c"
by(rule hoare_cong_start)(rule hoare_intros)+

由于Simplier会迭代simproc，直到它不再触发为止，因此最终应该是一个标准形式

---

如果您希望支持条件重写规则w.r.t.表示等价，则应将

规则hoare_intros

替换为检查子目标格式的内容。如果它的形式不是

fun\u equiv denotation\uuuuu

，那么simproc应该递归地调用简化器（或您选择的任何其他证明方法），而不是尝试另一个

hoare\u intros

的规则应用。下面是我的实现。第一部分是一个通用实现（适用于除指称等价之外的其他等价），下面是我的示例Hoare logic的实例

(* Written by Dominique Unruh *)
theory Test2
imports Main
begin

section "Implementation of modulo-simplifier"


definition fun_equiv :: "('a ⇒ 'b) ⇒ 'a ⇒ 'a ⇒ bool" where "fun_equiv f x y == f x = f y"
lemma fun_equiv_refl: "fun_equiv f x x" by(simp add: fun_equiv_def)

ML {*
(* Call as: hoare_simproc_tac (simplifications@congruences) context/simpset *)
fun fun_equiv_simproc_tac intros ctxt =
  SUBGOAL (fn (goal,i) =>
    case goal of
      Const(@{const_name Trueprop},_) $ (Const(@{const_name fun_equiv},_)$_$_$_) => 
        (resolve0_tac intros THEN_ALL_NEW fun_equiv_simproc_tac intros ctxt) i
        ORELSE (rtac @{thm fun_equiv_refl} i)
    | _ => 
        SOLVED' (simp_tac ctxt) i)

fun fun_equiv_simproc start intros _ ctxt (t:cterm) = 
  let val fresh_var = Var(("x",Term.maxidx_of_term (Thm.term_of t)+1),Thm.typ_of_cterm t)
      val goal = Logic.mk_equals (Thm.term_of t,fresh_var)
      val thm = Goal.prove ctxt [] [] goal 
                (fn {context,...} => resolve0_tac start 1 THEN ALLGOALS (fun_equiv_simproc_tac intros context))
  in 
    if (Thm.rhs_of thm) aconvc t then NONE else SOME thm
  end
  handle ERROR msg => (warning ("fun_equiv_simproc failed\nTerm was:\n"^(@{make_string} t)^"\nError: "^msg); NONE)

fun fun_equiv_simproc_named start cong simp morph ctxt =
  fun_equiv_simproc (Named_Theorems.get ctxt start) (Named_Theorems.get ctxt simp @ Named_Theorems.get ctxt cong) morph ctxt
*}

section "Minimal Hoare logic"

(* A simple language and Hoare logic *)
typedecl program
typedecl memory
consts
  seq :: "program ⇒ program ⇒ program" (infixl ";" 100) (* c;d: run c, then run d *)
  ifthen :: "(memory ⇒ bool) ⇒ program ⇒ program" (* ifthen e c: run c if e(current_mem)=true *)
  while :: "(memory ⇒ bool) ⇒ program ⇒ program" (* while e c: run c while e(current_mem)=true *)
  denotation :: "program ⇒ memory ⇒ memory"  (* denotation c m: memory after running c, when starting with memory m *)
  hoare :: "(memory ⇒ bool) ⇒ program ⇒ (memory ⇒ bool) ⇒ bool" 
      (* hoare P c Q: if P(current_mem), then after running c, we have Q(current_mem) *)

section "Instantiating the simplifier"

named_theorems denot_simp_start
named_theorems denot_simp
named_theorems denot_cong

lemma hoare_cong_start [denot_simp_start]: "fun_equiv denotation c c' ⟹ hoare P c Q == hoare P c' Q" sorry
lemma while_cong [denot_cong]: "fun_equiv denotation c c' ⟹ fun_equiv denotation (while b c) (while b c')" sorry
lemma seq_cong [denot_cong]: "fun_equiv denotation a a' ⟹ fun_equiv denotation b b' ⟹ fun_equiv denotation (a ; b) (a' ; b')" sorry
lemma if_cong [denot_cong]: "fun_equiv denotation c c' ⟹ fun_equiv denotation (ifthen b c) (ifthen b c')" sorry
lemma seq_assoc [denot_simp]: "fun_equiv denotation (a ; (b ; c)) (a; b; c)" sorry
lemma ifthen_true [denot_simp]: "(⋀m. e m) ⟹ fun_equiv denotation (ifthen e c) c" sorry
lemma double_while [denot_simp]: "(⋀m. e m = e' m) ⟹ fun_equiv denotation c d ⟹ fun_equiv denotation (seq (while e c) (while e' d)) (while e c)" sorry

(* -- "If the set of simplification theorems is fixed, we can use the following setup"
  lemmas hoare_congruences = while_cong if_cong seq_cong
  lemmas hoare_simps = ifthen_true seq_assoc double_while
  simproc_setup hoare_simproc ("hoare P c Q") = {* fun_equiv_simproc @{thms hoare_cong_start} @{thms hoare_simps hoare_congruences} *}
*)


(* To make use of dynamic lists of theorems, we use the following setup *)
simproc_setup hoare_simproc ("hoare P c Q") = {* 
  fun_equiv_simproc_named @{named_theorems denot_simp_start}
                          @{named_theorems denot_cong}
                          @{named_theorems denot_simp}
*}

section "Tests"

(* Testing the simplifier rules *)
lemma
  assumes "hoare P (while e (a;b;c)) Q"
  shows "hoare P (while e (a;(b;c))) Q ∧ True"
using assms 
by simp

lemma 
  assumes "hoare P (while P (c;d;e)) Q"
  assumes "⋀x. P x = R x"
  shows "hoare P ((while P (c;(d;e))); (while R ((c;d);e))) Q"
using assms by simp

lemma
  assumes "⋀x. Q x"
  assumes "hoare (λm. P x ∧ Q x) (while P (c;(d;e);(f;g);c)) (λm. m=m)"
  shows "hoare (λm. P x) (while P (c;(d;e);ifthen (λm. m=m) (f;g;c))) (λm. True)"
using assms by simp

(* Test: Disabling the simproc *)
lemma
  assumes "hoare P (a;(b;c)) Q"
  shows   "hoare P (a;(b;c)) Q ∧ True"
using[[simproc del: hoare_simproc]] -- "Without this, proof fails"
apply simp
by (fact assms)
end

---

是的，看起来效果不错。谢谢我已经执行了你的建议。由于评论的字符限制，我将我的实现发布在一个文档中。

(* Written by Dominique Unruh *)
theory Test2
imports Main
begin

section "Implementation of modulo-simplifier"


definition fun_equiv :: "('a ⇒ 'b) ⇒ 'a ⇒ 'a ⇒ bool" where "fun_equiv f x y == f x = f y"
lemma fun_equiv_refl: "fun_equiv f x x" by(simp add: fun_equiv_def)

ML {*
(* Call as: hoare_simproc_tac (simplifications@congruences) context/simpset *)
fun fun_equiv_simproc_tac intros ctxt =
  SUBGOAL (fn (goal,i) =>
    case goal of
      Const(@{const_name Trueprop},_) $ (Const(@{const_name fun_equiv},_)$_$_$_) => 
        (resolve0_tac intros THEN_ALL_NEW fun_equiv_simproc_tac intros ctxt) i
        ORELSE (rtac @{thm fun_equiv_refl} i)
    | _ => 
        SOLVED' (simp_tac ctxt) i)

fun fun_equiv_simproc start intros _ ctxt (t:cterm) = 
  let val fresh_var = Var(("x",Term.maxidx_of_term (Thm.term_of t)+1),Thm.typ_of_cterm t)
      val goal = Logic.mk_equals (Thm.term_of t,fresh_var)
      val thm = Goal.prove ctxt [] [] goal 
                (fn {context,...} => resolve0_tac start 1 THEN ALLGOALS (fun_equiv_simproc_tac intros context))
  in 
    if (Thm.rhs_of thm) aconvc t then NONE else SOME thm
  end
  handle ERROR msg => (warning ("fun_equiv_simproc failed\nTerm was:\n"^(@{make_string} t)^"\nError: "^msg); NONE)

fun fun_equiv_simproc_named start cong simp morph ctxt =
  fun_equiv_simproc (Named_Theorems.get ctxt start) (Named_Theorems.get ctxt simp @ Named_Theorems.get ctxt cong) morph ctxt
*}

section "Minimal Hoare logic"

(* A simple language and Hoare logic *)
typedecl program
typedecl memory
consts
  seq :: "program ⇒ program ⇒ program" (infixl ";" 100) (* c;d: run c, then run d *)
  ifthen :: "(memory ⇒ bool) ⇒ program ⇒ program" (* ifthen e c: run c if e(current_mem)=true *)
  while :: "(memory ⇒ bool) ⇒ program ⇒ program" (* while e c: run c while e(current_mem)=true *)
  denotation :: "program ⇒ memory ⇒ memory"  (* denotation c m: memory after running c, when starting with memory m *)
  hoare :: "(memory ⇒ bool) ⇒ program ⇒ (memory ⇒ bool) ⇒ bool" 
      (* hoare P c Q: if P(current_mem), then after running c, we have Q(current_mem) *)

section "Instantiating the simplifier"

named_theorems denot_simp_start
named_theorems denot_simp
named_theorems denot_cong

lemma hoare_cong_start [denot_simp_start]: "fun_equiv denotation c c' ⟹ hoare P c Q == hoare P c' Q" sorry
lemma while_cong [denot_cong]: "fun_equiv denotation c c' ⟹ fun_equiv denotation (while b c) (while b c')" sorry
lemma seq_cong [denot_cong]: "fun_equiv denotation a a' ⟹ fun_equiv denotation b b' ⟹ fun_equiv denotation (a ; b) (a' ; b')" sorry
lemma if_cong [denot_cong]: "fun_equiv denotation c c' ⟹ fun_equiv denotation (ifthen b c) (ifthen b c')" sorry
lemma seq_assoc [denot_simp]: "fun_equiv denotation (a ; (b ; c)) (a; b; c)" sorry
lemma ifthen_true [denot_simp]: "(⋀m. e m) ⟹ fun_equiv denotation (ifthen e c) c" sorry
lemma double_while [denot_simp]: "(⋀m. e m = e' m) ⟹ fun_equiv denotation c d ⟹ fun_equiv denotation (seq (while e c) (while e' d)) (while e c)" sorry

(* -- "If the set of simplification theorems is fixed, we can use the following setup"
  lemmas hoare_congruences = while_cong if_cong seq_cong
  lemmas hoare_simps = ifthen_true seq_assoc double_while
  simproc_setup hoare_simproc ("hoare P c Q") = {* fun_equiv_simproc @{thms hoare_cong_start} @{thms hoare_simps hoare_congruences} *}
*)


(* To make use of dynamic lists of theorems, we use the following setup *)
simproc_setup hoare_simproc ("hoare P c Q") = {* 
  fun_equiv_simproc_named @{named_theorems denot_simp_start}
                          @{named_theorems denot_cong}
                          @{named_theorems denot_simp}
*}

section "Tests"

(* Testing the simplifier rules *)
lemma
  assumes "hoare P (while e (a;b;c)) Q"
  shows "hoare P (while e (a;(b;c))) Q ∧ True"
using assms 
by simp

lemma 
  assumes "hoare P (while P (c;d;e)) Q"
  assumes "⋀x. P x = R x"
  shows "hoare P ((while P (c;(d;e))); (while R ((c;d);e))) Q"
using assms by simp

lemma
  assumes "⋀x. Q x"
  assumes "hoare (λm. P x ∧ Q x) (while P (c;(d;e);(f;g);c)) (λm. m=m)"
  shows "hoare (λm. P x) (while P (c;(d;e);ifthen (λm. m=m) (f;g;c))) (λm. True)"
using assms by simp

(* Test: Disabling the simproc *)
lemma
  assumes "hoare P (a;(b;c)) Q"
  shows   "hoare P (a;(b;c)) Q ∧ True"
using[[simproc del: hoare_simproc]] -- "Without this, proof fails"
apply simp
by (fact assms)
end