Lecture notes 20210331 Steps vs Denotations

Require Import PL.Imp PL.ImpExt PL.RTClosure.
Local Open Scope imp.

Semantic Equavalence: Brief Idea

For now, we have learnt axiomatic semantics, denotational semantics and small step semantics. Also, we have seen how to describe program equivalence via different program semantics. Today, we will turn to a different direction. We discuss the relation between two semantics. We will prove the equivalence between denotational semantics and small step semantics. If you forget the detailed definition, you can always use the Print command in Coq for help.
(* Print aeval. *)
(* Print beval. *)
(* Print ceval. *)
(* Print astep. *)
(* Print bstep. *)
(* Print cstep. *)
(* Print multi_astep. *)
(* Print multi_bstep. *)
(* Print multi_cstep. *)
We will prove:
        Theorem semantic_equiv: ∀c st1 st2,
          ceval c st1 st2 ↔ multi_cstep (c, st1) (CSkip, st2).
    
That is, the binary relation between denotational semantics is the same as the one defined by multi-step relation.
To prove this theorem, we need to prove two separate facts: the derivation from the left hand side to the right hand side and from the right hand side to the left hand side.

=>

For this direction, the main idea is to do induction over the syntax tree of c. A typical induction step is as follows.
        IHc1: ∀st1 st2,
                ceval c1 st1 st2 ->
                multi_cstep (c1, st1) (CSkip, st2)
        IHc2: ∀st1 st2,
                ceval c2 st1 st2 ->
                multi_cstep (c1, st1) (CSkip, st2)
        ----
        To prove: ∀st1 st2,
                ceval (c1 ;; c2) st1 st2 ->
                multi_cstep (c1 ;; c2, st1) (CSkip, st2).
    
From the fact that ceval (c1 ;; c2) st1 st2, we know that there exists an intermidiate state st3 s.t. ceval c1 st1 st3 and ceval c2 st3 st2. Then by induction hypothese, we know the following two facts:
        multi_cstep (c1, st1) (CSkip, st3)
        multi_cstep (c2, st3) (CSkip, st2).
    
Then according to the multi-step relation's congruence property on sequential composition, we know that
        multi_cstep (c1 ;; c2, st1) (CSkip;; c2, st3)
Adding cstep (CSkip;; c2, st3) (c2, st3), we achieve
        multi_cstep (c1 ;; c2, st1) (CSkip, st2).
    
In this process, we use multi_cstep's the congruence property that we have proved last time. In other induction steps, we also need semantic equivalence theorem for aexp and bexp, i.e.,
        Theorem semantic_equiv_bexp1: ∀st b,
          (beval b st -> multi_bstep st b BTrue) ∧
          (¬beval b st -> multi_bstep st b BFalse).

        Theorem semantic_equiv_aexp1: ∀st a n,
          aeval a st = n -> multi_astep st a (ANum n).
    

<=

To show:
    Theorem semantic_equiv_com2: ∀c st1 st2,
      multi_cstep (c, st1) (CSkip, st2) -> ceval c st1 st2.
We do induction over the steps from (c, st1) to (CSkip, st2) instead. Specifically, we first prove:
    Lemma ceval_preserve: ∀c1 c2 st1 st2,
      cstep (c1, st1) (c2, st2) ->
      ∀st3, ceval c2 st2 st3 -> ceval c1 st1 st3;
by induction over "how cstep" is constructed. Then we generalize it to:
    Lemma ceval_preserve': ∀c1 c2 st1 st2,
      multi_cstep (c1, st1) (c2, st2) ->
      ∀st3, ceval c2 st2 st3 -> ceval c1 st1 st3;
by induction over the steps. Our eventual goal semantic_equiv_com2 immediately follows.

<=: Alternative proof

Besides an induction over multi-step relation, we can also prove this direction by induction over c's structure. If we use sequential composition CSeq as an example again, what we need to prove is:
        IHc1: ∀st1 st2,
                multi_cstep (c1, st1) (CSkip, st2) -> ceval c1 st1 st2
        IHc2: ∀st1 st2,
                multi_cstep (c1, st1) (CSkip, st2) -> ceval c2 st1 st2
        ----
        To prove: ∀st1 st2,
            multi_cstep (c1 ;; c2, st1) (CSkip, st2) -> ceval (c1 ;; c2) st1 st2.
    
The key point is: suppose multi_cstep (c1 ;; c2, st1) (CSkip, st2), this path of program execution must contain the following two intermediate status:
        (CSkip;; c2, st3)
        (c2, st3)
for some program state st3. Furthermore, we can construct another path from (c1, st1) to (CSkip, st3) based on the path from (c1;; c2, st1) to (CSkip;; c2, st3) . This whole property can be formally stated as follows:
        Lemma CSeq_path_spec: ∀c1 st1 c2 st2,
          multi_cstep (CSeq c1 c2, st1) (CSkip, st2) ->
          ∃st3,
          multi_cstep (c1, st1) (CSkip, st3) ∧
          multi_cstep (c2, st3) (CSkip, st2).
    
Then we can prove our goal easily using two induction hypotheses.
In short, in the proof of all different induction steps, we need to prove different path properties for different commands.
Now, we demonstrate our proofs in Coq.

From Denotations To Multi-step Relations

If you forget the congruence properties of multi-step relations. You can use Coq's Check command for help.
(* Check multi_congr_APlus1. *)
(* Check multi_congr_APlus2. *)
(* Check multi_congr_AMinus1. *)
(* Check multi_congr_AMinus2. *)
(* Check multi_congr_AMult1. *)
(* Check multi_congr_AMult2. *)
(* Check multi_congr_BEq1. *)
(* Check multi_congr_BEq2. *)
(* Check multi_congr_BLe1. *)
(* Check multi_congr_BLe2. *)
(* Check multi_congr_BNot. *)
(* Check multi_congr_BAnd. *)
(* Check multi_congr_CAss. *)
(* Check multi_congr_CSeq. *)
(* Check multi_congr_CIf. *)
Theorem semantic_equiv_aexp1: ∀st a n,
  aeval a st = n -> multi_astep st a (ANum n).
Proof.
  intros.
  revert n H; induction a; intros; simpl in H.
  + unfold constant_func in H.
    rewrite H.
    reflexivity.
  + rewrite <- H.
    etransitivity_n1; [reflexivity |].
    apply AS_Id.
  + etransitivity.
    { apply multi_congr_APlus1, IHa1. reflexivity. }
    etransitivity_n1.
    { apply multi_congr_APlus2; [apply AH_num |]. apply IHa2. reflexivity. }
    rewrite <- H.
    apply AS_Plus.
  + etransitivity.
    { apply multi_congr_AMinus1, IHa1. reflexivity. }
    etransitivity_n1.
    { apply multi_congr_AMinus2; [apply AH_num |]. apply IHa2. reflexivity. }
    rewrite <- H.
    apply AS_Minus.
  + etransitivity.
    { apply multi_congr_AMult1, IHa1. reflexivity. }
    etransitivity_n1.
    { apply multi_congr_AMult2; [apply AH_num |]. apply IHa2. reflexivity. }
    rewrite <- H.
    apply AS_Mult.
Qed.
Theorem semantic_equiv_bexp1: ∀st b,
  (beval b st -> multi_bstep st b BTrue) ∧
  (¬beval b st -> multi_bstep st b BFalse).
Proof.
  intros.
  induction b; simpl.
  + split.
    - intros.
      reflexivity.
    - unfold Sets.full.
      tauto.
  + split.
    - unfold Sets.empty.
      tauto.
    - intros.
      reflexivity.
  + assert (multi_bstep st (a1 == a2) (aeval a1 st == aeval a2 st)).
    {
      etransitivity.
      - apply multi_congr_BEq1, semantic_equiv_aexp1.
        reflexivity.
      - apply multi_congr_BEq2; [apply AH_num |].
        apply semantic_equiv_aexp1.
        reflexivity.
    }
    split; unfold Func.test_eq; intros;
    (etransitivity_n1; [exact H |]).
    - apply BS_Eq_True, H0.
    - apply BS_Eq_False, H0.
  + assert (multi_bstep st (a1 ≤ a2) (aeval a1 st ≤ aeval a2 st)).
    {
      etransitivity.
      - apply multi_congr_BLe1, semantic_equiv_aexp1.
        reflexivity.
      - apply multi_congr_BLe2; [apply AH_num |].
        apply semantic_equiv_aexp1.
        reflexivity.
    }
    split; unfold Func.test_le; intros;
    (etransitivity_n1; [exact H |]).
    - apply BS_Le_True, H0.
    - apply BS_Le_False.
      lia.
  + destruct IHb as [IH1 IH2].
    split; intros.
    - etransitivity_n1.
      * apply multi_congr_BNot, IH2.
        unfold Sets.complement in H; exact H.
      * apply BS_NotFalse.
    - etransitivity_n1.
      * apply multi_congr_BNot, IH1.
        unfold Sets.complement in H; tauto.
      * apply BS_NotTrue.
  + destruct IHb1 as [IHb11 IHb12].
    destruct IHb2 as [IHb21 IHb22].
    pose proof classic (beval b1 st).
    destruct H.
    - assert (multi_bstep st (b1 && b2) b2).
      {
        etransitivity_n1.
        * apply multi_congr_BAnd, IHb11, H.
        * apply BS_AndTrue.
      }
      split; unfold Sets.intersect; intros;
      (etransitivity; [exact H0 |]).
      * apply IHb21; tauto.
      * apply IHb22; tauto.
    - split; unfold Sets.intersect; intros; [ tauto |].
      etransitivity_n1.
      * apply multi_congr_BAnd, IHb12, H.
      * apply BS_AndFalse.
Qed.
Corollary semantic_equiv_bexp1_true: ∀st b,
  beval b st -> multi_bstep st b BTrue.
Proof. intros. pose proof semantic_equiv_bexp1 st b. tauto. Qed.
Corollary semantic_equiv_bexp1_false: ∀st b,
  (Sets.complement (beval b) st -> multi_bstep st b BFalse).
Proof. intros. pose proof semantic_equiv_bexp1 st b. tauto. Qed.
Lemma semantic_equiv_iter_loop1: ∀st1 st2 n b c,
  (∀st1 st2, ceval c st1 st2 -> multi_cstep (c, st1) (Skip, st2)) ->
  iter_loop_body b (ceval c) n st1 st2 ->
  multi_cstep (While b Do c EndWhile, st1) (Skip, st2).
Proof.
  intros.
  revert st1 st2 H0; induction n; intros.
  + simpl in H0.
    unfold BinRel.test_rel in H0.
    destruct H0.
    subst st2.
    etransitivity_1n; [apply CS_While |].
    etransitivity; [apply multi_congr_CIf, semantic_equiv_bexp1_false, H1 |].
    etransitivity_1n; [apply CS_IfFalse |].
    reflexivity.
  + simpl in H0.
    unfold BinRel.concat at 1,
           BinRel.test_rel in H0.
    destruct H0 as [st [[? H0] ?]]; subst st.
    unfold BinRel.concat in H2.
    destruct H2 as [st1' [? ?]].
    etransitivity_1n; [apply CS_While |].
    etransitivity; [apply multi_congr_CIf, semantic_equiv_bexp1_true, H0 |].
    etransitivity_1n; [apply CS_IfTrue |].
    etransitivity; [apply multi_congr_CSeq, H, H1 |].
    etransitivity_1n; [apply CS_Seq |].
    apply IHn, H2.
Qed.
Theorem semantic_equiv_com1: ∀st1 st2 c,
  ceval c st1 st2 -> multi_cstep (c, st1) (Skip, st2).
Proof.
  intros.
  revert st1 st2 H; induction c; intros.
  + rewrite ceval_CSkip in H.
    unfold BinRel.id in H.
    rewrite H.
    reflexivity.
  + rewrite ceval_CAss in H.
    destruct H.
    etransitivity_n1.
    - apply multi_congr_CAss, semantic_equiv_aexp1.
      reflexivity.
    - apply CS_Ass; tauto.
  + rewrite ceval_CSeq in H.
    unfold BinRel.concat in H.
    destruct H as [st' [? ?]].
    etransitivity; [apply multi_congr_CSeq, IHc1, H |].
    etransitivity_1n; [ apply CS_Seq |].
    apply IHc2, H0.
  + rewrite ceval_CIf in H.
    unfold if_sem in H.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel in H.
    pose proof semantic_equiv_bexp1 st1 b.
    destruct H0.
    destruct H as [H | H]; destruct H as [st [[? ?] ?]]; subst st.
    - etransitivity; [apply multi_congr_CIf, H0, H2 |].
      etransitivity_1n; [apply CS_IfTrue |].
      apply IHc1, H3.
    - etransitivity; [apply multi_congr_CIf, H1, H2 |].
      etransitivity_1n; [apply CS_IfFalse |].
      apply IHc2, H3.
  + rewrite ceval_CWhile in H.
    unfold loop_sem in H.
    unfold BinRel.omega_union in H.
    destruct H as [n ?].
    apply semantic_equiv_iter_loop1 with n.
    - exact IHc.
    - exact H.
Qed.

From Multi-step Relations To Denotations


Lemma aeval_preserve: ∀st a1 a2,
  astep st a1 a2 ->
  aeval a1 st = aeval a2 st.
Proof.
  intros.
  induction H.
  + simpl.
    reflexivity.
  + simpl.
    unfold Func.add.
    lia.
  + simpl.
    unfold Func.add.
    lia.
  + simpl.
    unfold Func.add, constant_func.
    reflexivity.
  + simpl.
    unfold Func.sub.
    lia.
  + simpl.
    unfold Func.sub.
    lia.
  + simpl.
    unfold Func.sub, constant_func.
    reflexivity.
  + simpl.
    unfold Func.mul.
    nia.
  + simpl.
    unfold Func.mul.
    nia.
  + simpl.
    unfold Func.mul, constant_func.
    reflexivity.
Qed.
Theorem semantic_equiv_aexp2: ∀st a n,
  multi_astep st a (ANum n) -> aeval a st = n.
Proof.
  intros.
  induction_1n H.
  + simpl.
    reflexivity.
  + pose proof aeval_preserve _ _ _ H.
    lia.
Qed.
Lemma beval_preserve: ∀st b1 b2,
  bstep st b1 b2 ->
  (beval b1 st ↔ beval b2 st).
Proof.
  intros.
  induction H.
  + apply aeval_preserve in H.
    simpl.
    unfold Func.test_eq.
    lia.
  + apply aeval_preserve in H0.
    simpl.
    unfold Func.test_eq.
    lia.
  + simpl.
    unfold Func.test_eq, Sets.full.
    tauto.
  + simpl.
    unfold Func.test_eq, Sets.empty.
    tauto.
  + apply aeval_preserve in H.
    simpl.
    unfold Func.test_le.
    lia.
  + apply aeval_preserve in H0.
    simpl.
    unfold Func.test_le.
    lia.
  + simpl.
    unfold Func.test_le, Sets.full.
    tauto.
  + simpl.
    unfold Func.test_le, constant_func, Sets.empty.
    lia.
  + simpl.
    unfold Sets.complement.
    tauto.
  + simpl.
    unfold Sets.complement, Sets.full, Sets.empty.
    tauto.
  + simpl.
    unfold Sets.complement, Sets.full, Sets.empty.
    tauto.
  + simpl.
    unfold Sets.intersect.
    tauto.
  + simpl.
    unfold Sets.intersect, Sets.full.
    tauto.
  + simpl.
    unfold Sets.intersect, Sets.empty.
    tauto.
Qed.
Theorem semantic_equiv_bexp2: ∀st b TF,
  multi_bstep st b TF ->
  (TF = BTrue -> beval b st) ∧
  (TF = BFalse -> ¬beval b st).
Proof.
  intros.
  induction_1n H; simpl; intros.
  + split; intros; subst; simpl; unfold Sets.full, Sets.empty; tauto.
  + pose proof beval_preserve _ _ _ H.
    tauto.
Qed.
Lemma ceval_preserve: ∀c1 c2 st1 st2,
  cstep (c1, st1) (c2, st2) ->
  ∀st3, ceval c2 st2 st3 -> ceval c1 st1 st3.
Proof.
We could prove a stronger conclusion:
    ∀st3, ceval c1 st1 st3 ↔ ceval c2 st2 st3.
But this single direction version is enough to use.
  intros.
  revert st3 H0.
  induction_cstep H; simpl; intros.
  + apply aeval_preserve in H.
    rewrite ceval_CAss in H0.
    rewrite ceval_CAss.
    rewrite H.
    tauto.
  + rewrite ceval_CSkip in H1.
    rewrite ceval_CAss.
    unfold BinRel.id in H1.
    subst.
    tauto.
  + rewrite ceval_CSeq in H0.
    rewrite ceval_CSeq.
    unfold BinRel.concat in H0.
    unfold BinRel.concat.
    destruct H0 as [st2' [? ?]].
    ∃st2'.
    specialize (IHcstep _ H0).
    tauto.
  + rewrite ceval_CSeq.
    unfold BinRel.concat, BinRel.id.
    ∃st.
    split.
    - reflexivity.
    - exact H0.
  + rewrite ceval_CIf in H0.
    rewrite ceval_CIf.
    unfold if_sem in H0.
    unfold if_sem.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel in H0.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel.
    apply beval_preserve in H.
    simpl in H0.
    simpl.
    unfold Sets.complement in H0.
    unfold Sets.complement.
    destruct H0 as [[st2' ?] | [st2' ?]]; [left | right];
      ∃st2'; tauto.
  + rewrite ceval_CIf.
    unfold if_sem.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel.
    left; ∃st; simpl.
    unfold Sets.full; tauto.
  + rewrite ceval_CIf.
    unfold if_sem.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel.
    right; ∃st; simpl.
    unfold Sets.complement, Sets.empty; tauto.
  + pose proof loop_unrolling b c.
    unfold com_equiv, BinRel.equiv in H.
    specialize (H st st3).
    tauto.
Qed.
Theorem semantic_equiv_com2: ∀c st1 st2,
  multi_cstep (c, st1) (CSkip, st2) -> ceval c st1 st2.
Proof.
  intros.
  remember (CSkip) as c' eqn:H0.
  revert H0; induction_1n H; simpl; intros; subst.
  + simpl.
    unfold BinRel.id.
    reflexivity.
  + pose proof ceval_preserve _ _ _ _ H st2.
    tauto.
Qed.

Final Theorem


Theorem semantic_equiv: ∀c st1 st2,
  ceval c st1 st2 ↔ multi_cstep (c, st1) (CSkip, st2).
Proof.
  intros.
  split.
  + apply semantic_equiv_com1.
  + apply semantic_equiv_com2.
Qed.

Properties Of Execution Paths


Local Open Scope Z.
Local Close Scope imp.
Lemma ANum_halt: ∀st n a,
  multi_astep st (ANum n) a ->
  a = ANum n.
Proof.
  unfold_with_1n multi_astep.
  intros.
  inversion H; subst.
  + reflexivity.
  + inversion H0.
Qed.

Lemma never_BFalse_to_BTrue: ∀st,
  multi_bstep st BFalse BTrue -> False.
Proof.
  unfold_with_1n multi_bstep.
  intros.
  inversion H; subst.
  inversion H0.
Qed.

Lemma never_BTrue_to_BFalse: ∀st,
  multi_bstep st BTrue BFalse -> False.
Proof.
  unfold_with_1n multi_bstep.
  intros.
  inversion H; subst.
  inversion H0.
Qed.

Lemma CSkip_halt: ∀st st' c,
  multi_cstep (CSkip, st) (c, st') ->
  c = CSkip ∧ st = st'.
Proof.
  unfold_with_1n multi_cstep.
  intros.
  inversion H; subst.
  + split; reflexivity.
  + inversion H0.
Qed.

Lemma APlus_path_spec: ∀st a1 a2 n,
  multi_astep st (APlus a1 a2) (ANum n) ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n = (n1 + n2).
Proof.
  intros.
  remember (APlus a1 a2) as a eqn:H0.
  remember (ANum n) as a' eqn:H1.
  revert a1 a2 n H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      apply ANum_halt in H0.
      injection H0 as H1.
      ∃n1, n2.
      split; [reflexivity | split; [reflexivity | tauto]].
Qed.
Lemma AMinus_path_spec: ∀st a1 a2 n,
  multi_astep st (AMinus a1 a2) (ANum n) ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n = (n1 - n2).
Proof.
  intros.
  remember (AMinus a1 a2) as a eqn:H0.
  remember (ANum n) as a' eqn:H1.
  revert a1 a2 n H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      apply ANum_halt in H0.
      injection H0 as H1.
      ∃n1, n2.
      split; [reflexivity | split; [reflexivity | tauto]].
Qed.
Lemma AMult_path_spec: ∀st a1 a2 n,
  multi_astep st (AMult a1 a2) (ANum n) ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n = (n1 * n2).
Proof.
  intros.
  remember (AMult a1 a2) as a eqn:H0.
  remember (ANum n) as a' eqn:H1.
  revert a1 a2 n H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      apply ANum_halt in H0.
      injection H0 as H1.
      ∃n1, n2.
      split; [reflexivity | split; [reflexivity | tauto]].
Qed.
Lemma BEq_True_path_spec: ∀st a1 a2,
  multi_bstep st (BEq a1 a2) BTrue ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n1 = n2.
Proof.
  intros.
  remember (BEq a1 a2) as a eqn:H0.
  remember BTrue as a' eqn:H1.
  revert a1 a2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      ∃n2, n2.
      assert (multi_astep st n2 n2). { reflexivity. }
      tauto.
    - apply never_BFalse_to_BTrue in H0.
      destruct H0.
Qed.
Lemma BEq_False_path_spec: ∀st a1 a2,
  multi_bstep st (BEq a1 a2) BFalse ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n1 ≠ n2.
Proof.
  intros.
  remember (BEq a1 a2) as a eqn:H0.
  remember BFalse as a' eqn:H1.
  revert a1 a2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - apply never_BTrue_to_BFalse in H0.
      destruct H0.
    - clear IHrt.
      ∃n1, n2.
      assert (multi_astep st n1 n1). { reflexivity. }
      assert (multi_astep st n2 n2). { reflexivity. }
      tauto.
Qed.
Lemma BLe_True_path_spec: ∀st a1 a2,
  multi_bstep st (BLe a1 a2) BTrue ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n1 ≤ n2.
Proof.
  intros.
  remember (BLe a1 a2) as a eqn:H0.
  remember BTrue as a' eqn:H1.
  revert a1 a2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      ∃n1, n2.
      assert (multi_astep st n1 n1). { reflexivity. }
      assert (multi_astep st n2 n2). { reflexivity. }
      tauto.
    - apply never_BFalse_to_BTrue in H0.
      destruct H0.
Qed.
Lemma BLe_False_path_spec: ∀st a1 a2,
  multi_bstep st (BLe a1 a2) BFalse ->
  ∃n1 n2,
  multi_astep st a1 (ANum n1) ∧
  multi_astep st a2 (ANum n2) ∧
  n1 > n2.
Proof.
  intros.
  remember (BLe a1 a2) as a eqn:H0.
  remember BFalse as a' eqn:H1.
  revert a1 a2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a1 n1). { etransitivity_1n; eassumption. }
      tauto.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n1 [n2 [? [? ?]]]].
      ∃n1, n2.
      assert (multi_astep st a2 n2). { etransitivity_1n; eassumption. }
      tauto.
    - apply never_BTrue_to_BFalse in H0.
      destruct H0.
    - clear IHrt.
      ∃n1, n2.
      assert (multi_astep st n1 n1). { reflexivity. }
      assert (multi_astep st n2 n2). { reflexivity. }
      tauto.
Qed.
Lemma BNot_True_path_spec: ∀st b,
  multi_bstep st (BNot b) BTrue ->
  multi_bstep st b BFalse.
Proof.
  intros.
  remember (BNot b) as b1 eqn:H0.
  remember BTrue as b2 eqn:H1.
  revert b H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ ltac:(reflexivity) ltac:(reflexivity)).
      etransitivity_1n; eassumption.
    - apply never_BFalse_to_BTrue in H0.
      destruct H0.
    - reflexivity.
Qed.
Lemma BNot_False_path_spec: ∀st b,
  multi_bstep st (BNot b) BFalse ->
  multi_bstep st b BTrue.
Proof.
  intros.
  remember (BNot b) as b1 eqn:H0.
  remember BFalse as b2 eqn:H1.
  revert b H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ ltac:(reflexivity) ltac:(reflexivity)).
      etransitivity_1n; eassumption.
    - reflexivity.
    - apply never_BTrue_to_BFalse in H0.
      destruct H0.
Qed.
Lemma BAnd_True_path_spec: ∀st b1 b2,
  multi_bstep st (BAnd b1 b2) BTrue ->
  multi_bstep st b1 BTrue ∧
  multi_bstep st b2 BTrue.
Proof.
  intros.
  remember (BAnd b1 b2) as b eqn:H0.
  remember BTrue as b' eqn:H1.
  revert b1 b2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt.
      assert (multi_bstep st b1 BTrue). { etransitivity_1n; eassumption. }
      tauto.
    - split.
      * reflexivity.
      * exact H0.
    - apply never_BFalse_to_BTrue in H0.
      destruct H0.
Qed.
Lemma BAnd_False_path_spec: ∀st b1 b2,
  multi_bstep st (BAnd b1 b2) BFalse ->
  multi_bstep st b1 BFalse ∨
  multi_bstep st b2 BFalse.
Proof.
  intros.
  remember (BAnd b1 b2) as b eqn:H0.
  remember BFalse as b' eqn:H1.
  revert b1 b2 H0 H1; induction_1n H; intros; subst.
  + discriminate H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt.
      * assert (multi_bstep st b1 BFalse). { etransitivity_1n; eassumption. }
        tauto.
      * tauto.
    - right.
      exact H0.
    - left.
      reflexivity.
Qed.
Lemma CAss_path_spec: ∀X a st1 st2,
  multi_cstep (CAss X a, st1) (CSkip, st2) ->
  ∃n,
  multi_astep st1 a (ANum n) ∧
  st2 X = n ∧
  (∀Y : var, X ≠ Y -> st1 Y = st2 Y).
Proof.
  intros.
  remember (CAss X a) as c eqn:H0.
  remember CSkip as c' eqn:H1.
  revert a H0 H1; induction_1n H; intros; subst.
  + inversion H1.
  + inversion H; subst.
    - specialize (IHrt _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n [? ?]].
      ∃n.
      assert (multi_astep s a n). { etransitivity_1n; eassumption. }
      tauto.
    - clear IHrt.
      apply CSkip_halt in H0.
      destruct H0.
      subst s.
      ∃(st2 X).
      split; [reflexivity | tauto].
Qed.
Lemma CSeq_path_spec: ∀c1 st1 c2 st3,
  multi_cstep (CSeq c1 c2, st1) (CSkip, st3) ->
  ∃st2,
  multi_cstep (c1, st1) (CSkip, st2) ∧
  multi_cstep (c2, st2) (CSkip, st3).
Proof.
  intros.
  remember (CSeq c1 c2) as c eqn:H0.
  remember CSkip as c' eqn:H1.
  revert c1 c2 H0 H1; induction_1n H; intros; subst.
  + inversion H1.
  + inversion H; subst.
    - specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [st2 [? ?]].
      ∃st2.
      assert (multi_cstep (c1, st1) (Skip%imp, st2)).
      { etransitivity_1n; eassumption. }
      tauto.
    - ∃s.
      split; [reflexivity | tauto].
Qed.
Lemma CIf_path_spec: ∀b c1 c2 st1 st2,
  multi_cstep (CIf b c1 c2, st1) (CSkip, st2) ->
  multi_bstep st1 b BTrue ∧
  multi_cstep (c1, st1) (CSkip, st2) ∨
  multi_bstep st1 b BFalse ∧
  multi_cstep (c2, st1) (CSkip, st2).
Proof.
  intros.
  remember (CIf b c1 c2) as c eqn:H0.
  remember CSkip as c' eqn:H1.
  revert b c1 c2 H0 H1; induction_1n H; intros; subst.
  + inversion H1.
  + inversion H; subst.
    - specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [[? ?] | [? ?]].
      * assert (multi_bstep s b BTrue). { etransitivity_1n; eassumption. }
        tauto.
      * assert (multi_bstep s b BFalse). { etransitivity_1n; eassumption. }
        tauto.
    - assert (multi_bstep s BTrue BTrue). { reflexivity. }
      tauto.
    - assert (multi_bstep s BFalse BFalse). { reflexivity. }
      tauto.
Qed.
Fixpoint CWhile_path b c1 st1 st2 (n: nat): Prop:=
  match n with
  | O ⇒ multi_bstep st1 b BFalse ∧ st1 = st2
  | S n' ⇒ ∃st1',
            multi_bstep st1 b BTrue ∧
            multi_cstep (c1, st1) (CSkip, st1') ∧
            CWhile_path b c1 st1' st2 n'
  end.
Definition CWhile_path' b' b c1 st1 st2 (n: nat): Prop:=
  match n with
  | O ⇒ multi_bstep st1 b' BFalse ∧ st1 = st2
  | S n' ⇒ ∃st1',
            multi_bstep st1 b' BTrue ∧
            multi_cstep (c1, st1) (CSkip, st1') ∧
            CWhile_path b c1 st1' st2 n'
  end.
Definition CWhile_path'' c1' b c1 st1 st2 (n: nat): Prop:=
  ∃st1',
    multi_cstep (c1', st1) (CSkip, st1') ∧
    CWhile_path b c1 st1' st2 n.
Lemma CWhile_path_spec_aux: ∀st1 st2 c c',
  multi_cstep (c, st1) (c', st2) ->
  (∀b c1,
     c = CWhile b c1 ->
     c' = Skip%imp ->
     ∃n, CWhile_path b c1 st1 st2 n) ∧
  (∀b' b c1,
     c = CIf b' (CSeq c1 (CWhile b c1)) CSkip ->
     c' = Skip%imp ->
     ∃n, CWhile_path' b' b c1 st1 st2 n) ∧
  (∀c1' b c1,
     c = CSeq c1' (CWhile b c1) ->
     c' = Skip%imp ->
     ∃n, CWhile_path'' c1' b c1 st1 st2 n).
Proof.
  intros.
  induction_1n H; intros.
  + split.
    { intros; subst. inversion H0. }
    split.
    { intros; subst. inversion H0. }
    { intros; subst. inversion H0. }
  + split; [| split].
    - intros; subst.
      destruct IHrt as [_ [IHrt _]].
      inversion H; subst.
      specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
      destruct IHrt as [n ?].
      ∃n.
      destruct n; exact H1.
    - intros; subst.
      inversion H; subst.
      * destruct IHrt as [_ [IHrt _]].
        specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
        destruct IHrt as [n ?].
        ∃n.
        destruct n; simpl in H1; simpl.
       ++ destruct H1.
          split; [etransitivity_1n; eassumption | tauto].
       ++ destruct H1 as [st1' [? [? ?]]].
          ∃st1'.
          split; [etransitivity_1n; eassumption | tauto].
      * destruct IHrt as [_ [_ IHrt]].
        specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
        destruct IHrt as [n ?].
        ∃(S n).
        unfold CWhile_path'' in H1.
        simpl.
        destruct H1 as [st1' [? ?]].
        ∃st1'.
        assert (multi_bstep s BTrue BTrue). { reflexivity. }
        tauto.
      * ∃O.
        simpl.
        assert (multi_bstep s BFalse BFalse). { reflexivity. }
        apply CSkip_halt in H0.
        tauto.
    - intros; subst.
      inversion H; subst.
      * destruct IHrt as [_ [_ IHrt]].
        specialize (IHrt _ _ _ ltac:(reflexivity) ltac:(reflexivity)).
        destruct IHrt as [n ?].
        ∃n.
        unfold CWhile_path'' in H1.
        unfold CWhile_path''.
        destruct H1 as [st1' [? ?]].
        ∃st1'.
        assert (multi_cstep (c1', st1) (Skip%imp, st1')).
        { etransitivity_1n; eassumption. }
        tauto.
      * destruct IHrt as [IHrt [? ?]].
        specialize (IHrt _ _ ltac:(reflexivity) ltac:(reflexivity)).
        destruct IHrt as [n ?].
        ∃n.
        unfold CWhile_path''.
        ∃s.
        split; [reflexivity | tauto].
Qed.
Lemma CWhile_path_spec: ∀b c1 st1 st2,
  multi_cstep (CWhile b c1, st1) (CSkip, st2) ->
  ∃n, CWhile_path b c1 st1 st2 n.
Proof.
  intros.
  remember (CWhile b c1) as c eqn:H0.
  remember CSkip as c' eqn:H1.
  revert b c1 H0 H1.
  pose proof CWhile_path_spec_aux st1 st2 c c'.
  tauto.
Qed.

Alternative Proofs: From Multi-step Relations To Denotations


Theorem semantic_equiv_aexp3: ∀st a n,
  multi_astep st a (ANum n) -> aeval a st = n.
Proof.
  intros.
  revert n H; induction a; intros; simpl.
  + apply ANum_halt in H.
    injection H as ?H.
    rewrite H.
    reflexivity.
  + unfold_with_1n multi_astep in H.
    inversion H; subst.
    inversion H0; subst.
    inversion H1; subst.
    - reflexivity.
    - inversion H2.
  + apply APlus_path_spec in H.
    destruct H as [n1 [n2 [? [? ?]]]].
    apply IHa1 in H.
    apply IHa2 in H0.
    unfold Func.add; lia.
  + apply AMinus_path_spec in H.
    destruct H as [n1 [n2 [? [? ?]]]].
    apply IHa1 in H.
    apply IHa2 in H0.
    unfold Func.sub; lia.
  + apply AMult_path_spec in H.
    destruct H as [n1 [n2 [? [? ?]]]].
    apply IHa1 in H.
    apply IHa2 in H0.
    unfold Func.mul; nia.
Qed.
Theorem semantic_equiv_bexp3: ∀st b,
  (multi_bstep st b BTrue -> beval b st) ∧
  (multi_bstep st b BFalse -> ¬beval b st).
Proof.
  intros.
  induction b; simpl.
  + split; intros.
    - exact I.
    - apply never_BTrue_to_BFalse in H.
      destruct H.
  + split; intros.
    - apply never_BFalse_to_BTrue in H.
      destruct H.
    - tauto.
  + split; intros.
    - apply BEq_True_path_spec in H.
      destruct H as [n1 [n2 [? [? ?]]]].
      apply semantic_equiv_aexp3 in H.
      apply semantic_equiv_aexp3 in H0.
      unfold Func.test_eq; lia.
    - apply BEq_False_path_spec in H.
      destruct H as [n1 [n2 [? [? ?]]]].
      apply semantic_equiv_aexp2 in H.
      apply semantic_equiv_aexp2 in H0.
      unfold Func.test_eq; lia.
  + split; intros.
    - apply BLe_True_path_spec in H.
      destruct H as [n1 [n2 [? [? ?]]]].
      apply semantic_equiv_aexp3 in H.
      apply semantic_equiv_aexp3 in H0.
      unfold Func.test_le; lia.
    - apply BLe_False_path_spec in H.
      destruct H as [n1 [n2 [? [? ?]]]].
      apply semantic_equiv_aexp3 in H.
      apply semantic_equiv_aexp3 in H0.
      unfold Func.test_le; lia.
  + destruct IHb as [IHb1 IHb2].
    split; intros.
    - apply BNot_True_path_spec in H.
      unfold Sets.complement; tauto.
    - apply BNot_False_path_spec in H.
      unfold Sets.complement; tauto.
  + split; intros.
    - apply BAnd_True_path_spec in H.
      unfold Sets.intersect; tauto.
    - apply BAnd_False_path_spec in H.
      unfold Sets.intersect; tauto.
Qed.
Theorem semantic_equiv_com3: ∀c st1 st2,
  multi_cstep (c, st1) (CSkip, st2) -> ceval c st1 st2.
Proof.
  intros.
  revert st1 st2 H; induction c; intros.
  + apply CSkip_halt in H.
    destruct H.
    rewrite H0.
    simpl.
    unfold BinRel.id.
    reflexivity.
  + apply CAss_path_spec in H.
    destruct H as [n [? [? ?]]].
    apply semantic_equiv_aexp3 in H.
    rewrite ceval_CAss, H.
    tauto.
  + apply CSeq_path_spec in H.
    destruct H as [st1' [? ?]].
    apply IHc1 in H.
    apply IHc2 in H0.
    rewrite ceval_CSeq.
    unfold BinRel.concat.
    ∃st1'.
    tauto.
  + apply CIf_path_spec in H.
    rewrite ceval_CIf.
    unfold if_sem.
    unfold BinRel.union,
           BinRel.concat,
           BinRel.test_rel.
    specialize (IHc1 st1 st2).
    specialize (IHc2 st1 st2).
    pose proof semantic_equiv_bexp3 st1 b.
    destruct H; [left | right]; ∃st1; tauto.
  + apply CWhile_path_spec in H.
    rewrite ceval_CWhile.
    unfold loop_sem.
    unfold BinRel.omega_union.
    destruct H as [n ?].
    ∃n.
    revert st1 H; induction n; simpl; intros.
    - pose proof semantic_equiv_bexp3 st1 b.
      destruct H.
      subst st2.
      unfold BinRel.test_rel,
             Sets.complement.
      tauto.
    - destruct H as [st1' [? [? ?]]].
      specialize (IHn st1').
      unfold BinRel.concat,
             BinRel.test_rel.
      apply semantic_equiv_bexp3 in H.
      ∃st1.
      split.
      * tauto.
      * ∃st1'.
        specialize (IHc st1 st1').
        tauto.
Qed.
(* 2021-03-30 22:54 *)