Lecture notes 20210510 Error 2

Require Import Coq.Relations.Relation_Definitions.
Require Export Coq.ZArith.ZArith.
Require Export Coq.Strings.String.
Require Export Coq.Logic.Classical.
Open Scope Z.

Type Safe Language

Errors are harmful. Typical run-time-errors caused by careless coding includes arithmetic error, dangling pointer, no initialized value etc. For decades, computer scientist attempts to design programming languages that is safe by syntax. Consider the following expressions.
Definition var: Type := nat.
Definition state: Type := var -> Z.
Open Scope Z.
Inductive mexp : Type :=
  | MNum (n : Z)
  | MId (X : var)
  | MPlus (a1 a2 : mexp)
  | MMinus (a1 a2 : mexp)
  | MMult (a1 a2 : mexp)
  | MTrue
  | MFalse
  | MEq (a1 a2 : mexp)
  | MLe (a1 a2 : mexp)
  | MNot (b : mexp)
  | MAnd (b1 b2 : mexp)
.
Here, boolean operators and integer operators are allowed to appear in one single expression. For casting between integers and boolean values, we assume:
  • boolean values will be cast to 0 and 1 when necessary;
  • integers cannot be treated as booleans.
Based on these assumptions, we can formalize its denotational semantics as follows:
Inductive val: Type :=
| Vint (n: Z)
| Vbool (b: bool).
Definition val2Z (v: val): Z :=
  match v with
  | Vint n ⇒ n
  | Vbool true ⇒ 1
  | Vbool false ⇒ 0
  end.
Fixpoint meval (m: mexp): state -> option val :=
  match m with
  | MNum n ⇒ fun st ⇒ Some (Vint n)
  | MId X ⇒ fun st ⇒ Some (Vint (st X))
  | MPlus a1 a2 ⇒ fun st ⇒
      match meval a1 st, meval a2 st with
      | Some v1, Some v2 ⇒ Some (Vint (val2Z v1 + val2Z v2))
      | _, _ ⇒ None
      end
  | MMinus a1 a2 ⇒ fun st ⇒
      match meval a1 st, meval a2 st with
      | Some v1, Some v2 ⇒ Some (Vint (val2Z v1 - val2Z v2))
      | _, _ ⇒ None
      end
  | MMult a1 a2 ⇒ fun st ⇒
      match meval a1 st, meval a2 st with
      | Some v1, Some v2 ⇒ Some (Vint (val2Z v1 * val2Z v2))
      | _, _ ⇒ None
      end
  | MTrue ⇒ fun st ⇒ Some (Vbool true)
  | MFalse ⇒ fun st ⇒ Some (Vbool false)
  | MEq a1 a2 ⇒ fun st ⇒
      match meval a1 st, meval a2 st with
      | Some v1, Some v2 ⇒
          Some (Vbool (if Z.eq_dec (val2Z v1) (val2Z v2) then true else false))
      | _, _ ⇒ None
      end
  | MLe a1 a2 ⇒ fun st ⇒
      match meval a1 st, meval a2 st with
      | Some v1, Some v2 ⇒
          Some (Vbool (if Z_le_gt_dec (val2Z v1) (val2Z v2) then true else false))
      | _, _ ⇒ None
      end
  | MNot b ⇒ fun st ⇒
      match meval b st with
      | Some (Vbool true) ⇒ Some (Vbool false)
      | Some (Vbool false) ⇒ Some (Vbool true)
      | _ ⇒ None
      end
  | MAnd b1 b2 ⇒ fun st ⇒
      match meval b1 st, meval b2 st with
      | None, _ ⇒ None
      | Some (Vint _), _ ⇒ None
      | Some (Vbool false), _ ⇒ Some (Vbool false)
      | Some (Vbool true), Some (Vbool false) ⇒ Some (Vbool false)
      | Some (Vbool true), Some (Vbool true) ⇒ Some (Vbool true)
      | Some (Vbool true), _ ⇒ None
      end
  end.
Also, we can define its small step semantics as follows.
Inductive mexp_halt: mexp -> Prop :=
  | MH_num : ∀n, mexp_halt (MNum n)
  | MH_true: mexp_halt MTrue
  | MH_false: mexp_halt MFalse.
Inductive bool2Z_step: mexp -> mexp -> Prop :=
  | BZS_True: bool2Z_step MTrue (MNum 1)
  | BZS_False: bool2Z_step MFalse (MNum 0).
Inductive mstep : state -> mexp -> mexp -> Prop :=
  | MS_Id : ∀st X,
      mstep st
        (MId X) (MNum (st X))

  | MS_Plus1 : ∀st a1 a1' a2,
      mstep st
        a1 a1' ->
      mstep st
        (MPlus a1 a2) (MPlus a1' a2)
  | MS_Plus2 : ∀st a1 a2 a2',
      mexp_halt a1 ->
      mstep st
        a2 a2' ->
      mstep st
        (MPlus a1 a2) (MPlus a1 a2')
  | MS_Plus3 : ∀st a1 a1' a2, (* <-- new *)
      mexp_halt a2 ->
      bool2Z_step a1 a1' ->
      mstep st
        (MPlus a1 a2) (MPlus a1' a2)
  | MS_Plus4 : ∀st n1 a2 a2', (* <-- new *)
      bool2Z_step a2 a2' ->
      mstep st
        (MPlus (MNum n1) a2) (MPlus (MNum n1) a2')
  | MS_Plus : ∀st n1 n2,
      mstep st
        (MPlus (MNum n1) (MNum n2)) (MNum (n1 + n2))

  | MS_Minus1 : ∀st a1 a1' a2,
      mstep st
        a1 a1' ->
      mstep st
        (MMinus a1 a2) (MMinus a1' a2)
  | MS_Minus2 : ∀st a1 a2 a2',
      mexp_halt a1 ->
      mstep st
        a2 a2' ->
      mstep st
        (MMinus a1 a2) (MMinus a1 a2')
  | MS_Minus3 : ∀st a1 a1' a2, (* <-- new *)
      mexp_halt a2 ->
      bool2Z_step a1 a1' ->
      mstep st
        (MMinus a1 a2) (MMinus a1' a2)
  | MS_Minus4 : ∀st n1 a2 a2', (* <-- new *)
      bool2Z_step a2 a2' ->
      mstep st
        (MMinus (MNum n1) a2) (MMinus (MNum n1) a2')
  | MS_Minus : ∀st n1 n2,
      mstep st
        (MMinus (MNum n1) (MNum n2)) (MNum (n1 - n2))

  | MS_Mult1 : ∀st a1 a1' a2,
      mstep st
        a1 a1' ->
      mstep st
        (MMult a1 a2) (MMult a1' a2)
  | MS_Mult2 : ∀st a1 a2 a2',
      mexp_halt a1 ->
      mstep st
        a2 a2' ->
      mstep st
        (MMult a1 a2) (MMult a1 a2')
  | MS_Mult3 : ∀st a1 a1' a2, (* <-- new *)
      mexp_halt a2 ->
      bool2Z_step a1 a1' ->
      mstep st
        (MMult a1 a2) (MMult a1' a2)
  | MS_Mult4 : ∀st n1 a2 a2', (* <-- new *)
      bool2Z_step a2 a2' ->
      mstep st
        (MMult (MNum n1) a2) (MMult (MNum n1) a2')
  | MS_Mult : ∀st n1 n2,
      mstep st
        (MMult (MNum n1) (MNum n2)) (MNum (n1 * n2))

  | MS_Eq1 : ∀st a1 a1' a2,
      mstep st
        a1 a1' ->
      mstep st
        (MEq a1 a2) (MEq a1' a2)
  | MS_Eq2 : ∀st a1 a2 a2',
      mexp_halt a1 ->
      mstep st
        a2 a2' ->
      mstep st
        (MEq a1 a2) (MEq a1 a2')
  | MS_Eq3 : ∀st a1 a1' a2, (* <-- new *)
      mexp_halt a2 ->
      bool2Z_step a1 a1' ->
      mstep st
        (MEq a1 a2) (MEq a1' a2)
  | MS_Eq4 : ∀st n1 a2 a2', (* <-- new *)
      bool2Z_step a2 a2' ->
      mstep st
        (MEq (MNum n1) a2) (MEq (MNum n1) a2')
  | MS_Eq_True : ∀st n1 n2,
      n1 = n2 ->
      mstep st
        (MEq (MNum n1) (MNum n2)) MTrue
  | MS_Eq_False : ∀st n1 n2,
      n1 ≠ n2 ->
      mstep st
        (MEq (MNum n1) (MNum n2)) MFalse

  | MS_Le1 : ∀st a1 a1' a2,
      mstep st
        a1 a1' ->
      mstep st
        (MLe a1 a2) (MLe a1' a2)
  | MS_Le2 : ∀st a1 a2 a2',
      mexp_halt a1 ->
      mstep st
        a2 a2' ->
      mstep st
        (MLe a1 a2) (MLe a1 a2')
  | MS_Le3 : ∀st a1 a1' a2, (* <-- new *)
      mexp_halt a2 ->
      bool2Z_step a1 a1' ->
      mstep st
        (MLe a1 a2) (MLe a1' a2)
  | MS_Le4 : ∀st n1 a2 a2', (* <-- new *)
      bool2Z_step a2 a2' ->
      mstep st
        (MLe (MNum n1) a2) (MLe (MNum n1) a2')
  | MS_Le_True : ∀st n1 n2,
      n1 ≤ n2 ->
      mstep st
        (MLe (MNum n1) (MNum n2)) MTrue
  | MS_Le_False : ∀st n1 n2,
      n1 > n2 ->
      mstep st
        (MLe (MNum n1) (MNum n2)) MFalse

  | MS_NotStep : ∀st b1 b1',
      mstep st
        b1 b1' ->
      mstep st
        (MNot b1) (MNot b1')
  | MS_NotTrue : ∀st,
      mstep st
        (MNot MTrue) MFalse
  | MS_NotFalse : ∀st,
      mstep st
        (MNot MFalse) MTrue

  | MS_AndStep : ∀st b1 b1' b2,
      mstep st
        b1 b1' ->
      mstep st
       (MAnd b1 b2) (MAnd b1' b2)
  | MS_AndTrue : ∀st b,
      mstep st
       (MAnd MTrue b) b
  | MS_AndFalse : ∀st b,
      mstep st
       (MAnd MFalse b) MFalse.
Till now, everything is not very interesting. We have learnt how to define denotational semantics and small step semantics of expression evaluation with potential error.
But this time, we can do more. We can determine whether an expression can be safely evaluated only by its syntax — it does not depent on the program state.
The following function is a decision procedure.
Inductive type_check_result:Type :=
| TCR_int
| TCR_bool
| TCR_illegal.
Fixpoint type_check (m: mexp): type_check_result :=
  match m with
  | MNum _
  | MId _ ⇒

        TCR_int

  | MPlus m1 m2
  | MMinus m1 m2
  | MMult m1 m2 ⇒

        match type_check m1, type_check m2 with
        | TCR_illegal, _ ⇒ TCR_illegal
        | _, TCR_illegal ⇒ TCR_illegal
        | _, _ ⇒ TCR_int
        end

  | MTrue
  | MFalse ⇒

        TCR_bool

  | MEq m1 m2
  | MLe m1 m2 ⇒

        match type_check m1, type_check m2 with
        | TCR_illegal, _ ⇒ TCR_illegal
        | _, TCR_illegal ⇒ TCR_illegal
        | _, _ ⇒ TCR_bool
        end

  | MNot m1 ⇒

        match type_check m1 with
        | TCR_bool ⇒ TCR_bool
        | _ ⇒ TCR_illegal
        end

  | MAnd m1 m2 ⇒

        match type_check m1, type_check m2 with
        | TCR_bool, TCR_bool ⇒ TCR_bool
        | _, _ ⇒ TCR_illegal
        end

  end
.
That means, we can check whether an mexp expression is legal in compilation time.

Progress

How to justify that every mexp expression that passes type_check is safe to evaluate? There are two important theorems: progress and preservation.
"Progress" says every mexp that passes type_check will either take a step to evaluate or is already a constant.
Lemma mexp_halt_fact: ∀m,
  mexp_halt m ->
  ∃n, bool2Z_step m (MNum n) ∨ m = MNum n.
Proof.
  intros.
  inversion H; subst.
  + ∃n.
    right.
    reflexivity.
  + ∃1.
    left.
    apply BZS_True.
  + ∃0.
    left.
    apply BZS_False.
Qed.

Lemma mexp_halt_bool_fact: ∀m,
  mexp_halt m ->
  type_check m = TCR_bool ->
  m = MTrue ∨ m = MFalse.
Proof.
  intros.
  inversion H; subst.
  + simpl in H0.
    discriminate H0.
  + left.
    reflexivity.
  + right.
    reflexivity.
Qed.

Theorem Progress: ∀m st,
  type_check m ≠ TCR_illegal ->
  (∃m', mstep st m m') ∨ mexp_halt m.
Proof.
  intros.
  induction m.
  + right.
    apply MH_num.
  + left.
    ∃(MNum (st X)).
    apply MS_Id.
  + assert (type_check m1 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H0 in H.
      apply H; reflexivity.
    }
    assert (type_check m2 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H1 in H.
      destruct (type_check m1); apply H; reflexivity.
    }
    specialize (IHm1 H0).
    specialize (IHm2 H1).
    clear H H0 H1.
    destruct IHm1 as [[m1' ?] |].
    {
      left.
      ∃(MPlus m1' m2).
      apply MS_Plus1.
      exact H.
    }
    destruct IHm2 as [[m2' ?] |].
    {
      left.
      ∃(MPlus m1 m2').
      apply MS_Plus2.
      - exact H.
      - exact H0.
    }
    apply mexp_halt_fact in H.
    destruct H as [n1 [? | ?]].
    {
      left.
      ∃(MPlus (MNum n1) m2).
      apply MS_Plus3.
      - exact H0.
      - exact H.
    }
    subst m1.
    apply mexp_halt_fact in H0.
    destruct H0 as [n2 [? | ?]].
    {
      left.
      ∃(MPlus (MNum n1) (MNum n2)).
      apply MS_Plus4.
      exact H.
    }
    {
      subst m2.
      left.
      ∃(MNum (n1 + n2)).
      apply MS_Plus.
    }
  + assert (type_check m1 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H0 in H.
      apply H; reflexivity.
    }
    assert (type_check m2 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H1 in H.
      destruct (type_check m1); apply H; reflexivity.
    }
    specialize (IHm1 H0).
    specialize (IHm2 H1).
    clear H H0 H1.
    destruct IHm1 as [[m1' ?] |].
    {
      left.
      ∃(MMinus m1' m2).
      apply MS_Minus1.
      exact H.
    }
    destruct IHm2 as [[m2' ?] |].
    {
      left.
      ∃(MMinus m1 m2').
      apply MS_Minus2.
      - exact H.
      - exact H0.
    }
    apply mexp_halt_fact in H.
    destruct H as [n1 [? | ?]].
    {
      left.
      ∃(MMinus (MNum n1) m2).
      apply MS_Minus3.
      - exact H0.
      - exact H.
    }
    subst m1.
    apply mexp_halt_fact in H0.
    destruct H0 as [n2 [? | ?]].
    {
      left.
      ∃(MMinus (MNum n1) (MNum n2)).
      apply MS_Minus4.
      exact H.
    }
    {
      subst m2.
      left.
      ∃(MNum (n1 - n2)).
      apply MS_Minus.
    }
  + assert (type_check m1 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H0 in H.
      apply H; reflexivity.
    }
    assert (type_check m2 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H1 in H.
      destruct (type_check m1); apply H; reflexivity.
    }
    specialize (IHm1 H0).
    specialize (IHm2 H1).
    clear H H0 H1.
    destruct IHm1 as [[m1' ?] |].
    {
      left.
      ∃(MMult m1' m2).
      apply MS_Mult1.
      exact H.
    }
    destruct IHm2 as [[m2' ?] |].
    {
      left.
      ∃(MMult m1 m2').
      apply MS_Mult2.
      - exact H.
      - exact H0.
    }
    apply mexp_halt_fact in H.
    destruct H as [n1 [? | ?]].
    {
      left.
      ∃(MMult (MNum n1) m2).
      apply MS_Mult3.
      - exact H0.
      - exact H.
    }
    subst m1.
    apply mexp_halt_fact in H0.
    destruct H0 as [n2 [? | ?]].
    {
      left.
      ∃(MMult (MNum n1) (MNum n2)).
      apply MS_Mult4.
      exact H.
    }
    {
      subst m2.
      left.
      ∃(MNum (n1 * n2)).
      apply MS_Mult.
    }
  + right.
    apply MH_true.
  + right.
    apply MH_false.
  + assert (type_check m1 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H0 in H.
      apply H; reflexivity.
    }
    assert (type_check m2 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H1 in H.
      destruct (type_check m1); apply H; reflexivity.
    }
    specialize (IHm1 H0).
    specialize (IHm2 H1).
    clear H H0 H1.
    destruct IHm1 as [[m1' ?] |].
    {
      left.
      ∃(MEq m1' m2).
      apply MS_Eq1.
      exact H.
    }
    destruct IHm2 as [[m2' ?] |].
    {
      left.
      ∃(MEq m1 m2').
      apply MS_Eq2.
      - exact H.
      - exact H0.
    }
    apply mexp_halt_fact in H.
    destruct H as [n1 [? | ?]].
    {
      left.
      ∃(MEq (MNum n1) m2).
      apply MS_Eq3.
      - exact H0.
      - exact H.
    }
    subst m1.
    apply mexp_halt_fact in H0.
    destruct H0 as [n2 [? | ?]].
    {
      left.
      ∃(MEq (MNum n1) (MNum n2)).
      apply MS_Eq4.
      exact H.
    }
    {
      subst m2.
      left.
      destruct (Z.eq_dec n1 n2).
      - ∃MTrue.
        apply MS_Eq_True.
        exact e.
      - ∃MFalse.
        apply MS_Eq_False.
        exact n.
    }
  + assert (type_check m1 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H0 in H.
      apply H; reflexivity.
    }
    assert (type_check m2 ≠ TCR_illegal).
    {
      simpl in H.
      intro.
      rewrite H1 in H.
      destruct (type_check m1); apply H; reflexivity.
    }
    specialize (IHm1 H0).
    specialize (IHm2 H1).
    clear H H0 H1.
    destruct IHm1 as [[m1' ?] |].
    {
      left.
      ∃(MLe m1' m2).
      apply MS_Le1.
      exact H.
    }
    destruct IHm2 as [[m2' ?] |].
    {
      left.
      ∃(MLe m1 m2').
      apply MS_Le2.
      - exact H.
      - exact H0.
    }
    apply mexp_halt_fact in H.
    destruct H as [n1 [? | ?]].
    {
      left.
      ∃(MLe (MNum n1) m2).
      apply MS_Le3.
      - exact H0.
      - exact H.
    }
    subst m1.
    apply mexp_halt_fact in H0.
    destruct H0 as [n2 [? | ?]].
    {
      left.
      ∃(MLe (MNum n1) (MNum n2)).
      apply MS_Le4.
      exact H.
    }
    {
      subst m2.
      left.
      destruct (Z_le_gt_dec n1 n2).
      - ∃MTrue.
        apply MS_Le_True.
        exact l.
      - ∃MFalse.
        apply MS_Le_False.
        exact g.
    }
  + assert (type_check m = TCR_bool).
    {
      simpl in H.
      destruct (type_check m).
      - exfalso; apply H; reflexivity.
      - reflexivity.
      - exfalso; apply H; reflexivity.
    }
    assert (type_check m ≠ TCR_illegal).
    {
      rewrite H0; intro.
      discriminate H1.
    }
    specialize (IHm H1).
    clear H H1.
    destruct IHm as [[m' ?] | ?].
    {
      left.
      ∃(MNot m').
      apply MS_NotStep.
      exact H.
    }
    pose proof mexp_halt_bool_fact _ H H0.
    destruct H1; subst.
    {
      left.
      ∃MFalse.
      apply MS_NotTrue.
    }
    {
      left.
      ∃MTrue.
      apply MS_NotFalse.
    }
  + assert (type_check m1 = TCR_bool).
    {
      simpl in H.
      destruct (type_check m1).
      - exfalso; apply H; reflexivity.
      - reflexivity.
      - exfalso; apply H; reflexivity.
    }
    assert (type_check m1 ≠ TCR_illegal).
    {
      rewrite H0; intro.
      discriminate H1.
    }
    specialize (IHm1 H1).
    clear H H1 IHm2.
    destruct IHm1 as [[m1' ?] | ?].
    {
      left.
      ∃(MAnd m1' m2).
      apply MS_AndStep.
      exact H.
    }
    pose proof mexp_halt_bool_fact _ H H0.
    destruct H1; subst.
    {
      left.
      ∃m2.
      apply MS_AndTrue.
    }
    {
      left.
      ∃MFalse.
      apply MS_AndFalse.
    }
Qed.

Preservation

"Preservation" says: if an mexp type checks then it will only step to type-checked another expression.
Lemma bool2Z_step_fact: ∀m1 m2,
  bool2Z_step m1 m2 ->
  type_check m1 = TCR_bool ∧ type_check m2 = TCR_int.
Proof.
  intros.
  inversion H; subst.
  + split; reflexivity.
  + split; reflexivity.
Qed.
Lemma Preservation_aux: ∀st m1 m2,
  mstep st m1 m2 ->
  type_check m1 ≠ TCR_illegal ->
  type_check m1 = type_check m2.
Proof.
  intros.
  rename H0 into TC.
  induction H.
  + simpl in TC.
    simpl.
    reflexivity.
  + assert (type_check a1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + assert (type_check a2 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H1 in TC.
      destruct (type_check a1); apply TC; reflexivity.
    }
    specialize (IHmstep H1).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H0.
    destruct H0.
    rewrite H0, H1.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H.
    destruct H.
    rewrite H, H0.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check a1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + assert (type_check a2 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H1 in TC.
      destruct (type_check a1); apply TC; reflexivity.
    }
    specialize (IHmstep H1).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H0.
    destruct H0.
    rewrite H0, H1.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H.
    destruct H.
    rewrite H, H0.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check a1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + assert (type_check a2 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H1 in TC.
      destruct (type_check a1); apply TC; reflexivity.
    }
    specialize (IHmstep H1).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H0.
    destruct H0.
    rewrite H0, H1.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H.
    destruct H.
    rewrite H, H0.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check a1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + assert (type_check a2 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H1 in TC.
      destruct (type_check a1); apply TC; reflexivity.
    }
    specialize (IHmstep H1).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H0.
    destruct H0.
    rewrite H0, H1.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H.
    destruct H.
    rewrite H, H0.
    reflexivity.
  + simpl.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check a1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + assert (type_check a2 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H1 in TC.
      destruct (type_check a1); apply TC; reflexivity.
    }
    specialize (IHmstep H1).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H0.
    destruct H0.
    rewrite H0, H1.
    reflexivity.
  + simpl.
    apply bool2Z_step_fact in H.
    destruct H.
    rewrite H, H0.
    reflexivity.
  + simpl.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check b1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    reflexivity.
  + simpl.
    reflexivity.
  + assert (type_check b1 ≠ TCR_illegal).
    {
      simpl in TC.
      intro.
      rewrite H0 in TC.
      apply TC; reflexivity.
    }
    specialize (IHmstep H0).
    simpl.
    rewrite IHmstep.
    reflexivity.
  + simpl.
    simpl in TC.
    destruct (type_check b).
    - exfalso. apply TC. reflexivity.
    - reflexivity.
    - reflexivity.
  + simpl.
    simpl in TC.
    destruct (type_check b).
    - exfalso. apply TC. reflexivity.
    - reflexivity.
    - exfalso. apply TC. reflexivity.
Qed.

Theorem Preservation: ∀st m1 m2,
  mstep st m1 m2 ->
  type_check m1 ≠ TCR_illegal ->
  type_check m2 ≠ TCR_illegal.
Proof.
  intros.
  pose proof Preservation_aux _ _ _ H H0.
  rewrite <- H1.
  exact H0.
Qed.
(* 2021-05-10 09:17 *)