Lemma multi_astep_refl: ∀st a,
  multi_astep st a a.

Lemma multi_astep_step: ∀{st a₁ a₂},
  astep st a₁ a₂ →
  multi_astep st a₁ a₂.

Lemma multi_astep_trans: ∀{st a₁ a₂ a₃},
  multi_astep st a₁ a₂ →
  multi_astep st a₂ a₃ →
  multi_astep st a₁ a₃.

Lemma multi_astep_trans_n₁: ∀{st a₁ a₂ a₃},
  multi_astep st a₁ a₂ →
  astep st a₂ a₃ →
  multi_astep st a₁ a₃.

Lemma multi_astep_trans_1n: ∀{st a₁ a₂ a₃},
  astep st a₁ a₂ →
  multi_astep st a₂ a₃ →
  multi_astep st a₁ a₃.

Lemma multi_bstep_refl: ∀st b,
  multi_bstep st b b.

Lemma multi_bstep_step: ∀{st b₁ b₂},
  bstep st b₁ b₂ →
  multi_bstep st b₁ b₂.

Lemma multi_bstep_trans: ∀{st b₁ b₂ b₃},
  multi_bstep st b₁ b₂ →
  multi_bstep st b₂ b₃ →
  multi_bstep st b₁ b₃.

Lemma multi_bstep_trans_n₁: ∀{st b₁ b₂ b₃},
  multi_bstep st b₁ b₂ →
  bstep st b₂ b₃ →
  multi_bstep st b₁ b₃.

Lemma multi_bstep_trans_1n: ∀{st b₁ b₂ b₃},
  bstep st b₁ b₂ →
  multi_bstep st b₂ b₃ →
  multi_bstep st b₁ b₃.

Lemma multi_cstep_refl: ∀st c,
  multi_cstep (c, st) (c, st).

Lemma multi_cstep_step: ∀{st₁ st₂ c₁ c₂},
  cstep (c₁, st₁) (c₂, st₂) →
  multi_cstep (c₁, st₁) (c₂, st₂).

Lemma multi_cstep_trans: ∀{st₁ st₂ st₃ c₁ c₂ c₃},
  multi_cstep (c₁, st₁) (c₂, st₂) →
  multi_cstep (c₂, st₂) (c₃, st₃) →
  multi_cstep (c₁, st₁) (c₃, st₃).

Lemma multi_cstep_trans_n₁: ∀{st₁ st₂ st₃ c₁ c₂ c₃},
  multi_cstep (c₁, st₁) (c₂, st₂) →
  cstep (c₂, st₂) (c₃, st₃) →
  multi_cstep (c₁, st₁) (c₃, st₃).

Lemma multi_cstep_trans_1n: ∀{st₁ st₂ st₃ c₁ c₂ c₃},
  cstep (c₁, st₁) (c₂, st₂) →
  multi_cstep (c₂, st₂) (c₃, st₃) →
  multi_cstep (c₁, st₁) (c₃, st₃).

Lemma multi_astep_ind_n₁: ∀st (P: aexp → aexp → Prop),
  (∀a, P a a) →
  (∀a₁ a₂ a₃ (IH: P a₁ a₂),
    multi_astep st a₁ a₂ →
    astep st a₂ a₃ →
    P a₁ a₃) →
  (∀a₁ a₂,
    multi_astep st a₁ a₂ →
    P a₁ a₂).
Proof.
  intros.
  unfold multi_astep in H₁.
  apply Operators_Properties.clos_rt_rtn1_iff in H₁.
  induction H₁.
  + apply H.
  + apply Operators_Properties.clos_rt_rtn1_iff in H₂.
    unfold multi_astep in H₀.
    pose proof H₀ _ y _ IHclos_refl_trans_n₁ H₂ H₁.
    exact H₃.
Qed.

---

Lemma multi_bstep_ind_n₁: ∀st (P: bexp → bexp → Prop),
  (∀b, P b b) →
  (∀b₁ b₂ b₃ (IH: P b₁ b₂),
    multi_bstep st b₁ b₂ →
    bstep st b₂ b₃ →
    P b₁ b₃) →
  (∀b₁ b₂,
    multi_bstep st b₁ b₂ →
    P b₁ b₂).
Proof.
  intros.
  unfold multi_bstep in H₁.
  apply Operators_Properties.clos_rt_rtn1_iff in H₁.
  induction H₁.
  + apply H.
  + apply Operators_Properties.clos_rt_rtn1_iff in H₂.
    unfold multi_bstep in H₀.
    pose proof H₀ _ y _ IHclos_refl_trans_n₁ H₂ H₁.
    exact H₃.
Qed.

---

Lemma multi_cstep_ind_n₁: ∀(P: com → state → com → state → Prop),
  (∀c st, P c st c st) →
  (∀c₁ c₂ c₃ st₁ st₂ st₃ (IH: P c₁ st₁ c₂ st₂),
    multi_cstep (c₁, st₁) (c₂, st₂) →
    cstep (c₂, st₂) (c₃, st₃) →
    P c₁ st₁ c₃ st₃) →
  (∀c₁ c₂ st₁ st₂,
    multi_cstep (c₁, st₁) (c₂, st₂) →
    P c₁ st₁ c₂ st₂).
Proof.
  intros.
  unfold multi_cstep in H₁.
  apply Operators_Properties.clos_rt_rtn1_iff in H₁.
  remember (c₁, st₁) as cst1 eqn:HH₁.
  remember (c₂, st₂) as cst2 eqn:HH₂.
  revert c₁ c₂ st₁ st₂ HH₁ HH₂; induction H₁; intros; subst.
  + injection HH₂ as ? ?.
    subst.
    apply H.
  + apply Operators_Properties.clos_rt_rtn1_iff in H₂.
    destruct y as [c₀ st₀].
    unfold multi_cstep in H₀.
    assert ((c₁, st₁) = (c₁, st₁)). { reflexivity. }
    assert ((c₀, st₀) = (c₀, st₀)). { reflexivity. }
    pose proof IHclos_refl_trans_n₁ _ _ _ _ H₃ H₄.
    pose proof H₀ _ c₀ _ _ st₀ _ H₅ H₂ H₁.
    exact H₆.
Qed.

---

Lemma multi_astep_ind_1n: ∀st (P: aexp → aexp → Prop),
  (∀a, P a a) →
  (∀a₁ a₂ a₃ (IH: P a₂ a₃),
    astep st a₁ a₂ →
    multi_astep st a₂ a₃ →
    P a₁ a₃) →
  (∀a₁ a₂,
    multi_astep st a₁ a₂ →
    P a₁ a₂).
Proof.
  intros.
  unfold multi_astep in H₁.
  apply Operators_Properties.clos_rt_rt1n_iff in H₁.
  induction H₁.
  + apply H.
  + apply Operators_Properties.clos_rt_rt1n_iff in H₂.
    unfold multi_astep in H₀.
    pose proof H₀ _ y _ IHclos_refl_trans_1n H₁ H₂.
    exact H₃.
Qed.

---

Lemma multi_bstep_ind_1n: ∀st (P: bexp → bexp → Prop),
  (∀b, P b b) →
  (∀b₁ b₂ b₃ (IH: P b₂ b₃),
    bstep st b₁ b₂ →
    multi_bstep st b₂ b₃ →
    P b₁ b₃) →
  (∀b₁ b₂,
    multi_bstep st b₁ b₂ →
    P b₁ b₂).
Proof.
  intros.
  unfold multi_bstep in H₁.
  apply Operators_Properties.clos_rt_rt1n_iff in H₁.
  induction H₁.
  + apply H.
  + apply Operators_Properties.clos_rt_rt1n_iff in H₂.
    unfold multi_bstep in H₀.
    pose proof H₀ _ y _ IHclos_refl_trans_1n H₁ H₂.
    exact H₃.
Qed.

---

Lemma multi_cstep_ind_1n: ∀(P: com → state → com → state → Prop),
  (∀c st, P c st c st) →
  (∀c₁ c₂ c₃ st₁ st₂ st₃ (IH: P c₂ st₂ c₃ st₃),
    cstep (c₁, st₁) (c₂, st₂) →
    multi_cstep (c₂, st₂) (c₃, st₃) →
    P c₁ st₁ c₃ st₃) →
  (∀c₁ c₂ st₁ st₂,
    multi_cstep (c₁, st₁) (c₂, st₂) →
    P c₁ st₁ c₂ st₂).
Proof.
  intros.
  unfold multi_cstep in H₁.
  apply Operators_Properties.clos_rt_rt1n_iff in H₁.
  remember (c₁, st₁) as cst1 eqn:HH₁.
  remember (c₂, st₂) as cst2 eqn:HH₂.
  revert c₁ c₂ st₁ st₂ HH₁ HH₂; induction H₁; intros; subst.
  + injection HH₂ as ? ?.
    subst.
    apply H.
  + apply Operators_Properties.clos_rt_rt1n_iff in H₂.
    destruct y as [c₀ st₀].
    unfold multi_cstep in H₀.
    assert ((c₀, st₀) = (c₀, st₀)). { reflexivity. }
    assert ((c₂, st₂) = (c₂, st₂)). { reflexivity. }
    pose proof IHclos_refl_trans_1n _ _ _ _ H₃ H₄.
    pose proof H₀ _ c₀ _ _ st₀ _ H₅ H₁ H₂.
    exact H₆.
Qed.

---

Ltac induction_n₁ H :=
  match type of H with
  | multi_astep ?st ?a₁ ?a₂ ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern a₁, a₂ in P in
           match Q with
           | ?R a₁ a₂ ⇒
             revert a₁ a₂ H;
             refine (multi_astep_ind_n₁ st R _ _);
             [intros a₁ | intros a₁ ?a₁ a₂ ? ? ?]
           end
      end
  | multi_bstep ?st ?b₁ ?b₂ ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern b₁, b₂ in P in
           match Q with
           | ?R b₁ b₂ ⇒
             revert b₁ b₂ H;
             refine (multi_bstep_ind_n₁ st R _ _);
             [intros b₁ | intros b₁ ?b₁ b₂ ? ? ?]
           end
      end
  | multi_cstep (?c₁, ?st₁) (?c₂, ?st₂) ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern c₁, st₁, c₂, st₂ in P in
           match Q with
           | ?R c₁ st₁ c₂ st₂ ⇒
             revert c₁ c₂ st₁ st₂ H;
             refine (multi_cstep_ind_n₁ R _ _);
             [intros c₁ st₁ | intros c₁ ?c₁ c₂ st₁ ?st₁ st₂ ? ? ?]
           end
      end
  end.

---

Ltac induction_1n H :=
  match type of H with
  | multi_astep ?st ?a₁ ?a₂ ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern a₁, a₂ in P in
           match Q with
           | ?R a₁ a₂ ⇒
             revert a₁ a₂ H;
             refine (multi_astep_ind_1n st R _ _);
             [intros a₁ | intros a₁ ?a₁ a₂ ? ? ?]
           end
      end
  | multi_bstep ?st ?b₁ ?b₂ ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern b₁, b₂ in P in
           match Q with
           | ?R b₁ b₂ ⇒
             revert b₁ b₂ H;
             refine (multi_bstep_ind_1n st R _ _);
             [intros b₁ | intros b₁ ?b₁ b₂ ? ? ?]
           end
      end
  | multi_cstep (?c₁, ?st₁) (?c₂, ?st₂) ⇒
      match goal with
      | |- ?P ⇒
           let Q := eval pattern c₁, st₁, c₂, st₂ in P in
           match Q with
           | ?R c₁ st₁ c₂ st₂ ⇒
             revert c₁ c₂ st₁ st₂ H;
             refine (multi_cstep_ind_1n R _ _);
             [intros c₁ st₁ | intros c₁ ?c₁ c₂ st₁ ?st₁ st₂ ? ? ?]
           end
      end
  end.

Theorem multi_congr_APlus1: ∀st a₁ a₁' a₂,
  multi_astep st a₁ a₁' →
  multi_astep st (a₁ + a₂) (a₁' + a₂).

Theorem multi_congr_APlus2: ∀st a₁ a₂ a₂',
  aexp_halt a₁ →
  multi_astep st a₂ a₂' →
  multi_astep st (a₁ + a₂) (a₁ + a₂').

Theorem multi_congr_AMinus1: ∀st a₁ a₁' a₂,
  multi_astep st a₁ a₁' →
  multi_astep st (a₁ - a₂) (a₁' - a₂).

Theorem multi_congr_AMinus2: ∀st a₁ a₂ a₂',
  aexp_halt a₁ →
  multi_astep st a₂ a₂' →
  multi_astep st (a₁ - a₂) (a₁ - a₂').

Theorem multi_congr_AMult1: ∀st a₁ a₁' a₂,
  multi_astep st a₁ a₁' →
  multi_astep st (a₁ * a₂) (a₁' * a₂).

Theorem multi_congr_AMult2: ∀st a₁ a₂ a₂',
  aexp_halt a₁ →
  multi_astep st a₂ a₂' →
  multi_astep st (a₁ * a₂) (a₁ * a₂').

Theorem multi_congr_BEq1: ∀st a₁ a₁' a₂,
  multi_astep st a₁ a₁' →
  multi_bstep st (a₁ == a₂) (a₁' == a₂).

Theorem multi_congr_BEq2: ∀st a₁ a₂ a₂',
  aexp_halt a₁ →
  multi_astep st a₂ a₂' →
  multi_bstep st (a₁ == a₂) (a₁ == a₂').

Theorem multi_congr_BLe1: ∀st a₁ a₁' a₂,
  multi_astep st a₁ a₁' →
  multi_bstep st (a₁ ≤ a₂) (a₁' ≤ a₂).

Theorem multi_congr_BLe2: ∀st a₁ a₂ a₂',
  aexp_halt a₁ →
  multi_astep st a₂ a₂' →
  multi_bstep st (a₁ ≤ a₂) (a₁ ≤ a₂').

Theorem multi_congr_BNot: ∀st b b',
  multi_bstep st b b' →
  multi_bstep st (BNot b) (BNot b').

Theorem multi_congr_BAnd: ∀st b₁ b₁' b₂,
  multi_bstep st b₁ b₁' →
  multi_bstep st (BAnd b₁ b₂) (BAnd b₁' b₂).

Theorem multi_congr_CAss: ∀st X a a',
  multi_astep st a a' →
  multi_cstep (CAss X a, st) (CAss X a', st).

Theorem multi_congr_CSeq: ∀st₁ c₁ st₁' c₁' c₂,
  multi_cstep (c₁, st₁) (c₁', st₁') →
  multi_cstep (CSeq c₁ c₂, st₁) (CSeq c₁' c₂, st₁').

Theorem multi_congr_CIf: ∀st b b' c₁ c₂,
  multi_bstep st b b' →
  multi_cstep
    (CIf b c₁ c₂, st)
    (CIf b' c₁ c₂, st).

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.
  + simpl in H.
    rewrite H.
    apply multi_astep_refl.
  + rewrite <- H.
    apply multi_astep_step.
    apply AS_Id.
  + assert (aeval a₁ st = aeval a₁ st).
    { reflexivity. }
    pose proof IHa1 _ H₀.
    pose proof multi_congr_APlus1 _ _ _ a₂ H₁ as IH₁.
    clear IHa1 H₀ H₁.
    assert (aeval a₂ st = aeval a₂ st).
    { reflexivity. }
    pose proof IHa2 _ H₀.
    pose proof AH_num (aeval a₁ st).
    pose proof multi_congr_APlus2 _ _ _ _ H₂ H₁ as IH₂.
    clear IHa2 H₀ H₁ H₂.
    pose proof AS_Plus st (aeval a₁ st) (aeval a₂ st).
    rewrite H in H₀.
    pose proof multi_astep_trans IH₁ IH₂.
    pose proof multi_astep_trans_n₁ H₁ H₀.
    exact H₂.
  + assert (aeval a₁ st = aeval a₁ st).
    { reflexivity. }
    pose proof IHa1 _ H₀.
    pose proof multi_congr_AMinus1 _ _ _ a₂ H₁ as IH₁.
    clear IHa1 H₀ H₁.
    assert (aeval a₂ st = aeval a₂ st).
    { reflexivity. }
    pose proof IHa2 _ H₀.
    pose proof AH_num (aeval a₁ st).
    pose proof multi_congr_AMinus2 _ _ _ _ H₂ H₁ as IH₂.
    clear IHa2 H₀ H₁ H₂.
    pose proof AS_Minus st (aeval a₁ st) (aeval a₂ st).
    rewrite H in H₀.
    pose proof multi_astep_trans IH₁ IH₂.
    pose proof multi_astep_trans_n₁ H₁ H₀.
    exact H₂.
  + assert (aeval a₁ st = aeval a₁ st).
    { reflexivity. }
    pose proof IHa1 _ H₀.
    pose proof multi_congr_AMult1 _ _ _ a₂ H₁ as IH₁.
    clear IHa1 H₀ H₁.
    assert (aeval a₂ st = aeval a₂ st).
    { reflexivity. }
    pose proof IHa2 _ H₀.
    pose proof AH_num (aeval a₁ st).
    pose proof multi_congr_AMult2 _ _ _ _ H₂ H₁ as IH₂.
    clear IHa2 H₀ H₁ H₂.
    pose proof AS_Mult st (aeval a₁ st) (aeval a₂ st).
    rewrite H in H₀.
    pose proof multi_astep_trans IH₁ IH₂.
    pose proof multi_astep_trans_n₁ H₁ H₀.
    exact H₂.
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.
      apply multi_bstep_refl.
    - tauto.
  + split.
    - tauto.
    - intros.
      apply multi_bstep_refl.
  + assert (aeval a₁ st = aeval a₁ st).
    { reflexivity. }
    pose proof semantic_equiv_aexp1 st a₁ _ H.
    pose proof multi_congr_BEq1 _ _ _ a₂ H₀ as IH₁.
    clear H H₀.
    assert (aeval a₂ st = aeval a₂ st).
    { reflexivity. }
    pose proof semantic_equiv_aexp1 st a₂ _ H.
    pose proof AH_num (aeval a₁ st).
    pose proof multi_congr_BEq2 _ _ _ _ H₁ H₀ as IH₂.
    clear H H₀ H₁.

---

    split; intros.
    - pose proof BS_Eq_True st _ _ H.
      pose proof multi_bstep_trans IH₁ IH₂.
      pose proof multi_bstep_trans_n₁ H₁ H₀.
      exact H₂.
    - pose proof BS_Eq_False st _ _ H.
      pose proof multi_bstep_trans IH₁ IH₂.
      pose proof multi_bstep_trans_n₁ H₁ H₀.
      exact H₂.
  + assert (aeval a₁ st = aeval a₁ st).
    { reflexivity. }
    pose proof semantic_equiv_aexp1 st a₁ _ H.
    pose proof multi_congr_BLe1 _ _ _ a₂ H₀ as IH₁.
    clear H H₀.
    assert (aeval a₂ st = aeval a₂ st).
    { reflexivity. }
    pose proof semantic_equiv_aexp1 st a₂ _ H.
    pose proof AH_num (aeval a₁ st).
    pose proof multi_congr_BLe2 _ _ _ _ H₁ H₀ as IH₂.
    clear H H₀ H₁.

---

    split; intros.
    - pose proof BS_Le_True st _ _ H.
      pose proof multi_bstep_trans IH₁ IH₂.
      pose proof multi_bstep_trans_n₁ H₁ H₀.
      exact H₂.
    - assert (aeval a₁ st > aeval a₂ st). { omega. }
      pose proof BS_Le_False st _ _ H₀.
      pose proof multi_bstep_trans IH₁ IH₂.
      pose proof multi_bstep_trans_n₁ H₂ H₁.
      exact H₃.
  + destruct IHb as [IH₁ IH₂].
    split; intros.
    - specialize (IH₂ H).
      pose proof multi_congr_BNot st _ _ IH₂.
      pose proof BS_NotFalse st.
      pose proof multi_bstep_trans_n₁ H₀ H₁.
      exact H₂.
    - assert (multi_bstep st b BTrue). { tauto. }
      pose proof multi_congr_BNot st _ _ H₀.
      pose proof BS_NotTrue st.
      pose proof multi_bstep_trans_n₁ H₁ H₂.
      exact H₃.
  + destruct IHb1 as [IHb11 IHb12].
    destruct IHb2 as [IHb21 IHb22].
    pose proof classic (beval b₁ st).
    destruct H.
    - specialize (IHb11 H).
      pose proof multi_congr_BAnd _ _ _ b₂ IHb11.
      pose proof BS_AndTrue st b₂.
      split.
      * intros.
        destruct H₂.
        specialize (IHb21 H₃).
        pose proof multi_bstep_trans_n₁ H₀ H₁.
        pose proof multi_bstep_trans H₄ IHb21.
        exact H₅.
      * intros.
        assert (¬beval b₂ st). { tauto. }
        specialize (IHb22 H₃).
        pose proof multi_bstep_trans_n₁ H₀ H₁.
        pose proof multi_bstep_trans H₄ IHb22.
        exact H₅.
    - split; intros. { tauto. }
      specialize (IHb12 H).
      pose proof multi_congr_BAnd _ _ _ b₂ IHb12.
      pose proof BS_AndFalse st b₂.
      pose proof multi_bstep_trans_n₁ H₁ H₂.
      exact H₃.
Qed.

---

Lemma semantic_equiv_iter_loop1: ∀st₁ st₂ n b c,
  (∀st₁ st₂, ceval c st₁ st₂ → multi_cstep (c, st₁) (Skip, st₂)) →
  iter_loop_body b (ceval c) n st₁ st₂ →
  multi_cstep (While b Do c EndWhile, st₁) (Skip, st₂).
Proof.
  intros.
  revert st₁ st₂ H₀; induction n; intros.
  + simpl in H₀.
    unfold Relation_Operators.intersection,
           Relation_Operators.filter1,
           Relation_Operators.id in H₀.
    destruct H₀.
    subst st₂.
    pose proof CS_While st₁ b c.
    pose proof semantic_equiv_bexp1 st₁ b.
    assert (multi_bstep st₁ b BFalse). { tauto. }
    pose proof multi_congr_CIf _ _ _ (c;; While b Do c EndWhile) Skip H₃.
    pose proof CS_IfFalse st₁ (c;; While b Do c EndWhile) Skip.
    pose proof multi_cstep_trans_1n H₀ H₄.
    pose proof multi_cstep_trans_n₁ H₆ H₅.
    exact H₇.
  + simpl in H₀.
    unfold Relation_Operators.concat,
           Relation_Operators.intersection,
           Relation_Operators.filter1,
           Relation_Operators.id in H₀.
    destruct H₀ as [[st [? ?]] ?].

---

    pose proof CS_While st₁ b c as STEP1.

---

    pose proof semantic_equiv_bexp1 st₁ b.
    assert (multi_bstep st₁ b BTrue). { tauto. }
    pose proof multi_congr_CIf _ _ _ (c;; While b Do c EndWhile) Skip H₄
      as STEP2.
    clear H₄ H₃ H₂.

---

    pose proof CS_IfTrue st₁ (c;; While b Do c EndWhile) Skip as STEP3.

---

    pose proof H _ _ H₀.
    pose proof multi_congr_CSeq _ _ _ _ (While b Do c EndWhile) H₂ as STEP4.
    clear H H₀ H₂.

---

    pose proof CS_Seq st (While b Do c EndWhile) as STEP5.

---

    pose proof IHn _ _ H₁ as STEP6.
    clear IHn H₁.

---

    pose proof multi_cstep_trans_1n STEP1 STEP2.
    pose proof multi_cstep_trans_n₁ H STEP3.
    pose proof multi_cstep_trans H₀ STEP4.
    pose proof multi_cstep_trans_n₁ H₁ STEP5.
    pose proof multi_cstep_trans H₂ STEP6.
    exact H₃.
Qed.

---

Theorem semantic_equiv_com1: ∀st₁ st₂ c,
  ceval c st₁ st₂ → multi_cstep (c, st₁) (Skip, st₂).
Proof.
  intros.
  revert st₁ st₂ H; induction c; intros; simpl in H.
  + unfold Relation_Operators.id in H.
    rewrite H.
    apply multi_cstep_refl.
  + destruct H.
    assert (aeval a st₁ = aeval a st₁).
    { reflexivity. }
    pose proof semantic_equiv_aexp1 _ _ _ H₁.
    pose proof multi_congr_CAss st₁ X _ _ H₂.
    pose proof CS_Ass _ _ _ _ H H₀.
    pose proof multi_cstep_trans_n₁ H₃ H₄.
    exact H₅.
  + unfold Relation_Operators.concat in H.
    destruct H as [st' [? ?]].
    specialize (IHc1 _ _ H).
    specialize (IHc2 _ _ H₀).
    pose proof multi_congr_CSeq _ _ _ _ c₂ IHc1.
    pose proof CS_Seq st' c₂.
    pose proof multi_cstep_trans_n₁ H₁ H₂.
    pose proof multi_cstep_trans H₃ IHc2.
    exact H₄.
  + unfold if_sem in H.
    unfold Relation_Operators.union, Relation_Operators.intersection,
           Relation_Operators.filter1 in H.
    pose proof semantic_equiv_bexp1 st₁ b.
    destruct H₀.
    destruct H as [[? ?] | [? ?]].
    - specialize (H₀ H₂).
      pose proof IHc1 _ _ H.
      clear H H₁ H₂ IHc1 IHc2.
      pose proof multi_congr_CIf _ _ _ c₁ c₂ H₀.
      pose proof CS_IfTrue st₁ c₁ c₂.
      pose proof multi_cstep_trans_n₁ H H₁.
      pose proof multi_cstep_trans H₂ H₃.
      exact H₄.
    - specialize (H₁ H₂).
      pose proof IHc2 _ _ H.
      clear H H₀ H₂ IHc1 IHc2.
      pose proof multi_congr_CIf _ _ _ c₁ c₂ H₁.
      pose proof CS_IfFalse st₁ c₁ c₂.
      pose proof multi_cstep_trans_n₁ H H₀.
      pose proof multi_cstep_trans H₂ H₃.
      exact H₄.
  + unfold loop_sem in H.
    unfold Relation_Operators.omega_union in H.
    destruct H as [n ?].
    apply semantic_equiv_iter_loop1 with n.
    - exact IHc.
    - exact H.
Qed.

Local Open Scope Z.
Local Close Scope imp.

---

Lemma ANum_halt: ∀st n a,
  multi_astep st (ANum n) a →
  a = ANum n.

Lemma never_BFalse_to_BTrue: ∀st,
  multi_bstep st BFalse BTrue → False.

Lemma never_BTrue_to_BFalse: ∀st,
  multi_bstep st BTrue BFalse → False.

Lemma CSkip_halt: ∀st st' c,
  multi_cstep (CSkip, st) (c, st') →
  c = CSkip ∧ st = st'.
Proof.

Lemma APlus_path_spec: ∀st a₁ a₂ n,
  multi_astep st (APlus a₁ a₂) (ANum n) →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n = (n₁ + n₂).
Proof.
  intros.
  remember (APlus a₁ a₂) as a eqn:H₀.
  remember (ANum n) as a' eqn:H₁.
  revert a₁ a₂ n H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (APlus a₁' a₂ = APlus a₁' a₂).
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (APlus a₁ a₂' = APlus a₁ a₂').
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - clear IH.
      apply ANum_halt in H₀.
      injection H₀ as H₁.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
Qed.

---

Lemma AMinus_path_spec: ∀st a₁ a₂ n,
  multi_astep st (AMinus a₁ a₂) (ANum n) →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n = (n₁ - n₂).
Proof.
  intros.
  remember (AMinus a₁ a₂) as a eqn:H₀.
  remember (ANum n) as a' eqn:H₁.
  revert a₁ a₂ n H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (AMinus a₁' a₂ = AMinus a₁' a₂).
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (AMinus a₁ a₂' = AMinus a₁ a₂').
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - clear IH.
      apply ANum_halt in H₀.
      injection H₀ as H₁.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
Qed.

---

Lemma AMult_path_spec: ∀st a₁ a₂ n,
  multi_astep st (AMult a₁ a₂) (ANum n) →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n = (n₁ * n₂).
Proof.
  intros.
  remember (AMult a₁ a₂) as a eqn:H₀.
  remember (ANum n) as a' eqn:H₁.
  revert a₁ a₂ n H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (AMult a₁' a₂ = AMult a₁' a₂).
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (AMult a₁ a₂' = AMult a₁ a₂').
      { reflexivity. }
      assert (ANum n = ANum n).
      { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - clear IH.
      apply ANum_halt in H₀.
      injection H₀ as H₁.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
Qed.

---

Lemma BEq_True_path_spec: ∀st a₁ a₂,
  multi_bstep st (BEq a₁ a₂) BTrue →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n₁ = n₂.
Proof.
  intros.
  remember (BEq a₁ a₂) as a eqn:H₀.
  remember BTrue as a' eqn:H₁.
  revert a₁ a₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BEq a₁' a₂ = BEq a₁' a₂).
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (BEq a₁ a₂' = BEq a₁ a₂').
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - clear IH.
      ∃n₂, n₂.
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
    - apply never_BFalse_to_BTrue in H₀.
      destruct H₀.
Qed.

---

Lemma BEq_False_path_spec: ∀st a₁ a₂,
  multi_bstep st (BEq a₁ a₂) BFalse →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n₁ ≠ n₂.
Proof.
  intros.
  remember (BEq a₁ a₂) as a eqn:H₀.
  remember BFalse as a' eqn:H₁.
  revert a₁ a₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BEq a₁' a₂ = BEq a₁' a₂).
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      unfold multi_astep in H₁.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (BEq a₁ a₂' = BEq a₁ a₂').
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - apply never_BTrue_to_BFalse in H₀.
      destruct H₀.
    - clear IH.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
Qed.

---

Lemma BLe_True_path_spec: ∀st a₁ a₂,
  multi_bstep st (BLe a₁ a₂) BTrue →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n₁ ≤ n₂.
Proof.
  intros.
  remember (BLe a₁ a₂) as a eqn:H₀.
  remember BTrue as a' eqn:H₁.
  revert a₁ a₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BLe a₁' a₂ = BLe a₁' a₂).
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (BLe a₁ a₂' = BLe a₁ a₂').
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - clear IH.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      tauto.
    - apply never_BFalse_to_BTrue in H₀.
      destruct H₀.
Qed.

---

Lemma BLe_False_path_spec: ∀st a₁ a₂,
  multi_bstep st (BLe a₁ a₂) BFalse →
  ∃n₁ n₂,
  multi_astep st a₁ (ANum n₁) ∧
  multi_astep st a₂ (ANum n₂) ∧
  n₁ > n₂.
Proof.
  intros.
  remember (BLe a₁ a₂) as a eqn:H₀.
  remember BFalse as a' eqn:H₁.
  revert a₁ a₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BLe a₁' a₂ = BLe a₁' a₂).
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₅ H₁.
      tauto.
    - assert (BLe a₁ a₂' = BLe a₁ a₂').
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n₁ [n₂ [? [? ?]]]].
      ∃n₁, n₂.
      pose proof multi_astep_trans_1n H₆ H₂.
      tauto.
    - apply never_BTrue_to_BFalse in H₀.
      destruct H₀.
    - clear IH.
      ∃n₁, n₂.
      pose proof multi_astep_refl st (ANum n₁).
      pose proof multi_astep_refl st (ANum n₂).
      unfold multi_astep.
      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 b₁ eqn:H₀.
  remember BTrue as b₂ eqn:H₁.
  revert b H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BNot b₁' = BNot b₁').
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ H₁ H₂.
      pose proof multi_bstep_trans_1n H₃ H₄.
      exact H₅.
    - apply never_BFalse_to_BTrue in H₀.
      destruct H₀.
    - apply multi_bstep_refl.
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 b₁ eqn:H₀.
  remember BFalse as b₂ eqn:H₁.
  revert b H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BNot b₁' = BNot b₁').
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ H₁ H₂.
      pose proof multi_bstep_trans_1n H₃ H₄.
      exact H₅.
    - apply multi_bstep_refl.
    - apply never_BTrue_to_BFalse in H₀.
      destruct H₀.
Qed.

---

Lemma BAnd_True_path_spec: ∀st b₁ b₂,
  multi_bstep st (BAnd b₁ b₂) BTrue →
  multi_bstep st b₁ BTrue ∧
  multi_bstep st b₂ BTrue.
Proof.
  intros.
  remember (BAnd b₁ b₂) as b eqn:H₀.
  remember BTrue as b' eqn:H₁.
  revert b₁ b₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BAnd b₁' b₂ = BAnd b₁' b₂).
      { reflexivity. }
      assert (BTrue = BTrue).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      destruct H₃.
      pose proof multi_bstep_trans_1n H₅ H₃.
      tauto.
    - split.
      * apply multi_bstep_refl.
      * exact H₀.
    - apply never_BFalse_to_BTrue in H₀.
      destruct H₀.
Qed.

---

Lemma BAnd_False_path_spec: ∀st b₁ b₂,
  multi_bstep st (BAnd b₁ b₂) BFalse →
  multi_bstep st b₁ BFalse ∨
  multi_bstep st b₂ BFalse.
Proof.
  intros.
  remember (BAnd b₁ b₂) as b eqn:H₀.
  remember BFalse as b' eqn:H₁.
  revert b₁ b₂ H₀ H₁; induction_1n H; intros; subst.
  + discriminate H₁.
  + inversion H; subst.
    - assert (BAnd b₁' b₂ = BAnd b₁' b₂).
      { reflexivity. }
      assert (BFalse = BFalse).
      { reflexivity. }
      pose proof IH _ _ H₁ H₂.
      destruct H₃.
      * left.
        pose proof multi_bstep_trans_1n H₅ H₃.
        tauto.
      * right.
        exact H₃.
    - right.
      exact H₀.
    - left.
      apply multi_bstep_refl.
Qed.

---

Lemma CAss_path_spec: ∀X a st₁ st₂,
  multi_cstep (CAss X a, st₁) (CSkip, st₂) →
  ∃n,
  multi_astep st₁ a (ANum n) ∧
  st₂ X = n ∧
  (∀Y : var, X ≠ Y → st₁ Y = st₂ Y).
Proof.
  intros.
  remember (CAss X a) as c eqn:H₀.
  remember CSkip as c' eqn:H₁.
  revert a H₀ H₁; induction_1n H; intros; subst.
  + inversion H₁.
  + inversion H; subst.
    - assert (CAss X a' = CAss X a'). { reflexivity. }
      assert (CSkip = CSkip). { reflexivity. }
      pose proof IH _ H₁ H₃.
      clear IH H₁ H₃.
      destruct H₄ as [n [? ?]].
      ∃n.
      pose proof multi_astep_trans_1n H₂ H₁.
      tauto.
    - clear IH.
      apply CSkip_halt in H₀.
      destruct H₀.
      subst st₀.
      ∃(st₂ X).
      pose proof multi_astep_refl st₁ (ANum (st₂ X)).
      tauto.
Qed.

---

Lemma CSeq_path_spec: ∀c₁ st₁ c₂ st₃,
  multi_cstep (CSeq c₁ c₂, st₁) (CSkip, st₃) →
  ∃st₂,
  multi_cstep (c₁, st₁) (CSkip, st₂) ∧
  multi_cstep (c₂, st₂) (CSkip, st₃).
Proof.
  intros.
  remember (CSeq c₁ c₂) as c eqn:H₀.
  remember CSkip as c' eqn:H₁.
  revert c₁ c₂ H₀ H₁; induction_1n H; intros; subst.
  + inversion H₁.
  + inversion H; subst.
    - assert (CSeq c₁' c₂ = CSeq c₁' c₂). { reflexivity. }
      assert (CSkip = CSkip). { reflexivity. }
      pose proof IH _ _ H₁ H₃.
      clear IH H₁ H₃.
      destruct H₄ as [st₂ [? ?]].
      ∃st₂.
      pose proof multi_cstep_trans_1n H₂ H₁.
      tauto.
    - ∃st₀.
      pose proof multi_cstep_refl st₀ CSkip.
      tauto.
Qed.

---

Lemma CIf_path_spec: ∀b c₁ c₂ st₁ st₂,
  multi_cstep (CIf b c₁ c₂, st₁) (CSkip, st₂) →
  multi_bstep st₁ b BTrue ∧
  multi_cstep (c₁, st₁) (CSkip, st₂) ∨
  multi_bstep st₁ b BFalse ∧
  multi_cstep (c₂, st₁) (CSkip, st₂).
Proof.
  intros.
  remember (CIf b c₁ c₂) as c eqn:H₀.
  remember CSkip as c' eqn:H₁.
  revert b c₁ c₂ H₀ H₁; induction_1n H; intros; subst.
  + inversion H₁.
  + inversion H; subst.
    - assert (CIf b' c₁ c₂ = CIf b' c₁ c₂). { reflexivity. }
      assert (CSkip = CSkip). { reflexivity. }
      pose proof IH _ _ _ H₁ H₃.
      clear IH H₁ H₃.
      destruct H₄ as [[? ?] | [? ?]].
      * pose proof multi_bstep_trans_1n H₂ H₁.
        tauto.
      * pose proof multi_bstep_trans_1n H₂ H₁.
        tauto.
    - pose proof multi_bstep_refl st₀ BTrue.
      tauto.
    - pose proof multi_bstep_refl st₀ BFalse.
      tauto.
Qed.

---

Fixpoint CWhile_path b c₁ st₁ st₂ (n: nat): Prop:=
  match n with
  | O ⇒ multi_bstep st₁ b BFalse ∧ st₁ = st₂
  | S n' ⇒ ∃st₁',
            multi_bstep st₁ b BTrue ∧
            multi_cstep (c₁, st₁) (CSkip, st₁') ∧
            CWhile_path b c₁ st₁' st₂ n'
  end.

---

Definition CWhile_path' b' b c₁ st₁ st₂ (n: nat): Prop:=
  match n with
  | O ⇒ multi_bstep st₁ b' BFalse ∧ st₁ = st₂
  | S n' ⇒ ∃st₁',
            multi_bstep st₁ b' BTrue ∧
            multi_cstep (c₁, st₁) (CSkip, st₁') ∧
            CWhile_path b c₁ st₁' st₂ n'
  end.

---

Definition CWhile_path'' c₁' b c₁ st₁ st₂ (n: nat): Prop:=
  ∃st₁',
    multi_cstep (c₁', st₁) (CSkip, st₁') ∧
    CWhile_path b c₁ st₁' st₂ n.

---

Lemma CWhile_path_spec_aux: ∀st₁ st₂ c c',
  multi_cstep (c, st₁) (c', st₂) →
  (∀b c₁,
     c = CWhile b c₁ →
     c' = Skip%imp →
     ∃n, CWhile_path b c₁ st₁ st₂ n) ∧
  (∀b' b c₁,
     c = CIf b' (CSeq c₁ (CWhile b c₁)) CSkip →
     c' = Skip%imp →
     ∃n, CWhile_path' b' b c₁ st₁ st₂ n) ∧
  (∀c₁' b c₁,
     c = CSeq c₁' (CWhile b c₁) →
     c' = Skip%imp →
     ∃n, CWhile_path'' c₁' b c₁ st₁ st₂ n).
Proof.
  intros.
  induction_1n H; intros.
  + split.
    { intros; subst. inversion H₀. }
    split.
    { intros; subst. inversion H₀. }
    { intros; subst. inversion H₀. }
  + split.
    {
      intros; subst.
      destruct IH as [? [IH ?]].
      clear H₁ H₂.
      inversion H; subst.
      assert (CIf b (CSeq c₁ (CWhile b c₁)) CSkip =
              CIf b (CSeq c₁ (CWhile b c₁)) CSkip).
      { reflexivity. }
      assert (CSkip = CSkip). { reflexivity. }
      pose proof IH _ _ _ H₁ H₂.
      clear IH H₁ H₂.
      destruct H₃ as [n ?].
      ∃n.
      destruct n; exact H₁.
    }
    split.
    {
      intros; subst.
      inversion H; subst.
      - destruct IH as [? [IH ?]].
        clear H₁ H₃.
        assert (CIf b'0 (CSeq c₁ (CWhile b c₁)) CSkip =
                CIf b'0 (CSeq c₁ (CWhile b c₁)) CSkip).
        { reflexivity. }
        assert (CSkip = CSkip). { reflexivity. }
        pose proof IH _ _ _ H₁ H₃.
        clear IH H₁ H₃.
        destruct H₄ as [n ?].
        ∃n.
        destruct n; simpl in H₁; simpl.
        * destruct H₁.
          pose proof multi_bstep_trans_1n H₂ H₁.
          tauto.
        * destruct H₁ as [st₁' [? [? ?]]].
          ∃st₁'.
          pose proof multi_bstep_trans_1n H₂ H₁.
          tauto.
      - destruct IH as [? [? IH]].
        clear H₁ H₂.
        assert (CSeq c₁ (CWhile b c₁) = CSeq c₁ (CWhile b c₁)). { reflexivity. }
        assert (CSkip = CSkip). { reflexivity. }
        pose proof IH _ _ _ H₁ H₂.
        destruct H₃ as [n ?].
        ∃(S n).
        unfold CWhile_path'' in H₃.
        simpl.
        destruct H₃ as [st₁' [? ?]].
        ∃st₁'.
        pose proof multi_bstep_refl st₀ BTrue.
        tauto.
      - ∃O.
        simpl.
        pose proof multi_bstep_refl st₀ BFalse.
        apply CSkip_halt in H₀.
        tauto.
    }
    {
      intros; subst.
      inversion H; subst.
      - destruct IH as [? [? IH]].
        clear H₁ H₃.
        assert (CSeq c₁'0 (CWhile b c₁) = CSeq c₁'0 (CWhile b c₁)). { reflexivity. }
        assert (CSkip = CSkip). { reflexivity. }
        pose proof IH _ _ _ H₁ H₃.
        clear IH H₁ H₃.
        destruct H₄ as [n ?].
        ∃n.
        unfold CWhile_path'' in H₁.
        unfold CWhile_path''.
        destruct H₁ as [st₁' [? ?]].
        ∃st₁'.
        pose proof multi_cstep_trans_1n H₂ H₁.
        tauto.
      - destruct IH as [IH [? ?]].
        clear H₁ H₂.
        assert (CWhile b c₁ = CWhile b c₁). { reflexivity. }
        assert (CSkip = CSkip). { reflexivity. }
        pose proof IH _ _ H₁ H₂.
        clear IH H₁ H₂.
        destruct H₃ as [n ?].
        ∃n.
        unfold CWhile_path''.
        ∃st₀.
        pose proof multi_cstep_refl st₀ CSkip.
        tauto.
    }
Qed.

---

Lemma CWhile_path_spec: ∀b c₁ st₁ st₂,
  multi_cstep (CWhile b c₁, st₁) (CSkip, st₂) →
  ∃n, CWhile_path b c₁ st₁ st₂ n.
Proof.
  intros.
  remember (CWhile b c₁) as c eqn:H₀.
  remember CSkip as c' eqn:H₁.
  revert b c₁ H₀ H₁.
  pose proof CWhile_path_spec_aux st₁ st₂ c c'.
  tauto.
Qed.