Lecture notes 20210322 Denotational Semantics 4
Remark. Some material in this lecture is from << Software Foundation >>
volume 1 and volume 2.
Require Import Coq.Lists.List.
Require Import Coq.micromega.Psatz.
Require Import PL.Imp.
Require Import Coq.micromega.Psatz.
Require Import PL.Imp.
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 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.
Definition loop_sem (b: bexp) (loop_body: state -> state -> Prop):
state -> state -> Prop :=
BinRel.omega_union (iter_loop_body b loop_body).
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.
Inductively Defined Denotational Semantics
Module Inductive_Denotations.
Inductive ceval : com -> state -> state -> Prop :=
| E_Skip : ∀st,
ceval CSkip st st
| E_Ass : ∀st1 st2 X E,
st2 X = aeval E st1 ->
(∀Y, X ≠ Y -> st1 Y = st2 Y) ->
ceval (CAss X E) st1 st2
| E_Seq : ∀c1 c2 st st' st'',
ceval c1 st st' ->
ceval c2 st' st'' ->
ceval (c1 ;; c2) st st''
| E_IfTrue : ∀st st' b c1 c2,
beval b st ->
ceval c1 st st' ->
ceval (If b Then c1 Else c2 EndIf) st st'
| E_IfFalse : ∀st st' b c1 c2,
¬beval b st ->
ceval c2 st st' ->
ceval (If b Then c1 Else c2 EndIf) st st'
| E_WhileFalse : ∀b st c,
¬beval b st ->
ceval (While b Do c EndWhile) st st
| E_WhileTrue : ∀st st' st'' b c,
beval b st ->
ceval c st st' ->
ceval (While b Do c EndWhile) st' st'' ->
ceval (While b Do c EndWhile) st st''.
Inductive ceval : com -> state -> state -> Prop :=
| E_Skip : ∀st,
ceval CSkip st st
| E_Ass : ∀st1 st2 X E,
st2 X = aeval E st1 ->
(∀Y, X ≠ Y -> st1 Y = st2 Y) ->
ceval (CAss X E) st1 st2
| E_Seq : ∀c1 c2 st st' st'',
ceval c1 st st' ->
ceval c2 st' st'' ->
ceval (c1 ;; c2) st st''
| E_IfTrue : ∀st st' b c1 c2,
beval b st ->
ceval c1 st st' ->
ceval (If b Then c1 Else c2 EndIf) st st'
| E_IfFalse : ∀st st' b c1 c2,
¬beval b st ->
ceval c2 st st' ->
ceval (If b Then c1 Else c2 EndIf) st st'
| E_WhileFalse : ∀b st c,
¬beval b st ->
ceval (While b Do c EndWhile) st st
| E_WhileTrue : ∀st st' st'' b c,
beval b st ->
ceval c st st' ->
ceval (While b Do c EndWhile) st' st'' ->
ceval (While b Do c EndWhile) st st''.
What does this definition mean?
It is worth noticing that this definition is very first-order, in contrast
to the higher-order fashion in two previous lectures. Computer scientists
even prefer not to call it denotational semantics but big-step semantics.
That is, ceval c st st' holds if we can take a big step (executing c)
from st and get to st'. You can find more information about it in
<< Software Foundations >> volume 1.
Although we will not use this inductively defined ceval later in this
course, but inductive definitions are widely used in programming language
theories.
- First, it defines a ternary relation. We can see this from ceval's type.
That is: com -> state -> state -> Prop. As we know, ceval c st st'
means executing c from state st may end in st'.
- Second, in only 7 situations, command-state-state triples can appear in
this ternary relation. These 7 situations are tagged by E_Skip, E_Ass,
E_Seq, etc.
- Using E_Seq as an example, it says, if (c1, st, st') is in this
ternary relation and (c2, st', st'') is in this ternary relation, then
(c1;; c2, st', st'') is also in this relation. This is rule stating who
can appear in ceval.
- Overall, this definition says every triple in ceval must have a reason, one of these 7 kinds. If it is based an assumption that another triple is in ceval, that one must have a reason as well.
End Inductive_Denotations.
Understanding Inductive Propositions
Stone game
- There are n stones initially in a pile.
- Players move in turn.
- In his/her move, a player may remove one, two or three stones from the
pile.
- Who makes the pile empty wins the game.
Module StoneGame.
Inductive kind: Type :=
| previous_player_win
| next_player_win.
Inductive state_class: Z -> kind -> Prop :=
| neg_illegal: ∀n,
n < 0 ->
state_class n next_player_win
| zero_win:
state_class 0 previous_player_win
| winner_strategy_1: ∀n,
n > 0 ->
state_class (n-1) previous_player_win ->
state_class n next_player_win
| winner_strategy_2: ∀n,
n > 0 ->
state_class (n-2) previous_player_win ->
state_class n next_player_win
| winner_strategy_3: ∀n,
n > 0 ->
state_class (n-3) previous_player_win ->
state_class n next_player_win
| loser_strategy: ∀n,
n > 0 ->
state_class (n-1) next_player_win ->
state_class (n-2) next_player_win ->
state_class (n-3) next_player_win ->
state_class n previous_player_win.
Theorem ten_wins: state_class 10 next_player_win.
Proof.
intros.
assert (H0: state_class 0 previous_player_win).
{ apply zero_win. }
assert (H1: state_class 1 next_player_win).
{ apply winner_strategy_1; [ lia | exact H0 ]. }
assert (H2: state_class 2 next_player_win).
{ apply winner_strategy_2; [ lia | exact H0 ]. }
assert (H3: state_class 3 next_player_win).
{ apply winner_strategy_3; [ lia | exact H0 ]. }
assert (H4: state_class 4 previous_player_win).
{ apply loser_strategy; [ lia | tauto ..]. }
assert (H5: state_class 5 next_player_win).
{ apply winner_strategy_1; [ lia | exact H4 ]. }
assert (H6: state_class 6 next_player_win).
{ apply winner_strategy_2; [ lia | exact H4 ]. }
assert (H7: state_class 7 next_player_win).
{ apply winner_strategy_3; [ lia | exact H4 ]. }
assert (H8: state_class 8 previous_player_win).
{ apply loser_strategy; [ lia | tauto ..]. }
assert (H9: state_class 9 next_player_win).
{ apply winner_strategy_1; [ lia | exact H8 ]. }
assert (H10: state_class 10 next_player_win).
{ apply winner_strategy_2; [ lia | exact H8 ]. }
exact H10.
Qed.
End StoneGame.
Inductive kind: Type :=
| previous_player_win
| next_player_win.
Inductive state_class: Z -> kind -> Prop :=
| neg_illegal: ∀n,
n < 0 ->
state_class n next_player_win
| zero_win:
state_class 0 previous_player_win
| winner_strategy_1: ∀n,
n > 0 ->
state_class (n-1) previous_player_win ->
state_class n next_player_win
| winner_strategy_2: ∀n,
n > 0 ->
state_class (n-2) previous_player_win ->
state_class n next_player_win
| winner_strategy_3: ∀n,
n > 0 ->
state_class (n-3) previous_player_win ->
state_class n next_player_win
| loser_strategy: ∀n,
n > 0 ->
state_class (n-1) next_player_win ->
state_class (n-2) next_player_win ->
state_class (n-3) next_player_win ->
state_class n previous_player_win.
Theorem ten_wins: state_class 10 next_player_win.
Proof.
intros.
assert (H0: state_class 0 previous_player_win).
{ apply zero_win. }
assert (H1: state_class 1 next_player_win).
{ apply winner_strategy_1; [ lia | exact H0 ]. }
assert (H2: state_class 2 next_player_win).
{ apply winner_strategy_2; [ lia | exact H0 ]. }
assert (H3: state_class 3 next_player_win).
{ apply winner_strategy_3; [ lia | exact H0 ]. }
assert (H4: state_class 4 previous_player_win).
{ apply loser_strategy; [ lia | tauto ..]. }
assert (H5: state_class 5 next_player_win).
{ apply winner_strategy_1; [ lia | exact H4 ]. }
assert (H6: state_class 6 next_player_win).
{ apply winner_strategy_2; [ lia | exact H4 ]. }
assert (H7: state_class 7 next_player_win).
{ apply winner_strategy_3; [ lia | exact H4 ]. }
assert (H8: state_class 8 previous_player_win).
{ apply loser_strategy; [ lia | tauto ..]. }
assert (H9: state_class 9 next_player_win).
{ apply winner_strategy_1; [ lia | exact H8 ]. }
assert (H10: state_class 10 next_player_win).
{ apply winner_strategy_2; [ lia | exact H8 ]. }
exact H10.
Qed.
End StoneGame.
Reflexive Transitive Closure
Inductive clos_refl_trans {A: Type} (R: A -> A -> Prop) : A -> A -> Prop :=
| rt_step : ∀x y, R x y -> clos_refl_trans R x y
| rt_refl : ∀x, clos_refl_trans R x x
| rt_trans : ∀x y z,
clos_refl_trans R x y ->
clos_refl_trans R y z ->
clos_refl_trans R x z.
Inductive clos_refl_trans_1n {A : Type} (R: A -> A -> Prop) : A -> A -> Prop :=
| rt1n_refl : ∀x, clos_refl_trans_1n R x x
| rt1n_trans_1n : ∀x y z,
R x y ->
clos_refl_trans_1n R y z ->
clos_refl_trans_1n R x z.
Inductive clos_refl_trans_n1 {A : Type} (R: A -> A -> Prop) : A -> A -> Prop :=
| rtn1_refl : ∀x, clos_refl_trans_n1 R x x
| rtn1_trans_n1 : ∀x y z : A,
R y z ->
clos_refl_trans_n1 R x y ->
clos_refl_trans_n1 R x z.
| rt_step : ∀x y, R x y -> clos_refl_trans R x y
| rt_refl : ∀x, clos_refl_trans R x x
| rt_trans : ∀x y z,
clos_refl_trans R x y ->
clos_refl_trans R y z ->
clos_refl_trans R x z.
Inductive clos_refl_trans_1n {A : Type} (R: A -> A -> Prop) : A -> A -> Prop :=
| rt1n_refl : ∀x, clos_refl_trans_1n R x x
| rt1n_trans_1n : ∀x y z,
R x y ->
clos_refl_trans_1n R y z ->
clos_refl_trans_1n R x z.
Inductive clos_refl_trans_n1 {A : Type} (R: A -> A -> Prop) : A -> A -> Prop :=
| rtn1_refl : ∀x, clos_refl_trans_n1 R x x
| rtn1_trans_n1 : ∀x y z : A,
R y z ->
clos_refl_trans_n1 R x y ->
clos_refl_trans_n1 R x z.
Are they really equivalent? We can prove that they actually shares some
common properties.
Lemma rt_trans_1n: ∀A (R: A -> A -> Prop) x y z,
R x y ->
clos_refl_trans R y z ->
clos_refl_trans R x z.
Proof.
intros.
eapply rt_trans with y; [| exact H0].
apply rt_step.
exact H.
Qed.
Lemma rt_trans_n1: ∀A (R: A -> A -> Prop) x y z,
R y z ->
clos_refl_trans R x y ->
clos_refl_trans R x z.
Proof.
(* WORKED IN CLASS *)
intros.
eapply rt_trans with y; [exact H0 |].
apply rt_step.
exact H.
Qed.
Lemma rt1n_step: ∀A (R: A -> A -> Prop) x y,
R x y ->
clos_refl_trans_1n R x y.
Proof.
(* WORKED IN CLASS *)
intros.
apply rt1n_trans_1n with y.
+ exact H.
+ apply rt1n_refl.
Qed.
Lemma rtn1_step: ∀A (R: A -> A -> Prop) x y,
R x y ->
clos_refl_trans_n1 R x y.
Proof.
(* WORKED IN CLASS *)
intros.
apply rtn1_trans_n1 with x.
+ exact H.
+ apply rtn1_refl.
Qed.
R x y ->
clos_refl_trans R y z ->
clos_refl_trans R x z.
Proof.
intros.
eapply rt_trans with y; [| exact H0].
apply rt_step.
exact H.
Qed.
Lemma rt_trans_n1: ∀A (R: A -> A -> Prop) x y z,
R y z ->
clos_refl_trans R x y ->
clos_refl_trans R x z.
Proof.
(* WORKED IN CLASS *)
intros.
eapply rt_trans with y; [exact H0 |].
apply rt_step.
exact H.
Qed.
Lemma rt1n_step: ∀A (R: A -> A -> Prop) x y,
R x y ->
clos_refl_trans_1n R x y.
Proof.
(* WORKED IN CLASS *)
intros.
apply rt1n_trans_1n with y.
+ exact H.
+ apply rt1n_refl.
Qed.
Lemma rtn1_step: ∀A (R: A -> A -> Prop) x y,
R x y ->
clos_refl_trans_n1 R x y.
Proof.
(* WORKED IN CLASS *)
intros.
apply rtn1_trans_n1 with x.
+ exact H.
+ apply rtn1_refl.
Qed.
Induction On Inductive Propositions
Lemma rt1n_trans: ∀A (R: A -> A -> Prop) a b c,
clos_refl_trans_1n R a b ->
clos_refl_trans_1n R b c ->
clos_refl_trans_1n R a c.
Proof.
intros.
revert H0.
induction H.
+ (* clos_refl_trans_1n R a b is true due to rt1n_refl *)
(* i.e. clos_refl_trans_1n R x x holds, where a = x, b = x *)
tauto.
+ (* clos_refl_trans_1n R a b is true due to rt1n_trans_1n *)
(* i.e. clos_refl_trans_1n R x z holds because R x y and
clos_refl_trans_1n R y z, where a = x, b = z *)
intros.
apply rt1n_trans_1n with y.
- exact H.
- apply IHclos_refl_trans_1n, H1.
Qed.
clos_refl_trans_1n R a b ->
clos_refl_trans_1n R b c ->
clos_refl_trans_1n R a c.
Proof.
intros.
revert H0.
induction H.
+ (* clos_refl_trans_1n R a b is true due to rt1n_refl *)
(* i.e. clos_refl_trans_1n R x x holds, where a = x, b = x *)
tauto.
+ (* clos_refl_trans_1n R a b is true due to rt1n_trans_1n *)
(* i.e. clos_refl_trans_1n R x z holds because R x y and
clos_refl_trans_1n R y z, where a = x, b = z *)
intros.
apply rt1n_trans_1n with y.
- exact H.
- apply IHclos_refl_trans_1n, H1.
Qed.
In fact, the revert befor induction is not necessary.
Lemma rt1n_trans_again: ∀A (R: A -> A -> Prop) a b c,
clos_refl_trans_1n R a b ->
clos_refl_trans_1n R b c ->
clos_refl_trans_1n R a c.
Proof.
intros.
induction H.
+ exact H0.
+ apply IHclos_refl_trans_1n in H0.
apply rt1n_trans_1n with y.
- exact H.
- exact H0.
Qed.
clos_refl_trans_1n R a b ->
clos_refl_trans_1n R b c ->
clos_refl_trans_1n R a c.
Proof.
intros.
induction H.
+ exact H0.
+ apply IHclos_refl_trans_1n in H0.
apply rt1n_trans_1n with y.
- exact H.
- exact H0.
Qed.
Now, try to finish a similar proof by yourself.
Lemma rtn1_trans: ∀A (R: A -> A -> Prop) a b c,
clos_refl_trans_n1 R a b ->
clos_refl_trans_n1 R b c ->
clos_refl_trans_n1 R a c.
Proof.
(* WORKED IN CLASS *)
intros.
induction H0.
+ exact H.
+ apply rtn1_trans_n1 with y; tauto.
Qed.
clos_refl_trans_n1 R a b ->
clos_refl_trans_n1 R b c ->
clos_refl_trans_n1 R a c.
Proof.
(* WORKED IN CLASS *)
intros.
induction H0.
+ exact H.
+ apply rtn1_trans_n1 with y; tauto.
Qed.
In the end, we can prove equivalences.
Lemma rt1n_rt: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans_1n R a b -> clos_refl_trans R a b.
Proof.
intros.
induction H.
+ apply rt_refl.
+ apply rt_trans_1n with y; tauto.
Qed.
clos_refl_trans_1n R a b -> clos_refl_trans R a b.
Proof.
intros.
induction H.
+ apply rt_refl.
+ apply rt_trans_1n with y; tauto.
Qed.
The other three directions are left as exercise.
Lemma rt_rt1n: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans R a b -> clos_refl_trans_1n R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rt1n_step, H.
+ apply rt1n_refl.
+ apply rt1n_trans with y; tauto.
Qed.
Lemma rtn1_rt: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans_n1 R a b -> clos_refl_trans R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rt_refl.
+ apply rt_trans_n1 with y; tauto.
Qed.
Lemma rt_rtn1: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans R a b -> clos_refl_trans_n1 R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rtn1_step, H.
+ apply rtn1_refl.
+ apply rtn1_trans with y; tauto.
Qed.
clos_refl_trans R a b -> clos_refl_trans_1n R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rt1n_step, H.
+ apply rt1n_refl.
+ apply rt1n_trans with y; tauto.
Qed.
Lemma rtn1_rt: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans_n1 R a b -> clos_refl_trans R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rt_refl.
+ apply rt_trans_n1 with y; tauto.
Qed.
Lemma rt_rtn1: ∀A (R: A -> A -> Prop) a b,
clos_refl_trans R a b -> clos_refl_trans_n1 R a b.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ apply rtn1_step, H.
+ apply rtn1_refl.
+ apply rtn1_trans with y; tauto.
Qed.
Module Bounded_Evaluation.
In this course, the expression evaluation of integer expressions is
unbounded, unlike the situation of normal programming languages like C and Java.
But still, we can define "whether evaluating an expression a" is within the
range of signed 32-bit integers. We have defined this property in our previous
lectures. We redefine it again as an inductive predicate in Coq.
Definition max32: Z := 2^31 -1.
Definition min32: Z := - 2^31.
Inductive signed32_eval: aexp -> state -> Z -> Prop :=
| S32_ANum: ∀(n: Z) st,
min32 ≤ n ≤ max32 ->
signed32_eval (ANum n) st n
| S32_AId: ∀(X: var) st,
min32 ≤ st X ≤ max32 ->
signed32_eval (AId X) st (st X)
| S32_APlus: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 + v2 ≤ max32 ->
signed32_eval (APlus a1 a2) st (v1 + v2)
| S32_AMinus: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 - v2 ≤ max32 ->
signed32_eval (AMinus a1 a2) st (v1 - v2)
| S32_AMult: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 * v2 ≤ max32 ->
signed32_eval (AMult a1 a2) st (v1 * v2).
Definition min32: Z := - 2^31.
Inductive signed32_eval: aexp -> state -> Z -> Prop :=
| S32_ANum: ∀(n: Z) st,
min32 ≤ n ≤ max32 ->
signed32_eval (ANum n) st n
| S32_AId: ∀(X: var) st,
min32 ≤ st X ≤ max32 ->
signed32_eval (AId X) st (st X)
| S32_APlus: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 + v2 ≤ max32 ->
signed32_eval (APlus a1 a2) st (v1 + v2)
| S32_AMinus: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 - v2 ≤ max32 ->
signed32_eval (AMinus a1 a2) st (v1 - v2)
| S32_AMult: ∀a1 a2 st v1 v2,
signed32_eval a1 st v1 ->
signed32_eval a2 st v2 ->
min32 ≤ v1 * v2 ≤ max32 ->
signed32_eval (AMult a1 a2) st (v1 * v2).
In short, signed32_eval a st v says that evaluating a on state st is
within the range of signed 32-bit integers (including all intermediate results)
the final result is v. Obviously, the evaluation result must coincide with
the expressions' denotations defined by aeval.
Theorem signed32_eval_correct: ∀a st v,
signed32_eval a st v ->
aeval a st = v.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ simpl.
reflexivity.
+ simpl.
reflexivity.
+ simpl.
unfold Func.add.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
+ simpl.
unfold Func.sub.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
+ simpl.
unfold Func.mul.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
Qed.
signed32_eval a st v ->
aeval a st = v.
Proof.
(* WORKED IN CLASS *)
intros.
induction H.
+ simpl.
reflexivity.
+ simpl.
reflexivity.
+ simpl.
unfold Func.add.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
+ simpl.
unfold Func.sub.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
+ simpl.
unfold Func.mul.
rewrite IHsigned32_eval1.
rewrite IHsigned32_eval2.
reflexivity.
Qed.
Similarly, we can defined 16-bit evaluation.
Definition max16: Z := 2^15 -1.
Definition min16: Z := - 2^15.
Inductive signed16_eval: aexp -> state -> Z -> Prop :=
| S16_ANum: ∀(n: Z) st,
min16 ≤ n ≤ max16 ->
signed16_eval (ANum n) st n
| S16_AId: ∀(X: var) st,
min16 ≤ st X ≤ max16 ->
signed16_eval (AId X) st (st X)
| S16_APlus: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 + v2 ≤ max16 ->
signed16_eval (APlus a1 a2) st (v1 + v2)
| S16_AMinus: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 - v2 ≤ max16 ->
signed16_eval (AMinus a1 a2) st (v1 - v2)
| S16_AMult: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 * v2 ≤ max16 ->
signed16_eval (AMult a1 a2) st (v1 * v2).
Definition min16: Z := - 2^15.
Inductive signed16_eval: aexp -> state -> Z -> Prop :=
| S16_ANum: ∀(n: Z) st,
min16 ≤ n ≤ max16 ->
signed16_eval (ANum n) st n
| S16_AId: ∀(X: var) st,
min16 ≤ st X ≤ max16 ->
signed16_eval (AId X) st (st X)
| S16_APlus: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 + v2 ≤ max16 ->
signed16_eval (APlus a1 a2) st (v1 + v2)
| S16_AMinus: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 - v2 ≤ max16 ->
signed16_eval (AMinus a1 a2) st (v1 - v2)
| S16_AMult: ∀a1 a2 st v1 v2,
signed16_eval a1 st v1 ->
signed16_eval a2 st v2 ->
min16 ≤ v1 * v2 ≤ max16 ->
signed16_eval (AMult a1 a2) st (v1 * v2).
Of course, 16-bit evaluation defines only a subset of 32-bit evaluation.
Second half of the proof is left as exercise.
Lemma range16_range32: ∀v,
min16 ≤ v ≤ max16 ->
min32 ≤ v ≤ max32.
Proof.
intros.
unfold min16, max16 in H.
unfold min32, max32.
simpl in H.
simpl.
lia.
Qed.
Theorem signed16_signed32: ∀a st v,
signed16_eval a st v ->
signed32_eval a st v.
Proof.
intros.
induction H.
+ apply S32_ANum.
apply range16_range32.
exact H.
(* WORKED IN CLASS *)
+ apply S32_AId.
apply range16_range32.
exact H.
+ apply S32_APlus.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
+ apply S32_AMinus.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
+ apply S32_AMult.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
Qed.
min16 ≤ v ≤ max16 ->
min32 ≤ v ≤ max32.
Proof.
intros.
unfold min16, max16 in H.
unfold min32, max32.
simpl in H.
simpl.
lia.
Qed.
Theorem signed16_signed32: ∀a st v,
signed16_eval a st v ->
signed32_eval a st v.
Proof.
intros.
induction H.
+ apply S32_ANum.
apply range16_range32.
exact H.
(* WORKED IN CLASS *)
+ apply S32_AId.
apply range16_range32.
exact H.
+ apply S32_APlus.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
+ apply S32_AMinus.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
+ apply S32_AMult.
- tauto.
- tauto.
- apply range16_range32.
exact H1.
Qed.
Moreover, from the definition of signed32_eval, we know that if all
intermediate results of evaluating a on st fails in the range of 32-bit,
the same property is also true for any a's subexpression a'. We first
define sub_aexp.
Inductive sub_aexp: aexp -> aexp -> Prop :=
| sub_aexp_refl: ∀e: aexp,
sub_aexp e e
| sub_aexp_APlus1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (APlus e1 e2)
| sub_aexp_APlus2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (APlus e1 e2)
| sub_aexp_AMinus1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (AMinus e1 e2)
| sub_aexp_AMinus2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (AMinus e1 e2)
| sub_aexp_AMult1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (AMult e1 e2)
| sub_aexp_AMult2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (AMult e1 e2).
| sub_aexp_refl: ∀e: aexp,
sub_aexp e e
| sub_aexp_APlus1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (APlus e1 e2)
| sub_aexp_APlus2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (APlus e1 e2)
| sub_aexp_AMinus1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (AMinus e1 e2)
| sub_aexp_AMinus2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (AMinus e1 e2)
| sub_aexp_AMult1: ∀e e1 e2: aexp,
sub_aexp e e1 ->
sub_aexp e (AMult e1 e2)
| sub_aexp_AMult2: ∀e e1 e2: aexp,
sub_aexp e e2 ->
sub_aexp e (AMult e1 e2).
In the following proof, we use inversion to do case analysis over
inductive proposition. Moreover, subst is used to do substitution. In
other words, if there is an assumption of form x = v (where x is a Coq
variable), then x will be removed from the proof goal at all and its every
occurrence is replaced with v.
Theorem signed32_eval_sub_aexp: ∀e1 e2 st,
sub_aexp e1 e2 ->
(∃v2, signed32_eval e2 st v2) ->
(∃v1, signed32_eval e1 st v1).
Proof.
intros.
(* WORKED IN CLASS *)
induction H.
+ exact H0.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
Qed.
End Bounded_Evaluation.
sub_aexp e1 e2 ->
(∃v2, signed32_eval e2 st v2) ->
(∃v1, signed32_eval e1 st v1).
Proof.
intros.
(* WORKED IN CLASS *)
induction H.
+ exact H0.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v1.
tauto.
+ apply IHsub_aexp.
clear IHsub_aexp.
destruct H0.
inversion H0; subst.
∃v2.
tauto.
Qed.
End Bounded_Evaluation.
Module Loop_Free.
Now, we prove that a loop free program always terminate.
Inductive loop_free: com -> Prop :=
| loop_free_skip:
loop_free Skip
| loop_free_asgn: ∀X E,
loop_free (CAss X E)
| loop_free_seq: ∀c1 c2,
loop_free c1 ->
loop_free c2 ->
loop_free (c1 ;; c2)
| loop_free_if: ∀b c1 c2,
loop_free c1 ->
loop_free c2 ->
loop_free (If b Then c1 Else c2 EndIf).
Theorem loop_free_terminate: ∀c,
loop_free c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
| loop_free_skip:
loop_free Skip
| loop_free_asgn: ∀X E,
loop_free (CAss X E)
| loop_free_seq: ∀c1 c2,
loop_free c1 ->
loop_free c2 ->
loop_free (c1 ;; c2)
| loop_free_if: ∀b c1 c2,
loop_free c1 ->
loop_free c2 ->
loop_free (If b Then c1 Else c2 EndIf).
Theorem loop_free_terminate: ∀c,
loop_free c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
Try to understand why we need to strengthen the induction hypothesis
here.
revert st1.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
Abort.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
Abort.
In order to construct a program state st2 here. We want to use the
following definition and proof from our last lectures.
Definition state_update (st: state) (X: var) (v: Z): state :=
fun Y ⇒ if (Nat.eq_dec X Y) then v else st Y.
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).
fun Y ⇒ if (Nat.eq_dec X Y) then v else st Y.
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.
unfold state_update.
split.
+ destruct (Nat.eq_dec X X).
- reflexivity.
- assert (X = X). { reflexivity. }
tauto.
+ intros.
destruct (Nat.eq_dec X Y).
- tauto.
- reflexivity.
Qed.
intros.
unfold state_update.
split.
+ destruct (Nat.eq_dec X X).
- reflexivity.
- assert (X = X). { reflexivity. }
tauto.
+ intros.
destruct (Nat.eq_dec X Y).
- tauto.
- reflexivity.
Qed.
Now we are ready to prove loop_free_terminate.
Theorem loop_free_terminate: ∀c,
loop_free c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
revert st1.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
(* WORKED IN CLASS *)
+ specialize (IHloop_free1 st1).
destruct IHloop_free1 as [st2 ?].
specialize (IHloop_free2 st2).
destruct IHloop_free2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IHloop_free1 st1).
destruct IHloop_free1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IHloop_free2 st1).
destruct IHloop_free2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
Qed.
loop_free c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
revert st1.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
(* WORKED IN CLASS *)
+ specialize (IHloop_free1 st1).
destruct IHloop_free1 as [st2 ?].
specialize (IHloop_free2 st2).
destruct IHloop_free2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IHloop_free1 st1).
destruct IHloop_free1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IHloop_free2 st1).
destruct IHloop_free2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
Qed.
You migh wonder why we choose not to define "loop_free" by a recursive
function. For example:
Fixpoint loop_free_fun (c: com): Prop :=
match c with
| CSkip ⇒ True
| CAss _ _ ⇒ True
| CSeq c1 c2 ⇒ loop_free_fun c1 ∧ loop_free_fun c2
| CIf b c1 c2 ⇒ loop_free_fun c1 ∧ loop_free_fun c2
| CWhile _ _ ⇒ False
end.
match c with
| CSkip ⇒ True
| CAss _ _ ⇒ True
| CSeq c1 c2 ⇒ loop_free_fun c1 ∧ loop_free_fun c2
| CIf b c1 c2 ⇒ loop_free_fun c1 ∧ loop_free_fun c2
| CWhile _ _ ⇒ False
end.
It is no problem. And you can try to prove a similar theorem about
termination.
Theorem loop_free_fun_terminate: ∀c,
loop_free_fun c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
revert st1.
induction c as [| X E | c1 IH1 c2 IH2 | b c1 IH1 c2 IH2 | b c]; intros.
(* WORKED IN CLASS *)
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
+ simpl in H.
destruct H.
specialize (IH1 H st1).
destruct IH1 as [st2 ?].
specialize (IH2 H0 st2).
destruct IH2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl in H.
destruct H.
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IH1 H st1).
destruct IH1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IH2 H0 st1).
destruct IH2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
+ simpl in H.
destruct H.
Qed.
loop_free_fun c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
intros.
revert st1.
induction c as [| X E | c1 IH1 c2 IH2 | b c1 IH1 c2 IH2 | b c]; intros.
(* WORKED IN CLASS *)
+ ∃st1.
unfold ceval.
unfold id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
+ simpl in H.
destruct H.
specialize (IH1 H st1).
destruct IH1 as [st2 ?].
specialize (IH2 H0 st2).
destruct IH2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl in H.
destruct H.
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IH1 H st1).
destruct IH1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IH2 H0 st1).
destruct IH2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
+ simpl in H.
destruct H.
Qed.
If we compare loop_free and loop_free_fun, the latter one is less
flexible to extend.
Inductive loop_free': com -> Prop :=
| loop_free'_skip:
loop_free' Skip
| loop_free'_asgn: ∀X E,
loop_free' (CAss X E)
| loop_free'_seq: ∀c1 c2,
loop_free' c1 ->
loop_free' c2 ->
loop_free' (c1 ;; c2)
| loop_free'_if: ∀b c1 c2,
loop_free' c1 ->
loop_free' c2 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_if_then: ∀b c1 c2,
(∀st, beval b st) ->
loop_free' c1 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_if_else: ∀b c1 c2,
(∀st, ¬beval b st) ->
loop_free' c2 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_while_false: ∀b c,
(∀st, ¬beval b st) ->
loop_free' (While b Do c EndWhile).
| loop_free'_skip:
loop_free' Skip
| loop_free'_asgn: ∀X E,
loop_free' (CAss X E)
| loop_free'_seq: ∀c1 c2,
loop_free' c1 ->
loop_free' c2 ->
loop_free' (c1 ;; c2)
| loop_free'_if: ∀b c1 c2,
loop_free' c1 ->
loop_free' c2 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_if_then: ∀b c1 c2,
(∀st, beval b st) ->
loop_free' c1 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_if_else: ∀b c1 c2,
(∀st, ¬beval b st) ->
loop_free' c2 ->
loop_free' (If b Then c1 Else c2 EndIf)
| loop_free'_while_false: ∀b c,
(∀st, ¬beval b st) ->
loop_free' (While b Do c EndWhile).
This definition says: if an if-condition is always true, then the loops in
its else-branch should not be considered as real loops. Similarly, if an
if-condition is always false, then the loops in its then-branch should not be
considered as real loops. Also, if a while-loop's loop condition is always
false, the loop body will never be executed — that is not a real loop either.
Theorem loop_free'_terminate: ∀c,
loop_free' c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
(* WORKED IN CLASS *)
intros.
revert st1.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold BinRel.id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
+ specialize (IHloop_free'1 st1).
destruct IHloop_free'1 as [st2 ?].
specialize (IHloop_free'2 st2).
destruct IHloop_free'2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IHloop_free'1 st1).
destruct IHloop_free'1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IHloop_free'2 st1).
destruct IHloop_free'2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
+ (* new case # 1 *)
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
specialize (IHloop_free' st1).
destruct IHloop_free' as [st2 ?].
∃st2.
left.
∃st1.
specialize (H st1).
tauto.
+ (* new case # 2 *)
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
specialize (IHloop_free' st1).
destruct IHloop_free' as [st2 ?].
∃st2.
right.
∃st1.
specialize (H st1).
tauto.
+ (* new case # 3 *)
simpl.
∃st1.
unfold loop_sem.
unfold BinRel.omega_union.
∃O.
simpl.
unfold BinRel.test_rel, Sets.complement.
specialize (H st1).
split.
- reflexivity.
- exact H.
Qed.
End Loop_Free.
(* 2021-03-22 00:21 *)
loop_free' c ->
(∀st1, ∃st2, ceval c st1 st2).
Proof.
(* WORKED IN CLASS *)
intros.
revert st1.
induction H; intros.
+ ∃st1.
unfold ceval.
unfold BinRel.id.
reflexivity.
+ unfold ceval.
∃(state_update st1 X (aeval E st1)).
apply state_update_spec.
+ specialize (IHloop_free'1 st1).
destruct IHloop_free'1 as [st2 ?].
specialize (IHloop_free'2 st2).
destruct IHloop_free'2 as [st3 ?].
∃st3.
simpl.
unfold BinRel.concat.
∃st2.
tauto.
+ simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
simpl.
pose proof classic (beval b st1).
destruct H1.
- specialize (IHloop_free'1 st1).
destruct IHloop_free'1 as [st2 ?].
∃st2.
left.
∃st1.
tauto.
- specialize (IHloop_free'2 st1).
destruct IHloop_free'2 as [st2 ?].
∃st2.
right.
∃st1.
tauto.
+ (* new case # 1 *)
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
specialize (IHloop_free' st1).
destruct IHloop_free' as [st2 ?].
∃st2.
left.
∃st1.
specialize (H st1).
tauto.
+ (* new case # 2 *)
simpl.
unfold if_sem.
unfold BinRel.union, BinRel.concat, BinRel.test_rel.
specialize (IHloop_free' st1).
destruct IHloop_free' as [st2 ?].
∃st2.
right.
∃st1.
specialize (H st1).
tauto.
+ (* new case # 3 *)
simpl.
∃st1.
unfold loop_sem.
unfold BinRel.omega_union.
∃O.
simpl.
unfold BinRel.test_rel, Sets.complement.
specialize (H st1).
split.
- reflexivity.
- exact H.
Qed.
End Loop_Free.
(* 2021-03-22 00:21 *)