Require Import Coqlib.
Require Import Maps.
Require Import LibTactics.

Require Import Integers.
Open Scope Z_scope.
Import ListNotations.

Set Asymmetric Patterns.

Require Import state.
Require Import language.

Set Implicit Arguments.
Unset Strict Implicit.

Require Import logic.
Require Import soundness.

Require Import lemmas.
Require Import lemmas_ins.

Require Import Coq.Logic.FunctionalExtensionality.

Open Scope nat.
Open Scope code_scope.

(*+ Auxiliary Definition +*)

(*+ Soundness Proof of instruction +*)

Lemma ld_rule_sound :
  forall p q aexp l v v' (rd : GenReg),
    p ==> aexp ==ₓ l ->
    p ==> l |-> v ** rd |=> v' ** q ->
    ins_sound p (l |-> v ** rd |=> v ** q) (ld aexp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Haexp : H1.
  eapply H in Haexp.
  eapply H0 in H1.
  sep_star_split_tac.
  simpl in H4, H5.
  simpljoin1.
  exists (m ⊎ (m1 ⊎ m2), (r ⊎ ((RegMap.set rd (Some v) r1) ⊎ r2), f2), d2).
  split; eauto.

  eapply NormalIns; eauto.
  eapply Ld_step with (addr := l) (v := v); eauto.
  simpl in Haexp.
  simpljoin1; eauto.
  simpl in Haexp.
  simpljoin1; eauto.
  clear - H1.
  simpl in H1.
  simpljoin1.
  eapply get_vl_merge_still; eauto.
  unfold MemMap.set.
  destruct_addreq.
  clear - H2.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  clear - H2.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H2.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H1.
  simpls.
  simpljoin1.
  intro.
  unfold indom in *.
  simpljoin1.
  unfolds empR.
  tryfalse.
  simpl.
  do 2 eexists.
  repeat (split; eauto).
  Focus 2.
  do 2 eexists.
  repeat (split; eauto).
  instantiate (2 := (empM, (RegMap.set rd (Some v) r1, f2), d2)).
  simpl.
  repeat (split; eauto).
  clear - H2 H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eauto.
  eapply disj_indom_regset_still; eauto.
  clear - H2.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpls.
  clear - H2.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  simpl; eauto.
  simpl.
  simpl in H2.
  unfolds regSt.
  simpl in H2.
  simpljoin1.
  repeat (split; eauto).
  rewrite regset_twice; eauto.
  clear - H6.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H6; eauto.
  eapply disj_sym in H6.
  eapply disj_sym.
  eapply RegSet_same_addr_disj_stable; eauto.
  eapply disj_merge_disj_sep2 in H6; eauto.
Qed.

Lemma st_rule_sound :
  forall l v (rs : GenReg) v1 p aexp,
    l |-> v ** p ==> Or rs ==ₑ v1 //\\ aexp ==ₓ l ->
    ins_sound (l |-> v ** p) (l |-> v1 ** p) (st rs aexp).
Proof.
  intros.
  unfold ins_sound.
  intros.
  destruct_state s.
  lets Haexp : H0.
  eapply H in Haexp.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  simpl in Haexp.
  simpljoin1.
  exists (MemMap.set l (Some v1) m0 ⊎ m1, (r0 ⊎ r1, f1), d1).
  split; eauto.

  eapply NormalIns; eauto.
  eapply ST_step with (v := v1); eauto.
  eapply indom_merge_still; eauto.
  clear - H0.
  simpls.
  simpljoin1.
  eapply memset_l_l_indom; eauto.
  rewrite indom_memset_merge_eq; eauto.
  clear - H0.
  simpls.
  simpljoin1.
  eapply memset_l_l_indom; eauto.
  simpl.
  do 2 eexists.
  repeat (split; eauto).
  instantiate (1 := (MemMap.set l (Some v1) m0, (r0, f1), d1)).
  simpl.
  repeat (split; eauto).
  simpl in H0.
  simpljoin1.
  rewrite memset_twice; eauto.
  eapply MemSet_same_addr_disj_stable; eauto.
  simpl.
  clear - H0.
  simpls.
  simpljoin1.
  rewrite memset_twice; eauto.
  simpl.
  clear - H0.
  simpls.
  simpljoin1; eauto.
Qed.

Lemma add_rule_sound :
  forall p (rs rd : GenReg) v1 v2 v oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 +ᵢ v2 ** q) (add rs oexp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H1.
  lets Hrd : H1.
  eapply H in Hoexp.
  eapply H0 in Hrd.
  simpl in Hoexp.
  destruct_state s.
  simpl in Hoexp.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m0 ⊎ m1, (RegMap.set rd (Some (v1 +ᵢ v2)) r0 ⊎ r1, f1), d1).
  split; eauto.
  eapply NormalIns; eauto.
  eapply Add_step; eauto.
  eapply indom_merge_still; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m0, (RegMap.set rd (Some v1 +ᵢ v2) r0, f1), d1) (m1, (r1, f1), d1).
  repeat (split; eauto).
  clear - H4 H3.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  eapply RegSet_same_addr_disj_stable; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
Qed.

Lemma sub_rule_sound :
  forall p (rs rd : GenReg) v1 v2 v oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 -ᵢ v2 ** q) (sub rs oexp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H1.
  lets Hrd : H1.
  eapply H in Hoexp.
  eapply H0 in Hrd.
  simpl in Hoexp.
  destruct_state s.
  simpl in Hoexp.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m0 ⊎ m1, (RegMap.set rd (Some (v1 -ᵢ v2)) r0 ⊎ r1, f1), d1).
  split; eauto.
  eapply NormalIns; eauto.
  eapply Sub_step; eauto.
  eapply indom_merge_still; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m0, (RegMap.set rd (Some v1 -ᵢ v2) r0, f1), d1) (m1, (r1, f1), d1).
  repeat (split; eauto).
  clear - H4 H3.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  eapply RegSet_same_addr_disj_stable; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
Qed.

Lemma subcc_rule_sound :
  forall p oexp (r1 r2 : GenReg) v1 v2 v vr vn vz q,
    p ==> Or r1 ==ₑ v1 //\\ oexp ==ₑ v2 -> v = v1 -ᵢ v2 ->
    p ==> r2 |=> vr ** n |=> vn ** z |=> vz ** q ->
    ins_sound p (r2 |=> v ** n |=> get_range 31 31 v ** z |=> iszero v ** q)
              (subcc r1 oexp r2).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H2.
  eapply H in Hoexp.
  eapply H1 in H2.
  destruct_state s.
  simpl in Hoexp.
  simpljoin1.
  clear H H1.
  sep_star_split_tac.
  simpl in H7, H2, H5.
  simpljoin1.
  exists (m0 ⊎ (m2 ⊎ (m4 ⊎ m5)),
     (RegMap.set r2 (Some (v1 -ᵢ v2)) r0 ⊎
                 (RegMap.set n (Some (get_range 31 31 v1 -ᵢ v2)) r4 ⊎
                             (RegMap.set z (Some (iszero v1 -ᵢ v2)) r6 ⊎ r7)), f5), d5).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply Subcc_step; eauto.
  clear - H1.
  eapply indom_merge_still; eauto.
  simpl in H1.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.

  unfolds set_Rs.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.

  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.

  eapply regst_indom; eauto.
  eapply regst_indom; eauto.
  eapply regst_indom; eauto.
  eapply regst_indom; eauto.

  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H12.
  eapply disjoint_setR_still1; eauto.

  eapply regst_indom; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H8.
  eapply disjoint_setR_still1; eauto.
  eapply disjoint_setR_still2; eauto.

  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H8.
  eapply disjoint_setR_still1; eauto.

  eapply regst_indom; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.

  eapply disj_indom_regset_still; eauto.
  clear - H0 H12.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H12.
  eapply disj_sym in H12.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.
  eapply disj_merge_disj_sep2 in H12; eauto.
  eapply regst_indom; eauto.

  eapply disj_indom_regset_still; eauto.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H8; eauto.
  eapply disj_sym in H8.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.

  eapply disj_merge_disj_sep2 in H8.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H8.
  eapply disj_sym in H8.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.

  eapply regst_indom; eauto.
  eapply disj_merge_disj_sep2 in H8; eauto.

  eapply regst_indom; eauto.
Qed.

Lemma and_rule_sound :
  forall p (rs rd : GenReg) v1 v2 v oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 &ᵢ v2 ** q) (and rs oexp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H1.
  lets Hrd : H1.
  eapply H in Hoexp.
  eapply H0 in Hrd.
  simpl in Hoexp.
  destruct_state s.
  simpl in Hoexp.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m0 ⊎ m1, (RegMap.set rd (Some (v1 &ᵢ v2)) r0 ⊎ r1, f1), d1).
  split; eauto.
  eapply NormalIns; eauto.
  eapply And_step; eauto.
  eapply indom_merge_still; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m0, (RegMap.set rd (Some v1 &ᵢ v2) r0, f1), d1) (m1, (r1, f1), d1).
  repeat (split; eauto).
  clear - H4 H3.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  eapply RegSet_same_addr_disj_stable; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
Qed.

Lemma andcc_rule_sound :
  forall p oexp (r1 r2 : GenReg) v1 v2 v vr vn vz q,
    p ==> Or r1 ==ₑ v1 //\\ oexp ==ₑ v2 -> v = v1 &ᵢ v2 ->
    p ==> r2 |=> vr ** n |=> vn ** z |=> vz ** q ->
    ins_sound p (r2 |=> v ** n |=> get_range 31 31 v ** z |=> iszero v ** q)
              (andcc r1 oexp r2).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H2.
  eapply H in Hoexp.
  eapply H1 in H2.
  destruct_state s.
  simpl in Hoexp.
  simpljoin1.
  clear H H1.
  sep_star_split_tac.
  simpl in H7, H2, H5.
  simpljoin1.
  exists (m0 ⊎ (m2 ⊎ (m4 ⊎ m5)),
     (RegMap.set r2 (Some (v1 &ᵢ v2)) r0 ⊎
                 (RegMap.set n (Some (get_range 31 31 v1 &ᵢ v2)) r4 ⊎
                             (RegMap.set z (Some (iszero v1 &ᵢ v2)) r6 ⊎ r7)), f5), d5).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply Andcc_step; eauto.
  clear - H1.
  eapply indom_merge_still; eauto.
  simpl in H1.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.

  unfolds set_Rs.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.

  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.

  eapply regst_indom; eauto.
  eapply regst_indom; eauto.
  eapply regst_indom; eauto.
  eapply regst_indom; eauto.

  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H12.
  eapply disjoint_setR_still1; eauto.

  eapply regst_indom; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H8.
  eapply disjoint_setR_still1; eauto.
  eapply disjoint_setR_still2; eauto.

  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  rewrite indom_setR_eq_RegMap_set in H; eauto.
  rewrite regset_twice in H; eauto.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply regset_l_l_indom; eauto.

  clear - H8.
  eapply disjoint_setR_still1; eauto.

  eapply regst_indom; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_sep_star_merge; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.

  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.

  eapply disj_indom_regset_still; eauto.
  clear - H0 H12.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H12.
  eapply disj_sym in H12.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.
  eapply disj_merge_disj_sep2 in H12; eauto.
  eapply regst_indom; eauto.

  eapply disj_indom_regset_still; eauto.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H8; eauto.
  eapply disj_sym in H8.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.

  eapply disj_merge_disj_sep2 in H8.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H8.
  eapply disj_sym in H8.
  eapply disj_sym.
  eapply disj_indom_regset_still; eauto.

  eapply regst_indom; eauto.
  eapply disj_merge_disj_sep2 in H8; eauto.

  eapply regst_indom; eauto.
Qed.

Lemma or_rule_sound :
  forall p (rs rd : GenReg) v1 v2 v oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 |ᵢ v2 ** q) (or rs oexp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H1.
  lets Hrd : H1.
  eapply H in Hoexp.
  eapply H0 in Hrd.
  simpl in Hoexp.
  destruct_state s.
  simpl in Hoexp.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m0 ⊎ m1, (RegMap.set rd (Some (v1 |ᵢ v2)) r0 ⊎ r1, f1), d1).
  split; eauto.
  eapply NormalIns; eauto.
  eapply Or_step; eauto.
  eapply indom_merge_still; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m0, (RegMap.set rd (Some v1 |ᵢ v2) r0, f1), d1) (m1, (r1, f1), d1).
  repeat (split; eauto).
  clear - H4 H3.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  eapply RegSet_same_addr_disj_stable; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite regset_twice; eauto.
  simpl.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
Qed.

Lemma nop_rule_sound :
  forall p q,
    p ==> q -> ins_sound p q nop.
Proof.
  intros.
  unfolds ins_sound.
  intros.
  exists s.
  split; eauto.
  destruct_state s.
  do 2 econstructor.
Qed.

Lemma rd_rule_sound :
  forall (rsp : SpReg) (r1 : GenReg) v v1 p,
    ins_sound (rsp |=> v ** r1 |=> v1 ** p) (rsp |=> v ** r1 |=> v ** p) (rd rsp r1).
Proof.
  intros.
  unfolds ins_sound.
  intros.
  sep_star_split_tac.

  simpl in H2, H3.
  simpljoin1.

  exists (m ⊎ (m1 ⊎ m2), (r ⊎ (RegMap.set r1 (Some v) r2 ⊎ r3), f2), d2).
  split; eauto.
  eapply NormalIns; eauto.
  eapply Rd_step with (v := v); eauto.
  eapply get_R_merge_still; eauto.
  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite get_R_rn_neq_r0; eauto.
  unfolds RegMap.set.
  destruct_rneq.
  intro.
  tryfalse.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.

  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  eapply regst_indom; eauto.
  eapply regst_indom; eauto.

  clear - H.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  unfold indom in *.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.

  eapply disj_sep_star_merge; eauto.
  eapply disj_sep_star_merge; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  repeat (split; eauto).
  rewrite regset_twice; eauto.
  eapply disj_indom_regset_still; eauto.
  eapply regst_indom; eauto.
  eapply disj_sep_merge_still; eauto.
  eapply disj_sym; eauto.
  eapply disj_indom_regset_still; eauto.
  eapply disj_merge_disj_sep1 in H4; eauto.
  eapply disj_sym; eauto.
  eapply regst_indom; eauto.
  eapply disj_merge_disj_sep2 in H4; eauto.
Qed.

Lemma wr_rule_sound :
  forall (rsp : SpReg) v p (rs : GenReg) oexp v1 v2,
    rsp |=> v ** p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    ins_sound (rsp |=> v ** p)
              (3 @ rsp |==> (set_spec_reg rsp v1 xor v2) ** p) (wr rs oexp rsp).
Proof.
  intros.
  unfold ins_sound.
  intros.
  lets Hoexp : H0.
  eapply H in Hoexp.
  sep_star_split_tac.
  simpl in H4.
  simpljoin1.
  simpl in Hoexp.
  simpljoin1.
  exists (m ⊎ m0, (r ⊎ r0, f0), set_delay rsp (set_spec_reg rsp v1 xor v2) d0).
  split; eauto.

  eapply Wr; eauto.
  eapply indom_merge_still; eauto.
  eapply regst_indom; eauto.
  simpl.
  exists (m, (r, f0), set_delay rsp (set_spec_reg rsp v1 xor v2) d0)
    (m0, (r0, f0), set_delay rsp (set_spec_reg rsp v1 xor v2) d0).
  simpls.
  repeat (split; eauto).
  exists v.
  unfold regSt in H0.
  simpls.
  simpljoin1.
  unfold set_delay, X.
  repeat (split; eauto).
  unfold inDlyBuff.
  simpls.
  do 2 left.
  split; eauto.
  unfold noDup.
  simpl.
  destruct (sep_reg_dec rsp rsp); tryfalse.
  eauto.
  eapply notin_dom_set_delay_asrt_stable; eauto.
  clear - H0 H2.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  unfold indom in *.
  simpljoin1.
  unfold disjoint in *.
  specialize (H2 rsp).
  unfolds RegMap.set.
  destruct_rneq_H.
  rewrite H in H2; tryfalse.
  clear - H0.
  unfolds regSt.
  simpls.
  simpljoin1.
  eauto.
Qed.

Lemma getcwp_rule_sound :
  forall p id F (rd : GenReg) v' p1,
    p ==> {|id, F|} ** rd |=> v' ** p1 ->
    ins_sound p ({|id, F|} ** rd |=> id ** p1) (getcwp rd).
Proof.
  intros.
  unfold ins_sound.
  intros.
  eapply H in H0.
  sep_star_split_tac.
  simpl in H3, H4.
  simpljoin1.
  exists (m ⊎ (m1 ⊎ m2), (r ⊎ (set_R r1 rd id ⊎ r2), f2), d2).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply GetCwp_step; eauto.
  eapply get_R_merge_still; eauto.
  instantiate (1 := id).
  rewrite get_R_rn_neq_r0; eauto.
  Focus 2.
  intro; tryfalse.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  unfold RegMap.set.
  destruct_rneq.
  eapply indom_merge_still2; eauto.
  eapply indom_merge_still; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq2; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  clear - H0.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  intro.
  unfold indom in H.
  simpljoin1.
  unfolds RegMap.set.
  destruct_rneq_H.
  eapply disj_sep_star_merge; eauto.
  eapply disj_sep_star_merge; eauto.
  clear - H1.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  repeat (split; eauto).
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite regset_twice; eauto.
  eapply regset_l_l_indom; eauto.
  eapply disjoint_setR_still1; eauto.
  eapply disj_sep_merge_still; eauto.
  eapply disj_merge_disj_sep1 in H5.
  eapply disj_sym in H5.
  eapply disj_sym.
  eapply disjoint_setR_still1; eauto.
  eapply disj_merge_disj_sep2 in H5; eauto.
Qed.

Lemma save_rule_sound :
  forall p q (rs rd : GenReg) v1 v2 v v' id id' F fm1 fm2 fmo fml fmi p1 oexp,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> {|id, F ++ [fm1; fm2]|} ** Regs fmo fml fmi ** p1 ->
    id' = pre_cwp id -> win_masked id' v = false ->
    {|id', fml :: fmi :: F|} ** Regs fm1 fm2 fmo ** p1 ==> rd |=> v' ** q ->
    ins_sound (Rwim |=> v ** p) (Rwim |=> v ** rd |=> v1 +ᵢ v2 ** q) (save rs oexp rd).
Proof.
  intros.
  unfolds ins_sound.
  intros.
  destruct_state s.
  simpl in H4.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  simpl in H4.
  simpljoin1.

  lets Ht : H6.
  lets Ht1 : H6.
  eapply H0 in H6.

  eapply sep_star_split in H6.
  simpljoin1.
  destruct_state x.
  destruct_state x0.

  simpl in H8.
  simpljoin1.
  eapply sep_star_split in H7; eauto.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  simpl in H11.
  simpljoin1.

  assert (f1 = F ++ [fm1; fm2]).
  {
    clear - H6.
    simpl in H6.
    simpljoin1; eauto.
  }

  subst.
  lets Hf : H6.
  eapply frame_asrt_upd with (id' := pre_cwp id) (F' := fml :: fmi :: F) in Hf; eauto.
  simpljoin1.
  rename x into r'.

  lets Hreg : H7.
  eapply Regs_asrt_upd with
  (F' := fml :: fmi :: F) (fm1' := fm1) (fm2' := fm2) (fm3' := fmo) in Hreg.

  simpljoin1.
  rename x into r1'.
  eapply asrt_FrmFree_changefrm_stable with (F' := fml :: fmi :: F) in H10; eauto.

  Focus 2.
  clear - H6 H9.
  eapply disj_merge_disj_sep2 in H9.
  intro.
  simpl in H6.
  simpljoin1.
  unfolds regSt.
  simpls.
  simpljoin1.
  unfold disjoint in *.
  specialize (H9 cwp).
  unfolds RegMap.set.
  destruct_rneq_H.
  unfold indom in *; simpljoin1.
  rewrite H in H9; tryfalse.

  assert
    (Htt :
      ((merge m (merge m1 m3)), (merge r' (merge r1' r3), fml :: fmi :: F), d1) |=
      {|pre_cwp id, fml :: fmi :: F|} ** Regs fm1 fm2 fmo ** p1
    ).
  {
    eapply disj_sep_star_merge; eauto.
    eapply disj_sep_star_merge; eauto.
    eapply disj_dom_eq_still.
    2 : eauto.
    eauto.
    eapply same_m_dom_eq.

    eauto.
    eapply disj_sep_merge_still; eauto.
    eapply disj_merge_disj_sep1 in H9; eauto.
    eapply disj_dom_eq_still; eauto.
    eapply disj_merge_disj_sep2 in H9; eauto.
    eapply disj_dom_eq_still; eauto.
    eapply same_m_dom_eq; eauto.
  }

  unfolds regSt.
  simpl in H5.
  simpljoin1.
  eapply H3 in Htt.

  simpl in Htt.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  unfolds regSt.
  simpl in H5, H17.
  simpljoin1.

  eexists.
  split.
  Focus 2.
  simpl.

  exists (empM, (RegMap.set Rwim (Some v) empR, fml :: fmi :: F), d0).
  eexists.
  split.

  Focus 2.
  split.
  unfold regSt.
  simpl.
  repeat (split; eauto).

  exists (empM, (RegMap.set rd (Some (v1 +ᵢ v2)) empR, fml :: fmi :: F), d0).
  eexists.
  split.
  Focus 2.
  split; eauto.
  unfold regSt.
  simpl.
  split; eauto.

  simpl.
  repeat (split; eauto).
  eapply RegSet_same_addr_disj_stable; eauto.

  simpl.
  repeat (split; eauto).
  eapply disj_dom_eq_still with (m1 := RegMap.set Rwim (Some v) empR)
                                  (m2 := r ⊎ (r1 ⊎ r3)); eauto.
  eapply dom_eq_memset_same_addr_stable; eauto.
  eapply dom_eq_emp; eauto.
  eapply dom_eq_trans with (m2 := merge r' (merge r1' r3)).
  repeat (eapply dom_eq_merge_still; eauto).
  eapply same_m_dom_eq; eauto.
  rewrite H28; eauto.
  eapply dom_eq_merge_some_addr_stable; eauto.
  eapply same_m_dom_eq; eauto.

  rewrite H27.
  eapply SSave; eauto.
  {
    rewrite get_R_rn_neq_r0; eauto.
    2 : intro; tryfalse.
    eapply get_vl_merge_still2; eauto.
    eapply get_vl_merge_still; eauto.
    clear - H6.
    simpls.
    unfolds regSt.
    simpls.
    simpljoin1.
    unfold RegMap.set.
    destruct_rneq.
  }
  {
    rewrite get_R_rn_neq_r0; eauto.
    2 : intro; tryfalse.
    eapply get_vl_merge_still; eauto.
    unfold RegMap.set.
    destruct_rneq.
  }
  {
    instantiate (1 := fmo).
    eapply fetch_disj_merge_still2; eauto.
    eapply fetch_disj_merge_still2; eauto.
    eapply fetch_disj_merge_still1; eauto.
    eapply Regs_fetch; eauto.
  }
  {
    eapply indom_merge_still2; eauto.
    eapply indom_dom_eq_subst with (m := (r' ⊎ (r1' ⊎ r3))).
    rewrite H28.
    eapply indom_merge_still; eauto.
    eapply regset_l_l_indom; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_sym; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_sym; eauto.
    eapply same_m_dom_eq; eauto.
  }
  {
    instantiate (1 := v1).
    clear - H H4 Ht.
    eapply H in Ht; eauto.
    simpl in Ht.
    simpljoin1.
    eapply get_R_merge_still2; eauto.
  }
  {
    instantiate (1 := v2).
    clear - H H4 Ht.
    eapply H in Ht; eauto.
    simpl in Ht.
    simpljoin1.
    eapply eval_opexp_merge_still2; eauto.
  }
  {
    rewrite set_win_merge2; eauto.
    rewrite set_win_merge2; eauto.
    rewrite set_win_merge1; eauto.
    erewrite set_window_res with (R' := r1'); eauto.

    unfold set_Rs.
    rewrite indom_setR_merge_eq2; eauto.
    assert (set_R (r ⊎ (r1' ⊎ r3)) cwp (pre_cwp id) =
            (set_R r cwp (pre_cwp id)) ⊎ (r1' ⊎ r3)).
    {
      rewrite indom_setR_merge_eq1; eauto.
      clear - H6.
      simpls.
      unfolds regSt.
      simpls.
      simpljoin1.
      eapply regset_l_l_indom; eauto.
    }
    rewrite H17; eauto.
    assert (set_R r cwp (pre_cwp id) = r').
    {
      clear - H6 H13.
      simpls.
      unfolds regSt.
      simpls.
      simpljoin1.
      rewrite indom_setR_eq_RegMap_set; eauto.
      rewrite regset_twice; eauto.
      eapply regset_l_l_indom; eauto.
    }
    rewrite H20.
    rewrite H28.
    rewrite indom_setR_merge_eq2; eauto.
    rewrite indom_setR_merge_eq1; eauto.
    rewrite indom_setR_eq_RegMap_set; eauto.
    rewrite regset_twice; eauto.
    eapply regset_l_l_indom; eauto.
    eapply regset_l_l_indom; eauto.

    clear.
    unfold indom.
    intro.
    simpljoin1.
    unfolds RegMap.set.
    destruct_rneq_H.

    rewrite <- H28.
    eapply disj_dom_eq_still with (m2 := (r ⊎ (r1 ⊎ r3))); eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.

    clear.
    unfold indom.
    intro.
    simpljoin1.
    unfolds RegMap.set.
    destruct_rneq_H.

    eapply disj_dom_eq_still with (m2 := (r ⊎ (r1 ⊎ r3))); eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.

    clear - H15.
    eapply Regs_frm_free; eauto.
    eapply Regs_indom_Fmr; eauto.
    eapply indoms_merge_still1; eauto.
    eapply Regs_indom_Fmr; eauto.
    eapply indoms_merge_still2; eauto.
    eapply indoms_merge_still1; eauto.
    eapply Regs_indom_Fmr; eauto.
  }
Qed.

Lemma resotre_rule_sound :
  forall p q (rs rd : GenReg) v1 v2 v v' id id' F fm1 fm2 fmo fml fmi p1 oexp,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> {|id, fm1 :: fm2 :: F|} ** Regs fmo fml fmi ** p1 ->
    id' = post_cwp id -> win_masked id' v = false ->
    {|id', F ++ [fmo; fml]|} ** Regs fmi fm1 fm2 ** p1 ==> rd |=> v' ** q ->
    ins_sound (Rwim |=> v ** p) (Rwim |=> v ** rd |=> v1 +ᵢ v2 ** q) (restore rs oexp rd).
Proof.
  intros.
  unfolds ins_sound.
  intros.
  destruct_state s.
  simpl in H4.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  simpl in H4.
  simpljoin1.

  lets Ht : H6.
  lets Ht1 : H6.
  eapply H0 in H6.

  eapply sep_star_split in H6.
  simpljoin1.
  destruct_state x.
  destruct_state x0.

  simpl in H8.
  simpljoin1.
  eapply sep_star_split in H7; eauto.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  simpl in H11.
  simpljoin1.

  assert (f1 = fm1 :: fm2 :: F).
  {
    clear - H6.
    simpl in H6.
    simpljoin1; eauto.
  }

  subst.
  lets Hf : H6.
  eapply frame_asrt_upd with (id' := post_cwp id) (F' := F ++ [fmo; fml]) in Hf; eauto.
  simpljoin1.
  rename x into r'.

  lets Hreg : H7.
  eapply Regs_asrt_upd with
  (F' := F ++ [fmo; fml]) (fm1' := fmi) (fm2' := fm1) (fm3' := fm2) in Hreg.

  simpljoin1.
  rename x into r1'.
  eapply asrt_FrmFree_changefrm_stable with (F' := F ++ [fmo; fml]) in H10; eauto.

  Focus 2.
  clear - H6 H9.
  eapply disj_merge_disj_sep2 in H9.
  intro.
  simpl in H6.
  simpljoin1.
  unfolds regSt.
  simpls.
  simpljoin1.
  unfold disjoint in *.
  specialize (H9 cwp).
  unfolds RegMap.set.
  destruct_rneq_H.
  unfold indom in *; simpljoin1.
  rewrite H in H9; tryfalse.

  assert
    (Htt :
      ((merge m (merge m1 m3)), (merge r' (merge r1' r3), F ++ [fmo; fml]), d1) |=
      {|post_cwp id, F ++ [fmo; fml]|} ** Regs fmi fm1 fm2 ** p1
    ).
  {
    eapply disj_sep_star_merge; eauto.
    eapply disj_sep_star_merge; eauto.
    eapply disj_dom_eq_still.
    2 : eauto.
    eauto.
    eapply same_m_dom_eq.

    eauto.
    eapply disj_sep_merge_still; eauto.
    eapply disj_merge_disj_sep1 in H9; eauto.
    eapply disj_dom_eq_still; eauto.
    eapply disj_merge_disj_sep2 in H9; eauto.
    eapply disj_dom_eq_still; eauto.
    eapply same_m_dom_eq; eauto.
  }

  unfolds regSt.
  simpl in H5.
  simpljoin1.
  eapply H3 in Htt.

  simpl in Htt.
  simpljoin1.
  destruct_state x.
  destruct_state x0.
  unfolds regSt.
  simpl in H5, H17.
  simpljoin1.

  eexists.
  split.
  Focus 2.
  simpl.

  exists (empM, (RegMap.set Rwim (Some v) empR, F ++ [fmo; fml]), d0).
  eexists.
  split.

  Focus 2.
  split.
  unfold regSt.
  simpl.
  repeat (split; eauto).

  exists (empM, (RegMap.set rd (Some (v1 +ᵢ v2)) empR, F ++ [fmo; fml]), d0).
  eexists.
  split.
  Focus 2.
  split; eauto.
  unfold regSt.
  simpl.
  split; eauto.

  simpl.
  repeat (split; eauto).
  eapply RegSet_same_addr_disj_stable; eauto.

  simpl.
  repeat (split; eauto).
  eapply disj_dom_eq_still with (m1 := RegMap.set Rwim (Some v) empR)
                                  (m2 := r ⊎ (r1 ⊎ r3)); eauto.
  eapply dom_eq_memset_same_addr_stable; eauto.
  eapply dom_eq_emp; eauto.
  eapply dom_eq_trans with (m2 := merge r' (merge r1' r3)).
  repeat (eapply dom_eq_merge_still; eauto).
  eapply same_m_dom_eq; eauto.
  rewrite H28; eauto.
  eapply dom_eq_merge_some_addr_stable; eauto.
  eapply same_m_dom_eq; eauto.

  rewrite H27.
  eapply RRestore; eauto.
  {
    eapply get_R_merge_still2; eauto.
    eapply get_R_merge_still; eauto.
    clear - H6.
    simpls.
    unfolds regSt.
    simpls.
    simpljoin1.
    rewrite get_R_rn_neq_r0; eauto.
    2 : intro; tryfalse.
    unfold RegMap.set.
    destruct_rneq.
  }
  {
    eapply get_R_merge_still; eauto.
    rewrite get_R_rn_neq_r0; eauto.
    2 : intro; tryfalse.
    unfold RegMap.set.
    destruct_rneq.
  }
  {
    instantiate (1 := fmi).
    eapply fetch_disj_merge_still2; eauto.
    eapply fetch_disj_merge_still2; eauto.
    eapply fetch_disj_merge_still1; eauto.
    eapply Regs_fetch; eauto.
  }
  {
    eapply indom_merge_still2; eauto.
    eapply indom_dom_eq_subst with (m := (r' ⊎ (r1' ⊎ r3))).
    rewrite H28.
    eapply indom_merge_still; eauto.
    eapply regset_l_l_indom; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_sym; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_sym; eauto.
    eapply same_m_dom_eq; eauto.
  }
  {
    instantiate (1 := v1).
    clear - H H4 Ht.
    eapply H in Ht; eauto.
    simpl in Ht.
    simpljoin1.
    eapply get_R_merge_still2; eauto.
  }
  {
    instantiate (1 := v2).
    clear - H H4 Ht.
    eapply H in Ht; eauto.
    simpl in Ht.
    simpljoin1.
    eapply eval_opexp_merge_still2; eauto.
  }
  {
    rewrite set_win_merge2; eauto.
    rewrite set_win_merge2; eauto.
    rewrite set_win_merge1; eauto.
    erewrite set_window_res with (R' := r1'); eauto.

    unfold set_Rs.
    rewrite indom_setR_merge_eq2; eauto.
    assert (set_R (r ⊎ (r1' ⊎ r3)) cwp (post_cwp id) =
            (set_R r cwp (post_cwp id)) ⊎ (r1' ⊎ r3)).
    {
      rewrite indom_setR_merge_eq1; eauto.
      clear - H6.
      simpls.
      unfolds regSt.
      simpls.
      simpljoin1.
      eapply regset_l_l_indom; eauto.
    }
    rewrite H17; eauto.
    assert (set_R r cwp (post_cwp id) = r').
    {
      clear - H6 H13.
      simpls.
      unfolds regSt.
      simpls.
      simpljoin1.
      rewrite indom_setR_eq_RegMap_set; eauto.
      rewrite regset_twice; eauto.
      eapply regset_l_l_indom; eauto.
    }
    rewrite H20.
    rewrite H28.
    rewrite indom_setR_merge_eq2; eauto.
    rewrite indom_setR_merge_eq1; eauto.
    rewrite indom_setR_eq_RegMap_set; eauto.
    rewrite regset_twice; eauto.
    eapply regset_l_l_indom; eauto.
    eapply regset_l_l_indom; eauto.

    clear.
    unfold indom.
    intro.
    simpljoin1.
    unfolds RegMap.set.
    destruct_rneq_H.

    rewrite <- H28.
    eapply disj_dom_eq_still with (m2 := (r ⊎ (r1 ⊎ r3))); eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.

    clear.
    unfold indom.
    intro.
    simpljoin1.
    unfolds RegMap.set.
    destruct_rneq_H.

    eapply disj_dom_eq_still with (m2 := (r ⊎ (r1 ⊎ r3))); eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.
    eapply dom_eq_merge_still; eauto.
    eapply same_m_dom_eq; eauto.

    clear - H15.
    eapply Regs_frm_free; eauto.
    eapply Regs_indom_Fmr; eauto.
    eapply indoms_merge_still1; eauto.
    eapply Regs_indom_Fmr; eauto.
    eapply indoms_merge_still2; eauto.
    eapply indoms_merge_still1; eauto.
    eapply Regs_indom_Fmr; eauto.
  }
Qed.

Lemma sll_rule_sound :
  forall p (rs rd : GenReg) v v1 v2 oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 <<ᵢ (get_range 0 4 v2) ** q) (sll rs oexp rd).
Proof.
  unfold ins_sound.
  intros.
  lets Hexp : H1.
  lets Hrd : H1.
  eapply H in Hexp.
  eapply H0 in Hrd.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m ⊎ m0, (set_R r rd (v1 <<ᵢ (get_range 0 4 v2)) ⊎ r0, f0), d0).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply Sll_step; eauto.
  instantiate (1 := v1).
  clear - Hexp.
  simpl in Hexp.
  simpljoin1; eauto.
  instantiate (1 := v2).
  clear - Hexp.
  simpl in Hexp.
  simpljoin1; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply indom_merge_still; eauto.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m, (set_R r rd v1 <<ᵢ (get_range 0 4 v2), f0), d0).
  exists (m0, (r0, f0), d0).
  simpls.
  repeat (split; eauto).
  eapply disjoint_setR_still1; eauto.
  simpl.
  clear - H4.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite regset_twice; eauto.
  eapply regset_l_l_indom; eauto.
  simpl; eauto.
  clear - H4.
  unfolds regSt.
  simpls; eauto.
  simpljoin1; eauto.
Qed.

Lemma srl_rule_sound :
  forall p (rs rd : GenReg) v v1 v2 oexp q,
    p ==> Or rs ==ₑ v1 //\\ oexp ==ₑ v2 ->
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> v1 >>ᵢ (get_range 0 4 v2) ** q) (srl rs oexp rd).
Proof.
  unfold ins_sound.
  intros.
  lets Hexp : H1.
  lets Hrd : H1.
  eapply H in Hexp.
  eapply H0 in Hrd.
  sep_star_split_tac.
  simpl in H6.
  simpljoin1.
  exists (m ⊎ m0, (set_R r rd (v1 >>ᵢ (get_range 0 4 v2)) ⊎ r0, f0), d0).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply Srl_step; eauto.
  instantiate (1 := v1).
  clear - Hexp.
  simpl in Hexp.
  simpljoin1; eauto.
  instantiate (1 := v2).
  clear - Hexp.
  simpl in Hexp.
  simpljoin1; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply indom_merge_still; eauto.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  clear - H4.
  simpls.
  unfolds regSt.
  simpls.
  simpljoin1.
  eapply regset_l_l_indom; eauto.
  simpl.
  exists (m, (set_R r rd v1 >>ᵢ (get_range 0 4 v2), f0), d0).
  exists (m0, (r0, f0), d0).
  simpls.
  repeat (split; eauto).
  eapply disjoint_setR_still1; eauto.
  simpl.
  clear - H4.
  unfolds regSt.
  simpls.
  simpljoin1.
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite regset_twice; eauto.
  eapply regset_l_l_indom; eauto.
  simpl; eauto.
  clear - H4.
  unfolds regSt.
  simpls; eauto.
  simpljoin1; eauto.
Qed.

Lemma set_rule_sound :
  forall p q (rd : GenReg) v w,
    p ==> rd |=> v ** q ->
    ins_sound p (rd |=> w ** q) (sett w rd).
Proof.
  unfold ins_sound.
  intros.
  eapply H in H0.
  sep_star_split_tac.
  simpls.
  simpljoin1.
  unfolds regSt.
  simpls.
  simpljoin1.
  exists (empM ⊎ m0,
     (set_R (RegMap.set rd (Some v) empR) rd w ⊎ r0, f0), d0).
  repeat (split; eauto).
  eapply NormalIns; eauto.
  eapply Set_step; eauto.
  eapply indom_merge_still; eauto.
  eapply regset_l_l_indom; eauto.
  rewrite indom_setR_merge_eq1; eauto.
  eapply regset_l_l_indom; eauto.
  exists (empM, (set_R (RegMap.set rd (Some v) empR) rd w, f0), d0).
  exists (m0, (r0, f0), d0).
  simpls.
  repeat (split; eauto).
  eapply disjoint_setR_still1; eauto.
  rewrite indom_setR_eq_RegMap_set; eauto.
  rewrite regset_twice; eauto.
  eapply regset_l_l_indom; eauto.
Qed.

Lemma conj_ins_sound : forall p1 p2 q1 q2 i,
    ins_sound p1 q1 i -> ins_sound p2 q2 i -> ins_sound (p1 //\\ p2) (q1 //\\ q2) i.
Proof.
  unfold ins_sound.
  intros.
  simpl in H1.
  destruct H1.
  eapply H in H1; eauto.
  destruct H1 as [s1 [Hstep1 Hq1] ].
  eapply H0 in H2; eauto.
  destruct H2 as [s2 [Hstep2 Hq2] ].

  assert (s1 = s2).
  {
    eapply ins_exec_deterministic; eauto.
  }

  subst.
  exists s2. split; eauto.
  simpl.
  eauto.
Qed.

Lemma disj_ins_sound : forall p1 p2 q1 q2 i,
    ins_sound p1 q1 i -> ins_sound p2 q2 i -> ins_sound (p1 \\// p2) (q1 \\// q2) i.
Proof.
  unfold ins_sound.
  intros.
  simpl in H1.
  destruct H1.
  {
    eapply H in H1.
    destruct H1 as [s1' [HQ Hq1] ].
    exists s1'. split; eauto.
    simpl.
    left; eauto.
  }
  {
    eapply H0 in H1.
    destruct H1 as [s2' [HQ Hq2] ].
    exists s2'. split; eauto.
    simpl.
    right; eauto.
  }
Qed.

Lemma conseq_ins_sound : forall p p1 q q1 i,
    p ==> p1 -> ins_sound p1 q1 i -> q1 ==> q ->
    ins_sound p q i.
Proof.
  unfold ins_sound.
  intros.
  eapply H in H2.
  eapply H0 in H2.
  eauto.
  destruct H2 as [s' [HQ Hq1] ].
  eapply H1 in Hq1.
  eexists.
  eauto.
Qed.

Lemma frame_ins_sound : forall p q r i,
    ins_sound p q i -> DlyFrameFree r ->
    ins_sound (p ** r) (q ** r) i.
Proof.
  unfold ins_sound.
  intros.
  simpl in H1.
  destruct H1 as [s1 H1].
  destruct H1 as [s2 H1].
  destruct H1 as [Hunion [Hp Hr] ].
  lets Hpp : Hp.
  eapply H in Hpp.
  destruct Hpp as [s1' [HQ Hq] ].
  remember Hunion as Ht.
  clear HeqHt.
  eapply ins_safety_property in Ht; eauto.
  simpljoin1.
  renames x0 to s2', x to s'.
  exists s'.
  split; eauto.
  simpl.
  exists s1' s2'.
  repeat (split; eauto).
Qed.

Theorem ins_rule_sound : forall p q i,
      |- {{ p }} i {{ q }} ->
      ins_sound p q i.
Proof.
  intros.
  induction H.

  - (* ld *)
    eapply ld_rule_sound; eauto.

  - (* st *)
    eapply st_rule_sound; eauto.

  - (* add *)
    eapply add_rule_sound; eauto.

  - (* sub *)
    eapply sub_rule_sound; eauto.

  - (* subcc *)
    eapply subcc_rule_sound; eauto.

  - (* and *)
    eapply and_rule_sound; eauto.

  - (* andcc *)
    eapply andcc_rule_sound; eauto.

  - (* sll *)
    eapply sll_rule_sound; eauto.

  - (* srl *)
    eapply srl_rule_sound; eauto.

  - (* or *)
    eapply or_rule_sound; eauto.

  - (* set *)
    eapply set_rule_sound; eauto.

  - (* nop *)
    eapply nop_rule_sound; eauto.

  - (* rd *)
    eapply rd_rule_sound; eauto.

  - (* wr *)
    eapply wr_rule_sound; eauto.

  - (* getcwp *)
    eapply getcwp_rule_sound; eauto.

  - (* save *)
    eapply save_rule_sound; eauto.

  - (* restore *)
    eapply resotre_rule_sound; eauto.

  - (* conj *)
    eapply conj_ins_sound; eauto.

  - (* disj *)
    eapply disj_ins_sound; eauto.

  - (* conseq *)
    eapply conseq_ins_sound; eauto.

  - (* frame *)
    eapply frame_ins_sound; eauto.
Qed.


Require Import GL4ip_PSGL4ip_calcs.
Require Import List.
Export ListNotations.

Require Import genT gen.
Require Import ddT.
Require Import gen_tacs.
Require Import gen_seq.
Require Import List_lemmasT.
Require Import existsT.
Require Import univ_gen_ext.
Require Import GL4ip_PSGL4ip_list_lems.
Require Import dd_fc.
Require Import PeanoNat.
Require Import strong_inductionT.
Require Import GL4ip_exch.
Require Import GL4ip_wkn.
Require Import GL4ip_PSGL4ip_remove_list.
Require Import GL4ip_PSGL4ip_dec.
Require Import GL4ip_inv_AndR_AndL.
Require Import GL4ip_inv_OrL.
Require Import GL4ip_inv_AtomImpL.
Require Import GL4ip_inv_AndImpL.
Require Import GL4ip_inv_OrImpL.
Require Import GL4ip_inv_ImpImpL_R.
Require Import GL4ip_inv_BoxImpL_R.
Require Import GL4ip_ctr.
Require Import Lia.

Theorem ImpL_hpinv_R : forall (m k : nat) s (D0: derrec GL4ip_rules (fun _ => False) s) A B Γ0 Γ1 C,
        m = (weight_form (Imp A B)) ->
        k = (derrec_height D0) ->
        (s = (Γ0 ++ Imp A B :: Γ1, C)) ->
        derrec GL4ip_rules (fun _ => False) (Γ0 ++ B :: Γ1, C).
Proof.
assert (DersNilF: dersrec GL4ip_rules (fun _ : Seq  => False) []).
apply dersrec_nil.
(* Setting up the strong induction on the weight. *)
pose (strong_inductionT (fun (x:nat) => forall k s (D0 : derrec GL4ip_rules (fun _ => False) s) A B Γ0 Γ1 C,
        x = (weight_form (Imp A B)) ->
        k = (derrec_height D0) ->
        (s = (Γ0 ++ Imp A B :: Γ1, C)) ->
        derrec GL4ip_rules (fun _ => False) (Γ0 ++ B :: Γ1, C))).
apply d. intros n PIH. clear d.

(* Setting up the strong induction on the height. *)
pose (strong_inductionT (fun (x:nat) => forall s (D0 : derrec GL4ip_rules (fun _ => False) s) A B Γ0 Γ1 C,
        n = weight_form (Imp A B) ->
        x = (derrec_height D0) ->
        (s = (Γ0 ++ Imp A B :: Γ1, C)) ->
        derrec GL4ip_rules (fun _ => False) (Γ0 ++ B :: Γ1, C))).
apply d. intros m SIH. clear d.

(* Now we do the actual proof-theoretical work. *)
intros s D0. remember D0 as D0'. destruct D0.
(* D0 is a leaf *)
- destruct f.
(* D0 is ends with an application of rule *)
- intros A B Γ0 Γ1 C wei hei eq. inversion g ; subst.
  (* IdP *)
  * inversion H. subst. assert (InT # P (Γ0 ++ A → B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT # P (Γ0 ++ B :: Γ1)).
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. inversion i. subst. inversion H1. auto.
    apply InT_split in H1. destruct H1. destruct s. rewrite e. assert (IdPRule [] (x ++ # P :: x0, # P)).
    apply IdPRule_I. apply IdP in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x ++ # P :: x0, # P) H1 DersNilF). auto.
  (* BotL *)
  * inversion H. subst. assert (InT (⊥) (Γ0 ++ A → B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT (⊥) (Γ0 ++ B :: Γ1)).
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. inversion i. subst. inversion H1. auto. apply InT_split in H1. destruct H1. destruct s. rewrite e.
    assert (BotLRule [] (x ++ ⊥ :: x0, C)). apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x ++ ⊥ :: x0, C) H1 DersNilF). auto.
   (* AndR *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
    simpl in PIH. simpl in SIH.
    assert (J2: derrec_height x < S (dersrec_height d)). lia.
    assert (J3: derrec_height x = derrec_height x). reflexivity.
    assert (J4 : (Γ0 ++ A → B :: Γ1, A0) = (Γ0 ++ A → B :: Γ1, A0)). auto.
    assert (J40: S (weight_form A + weight_form B) = S (weight_form A + weight_form B)). auto.
    pose (SIH _ J2 _ x _ _ _ _ _ J40 J3 J4).
    assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
    assert (J7 : (Γ0 ++ A → B :: Γ1, B0) = (Γ0 ++ A → B :: Γ1, B0)). auto.
    pose (SIH _ J5 _ x0 _ _ _ _ _ J40 J6 J7).
    assert (AndRRule [(Γ0 ++ B :: Γ1, A0); (Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ B :: Γ1, A0 ∧ B0)). apply AndRRule_I. pose (dlCons d1 DersNilF). pose (dlCons d0 d2).
    apply AndR in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
   (ps:=[(Γ0 ++ B :: Γ1, A0); (Γ0 ++ B :: Γ1, B0)])
    (Γ0 ++ B :: Γ1, And A0 B0) H0 d3). auto.
  (* AndL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (J2: derrec_height x < S (dersrec_height d)). lia.
      assert (J3: derrec_height x = derrec_height x). reflexivity.
      assert (J4 : (((Γ0 ++ [A → B]) ++ x0) ++ A0 :: B0 :: Γ3, C) = (Γ0 ++ A → B :: x0 ++ A0 :: B0 :: Γ3, C)).
      repeat rewrite <- app_assoc. auto.
      assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
      pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
      assert (AndLRule [((Γ0 ++ B :: x0) ++ A0 :: B0 :: Γ3, C)]
       ((Γ0 ++ B :: x0) ++ A0 ∧ B0 :: Γ3, C)). apply AndLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
       pose (dlCons d0 DersNilF). apply AndL in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x0 ++ A0 :: B0 :: Γ3, C)])
       (Γ0 ++ B :: x0 ++ A0 ∧ B0 :: Γ3, C) H0 d1). auto.
  +  repeat destruct s. repeat destruct p ; subst.
      assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (J2: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J3: derrec_height x0 = derrec_height x0). reflexivity.
      assert (J4 : (Γ2 ++ A0 :: B0 :: x ++ A → B :: Γ1, C) = ((Γ2 ++ A0 :: B0 :: x) ++ A → B :: Γ1, C)).
      repeat rewrite <- app_assoc. auto.
      assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
      pose (SIH _ J2 _ x0 _ _ _ _ _ J70 J3 J4).
      pose (dlCons d0 DersNilF).
      assert (AndLRule [((Γ2 ++ A0 :: B0 :: x) ++ B :: Γ1, C)]
       ((Γ2 ++ A0 ∧ B0 :: x) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply AndLRule_I.
       apply AndL in H0.
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[((Γ2 ++ A0 :: B0 :: x) ++ B :: Γ1, C)])
      ((Γ2 ++ A0 ∧ B0 :: x) ++ B :: Γ1, C) H0 d1). auto.
  (* OrR1 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s. simpl.
    assert (J2: derrec_height x < S (dersrec_height d)). lia.
    assert (J3: derrec_height x = derrec_height x). reflexivity.
    assert (J4 : (Γ0 ++ A → B :: Γ1, A0) = (Γ0 ++ A → B :: Γ1, A0)). auto.
    assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
    pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
    assert (OrR1Rule [(Γ0 ++ B :: Γ1, A0)]
    (Γ0 ++ B :: Γ1, Or A0 B0)). apply OrR1Rule_I. pose (dlCons d0 DersNilF).
    apply OrR1 in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ B :: Γ1, A0)])
    (Γ0 ++ B  :: Γ1, Or A0 B0) H0 d1). auto.
  (* OrR2 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s. simpl.
    assert (J2: derrec_height x < S (dersrec_height d)). lia.
    assert (J3: derrec_height x = derrec_height x). reflexivity.
    assert (J4 : (Γ0 ++ A → B :: Γ1, B0) = (Γ0 ++ A → B :: Γ1, B0)). auto.
    assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
    pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
    assert (OrR2Rule [(Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ B :: Γ1, Or A0 B0)). apply OrR2Rule_I. pose (dlCons d0 DersNilF).
    apply OrR2 in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ B :: Γ1, B0)])
    (Γ0 ++ B  :: Γ1, Or A0 B0) H0 d1). auto.
  (* OrL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
      assert (J2: derrec_height x < S (dersrec_height d)). lia.
      assert (J3: derrec_height x = derrec_height x). reflexivity.
      assert (J4 : (((Γ0 ++ [A → B]) ++ x0) ++ A0 :: Γ3, C) = (Γ0 ++ A → B :: (x0 ++ A0 :: Γ3), C)). repeat rewrite <- app_assoc. auto.
      assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
      pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
      assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
      assert (J7 : (((Γ0 ++ [A → B]) ++ x0) ++ B0 :: Γ3, C) = (Γ0 ++ A → B :: (x0 ++ B0 :: Γ3), C)). repeat rewrite <- app_assoc. auto.
      pose (SIH _ J5 _ x1 _ _ _ _ _ J70 J6 J7).
      assert (OrLRule [((Γ0 ++ B :: x0) ++ A0 :: Γ3, C);((Γ0 ++ B :: x0) ++ B0 :: Γ3, C)]
      ((Γ0 ++ B :: x0) ++ A0 ∨ B0 :: Γ3, C)). apply OrLRule_I. apply OrL in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      pose (dlCons d1 DersNilF). pose (dlCons d0 d2).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[(Γ0 ++ B :: x0 ++ A0 :: Γ3, C); (Γ0 ++ B :: x0 ++ B0 :: Γ3, C)])
      (Γ0 ++ B :: x0 ++ A0 ∨ B0 :: Γ3, C) H0 d3). auto.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      assert (J2: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J3: derrec_height x0 = derrec_height x0). reflexivity.
      assert (J4 :(Γ2 ++ A0 :: x ++ A → B :: Γ1, C) = ((Γ2 ++ A0 :: x) ++ A → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
      assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
      pose (SIH _ J2 _ x0 _ _ _ _ _ J70 J3 J4).
      assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
      assert (J7 : (Γ2 ++ B0 :: x ++ A → B :: Γ1, C) = ((Γ2 ++ B0 :: x) ++ A → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
      pose (SIH _ J5 _ x1 _ _ _ _ _ J70 J6 J7).
      assert (OrLRule [((Γ2 ++ A0 :: x) ++ B :: Γ1, C);((Γ2 ++ B0 :: x) ++ B :: Γ1, C)]
      ((Γ2 ++ A0 ∨ B0 :: x) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply OrLRule_I. apply OrL in H0.
      pose (dlCons d1 DersNilF). pose (dlCons d0 d2).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[((Γ2 ++ A0 :: x) ++ B :: Γ1, C); ((Γ2 ++ B0 :: x) ++ B :: Γ1, C)])
      ((Γ2 ++ A0 ∨ B0 :: x) ++ B :: Γ1, C) H0 d3). auto.
  (* ImpR *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
    assert (J50: derrec_height x = derrec_height x). auto.
    assert (J51: list_exch_L (Γ2 ++ A0 :: Γ3, B0) (A0 :: Γ0 ++ A → B :: Γ1, B0)).
    assert (Γ2 ++ A0 :: Γ3 = [] ++ [] ++ Γ2 ++ [A0] ++ Γ3). auto. rewrite H0.
    assert (A0 :: Γ0 ++ A → B :: Γ1 = [] ++ [A0] ++ Γ2 ++ [] ++ Γ3). rewrite <- H2. auto. rewrite H1.
    apply list_exch_LI.
    pose (GL4ip_hpadm_list_exch_L (derrec_height x) _ x J50 _ J51). destruct s.
    assert (J2: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J3: derrec_height x0 = derrec_height x0). reflexivity.
    assert (J4: (A0 :: Γ0 ++ A → B :: Γ1, B0) = ((A0 :: Γ0) ++ A → B :: Γ1, B0)). repeat rewrite <- app_assoc. auto.
    assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
    pose (SIH _ J2 _ x0 _ _ _ _ _ J70 J3 J4).
    assert (ImpRRule [(([] ++ A0 :: Γ0) ++ B :: Γ1, B0)] ([] ++ Γ0 ++ B :: Γ1, A0 → B0)). repeat rewrite <- app_assoc. apply ImpRRule_I.
    simpl in H0. apply ImpR in H0. pose (dlCons d0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[((A0 :: Γ0) ++ B :: Γ1, B0)]) (Γ0 ++ B :: Γ1, A0 → B0) H0 d1). auto.
  (* AtomImpL1 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1.
   + assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (((Γ0 ++ [A → B]) ++ x1) ++ # P :: Γ3 ++ A0 :: Γ4, C) = (Γ0 ++ A → B :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (AtomImpL1Rule [((Γ0 ++ B :: x1) ++ # P :: Γ3 ++ A0 :: Γ4, C)]
       ((Γ0 ++ B :: x1) ++ # P :: Γ3 ++ # P → A0 :: Γ4, C)). apply AtomImpL1Rule_I.
       repeat rewrite <- app_assoc in H0. apply AtomImpL1 in H0.
       pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C)])
       (Γ0 ++ B :: x1 ++ # P :: Γ3 ++ # P → A0 :: Γ4, C) H0 d1). auto.
   + repeat destruct s. repeat destruct p ; subst.
      apply list_split_form in e1. destruct e1. repeat destruct s ; repeat destruct p ; subst.
      { inversion e1. subst. repeat rewrite <- app_assoc. auto. }
      { assert (J2: derrec_height x < S (dersrec_height d)). lia.
         assert (J3: derrec_height x = derrec_height x). reflexivity.
         assert (J4: (Γ2 ++ # P :: ((x0 ++ [A → B]) ++ x2) ++ A0 :: Γ4, C) = ((Γ2 ++ # P :: x0) ++ A → B :: x2 ++ A0 :: Γ4, C)). repeat rewrite <- app_assoc. auto.
         assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
         pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
         assert (AtomImpL1Rule [((Γ2 ++ # P :: x0) ++ B :: x2 ++ A0 :: Γ4, C)]
         ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4, C)).
         assert ((Γ2 ++ # P :: x0) ++ B :: x2 ++ A0 :: Γ4 = Γ2 ++ # P :: (x0 ++ B :: x2) ++ A0 :: Γ4). repeat rewrite <- app_assoc. auto.
         rewrite H0.
         assert ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4 = Γ2 ++ # P :: (x0 ++ B :: x2) ++ # P → A0 :: Γ4). repeat rewrite <- app_assoc. auto.
         rewrite H1. apply AtomImpL1Rule_I. apply AtomImpL1 in H0. pose (dlCons d0 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[((Γ2 ++ # P :: x0) ++ B :: x2 ++ A0 :: Γ4, C)])
         ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4, C) H0 d1). auto. }
      { repeat destruct s. repeat destruct p ; subst.
         assert (J2: derrec_height x < S (dersrec_height d)). lia.
         assert (J3: derrec_height x = derrec_height x). reflexivity.
         assert (J4: (Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A → B :: Γ1, C) = ((Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ A → B :: Γ1, C)).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto.
         assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
         pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
         assert (AtomImpL1Rule [((Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ B :: Γ1, C)]
         ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
         apply AtomImpL1Rule_I. apply AtomImpL1 in H0. pose (dlCons d0 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[((Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ B :: Γ1, C)])
         ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ B :: Γ1, C) H0 d1). auto. }
  (* AtomImpL2 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1 ; subst. auto.
   + assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (((Γ0 ++ [A → B]) ++ x1) ++ A0 :: Γ3 ++ # P :: Γ4, C) = (Γ0 ++ A → B :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (AtomImpL2Rule [((Γ0 ++ B :: x1) ++ A0 :: Γ3 ++ # P :: Γ4, C)]
       ((Γ0 ++ B :: x1) ++ # P → A0 :: Γ3 ++ # P :: Γ4, C)). apply AtomImpL2Rule_I.
       repeat rewrite <- app_assoc in H0. apply AtomImpL2 in H0.
       pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C)])
       (Γ0 ++ B :: x1 ++ # P → A0 :: Γ3 ++ # P :: Γ4, C) H0 d1). auto.
   + repeat destruct s. repeat destruct p ; subst.
      apply list_split_form in e1. destruct e1. repeat destruct s ; repeat destruct p ; subst.
      { inversion e1. }
      { assert (J2: derrec_height x < S (dersrec_height d)). lia.
         assert (J3: derrec_height x = derrec_height x). reflexivity.
         assert (J4: (Γ2 ++ A0 :: ((x0 ++ [A → B]) ++ x2) ++ # P :: Γ4, C) = ((Γ2 ++ A0 :: x0) ++ A → B :: x2 ++ # P :: Γ4, C)). repeat rewrite <- app_assoc. auto.
         assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
         pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
         assert (AtomImpL2Rule [((Γ2 ++ A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C)]
         ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C)).
         assert ((Γ2 ++ A0 :: x0) ++ B :: x2 ++ # P :: Γ4 = Γ2 ++ A0 :: (x0 ++ B :: x2) ++ # P :: Γ4). repeat rewrite <- app_assoc. auto.
         rewrite H0.
         assert ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P  :: Γ4 = Γ2 ++ # P → A0 :: (x0 ++ B :: x2) ++ # P :: Γ4). repeat rewrite <- app_assoc. auto.
         rewrite H1. apply AtomImpL2Rule_I. apply AtomImpL2 in H0. pose (dlCons d0 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[((Γ2 ++ A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C)])
         ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C) H0 d1). auto. }
      { repeat destruct s. repeat destruct p ; subst.
         assert (J2: derrec_height x < S (dersrec_height d)). lia.
         assert (J3: derrec_height x = derrec_height x). reflexivity.
         assert (J4: (Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A → B :: Γ1, C) = ((Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ A → B :: Γ1, C)).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto.
         assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
         pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
         assert (AtomImpL2Rule [((Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C)]
         ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
         apply AtomImpL2Rule_I. apply AtomImpL2 in H0. pose (dlCons d0 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[((Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C)])
         ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C) H0 d1). auto. }
 (* AndImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1. subst.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (Γ0 ++ A0 → B0 → B :: Γ1, C) = (Γ0 ++ A0 → B0 → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
       assert (J71: weight_form (A0 → B0 → B) < weight_form ((A0 ∧ B0) → B)). simpl ; lia.
       assert (J72: weight_form (A0 → B0 → B) = weight_form (A0 → (B0 → B))). auto.
       pose (PIH _ J71 _ _ _ _ _ _ _ _ J72 J3 J4).
       assert (J6: derrec_height d0 = derrec_height d0). reflexivity.
       assert (J7: (Γ0 ++ B0 → B :: Γ1, C) = (Γ0 ++ B0 → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
       assert (J73: weight_form (B0 → B) < weight_form ((A0 ∧ B0) → B)). simpl ; lia.
       assert (J74: weight_form (B0 → B) = weight_form (B0 → B)). auto.
       pose (PIH _ J73 _ _ _ _ _ _ _ _ J74 J6 J7). auto.
   +  assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (((Γ0 ++ [A → B]) ++ x1) ++ A0 → B0 → C0 :: Γ3, C) = (Γ0 ++ A → B :: x1 ++ A0 → B0 → C0 :: Γ3, C)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (AndImpLRule [((Γ0 ++ B :: x1) ++ A0 → B0 → C0 :: Γ3, C)]
       ((Γ0 ++ B :: x1) ++ (A0 ∧ B0) → C0 :: Γ3, C)). apply AndImpLRule_I.
       repeat rewrite <- app_assoc in H0. apply AndImpL in H0.
       pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x1 ++ A0 → B0 → C0 :: Γ3, C)])
       (Γ0 ++ B :: x1 ++ (A0 ∧ B0) → C0 :: Γ3, C) H0 d1). auto.
   +  repeat destruct s. repeat destruct p ; subst.
       assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (Γ2 ++ A0 → B0 → C0 :: x0 ++ A → B :: Γ1, C) = ((Γ2 ++ A0 → B0 → C0 :: x0) ++ A → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (AndImpLRule [((Γ2 ++ A0 → B0 → C0 :: x0) ++ B :: Γ1, C)]
       ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
       apply AndImpL in H0. pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ2 ++ A0 → B0 → C0 :: x0) ++ B :: Γ1, C)])
       ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ B :: Γ1, C) H0 d1). auto.
  (* OrImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity. simpl.
     pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
     apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1. subst.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (Γ0 ++ A0 → B :: Γ3 ++ B0 → B :: Γ4, C) = (Γ0 ++ A0 → B :: Γ3 ++ B0 → B :: Γ4, C)).
       repeat rewrite <- app_assoc. auto.
       assert (J73: weight_form (A0 → B) < weight_form ((A0 ∨ B0) → B)). simpl ; lia.
       assert (J74: weight_form (A0 → B) = weight_form (A0 → B)). auto.
       pose (PIH _ J73 _ _ _ _ _ _ _ _ J74 J3 J4).
       assert (J6: derrec_height d0 = derrec_height d0). reflexivity.
       assert (J7: (Γ0 ++ B :: Γ3 ++ B0 → B :: Γ4, C) = ((Γ0 ++ B :: Γ3) ++ B0 → B :: Γ4, C)).
       repeat rewrite <- app_assoc. auto.
       assert (J71: weight_form (B0 → B) < weight_form ((A0 ∨ B0) → B)). simpl ; lia.
       assert (J72: weight_form (B0 → B) = weight_form (B0 → B)). auto.
       pose (PIH _ J71 _ _ _ _ _ _ _ _ J72 J6 J7).
       assert (J8: ctr_L B ((Γ0 ++ B :: Γ3) ++ B :: Γ4, C) (Γ0 ++ B :: Γ3 ++ Γ4, C)). repeat rewrite <- app_assoc ; simpl.
       apply ctr_LI.
       assert (J9: derrec_height d1 = derrec_height d1). auto.
       assert (J10: weight_form B = weight_form B). auto.
       pose (@GL4ip_ctr_L _ _ _ _ J9 _ _ J10 J8). auto.
   +  assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (((Γ0 ++ [A → B]) ++ x1) ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C) = (Γ0 ++ A → B ::  x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)).
       repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (OrImpLRule [((Γ0 ++ B :: x1) ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)]
       ((Γ0 ++ B :: x1) ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C)). apply OrImpLRule_I.
       repeat rewrite <- app_assoc in H0. apply OrImpL in H0.
       pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)])
       (Γ0 ++ B :: x1 ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C) H0 d1). auto.
   +  repeat destruct s. repeat destruct p ; subst.
       assert (J50: derrec_height x = derrec_height x). auto.
       assert (J51: list_exch_L (Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C) (Γ2 ++ A0 → C0 :: B0 → C0 :: x0 ++ A → B :: Γ1, C)).
       assert (Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4 = (Γ2 ++ [A0 → C0]) ++ [] ++ Γ3 ++ [B0 → C0] ++ Γ4).
       repeat rewrite <- app_assoc. auto. rewrite H0.
       assert (Γ2 ++ A0 → C0 :: B0 → C0 :: x0 ++ A → B :: Γ1 = (Γ2 ++ [A0 → C0]) ++ [B0 → C0] ++ Γ3 ++ [] ++ Γ4).
       rewrite <- e1 ; repeat rewrite <- app_assoc ; auto. rewrite H1. apply list_exch_LI.
       pose (GL4ip_hpadm_list_exch_L (derrec_height x) _ x J50 _ J51). destruct s.
       assert (J2: derrec_height x1 < S (dersrec_height d)). lia.
       assert (J3: derrec_height x1 = derrec_height x1). reflexivity.
       assert (J4: (Γ2 ++ A0 → C0 :: B0 → C0 :: x0 ++ A → B :: Γ1, C) = ((Γ2 ++ A0 → C0 :: B0 → C0 :: x0) ++ A → B :: Γ1, C)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x1 _ _ _ _ _ J70 J3 J4).
       assert (OrImpLRule [((Γ2 ++ A0 → C0 :: B0 → C0 :: x0) ++ B :: Γ1, C)]
       ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: Γ1, C)).
       assert ((Γ2 ++ A0 → C0 :: B0 → C0 :: x0) ++ B :: Γ1 = Γ2 ++ A0 → C0 :: [] ++ B0 → C0 :: x0 ++ B :: Γ1).
       repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H0.
       assert ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: Γ1 = Γ2 ++ (A0 ∨ B0) → C0 :: [] ++ x0 ++ B :: Γ1).
       repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H1.
       apply OrImpLRule_I.  apply OrImpL in H0. pose (dlCons d0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ2 ++ A0 → C0 :: B0 → C0 :: x0) ++ B :: Γ1, C)])
       ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: Γ1, C) H0 d1). auto.
  (* ImpImpL *)
 * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1. subst.
       pose (derI (Γ0 ++ (A0 → B0) → B :: Γ1, C) g d).
       assert (J40: derrec_height d0 = derrec_height d0). auto.
       pose (ImpImpL_hpinv_R _ _ _ J40 _ _ H). destruct s. auto.
   +  assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (((Γ0 ++ [A → B]) ++ x2) ++ B0 → C0 :: Γ3, A0 → B0) = (Γ0 ++ A → B :: x2 ++ B0 → C0 :: Γ3, A0 → B0)).
       repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       assert (J7: (((Γ0 ++ [A → B]) ++ x2) ++ C0 :: Γ3, C) = (Γ0 ++ A → B :: x2 ++ C0 :: Γ3, C)).
       repeat rewrite <- app_assoc. auto.
       pose (SIH _ J5 _ x0 _ _ _ _ _ J70 J6 J7).
       assert (ImpImpLRule [((Γ0 ++ B :: x2) ++ B0 → C0 :: Γ3, A0 → B0);((Γ0 ++ B :: x2) ++ C0 :: Γ3, C)]
       ((Γ0 ++ B :: x2) ++ (A0 → B0) → C0 :: Γ3, C)). apply ImpImpLRule_I.
       repeat rewrite <- app_assoc in H0. apply ImpImpL in H0.
       pose (dlCons d1 DersNilF). pose (dlCons d0 d2).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ B :: x2 ++ B0 → C0 :: Γ3, A0 → B0); (Γ0 ++ B :: x2 ++ C0 :: Γ3, C)])
       (Γ0 ++ B :: x2 ++ (A0 → B0) → C0 :: Γ3, C) H0 d3). auto.
   +  repeat destruct s. repeat destruct p ; subst.
       assert (J2: derrec_height x < S (dersrec_height d)). lia.
       assert (J3: derrec_height x = derrec_height x). reflexivity.
       assert (J4: (Γ2 ++ B0 → C0 :: x1 ++ A → B :: Γ1, A0 → B0) = ((Γ2 ++ B0 → C0 :: x1) ++ A → B :: Γ1, A0 → B0)). repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J2 _ x _ _ _ _ _ J70 J3 J4).
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       assert (J7: (Γ2 ++ C0 :: x1 ++ A → B :: Γ1, C) = ((Γ2 ++ C0 :: x1) ++ A → B :: Γ1, C)).
       repeat rewrite <- app_assoc. auto.
       pose (SIH _ J5 _ x0 _ _ _ _ _ J70 J6 J7).
       assert (ImpImpLRule [((Γ2 ++ B0 → C0 :: x1) ++ B :: Γ1, A0 → B0);((Γ2 ++ C0 :: x1) ++ B :: Γ1, C)]
       ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply ImpImpLRule_I.
       apply ImpImpL in H0. pose (dlCons d1 DersNilF). pose (dlCons d0 d2).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ2 ++ B0 → C0 :: x1) ++ B :: Γ1, A0 → B0); ((Γ2 ++ C0 :: x1) ++ B :: Γ1, C)])
       ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ B :: Γ1, C) H0 d3). auto.
  (* BoxImpL *)
 * inversion X. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
    apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p ; subst.
    apply list_split_form in H. destruct H. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1. subst.
       pose (derI (Γ0 ++ Box A0 → B :: Γ1, C) g d).
       assert (J40: derrec_height d0 = derrec_height d0). auto.
       pose (BoxImpL_hpinv_R _ _ _ J40 _ _ X). destruct s. auto.
   +  apply univ_gen_ext_splitR in u. destruct u. destruct s. repeat destruct p ; subst.
       apply univ_gen_ext_splitR in u. destruct u. destruct s. repeat destruct p ; subst.
       inversion u2. subst. exfalso. assert (In (A → B) (((x1 ++ A → B :: l) ++ x5) ++ x2)).
       apply in_or_app ; left ; apply in_or_app ; left ; apply in_or_app ; right ; apply in_eq.
       apply H1 in H. destruct H. inversion H. subst. inversion X0. subst.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       assert (J7: (((Γ0 ++ [A → B]) ++ x4) ++ B0 :: Γ3, C) = (Γ0 ++ A → B :: x4 ++ B0 :: Γ3, C)).
       repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J5 _ x0 _ _ _ _ _ J70 J6 J7).
       destruct (dec_is_boxedT B).
       { assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : list (MPropF) * MPropF => False) (XBoxed_list x1 ++ XBoxed_list (x5 ++ x2) ++ [Box A0], A0)),
          derrec_height D1 = derrec_height x).
          assert (XBoxed_list x1 ++ XBoxed_list (x5 ++ x2) ++ [Box A0] = XBoxed_list (((x1 ++ []) ++ x5) ++ x2) ++ [Box A0]).
          repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc ; auto. rewrite H.
          exists x ; auto. destruct X1. symmetry in e0.
          pose (@GL4ip_list_wkn_L (derrec_height x) (XBoxed_list x1) (XBoxed_list (x5 ++ x2) ++ [Box A0]) A0 x3 e0 [unBox_formula B ; B]).
          destruct s.
          assert (BoxImpLRule [(XBoxed_list x1 ++ [unBox_formula B; B] ++ XBoxed_list (x5 ++ x2) ++ [Box A0], A0);((Γ0 ++ B :: x4) ++ B0 :: Γ3, C)]
          ((Γ0 ++ B :: x4) ++ Box A0 → B0 :: Γ3, C)).
          assert (XBoxed_list x1 ++ [unBox_formula B; B] ++ XBoxed_list (x5 ++ x2) ++ [Box A0] = XBoxed_list (x1 ++ B :: x5 ++ x2) ++ [Box A0]).
          repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto.
           rewrite H. apply BoxImpLRule_I. intro. intros. apply in_app_or in H0. repeat rewrite <- app_assoc in H1.
           simpl in H1. destruct H0. apply H1. apply in_or_app ; auto. inversion H0 ; subst. destruct i. exists x7 ; subst ; auto.
           apply in_app_or in H3. destruct H3. apply H1. apply in_or_app ; right ; apply in_or_app ; auto.
           apply H1. apply in_or_app ; right ; apply in_or_app ; auto. repeat rewrite <- app_assoc.
           apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_cons ; auto. apply univ_gen_ext_combine ; auto.
           repeat rewrite <- app_assoc in X1. apply BoxImpL in X1.
           pose (dlCons d0 DersNilF). pose (dlCons x6 d1).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
           (ps:=[(XBoxed_list x1 ++ [unBox_formula B; B] ++ XBoxed_list (x5 ++ x2) ++ [Box A0], A0); (Γ0 ++ B :: x4 ++ B0 :: Γ3, C)])
           (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C) X1 d2). auto. }
       { assert (BoxImpLRule [(XBoxed_list (((x1 ++ []) ++ x5) ++ x2) ++ [Box A0], A0);((Γ0 ++ B :: x4) ++ B0 :: Γ3, C)]
          ((Γ0 ++ B :: x4) ++ Box A0 → B0 :: Γ3, C)).
          apply BoxImpLRule_I ; auto. repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine ; auto.
          apply univ_gen_ext_extra ; auto. apply univ_gen_ext_combine ; auto.
           assert ((Γ0 ++ B :: x4) ++ B0 :: Γ3 = Γ0 ++ B :: x4 ++ B0 :: Γ3). repeat rewrite <- app_assoc. auto. rewrite H in X1.
           assert ((Γ0 ++ B :: x4) ++ Box A0 → B0 :: Γ3 = Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3). repeat rewrite <- app_assoc. auto. rewrite H0 in X1.
           pose (dlCons d0 DersNilF). pose (dlCons x d1). apply BoxImpL in X1.
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
           (ps:=[(XBoxed_list (((x1 ++ []) ++ x5) ++ x2) ++ [Box A0], A0); (Γ0 ++ B :: x4 ++ B0 :: Γ3, C)])
           (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C) X1 d2). auto. }
   +  repeat destruct s. repeat destruct p ; subst.
       apply univ_gen_ext_splitR in u0. destruct u0. destruct s. repeat destruct p ; subst.
       inversion u1. subst. exfalso. assert (In (A → B) (x1 ++ x4 ++ A → B :: l)).
       apply in_or_app ; right ; apply in_or_app ; right ; apply in_eq.
       apply H1 in H. destruct H. inversion H. subst.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       assert (J7: (Γ2 ++ B0 :: x3 ++ A → B :: Γ1, C) = ((Γ2 ++ B0 :: x3) ++ A → B :: Γ1, C)).
       repeat rewrite <- app_assoc. auto.
       assert (J70: weight_form (A → B) = weight_form (A → B)). auto.
       pose (SIH _ J5 _ x0 _ _ _ _ _ J70 J6 J7).
       destruct (dec_is_boxedT B).
       { assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : list (MPropF) * MPropF => False) (XBoxed_list (x1 ++ x4) ++ XBoxed_list  x5 ++ [Box A0], A0)),
          derrec_height D1 = derrec_height x).
          assert (XBoxed_list (x1 ++ x4) ++ XBoxed_list x5 ++ [Box A0] = XBoxed_list (x1++ x4 ++ x5) ++ [Box A0]).
          repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc ; auto. rewrite H.
          exists x ; auto. destruct X1. symmetry in e0.
          pose (@GL4ip_list_wkn_L (derrec_height x) (XBoxed_list (x1 ++ x4)) (XBoxed_list x5 ++ [Box A0]) A0 x2 e0 [unBox_formula B ; B]).
          destruct s.
          assert (BoxImpLRule [(XBoxed_list (x1 ++ x4) ++ [unBox_formula B; B] ++ XBoxed_list x5 ++ [Box A0], A0);((Γ2 ++ B0 :: x3) ++ B :: Γ1, C)]
          ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl.
          assert (XBoxed_list (x1 ++ x4) ++ unBox_formula B :: B :: XBoxed_list x5 ++ [Box A0] = XBoxed_list (x1 ++ x4 ++ B :: x5) ++ [Box A0]).
          repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto.
           rewrite H. apply BoxImpLRule_I. intro. intros. apply in_app_or in H0. repeat rewrite <- app_assoc in H1.
           simpl in H1. destruct H0. apply H1. apply in_or_app ; auto.
           apply in_app_or in H0. destruct H0. apply H1. apply in_or_app ; right ; apply in_or_app ; auto.
           inversion H0 ; subst. destruct i. exists x7 ; subst ; auto.
           apply H1. apply in_or_app ; right ; apply in_or_app ; auto.
           apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto.
           apply BoxImpL in X1.
           pose (dlCons d0 DersNilF). pose (dlCons x6 d1).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
           (ps:=[(XBoxed_list (x1 ++ x4) ++ [unBox_formula B; B] ++ XBoxed_list x5 ++ [Box A0], A0); ((Γ2 ++ B0 :: x3) ++ B :: Γ1, C)])
           ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C) X1 d2). auto. }
       { assert (BoxImpLRule [(XBoxed_list (x1 ++ x4 ++ x5) ++ [Box A0], A0);((Γ2 ++ B0 :: x3) ++ B :: Γ1, C)]
          ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl.
          apply BoxImpLRule_I ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto.
          apply univ_gen_ext_extra ; auto. apply BoxImpL in X1.
           pose (dlCons d0 DersNilF). pose (dlCons x d1).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
           (ps:=[(XBoxed_list (x1 ++ x4 ++ x5) ++ [Box A0], A0); ((Γ2 ++ B0 :: x3) ++ B :: Γ1, C)])
           ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C) X1 d2). auto. }
  (* GLR *)
  * inversion X. subst. simpl. apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p ; subst.
    inversion u0. subst. exfalso. assert (In (A → B) (x ++ A → B :: l)). apply in_or_app ; right ; apply in_eq.
    apply H1 in H. destruct H. inversion H. subst.
    assert (GLRRule [(XBoxed_list (x ++ x0) ++ [Box A0], A0)] (Γ0 ++ Γ1, Box A0)). apply GLRRule_I ; auto.
    apply univ_gen_ext_combine ; auto. apply GLR in X1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(XBoxed_list (x ++ x0) ++ [Box A0], A0)]) (Γ0 ++ Γ1, Box A0) X1 d).
    assert (J1: derrec_height d0 = derrec_height d0). auto.
    assert (J2: wkn_L B (Γ0 ++ Γ1, Box A0) (Γ0 ++ B :: Γ1, Box A0)). apply wkn_LI.
    pose (@GL4ip_wkn_L (derrec_height d0) _ d0 J1 (Γ0 ++ B :: Γ1, Box A0) B J2). destruct s. auto.
Qed.

Theorem ImpL_inv_R : forall A B Γ0 Γ1 C, derrec GL4ip_rules (fun _ => False) (Γ0 ++ Imp A B :: Γ1, C) ->
                  derrec GL4ip_rules (fun _ => False) (Γ0 ++ B :: Γ1, C).
Proof.
intros.
assert (J1: derrec_height X = derrec_height X). auto.
assert (J2: (Γ0 ++ A → B :: Γ1, C) = (Γ0 ++ A → B :: Γ1, C)). auto.
assert (J3: weight_form (A → B) = weight_form (A → B)). auto.
pose (ImpL_hpinv_R _ _ _ _ _ _ _ _ _ J3 J1 J2). auto.
Qed.


From isla Require Import opsem.

Definition a80008 : isla_trace :=
  WriteReg "R0" [] (RegVal_Base (Val_Bits (BV 64%N 0x80000000%Z))) Mk_annot :t:
  Smt (DeclareConst 46%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "_PC" [] (RegVal_Base (Val_Symbolic 46%Z)) Mk_annot :t:
  Smt (DefineConst 47%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 46%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  WriteReg "_PC" [] (RegVal_Base (Val_Symbolic 47%Z)) Mk_annot :t:
  tnil
.


Require Import Arith.
Require Import NPeano.
Require Import Omega.
Require Import List.
Require Import Coq.Numbers.Natural.Abstract.NDiv.
Import ListNotations.
Require Import Sorting.Permutation.

Require Import Util.
Require Import Net.
Require Import Raft.
Require Import VerdiTactics.

Require Import Sorted.

Require Import CommonTheorems.

Section UniqueIndices.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition uniqueIndices_host_invariant net :=
    (forall h, uniqueIndices (log (nwState net h))).

  Definition uniqueIndices_nw_invariant net :=
    forall p t leaderId prevLogIndex prevLogTerm entries leaderCommit,
      In p (nwPackets net) ->
      pBody p = AppendEntries t leaderId prevLogIndex prevLogTerm
                              entries leaderCommit ->
      uniqueIndices entries.

  Definition UniqueIndices net : Prop :=
    uniqueIndices_host_invariant net /\ uniqueIndices_nw_invariant net.

  Theorem UniqueIndices_invariant :
    forall net,
      raft_intermediate_reachable net ->
      UniqueIndices net.
  Proof.
    intros.
    find_apply_lem_hyp logs_sorted_invariant.
    unfold logs_sorted, UniqueIndices in *. intuition.
    - unfold uniqueIndices_host_invariant, logs_sorted_host in *.
      eauto using sorted_uniqueIndices.
    - unfold uniqueIndices_nw_invariant, logs_sorted_nw in *.
      eauto using sorted_uniqueIndices.
  Qed.
End UniqueIndices.


Require Export Arrow.

Hypothesis Φ0 : Φ <> ∅.
Variable φ : Class.
Hypothesis φΦ :  φ ∈ Φ.

Definition Overriding A r s :=
  A ⊂ N /\
    (forall ρ, ρ ∈ Tn ->
      (forall i, i ∈ A        -> <|r,s|> ∈ Pref (Value ρ i)) ->
      (forall i, i ∈ (N // A) -> <|s,r|> ∈ Pref (Value ρ i)) ->
     <|r,s|> ∈ Pref (Value φ ρ)).
Notation "A ▷ <| r , s |>" := (Overriding A r s)(at level 10).

Variable x y j J : Class.
Hypothesis JS : J ⊆  X.
Hypothesis xX : x ∈ X.
Hypothesis yX : y ∈ X.
Hypothesis x_ : M x.
Hypothesis y_ : M y.
Hypothesis jJ : j ∈ J.
Hypothesis Jxy : J ▷ <|x,y|>.

Definition K := Single j.
Definition L := J // K.
Definition M := N // J.

Variable z σ : Class.
Hypothesis zX : z ∈ X.
Hypothesis z_ : Axioms.M z.
Hypothesis σTn : σ ∈ Tn.
Hypothesis xyσj : <|x,y|> ∈ Pref (Value σ j).
Hypothesis yzσj : <|y,z|> ∈ Pref (Value σ j).
Hypothesis Lσ : forall l, l ∈ L -> <|z,x|> ∈ Pref (Value σ l) /\ <|x,y|> ∈ Pref (Value σ l).
Hypothesis Mσ : forall m, m ∈ M -> <|y,z|> ∈ Pref (Value σ m) /\ <|z,x|> ∈ Pref (Value σ m).

Theorem pref x y R (x_ : Axioms.M x) (y_ : Axioms.M y):
  <|x,y|> ∈ Pref R <-> <|x,y|> ∈ R /\ ~ <|y,x|> ∈ R.
Proof.
split => [H | H].
+ apply separation in H.
  induction H.
  apply (conj H).
  induction H0 as [a]; induction H0 as [b].
  induction H0 as [a_]; induction H0 as [b_].
  induction H0 as [xyab notbaR].
  apply (OP_eq x y a b x_ y_ a_ b_) in xyab.
  by induction xyab; subst a b.
+ induction H.
  apply separation.
  apply (conj H).
  by exists x; exists y.
Qed.

Theorem pref_ord x y R (x_ : Axioms.M x) (y_ : Axioms.M y):
  <|x,y|> ∈ Pref R -> <|x,y|> ∈ R.
Proof.
  rewrite (pref x y R x_ y_).
  intro.
  apply H.
Qed.

Theorem xyJσ :
  forall i, i ∈ J -> <|x,y|> ∈ Pref (Value σ i).
Proof.
  intros i iJ.
  assert (x_ : Axioms.M x) by (exists X; apply xX).
  assert (y_ : Axioms.M y) by (exists X; apply yX).
  case (ExcludedMiddle (i = j)) as [ij | notij].
  + subst i.
    apply xyσj.
  + assert (i ∈ L).
      apply diff.
      apply (conj iJ).
      intro iK.
      apply in_single in iK.
      case (notij iK).
      by exists J.
      exists J. apply jJ.
    specialize (Lσ i H) as H0.
    apply H0.
Qed.

Theorem Ri_T :
  forall R i, R ∈ Tn -> i ∈ N -> Value R i ∈ T.
Proof.
  intros R i RTn iX.
  apply separation in RTn.
  induction RTn.
  induction H0.
  induction H1.
  induction H0.
  rewrite <- H1 in iX.
  specialize (value R i H3 iX) as V.
  induction V.
  apply H2.
  apply ran.
  done.
  assert (i_ : Axioms.M i) by (by exists (Dom R)).
  by exists i.
Qed.

Theorem yxMσ :
  forall i, i ∈ M -> <|y,x|> ∈ Pref (Value σ i).
Proof.
  intros i iM.
  specialize (Mσ i iM) as H.
  induction H.
  apply (pref y z (Value σ i) y_ z_) in H.
  induction H.
  apply (pref z x (Value σ i) z_ x_) in H0.
  induction H0.
  assert (Transitive (Value σ i) X).
    assert (iN : i ∈ N).
      apply diff in iM.
      apply iM.
    specialize (Ri_T σ i σTn iN) as H3.
    apply separation in H3.
    induction H3.
    apply H4.
  specialize (H3 y z x yX zX xX H H0) as H4.
  apply (pref y x (Value σ i) y_ x_).
  apply (conj H4).
  intro.
  apply H1.
  apply (H3 z x y zX xX yX H0 H5).
Qed.

Theorem xyφσ :
  <|x,y|> ∈ Pref (Value φ σ).
Proof.
  induction Jxy.
  apply (H0 σ σTn xyJσ yxMσ).
Qed.