Lecture notes 20210317 Denotational Semantics 3
Remark. Some material in this lecture is from << Software Foundation >>
volume 1 and volume 2.
Require Import PL.Imp.
Require Import Coq.Classes.RelationClasses.
Require Import Coq.Classes.Morphisms.
Require Import Coq.Classes.RelationClasses.
Require Import Coq.Classes.Morphisms.
Review: Programs' Denotation
- [[ a1 + a2 ]] = [[ a1 ]] + [[ a2 ]]
- [[ a1 - a2 ]] = [[ a1 ]] - [[ a2 ]]
- [[ a1 * a2 ]] = [[ a1 ]] * [[ a2 ]]
- [[ b1 && b2 ]] = the intersection of [[ b1 ]] and [[ b2 ]]
- [[ ! b ]] = the complement of [[ b ]].
- [[ a1 - a2 ]] = [[ a1 ]] - [[ a2 ]]
- [[ a1 * a2 ]] = [[ a1 ]] * [[ a2 ]]
- [[ b1 && b2 ]] = the intersection of [[ b1 ]] and [[ b2 ]]
- [[ ! b ]] = the complement of [[ b ]].
Module CEval_first_try.
Definition if_sem
(b: bexp)
(then_branch else_branch: state -> state -> Prop)
: state -> state -> Prop
:=
BinRel.union
(BinRel.concat (BinRel.test_rel (beval b)) then_branch)
(BinRel.concat (BinRel.test_rel (beval (BNot b))) else_branch).
Definition if_sem
(b: bexp)
(then_branch else_branch: state -> state -> Prop)
: state -> state -> Prop
:=
BinRel.union
(BinRel.concat (BinRel.test_rel (beval b)) then_branch)
(BinRel.concat (BinRel.test_rel (beval (BNot b))) else_branch).
Soppose then_branch and else_branch are denotations of the then-branch
and else-branch of an if-command. Here, the first clause of union the set of
program state pairs (st1, st2) such that:
- (st1, st2) belongs to then_branch and b is true on st1
- (st1, st2) belongs to else_branch and b is false on st1
Fixpoint ceval (c: com): state -> state -> Prop :=
match c with
| CSkip ⇒ BinRel.id
| CAss X E ⇒
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y
| CSeq c1 c2 ⇒ BinRel.concat (ceval c1) (ceval c2)
| CIf b c1 c2 ⇒ if_sem b (ceval c1) (ceval c2)
| CWhile _ _ ⇒ BinRel.empty
end.
match c with
| CSkip ⇒ BinRel.id
| CAss X E ⇒
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y
| CSeq c1 c2 ⇒ BinRel.concat (ceval c1) (ceval c2)
| CIf b c1 c2 ⇒ if_sem b (ceval c1) (ceval c2)
| CWhile _ _ ⇒ BinRel.empty
end.
Here, a pair (st1, st2) is inside the denotation of c if and only if
ceval c st1 st2 holds. The following notation and lemmas may help you
understand.
Notation "'The_pair_(' st1 , st2 ')_is_in_[[' c ]]" := (ceval c st1 st2) (at level 45, no associativity).
Lemma ceval_skip: ∀st1 st2,
The_pair_( st1 , st2 )_is_in_[[ Skip ]] ↔
st1 = st2.
Lemma ceval_seq: ∀st1 st3 c1 c2,
The_pair_( st1 , st3 )_is_in_[[ c1;; c2 ]] ↔
∃st2,
The_pair_( st1 , st2 )_is_in_[[ c1 ]] ∧
The_pair_( st2 , st3 )_is_in_[[ c2 ]].
Lemma ceval_if: ∀st1 st2 b c1 c2,
The_pair_( st1 , st2 )_is_in_[[ If b Then c1 Else c2 EndIf ]] ↔
The_pair_( st1 , st2 )_is_in_[[ c1 ]] ∧ beval b st1 ∨
The_pair_( st1 , st2 )_is_in_[[ c2 ]] ∧ ¬beval b st1.
End CEval_first_try.
Lemma ceval_skip: ∀st1 st2,
The_pair_( st1 , st2 )_is_in_[[ Skip ]] ↔
st1 = st2.
Proof.
intros.
simpl.
unfold id.
tauto.
Qed.
intros.
simpl.
unfold id.
tauto.
Qed.
Lemma ceval_seq: ∀st1 st3 c1 c2,
The_pair_( st1 , st3 )_is_in_[[ c1;; c2 ]] ↔
∃st2,
The_pair_( st1 , st2 )_is_in_[[ c1 ]] ∧
The_pair_( st2 , st3 )_is_in_[[ c2 ]].
Proof.
intros.
simpl.
unfold concat.
tauto.
Qed.
intros.
simpl.
unfold concat.
tauto.
Qed.
Lemma ceval_if: ∀st1 st2 b c1 c2,
The_pair_( st1 , st2 )_is_in_[[ If b Then c1 Else c2 EndIf ]] ↔
The_pair_( st1 , st2 )_is_in_[[ c1 ]] ∧ beval b st1 ∨
The_pair_( st1 , st2 )_is_in_[[ c2 ]] ∧ ¬beval b st1.
Proof.
intros.
simpl.
unfold if_sem.
unfold iff, BinRel.union, BinRel.concat, BinRel.test_rel;
split; simpl.
+ intros.
destruct H as [[st1' [[? ?] ?]] | [st1' [[? ?] ?]]].
- left.
rewrite <- H in H1; tauto.
- right.
rewrite <- H in H1; tauto.
+ intros.
destruct H as [[? ?] | [? ?]].
- left.
∃st1.
tauto.
- right.
∃st1.
tauto.
Qed.
intros.
simpl.
unfold if_sem.
unfold iff, BinRel.union, BinRel.concat, BinRel.test_rel;
split; simpl.
+ intros.
destruct H as [[st1' [[? ?] ?]] | [st1' [[? ?] ?]]].
- left.
rewrite <- H in H1; tauto.
- right.
rewrite <- H in H1; tauto.
+ intros.
destruct H as [[? ?] | [? ?]].
- left.
∃st1.
tauto.
- right.
∃st1.
tauto.
Qed.
End CEval_first_try.
Loops' Denotations
Fixpoint iter_loop_body (b: bexp)
(loop_body: state -> state -> Prop)
(n: nat): state -> state -> Prop :=
match n with
| O ⇒
BinRel.test_rel (beval (BNot b))
| S n' ⇒
BinRel.concat
(BinRel.test_rel (beval b))
(BinRel.concat
loop_body
(iter_loop_body b loop_body n'))
end.
(loop_body: state -> state -> Prop)
(n: nat): state -> state -> Prop :=
match n with
| O ⇒
BinRel.test_rel (beval (BNot b))
| S n' ⇒
BinRel.concat
(BinRel.test_rel (beval b))
(BinRel.concat
loop_body
(iter_loop_body b loop_body n'))
end.
In short, iter_loop_body b loop_body n is defined as:
The union of these binary relations is exactly the meaning of while loops.
The following relation operator omega_union defines the union of countably
many relations.
- if n = 0, identity relation with the restriction that b is not true;
- if n = n' + 1, first do loop_body then do iter_loop_body b loop_body n' with the restriction that b is true at beginning.
Module DefinitionOfOmegaUnion.
Module BinRel.
Definition omega_union {A B} (rs: nat -> A -> B -> Prop): A -> B -> Prop :=
fun st1 st2 ⇒ ∃n, rs n st1 st2.
End BinRel.
End DefinitionOfOmegaUnion.
Import DefinitionOfOmegaUnion.
Definition loop_sem (b: bexp) (loop_body: state -> state -> Prop):
state -> state -> Prop :=
BinRel.omega_union (iter_loop_body b loop_body).
Module BinRel.
Definition omega_union {A B} (rs: nat -> A -> B -> Prop): A -> B -> Prop :=
fun st1 st2 ⇒ ∃n, rs n st1 st2.
End BinRel.
End DefinitionOfOmegaUnion.
Import DefinitionOfOmegaUnion.
Definition loop_sem (b: bexp) (loop_body: state -> state -> Prop):
state -> state -> Prop :=
BinRel.omega_union (iter_loop_body b loop_body).
With loop_sem which is just defined, we are eventually ready to complete
our definition of ceval.
Definition if_sem
(b: bexp)
(then_branch else_branch: state -> state -> Prop)
: state -> state -> Prop
:=
BinRel.union
(BinRel.concat (BinRel.test_rel (beval b)) then_branch)
(BinRel.concat (BinRel.test_rel (beval (BNot b))) else_branch).
Fixpoint ceval (c: com): state -> state -> Prop :=
match c with
| CSkip ⇒ BinRel.id
| CAss X E ⇒
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y
| CSeq c1 c2 ⇒ BinRel.concat (ceval c1) (ceval c2)
| CIf b c1 c2 ⇒ if_sem b (ceval c1) (ceval c2)
| CWhile b c ⇒ loop_sem b (ceval c)
end.
Notation "'The_pair_(' st1 , st2 ')_is_in_[[' c ]]" :=
(ceval c%imp st1 st2) (at level 45, no associativity, c at level 0).
(b: bexp)
(then_branch else_branch: state -> state -> Prop)
: state -> state -> Prop
:=
BinRel.union
(BinRel.concat (BinRel.test_rel (beval b)) then_branch)
(BinRel.concat (BinRel.test_rel (beval (BNot b))) else_branch).
Fixpoint ceval (c: com): state -> state -> Prop :=
match c with
| CSkip ⇒ BinRel.id
| CAss X E ⇒
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y
| CSeq c1 c2 ⇒ BinRel.concat (ceval c1) (ceval c2)
| CIf b c1 c2 ⇒ if_sem b (ceval c1) (ceval c2)
| CWhile b c ⇒ loop_sem b (ceval c)
end.
Notation "'The_pair_(' st1 , st2 ')_is_in_[[' c ]]" :=
(ceval c%imp st1 st2) (at level 45, no associativity, c at level 0).
The following five lemmas are only presented for Coq proofs' convenience.
Lemma ceval_CSkip: ceval CSkip = BinRel.id.
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CAss: ∀X E,
ceval (CAss X E) =
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y.
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CSeq: ∀c1 c2,
ceval (c1 ;; c2) = BinRel.concat (ceval c1) (ceval c2).
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CIf: ∀b c1 c2,
ceval (CIf b c1 c2) = if_sem b (ceval c1) (ceval c2).
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CWhile: ∀b c,
ceval (While b Do c EndWhile) = loop_sem b (ceval c).
Proof. intros. simpl. reflexivity. Qed.
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CAss: ∀X E,
ceval (CAss X E) =
fun st1 st2 ⇒
st2 X = aeval E st1 ∧
∀Y, X ≠ Y -> st1 Y = st2 Y.
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CSeq: ∀c1 c2,
ceval (c1 ;; c2) = BinRel.concat (ceval c1) (ceval c2).
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CIf: ∀b c1 c2,
ceval (CIf b c1 c2) = if_sem b (ceval c1) (ceval c2).
Proof. intros. simpl. reflexivity. Qed.
Lemma ceval_CWhile: ∀b c,
ceval (While b Do c EndWhile) = loop_sem b (ceval c).
Proof. intros. simpl. reflexivity. Qed.
Application Of Denotational Semantics
While true Do X ::= X + 1 EndWhile
Module Example1.
Module DenotationalSemanticsApproach.
Import Abstract_Pretty_Printing.
Arguments ceval: simpl never.
Fact not_terminating: ∀(X: var) (st: state), ¬∃st',
The_pair_( st , st' )_is_in_[[ While true Do X ::= X + 1 EndWhile ]].
Proof.
intros.
pose proof
classic
(∃st',
The_pair_( st , st' )_is_in_[[ While true Do X ::= X + 1 EndWhile ]]).
destruct H; [| exact H].
destruct H as [st' ?].
assert (False); [| contradiction].
rewrite ceval_CWhile in H.
unfold loop_sem in H.
unfold BinRel.omega_union in H.
destruct H as [n H].
revert st st' H; induction n; intros.
+ simpl in H.
unfold BinRel.test_rel, Sets.complement, Sets.full in H.
tauto.
+ simpl in H.
unfold BinRel.concat at 1 in H.
destruct H as [st0 [_ ?]].
unfold concat in H.
destruct H as [st1 [_ ?]].
apply IHn in H.
tauto.
Qed.
End DenotationalSemanticsApproach.
Module HoareLogicApproach.
Import Assertion_S_Tac.
Import Concrete_Pretty_Printing.
Import Axiomatic_semantics.
Import Derived_Rules.
Local Instance X: var := new_var().
Fact not_terminating: {{ True }} While true Do X ::= X + 1 EndWhile {{ False }} .
End HoareLogicApproach.
End Example1.
Module DenotationalSemanticsApproach.
Import Abstract_Pretty_Printing.
Arguments ceval: simpl never.
Fact not_terminating: ∀(X: var) (st: state), ¬∃st',
The_pair_( st , st' )_is_in_[[ While true Do X ::= X + 1 EndWhile ]].
Proof.
intros.
pose proof
classic
(∃st',
The_pair_( st , st' )_is_in_[[ While true Do X ::= X + 1 EndWhile ]]).
destruct H; [| exact H].
destruct H as [st' ?].
assert (False); [| contradiction].
rewrite ceval_CWhile in H.
unfold loop_sem in H.
unfold BinRel.omega_union in H.
destruct H as [n H].
revert st st' H; induction n; intros.
+ simpl in H.
unfold BinRel.test_rel, Sets.complement, Sets.full in H.
tauto.
+ simpl in H.
unfold BinRel.concat at 1 in H.
destruct H as [st0 [_ ?]].
unfold concat in H.
destruct H as [st1 [_ ?]].
apply IHn in H.
tauto.
Qed.
End DenotationalSemanticsApproach.
Module HoareLogicApproach.
Import Assertion_S_Tac.
Import Concrete_Pretty_Printing.
Import Axiomatic_semantics.
Import Derived_Rules.
Local Instance X: var := new_var().
Fact not_terminating: {{ True }} While true Do X ::= X + 1 EndWhile {{ False }} .
Proof.
eapply hoare_consequence_post.
+ apply hoare_while.
apply hoare_asgn_conseq.
assert_subst.
assert_simpl.
entailer.
intros.
exact I.
+ entailer.
tauto.
Qed.
eapply hoare_consequence_post.
+ apply hoare_while.
apply hoare_asgn_conseq.
assert_subst.
assert_simpl.
entailer.
intros.
exact I.
+ entailer.
tauto.
Qed.
End HoareLogicApproach.
End Example1.
Will this program terminate?
Yes.
This time, the only formal description we can use is via denotational
semantics and we can prove it the following statement in Coq.
You can read its Coq proof after class.
This time, we need to do constructive reasoning, i.e. construct an ending
state from the beginning state.
X ::= 2;;
While 0 ≤ X Do X ::= X - 1 EndWhile
While 0 ≤ X Do X ::= X - 1 EndWhile
Fact terminating: ∀(X: var) st, ∃st',
The_pair_( st , st' )_is_in_[[ X ::= 2;;
While 1 ≤ X Do X ::= X - 1 EndWhile ]].
The_pair_( st , st' )_is_in_[[ X ::= 2;;
While 1 ≤ X Do X ::= X - 1 EndWhile ]].
Additional Readings
Definition state_update (st: state) (X: var) (v: Z): state :=
fun Y ⇒ if (Nat.eq_dec X Y) then v else st Y.
fun Y ⇒ if (Nat.eq_dec X Y) then v else st Y.
Here, we define a program state, i.e. a new function from program variables
to integers. This program state is almost the same as st but only differs
with st on X's value. X's new value will be v.
The Coq expression if (Nat.eq_dec X Y) then _ else _ says, if X and Y are
the same variable, do the calculation described by then; otherwise do the
calculation defined by else. In proofs, we can write destruct (Nat.eq_dec X Y)
to do case analysis on whether X and Y are the same variable.
It is worth one more sentence emphasizing that Nat.eq_dec X Y is not to tell
whether their values are the same; it tells whether they are the same variable.
You might be curious why Nat appears here. Here is some explanation.
You do not need understand all of this. You can freely skip it if you want.
If you take a look at how "variables" are formalized in Imp, you would find
that they are just names! And different variables are just represented by
different natural numbers, i.e. 1st variable, 2nd variable, etc. That is why to
determine whether two variable names are the same is to determine whether two
natural numbers are the same.
Lemma state_update_same: ∀st X v,
(state_update st X v) X = v.
Proof.
intros.
unfold state_update.
destruct (Nat.eq_dec X X).
+ reflexivity.
+ assert (X = X). { reflexivity. }
contradiction.
Qed.
Lemma state_update_diff: ∀st X v,
(∀Y, X ≠ Y -> st Y = (state_update st X v) Y).
Proof.
intros.
unfold state_update.
destruct (Nat.eq_dec X Y).
- tauto.
- reflexivity.
Qed.
Lemma state_update_spec: ∀st X v,
(state_update st X v) X = v ∧
(∀Y, X ≠ Y -> st Y = (state_update st X v) Y).
Proof.
intros.
split; [apply state_update_same | apply state_update_diff].
Qed.
Module Example2.
Import Abstract_Pretty_Printing.
Arguments ceval: simpl never.
Fact terminating: ∀(X: var) st, ∃st',
The_pair_( st , st' )_is_in_[[ X ::= 2;;
While 1 ≤ X Do X ::= X - 1 EndWhile ]].
End Example2.
(state_update st X v) X = v.
Proof.
intros.
unfold state_update.
destruct (Nat.eq_dec X X).
+ reflexivity.
+ assert (X = X). { reflexivity. }
contradiction.
Qed.
Lemma state_update_diff: ∀st X v,
(∀Y, X ≠ Y -> st Y = (state_update st X v) Y).
Proof.
intros.
unfold state_update.
destruct (Nat.eq_dec X Y).
- tauto.
- reflexivity.
Qed.
Lemma state_update_spec: ∀st X v,
(state_update st X v) X = v ∧
(∀Y, X ≠ Y -> st Y = (state_update st X v) Y).
Proof.
intros.
split; [apply state_update_same | apply state_update_diff].
Qed.
Module Example2.
Import Abstract_Pretty_Printing.
Arguments ceval: simpl never.
Fact terminating: ∀(X: var) st, ∃st',
The_pair_( st , st' )_is_in_[[ X ::= 2;;
While 1 ≤ X Do X ::= X - 1 EndWhile ]].
Proof.
intros.
∃(state_update st X 0).
rewrite ceval_CSeq.
unfold concat.
∃(state_update st X 2).
split.
+ rewrite ceval_CAss.
apply state_update_spec.
+ rewrite ceval_CWhile.
unfold loop_sem, BinRel.omega_union.
∃2%nat.
simpl.
unfold BinRel.concat at 1.
∃(state_update st X 2).
split.
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
unfold BinRel.concat at 1.
∃(state_update st X 1).
split.
{
rewrite ceval_CAss.
split.
+ rewrite state_update_same.
simpl.
unfold Func.sub, query_var, constant_func.
rewrite state_update_same.
lia.
+ intros.
rewrite <- ! state_update_diff by exact H.
reflexivity.
}
unfold BinRel.concat at 1.
∃(state_update st X 1).
split.
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
unfold BinRel.concat at 1.
∃(state_update st X 0).
split.
{
rewrite ceval_CAss.
split.
+ rewrite state_update_same.
simpl.
unfold Func.sub, query_var, constant_func.
rewrite state_update_same.
lia.
+ intros.
rewrite <- ! state_update_diff by exact H.
reflexivity.
}
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Sets.complement, Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
Qed.
intros.
∃(state_update st X 0).
rewrite ceval_CSeq.
unfold concat.
∃(state_update st X 2).
split.
+ rewrite ceval_CAss.
apply state_update_spec.
+ rewrite ceval_CWhile.
unfold loop_sem, BinRel.omega_union.
∃2%nat.
simpl.
unfold BinRel.concat at 1.
∃(state_update st X 2).
split.
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
unfold BinRel.concat at 1.
∃(state_update st X 1).
split.
{
rewrite ceval_CAss.
split.
+ rewrite state_update_same.
simpl.
unfold Func.sub, query_var, constant_func.
rewrite state_update_same.
lia.
+ intros.
rewrite <- ! state_update_diff by exact H.
reflexivity.
}
unfold BinRel.concat at 1.
∃(state_update st X 1).
split.
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
unfold BinRel.concat at 1.
∃(state_update st X 0).
split.
{
rewrite ceval_CAss.
split.
+ rewrite state_update_same.
simpl.
unfold Func.sub, query_var, constant_func.
rewrite state_update_same.
lia.
+ intros.
rewrite <- ! state_update_diff by exact H.
reflexivity.
}
{
unfold BinRel.test_rel.
split; [reflexivity |].
unfold Sets.complement, Func.test_le, constant_func, query_var.
rewrite state_update_same.
lia.
}
Qed.
End Example2.
Semantic Equivalence
An Equivalence Between Integer Expressions
- Two expressions a1 and a2 are equivalent if evaluating them on st has the same result for every program state st.
- Two expressions a1 and a2 are equivalent if their denotations are equivalent functions.
Definition aexp_equiv (a1 a2: aexp): Prop :=
Func.equiv (aeval a1) (aeval a2).
Func.equiv (aeval a1) (aeval a2).
It is a equivalence relation.
Lemma aexp_equiv_refl: Reflexive aexp_equiv.
Lemma aexp_equiv_sym: Symmetric aexp_equiv.
Lemma aexp_equiv_trans: Transitive aexp_equiv.
Proof.
unfold Reflexive, aexp_equiv.
intros.
reflexivity.
Qed.
unfold Reflexive, aexp_equiv.
intros.
reflexivity.
Qed.
Lemma aexp_equiv_sym: Symmetric aexp_equiv.
Proof.
unfold Symmetric, aexp_equiv.
intros.
rewrite H.
reflexivity.
Qed.
unfold Symmetric, aexp_equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma aexp_equiv_trans: Transitive aexp_equiv.
Proof.
unfold Transitive, aexp_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
unfold Transitive, aexp_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Moreover, it is a congruence (同余关系). That is, the equivalence of two
subexpressions implies the equivalence of the larger expressions in which
they are embedded.
The main idea is that the congruence property allows us to replace a small
part of a large expression with an equivalent small part and know that the
whole large expressions are equivalent without doing an explicit proof
about the non-varying parts — i.e., the "proof burden" of a small change
to a large expression is proportional to the size of the change, not the
expression.
Lemma APlus_congr:
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) APlus.
Lemma AMinus_congr:
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) AMinus.
Lemma AMult_congr:
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) AMult.
Existing Instances aexp_equiv_refl
aexp_equiv_sym
aexp_equiv_trans
APlus_congr
AMinus_congr
AMult_congr.
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) APlus.
Proof.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
Lemma AMinus_congr:
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) AMinus.
Proof.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
Lemma AMult_congr:
Proper (aexp_equiv ==> aexp_equiv ==> aexp_equiv) AMult.
Proof.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv.
intros a1 a1' ? a2 a2' ?.
simpl.
rewrite H, H0.
reflexivity.
Qed.
Existing Instances aexp_equiv_refl
aexp_equiv_sym
aexp_equiv_trans
APlus_congr
AMinus_congr
AMult_congr.
An Equivalence Between Boolean Expressions
Definition bexp_equiv (b1 b2: bexp): Prop :=
Sets.equiv (beval b1) (beval b2).
Sets.equiv (beval b1) (beval b2).
We need the following auxiliary lemmas.
Lemma Sets_equiv_refl: ∀A, Reflexive (@Sets.equiv A).
Proof.
unfold Reflexive, Sets.equiv.
intros.
reflexivity.
Qed.
Lemma Sets_equiv_sym: ∀A, Symmetric (@Sets.equiv A).
Proof.
unfold Symmetric, Sets.equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma Sets_equiv_trans: ∀A, Transitive (@Sets.equiv A).
Proof.
unfold Transitive, Sets.equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Func_test_eq_equiv: ∀A,
Proper (@Func.equiv A ==> @Func.equiv A ==> @Sets.equiv A) Func.test_eq.
Proof.
unfold Proper, respectful.
unfold Func.equiv, Sets.equiv, Func.test_eq.
intros A f1 f2 ? g1 g2 ?.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Func_test_le_equiv: ∀A,
Proper (@Func.equiv A ==> @Func.equiv A ==> @Sets.equiv A) Func.test_le.
Proof.
unfold Proper, respectful.
unfold Func.equiv, Sets.equiv, Func.test_le.
intros A f1 f2 ? g1 g2 ?.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Sets_intersect_equiv: ∀A,
Proper (@Sets.equiv A ==> @Sets.equiv A ==> @Sets.equiv A) Sets.intersect.
Proof.
unfold Proper, respectful.
unfold Sets.equiv, Sets.intersect.
intros A S1 S2 ? T1 T2 ?.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Sets_complement_equiv: ∀A,
Proper (@Sets.equiv A ==> @Sets.equiv A) Sets.complement.
Proof.
unfold Proper, respectful.
unfold Sets.equiv, Sets.complement.
intros A S1 S2 ?.
intros.
rewrite H.
reflexivity.
Qed.
Lemma Sets_complement_complement: ∀A (S: A -> Prop),
Sets.equiv (Sets.complement (Sets.complement S)) S.
Proof.
intros.
unfold Sets.equiv, Sets.complement.
intros.
tauto.
Qed.
Existing Instances Sets_equiv_refl
Sets_equiv_sym
Sets_equiv_trans
Func_test_eq_equiv
Func_test_le_equiv
Sets_intersect_equiv
Sets_complement_equiv.
Similar to integer expressions' equivalence, boolean expressions'
equivalence is also an equivalence relation and a congruence relation.
Lemma bexp_equiv_refl: Reflexive bexp_equiv.
Lemma bexp_equiv_sym: Symmetric bexp_equiv.
Lemma bexp_equiv_trans: Transitive bexp_equiv.
Lemma BEq_congr:
Proper (aexp_equiv ==> aexp_equiv ==> bexp_equiv) BEq.
Lemma BLe_congr:
Proper (aexp_equiv ==> aexp_equiv ==> bexp_equiv) BLe.
Lemma BAnd_congr:
Proper (bexp_equiv ==> bexp_equiv ==> bexp_equiv) BAnd.
Lemma BNot_congr: Proper (bexp_equiv ==> bexp_equiv) BNot.
Existing Instances bexp_equiv_refl
bexp_equiv_sym
bexp_equiv_trans
BEq_congr
BLe_congr
BAnd_congr
BNot_congr.
Proof.
unfold Reflexive, bexp_equiv.
intros.
reflexivity.
Qed.
unfold Reflexive, bexp_equiv.
intros.
reflexivity.
Qed.
Lemma bexp_equiv_sym: Symmetric bexp_equiv.
Proof.
unfold Symmetric, bexp_equiv.
intros.
rewrite H.
reflexivity.
Qed.
unfold Symmetric, bexp_equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma bexp_equiv_trans: Transitive bexp_equiv.
Proof.
unfold Transitive, bexp_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
unfold Transitive, bexp_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma BEq_congr:
Proper (aexp_equiv ==> aexp_equiv ==> bexp_equiv) BEq.
Proof.
unfold Proper, respectful.
unfold aexp_equiv, bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv, bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
Lemma BLe_congr:
Proper (aexp_equiv ==> aexp_equiv ==> bexp_equiv) BLe.
Proof.
unfold Proper, respectful.
unfold aexp_equiv, bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv, bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
Lemma BAnd_congr:
Proper (bexp_equiv ==> bexp_equiv ==> bexp_equiv) BAnd.
Proof.
unfold Proper, respectful.
unfold bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold bexp_equiv.
intros; simpl.
rewrite H, H0.
reflexivity.
Qed.
Lemma BNot_congr: Proper (bexp_equiv ==> bexp_equiv) BNot.
Proof.
unfold Proper, respectful.
unfold bexp_equiv.
intros; simpl.
rewrite H.
reflexivity.
Qed.
unfold Proper, respectful.
unfold bexp_equiv.
intros; simpl.
rewrite H.
reflexivity.
Qed.
Existing Instances bexp_equiv_refl
bexp_equiv_sym
bexp_equiv_trans
BEq_congr
BLe_congr
BAnd_congr
BNot_congr.
An Equivalence Between Programs
Module BinRel.
Definition equiv {A B: Type} (r1 r2: A -> B -> Prop): Prop :=
∀a b, r1 a b ↔ r2 a b.
Definition le {A B: Type} (r1 r2: A -> B -> Prop): Prop :=
∀a b, r1 a b -> r2 a b.
End BinRel.
Definition equiv {A B: Type} (r1 r2: A -> B -> Prop): Prop :=
∀a b, r1 a b ↔ r2 a b.
Definition le {A B: Type} (r1 r2: A -> B -> Prop): Prop :=
∀a b, r1 a b -> r2 a b.
End BinRel.
Here is its properties.
Lemma Rel_equiv_refl: ∀A B, Reflexive (@BinRel.equiv A B).
Lemma Rel_equiv_sym: ∀A B, Symmetric (@BinRel.equiv A B).
Lemma Rel_equiv_trans: ∀A B, Transitive (@BinRel.equiv A B).
Lemma Rel_equiv_test_rel: ∀A,
Proper (@Sets.equiv A ==> @BinRel.equiv A A) BinRel.test_rel.
Lemma Rel_equiv_concat: ∀A,
Proper (@BinRel.equiv A A ==> @BinRel.equiv A A ==> @BinRel.equiv A A)
BinRel.concat.
Lemma Rel_equiv_union: ∀A,
Proper (@BinRel.equiv A A ==> @BinRel.equiv A A ==> @BinRel.equiv A A)
BinRel.union.
Lemma Rel_equiv_omega_union: ∀A B (r1 r2: nat -> A -> B -> Prop),
(∀n, BinRel.equiv (r1 n) (r2 n)) ->
BinRel.equiv (BinRel.omega_union r1) (BinRel.omega_union r2).
Lemma Rel_equiv_Rel_le: ∀A B (r1 r2: A -> B -> Prop),
BinRel.equiv r1 r2 ↔ BinRel.le r1 r2 ∧ BinRel.le r2 r1.
Lemma union_comm: ∀A B (r1 r2: A -> B -> Prop),
BinRel.equiv (BinRel.union r1 r2) (BinRel.union r2 r1).
Existing Instances Rel_equiv_refl
Rel_equiv_sym
Rel_equiv_trans
Rel_equiv_test_rel
Rel_equiv_concat
Rel_equiv_union.
Proof.
unfold Reflexive, BinRel.equiv.
intros.
reflexivity.
Qed.
unfold Reflexive, BinRel.equiv.
intros.
reflexivity.
Qed.
Lemma Rel_equiv_sym: ∀A B, Symmetric (@BinRel.equiv A B).
Proof.
unfold Symmetric, BinRel.equiv.
intros.
rewrite H.
reflexivity.
Qed.
unfold Symmetric, BinRel.equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma Rel_equiv_trans: ∀A B, Transitive (@BinRel.equiv A B).
Proof.
unfold Transitive, BinRel.equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
unfold Transitive, BinRel.equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Rel_equiv_test_rel: ∀A,
Proper (@Sets.equiv A ==> @BinRel.equiv A A) BinRel.test_rel.
Proof.
unfold Proper, respectful.
unfold Sets.equiv, BinRel.equiv, BinRel.test_rel.
intros A X Y ?.
intros.
rewrite H.
reflexivity.
Qed.
unfold Proper, respectful.
unfold Sets.equiv, BinRel.equiv, BinRel.test_rel.
intros A X Y ?.
intros.
rewrite H.
reflexivity.
Qed.
Lemma Rel_equiv_concat: ∀A,
Proper (@BinRel.equiv A A ==> @BinRel.equiv A A ==> @BinRel.equiv A A)
BinRel.concat.
Proof.
unfold Proper, respectful.
unfold BinRel.equiv, BinRel.concat.
intros A X1 X2 ? Y1 Y2 ?.
intros a c.
unfold iff.
split.
+ intros [b [? ?]].
∃b.
rewrite <- H, <- H0.
tauto.
+ intros [b [? ?]].
∃b.
rewrite H, H0.
tauto.
Qed.
unfold Proper, respectful.
unfold BinRel.equiv, BinRel.concat.
intros A X1 X2 ? Y1 Y2 ?.
intros a c.
unfold iff.
split.
+ intros [b [? ?]].
∃b.
rewrite <- H, <- H0.
tauto.
+ intros [b [? ?]].
∃b.
rewrite H, H0.
tauto.
Qed.
Lemma Rel_equiv_union: ∀A,
Proper (@BinRel.equiv A A ==> @BinRel.equiv A A ==> @BinRel.equiv A A)
BinRel.union.
Proof.
unfold Proper, respectful.
unfold BinRel.equiv, BinRel.union.
intros A X1 X2 ? Y1 Y2 ?.
intros.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold BinRel.equiv, BinRel.union.
intros A X1 X2 ? Y1 Y2 ?.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma Rel_equiv_omega_union: ∀A B (r1 r2: nat -> A -> B -> Prop),
(∀n, BinRel.equiv (r1 n) (r2 n)) ->
BinRel.equiv (BinRel.omega_union r1) (BinRel.omega_union r2).
Proof.
unfold BinRel.equiv, BinRel.omega_union.
intros.
unfold iff; split; intros HH;
destruct HH as [n ?]; ∃n.
+ rewrite <- H.
exact H0.
+ rewrite H.
exact H0.
Qed.
unfold BinRel.equiv, BinRel.omega_union.
intros.
unfold iff; split; intros HH;
destruct HH as [n ?]; ∃n.
+ rewrite <- H.
exact H0.
+ rewrite H.
exact H0.
Qed.
Lemma Rel_equiv_Rel_le: ∀A B (r1 r2: A -> B -> Prop),
BinRel.equiv r1 r2 ↔ BinRel.le r1 r2 ∧ BinRel.le r2 r1.
Proof.
unfold BinRel.equiv, BinRel.le.
intros.
unfold iff at 1.
split; intros.
+ split; intros ? ?; rewrite H; tauto.
+ destruct H.
unfold iff; split.
- apply H.
- apply H0.
Qed.
unfold BinRel.equiv, BinRel.le.
intros.
unfold iff at 1.
split; intros.
+ split; intros ? ?; rewrite H; tauto.
+ destruct H.
unfold iff; split.
- apply H.
- apply H0.
Qed.
Lemma union_comm: ∀A B (r1 r2: A -> B -> Prop),
BinRel.equiv (BinRel.union r1 r2) (BinRel.union r2 r1).
Proof.
intros.
unfold BinRel.equiv, BinRel.union.
intros.
tauto.
Qed.
intros.
unfold BinRel.equiv, BinRel.union.
intros.
tauto.
Qed.
Existing Instances Rel_equiv_refl
Rel_equiv_sym
Rel_equiv_trans
Rel_equiv_test_rel
Rel_equiv_concat
Rel_equiv_union.
Then we define program equivalence and prove its properties.
Definition com_equiv (c1 c2: com): Prop :=
BinRel.equiv (ceval c1) (ceval c2).
BinRel.equiv (ceval c1) (ceval c2).
This just says, two programs c1 and c2 are equivalent when c1 turns
st1 to st2 if and only if c2 also turns st1 to st2, for any st1
and st2. This relation is also an equivalence and congruence.
Lemma com_equiv_refl: Reflexive com_equiv.
Proof.
unfold Reflexive, com_equiv.
intros.
reflexivity.
Qed.
Lemma com_equiv_sym: Symmetric com_equiv.
Proof.
unfold Symmetric, com_equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma com_equiv_trans: Transitive com_equiv.
Proof.
unfold Transitive, com_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma CAss_congr: ∀(X: var),
Proper (aexp_equiv ==> com_equiv) (CAss X).
Lemma CSeq_congr: Proper (com_equiv ==> com_equiv ==> com_equiv) CSeq.
Lemma CIf_congr:
Proper (bexp_equiv ==> com_equiv ==> com_equiv ==> com_equiv) CIf.
Lemma CWhile_congr:
Proper (bexp_equiv ==> com_equiv ==> com_equiv) CWhile.
Proof.
unfold Reflexive, com_equiv.
intros.
reflexivity.
Qed.
Lemma com_equiv_sym: Symmetric com_equiv.
Proof.
unfold Symmetric, com_equiv.
intros.
rewrite H.
reflexivity.
Qed.
Lemma com_equiv_trans: Transitive com_equiv.
Proof.
unfold Transitive, com_equiv.
intros.
rewrite H, H0.
reflexivity.
Qed.
Lemma CAss_congr: ∀(X: var),
Proper (aexp_equiv ==> com_equiv) (CAss X).
Proof.
unfold Proper, respectful.
unfold aexp_equiv, com_equiv, BinRel.equiv.
intros X E E' ?.
intros st1 st2.
rewrite ! ceval_CAss.
unfold Func.equiv in H.
specialize (H st1).
rewrite H.
reflexivity.
Qed.
unfold Proper, respectful.
unfold aexp_equiv, com_equiv, BinRel.equiv.
intros X E E' ?.
intros st1 st2.
rewrite ! ceval_CAss.
unfold Func.equiv in H.
specialize (H st1).
rewrite H.
reflexivity.
Qed.
Lemma CSeq_congr: Proper (com_equiv ==> com_equiv ==> com_equiv) CSeq.
Proof.
unfold Proper, respectful.
unfold com_equiv.
intros c1 c1' ? c2 c2' ?.
rewrite ! ceval_CSeq.
rewrite H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold com_equiv.
intros c1 c1' ? c2 c2' ?.
rewrite ! ceval_CSeq.
rewrite H, H0.
reflexivity.
Qed.
Lemma CIf_congr:
Proper (bexp_equiv ==> com_equiv ==> com_equiv ==> com_equiv) CIf.
Proof.
unfold Proper, respectful.
unfold bexp_equiv, com_equiv.
intros b b' ? c1 c1' ? c2 c2' ?.
rewrite ! ceval_CIf.
unfold if_sem.
simpl.
rewrite H, H0, H1.
reflexivity.
Qed.
unfold Proper, respectful.
unfold bexp_equiv, com_equiv.
intros b b' ? c1 c1' ? c2 c2' ?.
rewrite ! ceval_CIf.
unfold if_sem.
simpl.
rewrite H, H0, H1.
reflexivity.
Qed.
Lemma CWhile_congr:
Proper (bexp_equiv ==> com_equiv ==> com_equiv) CWhile.
Proof.
unfold Proper, respectful.
unfold bexp_equiv, com_equiv.
intros b b' ? c c' ?.
rewrite ! ceval_CWhile.
unfold loop_sem.
apply Rel_equiv_omega_union.
intros.
induction n; simpl.
+ rewrite H.
reflexivity.
+ rewrite IHn, H, H0.
reflexivity.
Qed.
unfold Proper, respectful.
unfold bexp_equiv, com_equiv.
intros b b' ? c c' ?.
rewrite ! ceval_CWhile.
unfold loop_sem.
apply Rel_equiv_omega_union.
intros.
induction n; simpl.
+ rewrite H.
reflexivity.
+ rewrite IHn, H, H0.
reflexivity.
Qed.
Program equivalence is the theoretical foundation of compiler optimization.
Let's take a look at some typical examples.
For examples of general equivalence schema, let's start by looking at some
trivial program transformations involving Skip:
Theorem skip_left : ∀c,
com_equiv
(Skip;; c)
c.
Proof.
intros.
unfold com_equiv, BinRel.equiv.
intros st1 st2.
rewrite ceval_CSeq, ceval_CSkip.
split; intros.
+ unfold concat, id in H.
destruct H as [st' [? ?]].
rewrite H.
exact H0.
+ unfold concat, id.
∃st1.
split.
- reflexivity.
- exact H.
Qed.
com_equiv
(Skip;; c)
c.
Proof.
intros.
unfold com_equiv, BinRel.equiv.
intros st1 st2.
rewrite ceval_CSeq, ceval_CSkip.
split; intros.
+ unfold concat, id in H.
destruct H as [st' [? ?]].
rewrite H.
exact H0.
+ unfold concat, id.
∃st1.
split.
- reflexivity.
- exact H.
Qed.
Also, we can prove that adding a Skip after a command results in an
equivalent program.
Theorem skip_right : ∀c,
com_equiv
(c ;; Skip)
c.
Proof.
(* WORKED IN CLASS *)
intros.
unfold com_equiv, BinRel.equiv.
intros st1 st2.
rewrite ceval_CSeq, ceval_CSkip.
split; intros.
+ simpl in H.
unfold concat, id in H.
destruct H as [st' [? ?]].
rewrite <- H0.
exact H.
+ simpl.
unfold concat, id.
∃st2.
split.
- exact H.
- reflexivity.
Qed.
com_equiv
(c ;; Skip)
c.
Proof.
(* WORKED IN CLASS *)
intros.
unfold com_equiv, BinRel.equiv.
intros st1 st2.
rewrite ceval_CSeq, ceval_CSkip.
split; intros.
+ simpl in H.
unfold concat, id in H.
destruct H as [st' [? ?]].
rewrite <- H0.
exact H.
+ simpl.
unfold concat, id.
∃st2.
split.
- exact H.
- reflexivity.
Qed.
Now we show that we can swap the branches of an IF if we also negate its
guard.
Theorem swap_if_branches : ∀b e1 e2,
com_equiv
(If b Then e1 Else e2 EndIf)
(If (BNot b) Then e2 Else e1 EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ! ceval_CIf.
unfold if_sem; simpl.
rewrite union_comm.
rewrite Sets_complement_complement.
reflexivity.
Qed.
com_equiv
(If b Then e1 Else e2 EndIf)
(If (BNot b) Then e2 Else e1 EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ! ceval_CIf.
unfold if_sem; simpl.
rewrite union_comm.
rewrite Sets_complement_complement.
reflexivity.
Qed.
An interesting fact about While commands is that any number of copies of
the body can be "unrolled" without changing meaning. Loop unrolling is a common
transformation in real compilers.
Theorem loop_unrolling : ∀b c,
com_equiv
(While b Do c EndWhile)
(If b Then (c ;; While b Do c EndWhile) Else Skip EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ceval_CIf, ceval_CSeq, ceval_CSkip.
rewrite ceval_CWhile.
Abort.
com_equiv
(While b Do c EndWhile)
(If b Then (c ;; While b Do c EndWhile) Else Skip EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ceval_CIf, ceval_CSeq, ceval_CSkip.
rewrite ceval_CWhile.
Abort.
This is not easy to prove. Let's isolate it.
Lemma loop_sem_unrolling: ∀b (R: state -> state -> Prop),
BinRel.equiv
(loop_sem b R)
(if_sem b (BinRel.concat R (loop_sem b R)) BinRel.id).
Proof.
intros.
unfold BinRel.equiv; intros st1 st2.
unfold iff; split; intros.
+ unfold loop_sem, BinRel.omega_union in H.
destruct H as [n ?].
destruct n.
- simpl in H.
unfold if_sem, BinRel.union.
right; simpl.
unfold concat, id.
∃st2; split; [exact H | reflexivity].
- simpl in H.
unfold if_sem, BinRel.union.
left.
unfold loop_sem, BinRel.omega_union.
destruct H.
2: {
∃0%nat.
unfold BinRel.concat at 1 in H.
destruct H as [st1' [? ?]].
unfold BinRel.concat in H0.
destruct H0 as [st0 [? ?]].
unfold loop_sem, BinRel.omega_union in H1.
destruct H1 as [n ?].
∃(S n).
simpl.
unfold BinRel.concat at 1.
∃st1'; split; [exact H |].
unfold BinRel.concat.
∃st0; split; [exact H0 | exact H1].
Qed.
Theorem loop_unrolling : ∀b c,
com_equiv
(While b Do c EndWhile)
(If b Then (c ;; While b Do c EndWhile) Else Skip EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ceval_CIf, ceval_CSeq, ceval_CSkip.
rewrite ceval_CWhile.
apply loop_sem_unrolling.
Qed.
BinRel.equiv
(loop_sem b R)
(if_sem b (BinRel.concat R (loop_sem b R)) BinRel.id).
Proof.
intros.
unfold BinRel.equiv; intros st1 st2.
unfold iff; split; intros.
+ unfold loop_sem, BinRel.omega_union in H.
destruct H as [n ?].
destruct n.
- simpl in H.
unfold if_sem, BinRel.union.
right; simpl.
unfold concat, id.
∃st2; split; [exact H | reflexivity].
- simpl in H.
unfold if_sem, BinRel.union.
left.
unfold concat in H.
unfold concat.
destruct H as [st1' [? [st1'' [? ?]]]].
∃st1'; split; [exact H |].
∃st1''; split; [exact H0 |].
unfold loop_sem, BinRel.omega_union.
∃n.
exact H1.
+ unfold if_sem, BinRel.union in H.unfold concat.
destruct H as [st1' [? [st1'' [? ?]]]].
∃st1'; split; [exact H |].
∃st1''; split; [exact H0 |].
unfold loop_sem, BinRel.omega_union.
∃n.
exact H1.
unfold loop_sem, BinRel.omega_union.
destruct H.
2: {
∃0%nat.
simpl.
unfold BinRel.concat, BinRel.id in H.
destruct H as [st2' [? ?]].
rewrite H0 in H; exact H.
}unfold BinRel.concat, BinRel.id in H.
destruct H as [st2' [? ?]].
rewrite H0 in H; exact H.
unfold BinRel.concat at 1 in H.
destruct H as [st1' [? ?]].
unfold BinRel.concat in H0.
destruct H0 as [st0 [? ?]].
unfold loop_sem, BinRel.omega_union in H1.
destruct H1 as [n ?].
∃(S n).
simpl.
unfold BinRel.concat at 1.
∃st1'; split; [exact H |].
unfold BinRel.concat.
∃st0; split; [exact H0 | exact H1].
Qed.
Theorem loop_unrolling : ∀b c,
com_equiv
(While b Do c EndWhile)
(If b Then (c ;; While b Do c EndWhile) Else Skip EndIf).
Proof.
intros.
unfold com_equiv.
rewrite ceval_CIf, ceval_CSeq, ceval_CSkip.
rewrite ceval_CWhile.
apply loop_sem_unrolling.
Qed.
Bourbaki-Witt Theorem
- X = (if_sem b (concat R X) id) .
Partial Order
∀x: A, x ≤ x;
∀x y z: A, x ≤ y -> y ≤ z -> x ≤ z;
∀x y: A, x ≤ y -> y ≤ x -> x = y.
∀x y z: A, x ≤ y -> y ≤ z -> x ≤ z;
∀x y: A, x ≤ y -> y ≤ x -> x = y.
∀x: A, bot ≤ x
Chain
∀n: nat, xs n ≤ xs (n + 1),
then it forms a chain.
Monotonic and Continuous Functions
∀x y: A, x ≤A= y -> F(x) ≤B= F(y).
∀xs: chain(A), lub(F(xs)) = F(lub(xs))
Here, the lub function on the left hand side means the least upper bound
defined by B and the one on the right hand side is defined by A.
Least fixpoint
bot, F(bot), F(F(bot)), F(F(F(bot))), ...
Obviously, bot ≤ F(bot) is true due to the definition of bot. If F is
monotonic, it is immediately followed by F(bot) ≤ F(F(bot)). Similarly,
F(F(bot)) ≤ F(F(F(bot))), F(F(F(bot))) ≤ F(F(F(F(bot)))) ...
In other words, if F is monotonic, this sequence is a chain.
lub [bot, F(bot), F(F(bot)), F(F(F(bot))), ...].
F (lub [bot, F(bot), F(F(bot)), F(F(F(bot))), ...]) =
lub [F(bot), F(F(bot)), F(F(F(bot))), F(F(F(F(bot)))), ...] =
lub [bot, F(bot), F(F(bot)), F(F(F(bot))), ...].
The first equality is true because F is continuous. The second equality is
true because bot is less than or equal to all other elements in the sequence.
lub [F(bot), F(F(bot)), F(F(F(bot))), F(F(F(F(bot)))), ...] =
lub [bot, F(bot), F(F(bot)), F(F(F(bot))), ...].
bot ≤ x
Thus,
F(bot) ≤ F(x) = x
due to the fact that F is monotonic and x is a fixpoint. And so on,
F(F(bot)) ≤ x, F(F(F(bot))) ≤ x, F(F(F(F(bot)))) ≤ x, ...
That means, x is an upper bound of bot, F(bot), F(F(bot)), .... It must be
greater than or equal to
lub [bot, F(bot), F(F(bot)), F(F(F(bot))), ...].
Denotation of Loops as Bourbaki-Witt Fixpoint
(* 2021-03-17 12:59 *)