Require Import Ensembles.
Require Import syntax.
Require Import infrastructure.
Require Import infrastructure_props.
Require Import dom_list.
Require Import analysis.
Require Import typings.
Require Import typings_props.
Require Import List.
Require Import Arith.
Require Import tactics.
Require Import monad.
Require Import Metatheory.
Require Import genericvalues.
Require Import alist.
Require Import Values.
Require Import Memory.
Require Import Integers.
Require Import Coqlib.
Require Import targetdata.
Require Import Lattice.
Require Import Floats.
Require Import AST.
Require Import Maps.
Require Import opsem.
Require Import opsem_props.
Require Import opsem_wf.

(************************************************************)
(* This file proves that the dynamic value of a pure definition is invariant
   in the scope the definition dominates. *)

Module OpsemDom. Section OpsemDom.

Context `{GVsSig : GenericValues}.

Export Opsem.
Export OpsemProps.
Import AtomSet.

Notation GVs := GVsSig.(GVsT).
Notation "gv @ gvs" :=
  (GVsSig.(instantiate_gvs) gv gvs) (at level 43, right associativity).
Notation "$ gv # t $" := (GVsSig.(gv2gvs) gv t) (at level 41).
Notation "vidxs @@ vidxss" := (in_list_gvs vidxs vidxss)
  (at level 43, right associativity).

(* A predicate that checks purity: Select/GEP are impure because of
   non-deterministics *)
Definition pure_cmd (c:cmd) : Prop :=
match c with
| insn_bop _ _ _ _ _
| insn_fbop _ _ _ _ _
| insn_extractvalue _ _ _ _ _
| insn_insertvalue _ _ _ _ _ _
| insn_trunc _ _ _ _ _
| insn_ext _ _ _ _ _
| insn_cast _ _ _ _ _
| insn_icmp _ _ _ _ _
| insn_fcmp _ _ _ _ _ => True
| _ => False
end.

(* Check if gv is the semantics value of the command c. *)
Definition eval_rhs TD gl (lc:GVsMap) (c:cmd) (gv:GVs) : Prop :=
match c with
| insn_bop _ bop0 sz v1 v2 => BOP TD lc gl bop0 sz v1 v2 = Some gv
| insn_fbop _ fbop fp v1 v2 => FBOP TD lc gl fbop fp v1 v2  = Some gv
| insn_extractvalue id t v idxs _ =>
    exists gv0, getOperandValue TD v lc gl = Some gv0 /\
                extractGenericValue TD t gv0 idxs = Some gv
| insn_insertvalue _ t v t' v' idxs =>
    exists gv1, exists gv2,
      getOperandValue TD v lc gl = Some gv1 /\
      getOperandValue TD v' lc gl = Some gv2 /\
      insertGenericValue TD t gv1 idxs t' gv2 = Some gv
| insn_trunc _ truncop t1 v1 t2 => TRUNC TD lc gl truncop t1 v1 t2 = Some gv
| insn_ext _ extop t1 v1 t2 => EXT TD lc gl extop t1 v1 t2 = Some gv
| insn_cast _ castop t1 v1 t2 => CAST TD lc gl castop t1 v1 t2 = Some gv
| insn_icmp _ cond0 t v1 v2 => ICMP TD lc gl cond0 t v1 v2 = Some gv
| insn_fcmp _ fcond fp v1 v2 => FCMP TD lc gl fcond fp v1 v2 = Some gv
| _ => ~ pure_cmd c
end.

(* ids0 includes the definitions that strictly dominate the current program
   counter. For any definition in ids0 that is defined by a command, the
   dynamic value of the definition equals the result of the command;
   and the command is defined in a reachable block. *)
Definition wf_GVs TD gl (f:fdef) (lc:GVsMap) (id1:id) (gvs1:GVs) : Prop :=
forall c1,
  lookupInsnViaIDFromFdef f id1 = Some (insn_cmd c1) ->
  (eval_rhs TD gl lc c1 gvs1 /\
   forall b1, cmdInFdefBlockB c1 f b1 = true -> isReachableFromEntry f b1).

Definition wf_defs TD gl (f:fdef) (lc:GVsMap)(ids0:list atom) : Prop :=
forall id0 gvs0,
  In id0 ids0 ->
  lookupAL _ lc id0 = Some gvs0 ->
  wf_GVs TD gl f lc id0 gvs0.

Definition wf_ExecutionContext TD gl (ps:list product) (ec:ExecutionContext)
  : Prop :=
let '(mkEC f b cs tmn lc als) := ec in
match cs with
| nil =>
    match inscope_of_tmn f b tmn with
    | Some ids => wf_defs TD gl f lc ids
    | None => False
    end
| c::_ =>
    match inscope_of_cmd f b c with
    | Some ids => wf_defs TD gl f lc ids
    | None => False
    end
end.

Fixpoint wf_ECStack TD gl (ps:list product) (ecs:ECStack) : Prop :=
match ecs with
| nil => True
| ec::ecs' =>
    wf_ExecutionContext TD gl ps ec /\ wf_ECStack TD gl ps ecs'
end.

Definition wf_State (cfg:Config) (S:State) : Prop :=
let '(mkCfg s (los, nts) ps gl _ ) := cfg in
let '(mkState ecs _) := S in
wf_ECStack (los,nts) gl ps ecs.

(* Properties of eval_rhs *)
Require Import Maps.

Lemma eval_rhs_updateValuesForNewBlock : forall TD gl c lc gv rs,
  (forall i, i `in` dom rs -> ~ In i (getCmdOperands c)) ->
  (eval_rhs TD gl (updateValuesForNewBlock rs lc) c gv <->
   eval_rhs TD gl lc c gv).
Proof.
  induction rs; simpl; intros.
    split; auto.

Ltac eru_tac1 :=
let foo a i1 i2 rs H :=
  destruct (id_dec a i1); subst; try solve [
    assert (i1 `in` add i1 (dom rs)) as IN; auto;
    apply H in IN; contradict IN; auto |

    rewrite <- lookupAL_updateAddAL_neq; auto;
    destruct (id_dec a i2); subst; try solve [
      assert (i2 `in` add i2 (dom rs)) as IN; auto;
      apply H in IN; contradict IN; auto |

      rewrite <- lookupAL_updateAddAL_neq; auto
    ]
  ] in
match goal with
| rs : list (atom * GVs),
  H : forall i : atom, i `in` add ?a (dom ?rs) -> ~ (?i1 = i \/ ?i2 = i \/ False)
  |- _ =>
  match goal with
  | |- _ <-> match lookupAL _ _ ?i1 with
             | ret _ =>
               match lookupAL _ _ ?i2 with
               | ret _ => _
               | merror => _
               end
             | merror => _
             end = _ => foo a i1 i2 rs H
  | |- _ <-> (exists _ : _, exists _ : _,
             lookupAL _ _ ?i1 = ret _ /\ lookupAL _ _ ?i2 = ret _ /\ _) =>
      foo a i1 i2 rs H
  end
end.

Ltac eru_tac2 :=
let foo a i1 rs H :=
  destruct (id_dec a i1); subst; try solve [
    assert (i1 `in` add i1 (dom rs)) as IN; auto;
    apply H in IN; contradict IN; auto |
    rewrite <- lookupAL_updateAddAL_neq; auto
  ] in
match goal with
| rs : list (atom * GVs),
  H : forall i : atom, i `in` add ?a (dom ?rs) -> ~ (?i1 = i \/ False)
  |- _ =>
  match goal with
  | |- _ <-> match lookupAL _ _ ?i1 with
             | ret _ =>
               match const2GV _ _ _ with
               | ret _ => _
               | merror => _
               end
             | merror => _
             end = _ => foo a i1 rs H
  | |- _ <-> (exists _ : _, exists _ : _,
             lookupAL _ _ ?i1 = ret _ /\ const2GV _ _ _ = ret _ /\ _) =>
      foo a i1 rs H
  end
end.

Ltac eru_tac3 :=
let foo a i1 rs H :=
  destruct (id_dec a i1); subst; try solve [
    assert (i1 `in` add i1 (dom rs)) as IN; auto;
    apply H in IN; contradict IN; auto |
    rewrite <- lookupAL_updateAddAL_neq; auto
  ] in
match goal with
| rs : list (atom * GVs),
  H : forall i : atom, i `in` add ?a (dom ?rs) -> ~ (?i1 = i \/ False)
  |- _ =>
  match goal with
  | |- _ <-> match const2GV _ _ _ with
             | ret _ =>
               match lookupAL _ _ ?i1 with
               | ret _ => _
               | merror => _
               end
             | merror => _
             end = _ => foo a i1 rs H
  | |- _ <-> (exists _ : _, exists _ : _,
             const2GV _ _ _ = ret _ /\ lookupAL _ _ ?i1 = ret _ /\ _) =>
      foo a i1 rs H
  end
end.

Ltac eru_tac4 :=
let foo a i1 rs H :=
  destruct (id_dec a i1); subst; try solve [
    assert (i1 `in` add i1 (dom rs)) as IN; auto;
    apply H in IN; contradict IN; auto |
    rewrite <- lookupAL_updateAddAL_neq; auto
  ] in
match goal with
| rs : list (atom * GVs),
  H : forall i : atom, i `in` add ?a (dom ?rs) -> ~ (?i1 = i \/ False)
  |- _ =>
  match goal with
  | |- _ <-> match lookupAL _ _ ?i1 with
             | ret _ => _
             | merror => _
             end = _ => foo a i1 rs H
  | |- _ <-> (exists _ : _, lookupAL _ _ ?i1 = ret _ /\ _) => foo a i1 rs H
  end
end.

    destruct a as [a g].
    destruct c as [i0 b s0 v v0|i0 f0 f1 v v0|i0 t v l2|i0 t v t0 v0 l2|
                   i0 t v ?|i0 t v|i0 t v ?|i0 t v ?|i0 t v v0 ?|i0 i1 t v l2|
                   i0 t t0 v t1|i0 e t v t0|i0 c t v t0|i0 c t v v0|
                   i0 f0 f1 v v0|i0 v t v0 v1|i0 n c t v p]; simpl;
      unfold BOP, FBOP, TRUNC, EXT, ICMP, FCMP, CAST; try solve [
        auto |
        destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *;
          try solve [auto | eru_tac1 | eru_tac2 | eru_tac3] |
        destruct v as [i1|c1]; simpl in *; try solve [auto | eru_tac4]
      ].
Qed.

Lemma eval_rhs_updateAddAL : forall TD gl id1 gvs1 lc gv c,
  ~ In id1 (getCmdOperands c) ->
  (eval_rhs TD gl (@updateAddAL GVs lc id1 gvs1) c gv <->
   eval_rhs TD gl lc c gv).
Proof.
  destruct c as [i0 b s0 v v0|i0 f0 f1 v v0|i0 t v l2|i0 t v t0 v0 l2|
                 i0 t v ?|i0 t v|i0 t v ?|i0 t v ?|i0 t v v0 ?|i0 i1 t v l2|
                 i0 t t0 v t1|i0 e t v t0|i0 c t v t0|i0 c t v v0|
                 i0 f0 f1 v v0|i0 v t v0 v1|i0 n c t v p];
    simpl; intros; try solve [split; auto].
    unfold BOP.
    destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        destruct (id_dec id1 i2); subst.
          contradict H; auto.
          rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i2); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].

    unfold FBOP.
    destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        destruct (id_dec id1 i2); subst.
          contradict H; auto.
          rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i2); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].

    destruct v as [i1|c1]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        split; auto.

    destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        destruct (id_dec id1 i2); subst.
          contradict H; auto.
          rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i2); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].

    unfold TRUNC.
    destruct v as [i1|c1]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        split; auto.

    unfold EXT.
    destruct v as [i1|c1]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        split; auto.

    unfold CAST.
    destruct v as [i1|c1]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        split; auto.

    unfold ICMP.
    destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        destruct (id_dec id1 i2); subst.
          contradict H; auto.
          rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i2); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].

    unfold FCMP.
    destruct v as [i1|c1]; destruct v0 as [i2|c2]; simpl in *; try solve [split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; auto.
        destruct (id_dec id1 i2); subst.
          contradict H; auto.
          rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i1); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
      destruct (id_dec id1 i2); subst.
        contradict H; auto.
        rewrite <- lookupAL_updateAddAL_neq; try solve [auto | split; auto].
Qed.

Lemma impure_cmd__eval_rhs: forall TD gl lc c gv3,
  ~ pure_cmd c -> eval_rhs TD gl lc c gv3.
Proof.
  destruct c; simpl; intros; try solve [auto | contradict H; auto].
Qed.

(* Properties of wf_GVs *)
Lemma getIncomingValuesForBlockFromPHINodes_spec1 : forall TD S M f
    gl lc id1 l3 cs tmn ps lc' gvs b,
  Some lc' = getIncomingValuesForBlockFromPHINodes TD ps b gl lc ->
  In id1 (getPhiNodesIDs ps) ->
  Some (stmts_intro ps cs tmn) = lookupBlockViaLabelFromFdef f l3 ->
  wf_fdef S M f -> uniqFdef f ->
  lookupAL _ lc' id1 = Some gvs ->
  wf_GVs TD gl f lc id1 gvs.
Proof.
  intros. intros c1 Hin. eapply phinode_isnt_cmd in H1; eauto. inv H1.
Qed.

Lemma state_tmn_typing : forall TD S M f l1 ps1 cs1 tmn1 defs id1 lc gv gl,
  isReachableFromEntry f (l1, stmts_intro ps1 cs1 tmn1) ->
  wf_insn S M f (l1, stmts_intro ps1 cs1 tmn1) (insn_terminator tmn1) ->
  Some defs = inscope_of_tmn f (l1, stmts_intro ps1 cs1 tmn1) tmn1 ->
  wf_defs TD gl f lc defs ->
  wf_fdef S M f -> uniqFdef f ->
  In id1 (getInsnOperands (insn_terminator tmn1)) ->
  lookupAL _ lc id1 = Some gv ->
  wf_GVs TD gl f lc id1 gv /\ In id1 defs.
Proof.
  intros TD S M f l1 ps1 cs1 tmn1 defs id1 lc gv gl Hreach HwfInstr
    Hinscope HwfDefs HwfF HuniqF HinOps Hlkup.
  apply wf_insn__wf_insn_base in HwfInstr;
    try solve [unfold isPhiNode; simpl; auto].
  inv HwfInstr. find_wf_operand_list. subst. find_wf_operand_by_id.

  assert (In id1 defs) as Hin.
    eapply terminator_operands__in_scope; eauto.
  auto.
Qed.

Lemma state_cmd_typing : forall S M f b c defs id1 lc gv TD gl,
  NoDup (getStmtsLocs (snd b)) ->
  isReachableFromEntry f b ->
  wf_insn S M f b (insn_cmd c) ->
  Some defs = inscope_of_cmd f b c ->
  wf_defs TD gl f lc defs ->
  wf_fdef S M f -> uniqFdef f ->
  In id1 (getInsnOperands (insn_cmd c)) ->
  lookupAL _ lc id1 = Some gv ->
  wf_GVs TD gl f lc id1 gv /\ In id1 defs.
Proof.
  intros S M f b c defs id1 lc gv TD gl Hnodup Hreach HwfInstr Hinscope
    HwfDefs HwfF HuniqF HinOps Hlkup.
  apply wf_insn__wf_insn_base in HwfInstr;
    try solve [unfold isPhiNode; simpl; auto].
  inv HwfInstr. find_wf_operand_list. subst. find_wf_operand_by_id.

  assert (In id1 defs) as Hin.
    eapply cmd_operands__in_scope; eauto.
  auto.
Qed.

Lemma uniqFdef__lookupInsnViaIDFromBlocks : forall bs1 id1 c1 c2,
  lookupInsnViaIDFromBlocks bs1 id1 = ret insn_cmd c1 ->
  lookupInsnViaIDFromBlocks bs1 id1 = ret insn_cmd c2 ->
  c1 = c2.
Proof. congruence. Qed.

Ltac OP__wf_gvs :=
intros;
match goal with
| F1: fdef, Huniq: uniqFdef ?F1, id1:id,
  Hin: blockInFdefB
          (?l3,
          stmts_intro ?ps1 (?cs1' ++ ?c0 :: ?cs1) ?tmn1)
          ?F1 = true
 |- _ =>
  destruct F1 as [fh1 bs1];
  assert (lookupInsnViaIDFromBlocks bs1 id1 =
    Some (insn_cmd c0)) as Hlk1; try solve
    [apply uniqF__uniqBlocks in Huniq; inv Huniq;
     eapply InBlocksB__lookupInsnViaIDFromBlocks; eauto];
  intros c1 Hlkc1;
  assert (c1 = c0) as EQ; try solve
    [eapply uniqFdef__lookupInsnViaIDFromBlocks in Hlk1; eauto];
  subst;
  split; try solve [
    auto |
    intros b1 H;
    assert ((l3, stmts_intro ps1 (cs1' ++ c0 :: cs1) tmn1) = b1) as EQ;
      try solve
        [eapply blockInFdefB__cmdInFdefBlockB__eqBlock; eauto using in_middle];
    subst; auto
  ]
end.

Lemma BOP__wf_gvs : forall
  (F1 : fdef) (v : value) (v0 : value) lc
  (id1 : id) (bop0 : bop) gvs3 TD sz0 gl
  (H11 : BOP TD lc gl bop0 sz0 v v0 = ret gvs3)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_bop id1 bop0 sz0 v v0 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_bop id1 bop0 sz0 v v0 :: cs1) tmn1)
           F1 = true),
  wf_GVs TD gl F1 lc id1 gvs3.
Proof. OP__wf_gvs. Qed.

Lemma FBOP__wf_gvs : forall
  (F1 : fdef) (v : value) (v0 : value) lc
  (id1 : id) (fbop0 : fbop) gvs3 TD fp0 gl
  (H11 : FBOP TD lc gl fbop0 fp0 v v0 = ret gvs3)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_fbop id1 fbop0 fp0 v v0 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_fbop id1 fbop0 fp0 v v0 :: cs1) tmn1)
           F1 = true),
  wf_GVs TD gl F1 lc id1 gvs3.
Proof. OP__wf_gvs. Qed.

Lemma extractvalue__wf_gvs : forall
  (F1 : fdef) (v : value) lc
  id1 t idxs gv TD gl gv0
  (J1 : getOperandValue TD v lc gl = Some gv0)
  (J2 : extractGenericValue TD t gv0 idxs = Some gv)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1 t'
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_extractvalue id1 t v idxs t' :: cs1) tmn1))
  (Hin : blockInFdefB
          (l3, stmts_intro ps1
            (cs1' ++ insn_extractvalue id1 t v idxs t' :: cs1) tmn1)
          F1 = true),
  wf_GVs TD gl F1 lc id1 gv.
Proof.
  OP__wf_gvs.
    simpl. exists gv0. split; auto.
Qed.

Lemma insertvalue__wf_gvs : forall
  (F1 : fdef) (v v' : value) lc
  id1 t t' idxs gv1 gv2 TD gl gv0
  (J1 : getOperandValue TD v lc gl = Some gv1)
  (J2 : getOperandValue TD v' lc gl = Some gv2)
  (J3 : insertGenericValue TD t gv1 idxs t' gv2 = Some gv0)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_insertvalue id1 t v t' v' idxs :: cs1)
      tmn1))
  (Hin : blockInFdefB
          (l3, stmts_intro ps1
            (cs1' ++ insn_insertvalue id1 t v t' v' idxs :: cs1) tmn1)
          F1 = true),
  wf_GVs TD gl F1 lc id1 gv0.
Proof.
  OP__wf_gvs.
    simpl. exists gv1. exists gv2. split; auto.
Qed.

Lemma TRUNC__wf_gvs : forall
  (F1 : fdef) truncop0 t1 v1 t2 lc
  (id1 : id) gvs TD gl
  (H11 : TRUNC TD lc gl truncop0 t1 v1 t2 = Some gvs)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_trunc id1 truncop0 t1 v1 t2 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_trunc id1 truncop0 t1 v1 t2 :: cs1)
             tmn1) F1 = true),
  wf_GVs TD gl F1 lc id1 gvs.
Proof. OP__wf_gvs. Qed.

Lemma EXT__wf_gvs : forall
  (F1 : fdef) extop0 t1 v1 t2 lc
  (id1 : id) gvs TD gl
  (H11 : EXT TD lc gl extop0 t1 v1 t2 = Some gvs)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_ext id1 extop0 t1 v1 t2 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_ext id1 extop0 t1 v1 t2 :: cs1)
             tmn1) F1 = true),
  wf_GVs TD gl F1 lc id1 gvs.
Proof. OP__wf_gvs. Qed.

Lemma CAST__wf_gvs : forall
  (F1 : fdef) castop0 t1 v1 t2 lc
  (id1 : id) gvs TD gl
  (H11 : CAST TD lc gl castop0 t1 v1 t2 = Some gvs)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_cast id1 castop0 t1 v1 t2 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_cast id1 castop0 t1 v1 t2 :: cs1)
             tmn1) F1 = true),
  wf_GVs TD gl F1 lc id1 gvs.
Proof. OP__wf_gvs. Qed.

Lemma ICMP__wf_gvs : forall
  (F1 : fdef) (v : value) (v0 : value) lc
  (id1 : id) (cnd0 : cond) gvs3 TD t0 gl
  (H11 : ICMP TD lc gl cnd0 t0 v v0 = ret gvs3)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_icmp id1 cnd0 t0 v v0 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_icmp id1 cnd0 t0 v v0 :: cs1) tmn1)
           F1 = true),
  wf_GVs TD gl F1 lc id1 gvs3.
Proof. OP__wf_gvs. Qed.

Lemma FCMP__wf_gvs : forall
  (F1 : fdef) (v1 v2 : value) lc
  (id1 : id) fcond0 fp0 gvs3 TD gl
  (H11 : FCMP TD lc gl fcond0 fp0 v1 v2 = ret gvs3)
  (Huniq : uniqFdef F1) l3 ps1 cs1' cs1 tmn1
  (Hreach: isReachableFromEntry F1
    (l3, stmts_intro ps1 (cs1' ++ insn_fcmp id1 fcond0 fp0 v1 v2 :: cs1) tmn1))
  (Hin : blockInFdefB
           (l3, stmts_intro ps1 (cs1' ++ insn_fcmp id1 fcond0 fp0 v1 v2 :: cs1)
           tmn1) F1 = true),
  wf_GVs TD gl F1 lc id1 gvs3.
Proof. OP__wf_gvs. Qed.

Definition wf_impure_id (f:fdef) (id1:id) : Prop :=
forall c1,
  lookupInsnViaIDFromFdef f id1 = Some (insn_cmd c1) ->
  (forall b1, cmdInFdefBlockB c1 f b1 = true -> isReachableFromEntry f b1).

Lemma wf_impure_id__wf_gvs: forall F c TD gl lc gv b,
  uniqFdef F -> wf_impure_id F (getCmdLoc c) -> ~ pure_cmd c ->
  cmdInBlockB c b -> blockInFdefB b F ->
  wf_GVs TD gl F lc (getCmdLoc c) gv.
Proof.
  intros. intros x Hlkx.
  assert (c = x) as EQ.
    destruct b as [? []].
    simpl in H2.
    apply IngetCmdsIDs__lookupCmdViaIDFromFdef with (c1:=c) in H3; auto.
      congruence.
      apply InCmdsB_in; auto.
  subst.
  split.
    apply impure_cmd__eval_rhs; auto.
    unfold wf_impure_id in H0. eauto.
Qed.

(* Properties of wf_defs *)
Lemma wf_defs_eq : forall ids2 ids1 TD gl F' lc',
  set_eq ids1 ids2 ->
  wf_defs TD gl F' lc' ids1 ->
  wf_defs TD gl F' lc' ids2.
Proof.
  intros.
  intros id2 gvs1 Hin Hlk.
  destruct H as [J1 J2]. eauto.
Qed.

Lemma wf_defs_br_aux : forall TD gl S M lc l' ps' cs' lc' F tmn' b
  (Hreach : isReachableFromEntry F b)
  (Hreach': isReachableFromEntry F (l', stmts_intro ps' cs' tmn'))
  (Hlkup : Some (stmts_intro ps' cs' tmn') = lookupBlockViaLabelFromFdef F l')
  (Hswitch : switchToNewBasicBlock TD (l', stmts_intro ps' cs' tmn') b gl lc =
    ret lc')
  (t : list atom)
  (Hwfdfs : wf_defs TD gl F lc t)
  (ids0' : list atom)
  (HwfF : wf_fdef S M F) (HuniqF: uniqFdef F)
  (contents' : ListSet.set atom)
  (Heqdefs' : contents' = AlgDom.sdom F l')
  (Hinscope : (fold_left (inscope_of_block F l') contents'
    (ret (getPhiNodesIDs ps' ++ getArgsIDsOfFdef F)) = ret ids0'))
  (Hinc : incl (ListSet.set_diff eq_atom_dec ids0' (getPhiNodesIDs ps')) t),
  wf_defs TD gl F lc' ids0'.
Proof.
  intros.
  unfold switchToNewBasicBlock in Hswitch. simpl in Hswitch.
  intros id1 gvs Hid1 Hlk.
  remember (getIncomingValuesForBlockFromPHINodes TD ps' b gl lc) as R1.
  destruct R1 as [rs|]; inv Hswitch.
  destruct (In_dec eq_atom_dec id1 (getPhiNodesIDs ps')) as [Hin | Hnotin].
  Case "id1 in ps'".
    apply updateValuesForNewBlock_spec6 in Hlk; auto.
      eapply getIncomingValuesForBlockFromPHINodes_spec1 with (gvs:=gvs) in HeqR1;
        eauto.
      intros c1 Hlkc1. eapply phinode_isnt_cmd in Hlkup; eauto. inv Hlkup.

      eapply getIncomingValuesForBlockFromPHINodes_spec6 in HeqR1; eauto.

  Case "id1 notin ps'".
    assert (Hnotin' := Hnotin).
    apply ListSet.set_diff_intro with (x:=ids0')(Aeq_dec:=eq_atom_dec) in Hnotin;
      auto.
    apply Hinc in Hnotin. assert (HeqR1':=HeqR1).
    eapply getIncomingValuesForBlockFromPHINodes_spec8 in HeqR1; eauto.
    eapply updateValuesForNewBlock_spec7 in Hlk; eauto.
    apply Hwfdfs in Hlk; auto.
      intros c1 Hlkc1.
      assert (~ In id1 (getArgsIDsOfFdef F)) as Hnotina.
        apply getInsnLoc__notin__getArgsIDs' in Hlkc1; auto.
      destruct (@Hlk c1) as [Hlkc1' Hreach'']; auto.
      split; auto.
      apply eval_rhs_updateValuesForNewBlock; auto.
         intros i0 Hin.
         destruct (in_dec id_dec i0 (getCmdOperands c1)); auto.
           elimtype False.
           eapply operands_of_cmd__cannot_be__phis_that_cmd_doms; intuition eauto.
             apply in_app_or in H as []; auto.
             eapply getIncomingValuesForBlockFromPHINodes_spec7 in HeqR1'; eauto.

Qed.

Lemma inscope_of_tmn_br_aux : forall S M F l3 ps cs tmn ids0 ps' cs' tmn'
  l0 lc lc' gl TD (Hreach : isReachableFromEntry F (l3, stmts_intro ps cs tmn)),
wf_fdef S M F -> uniqFdef F ->
blockInFdefB (l3, stmts_intro ps cs tmn) F = true ->
In l0 (successors_terminator tmn) ->
Some ids0 = inscope_of_tmn F (l3, stmts_intro ps cs tmn) tmn ->
Some (stmts_intro ps' cs' tmn') = lookupBlockViaLabelFromFdef F l0 ->
switchToNewBasicBlock TD (l0, stmts_intro ps' cs' tmn')
  (l3, stmts_intro ps cs tmn) gl lc = Some lc' ->
wf_defs TD gl F lc ids0 ->
exists ids0',
  match cs' with
  | nil => Some ids0' = inscope_of_tmn F (l0, stmts_intro ps' cs' tmn') tmn'
  | c'::_ => Some ids0' = inscope_of_cmd F (l0, stmts_intro ps' cs' tmn') c'
  end /\
  incl (ListSet.set_diff eq_atom_dec ids0' (getPhiNodesIDs ps')) ids0 /\
  wf_defs TD gl F lc' ids0'.
Proof.
  intros S M F l3 ps cs tmn ids0 ps' cs' tmn' l0 lc lc' gl TD Hreach
    HwfF HuniqF HBinF Hsucc Hinscope Hlkup Hswitch Hwfdfs.
  symmetry in Hlkup.
  assert (J:=Hlkup).
  apply lookupBlockViaLabelFromFdef_inv in J; auto.
  unfold inscope_of_tmn in Hinscope.
  unfold inscope_of_tmn. unfold inscope_of_cmd, inscope_of_id.
  destruct F as [fh bs].

  assert (incl (AlgDom.sdom (fdef_intro fh bs) l0)
    (l3::(AlgDom.sdom (fdef_intro fh bs) l3))) as Hsub.
    clear - HBinF Hsucc HuniqF HwfF.
    eapply dom_successors; eauto.

  assert (isReachableFromEntry (fdef_intro fh bs) (l0, stmts_intro ps' nil tmn'))
    as Hreach'.
    eapply isReachableFromEntry_successors in Hlkup; eauto.

  assert (J1:=AlgDom.sdom_in_bound fh bs l0).
  destruct fh as [f t i0 a v].
  apply fold_left__bound_blocks with (init:=getPhiNodesIDs ps' ++
      getCmdsIDs nil ++ getArgsIDs a)(bs:=bs)(l0:=l0)
      (fh:=fheader_intro f t i0 a v) in J1; auto.
  destruct J1 as [r J1].
  exists r.

  assert (incl (ListSet.set_diff eq_atom_dec r (getPhiNodesIDs ps')) ids0)
    as Jinc.
    clear - Hinscope J1 Hsub HBinF HuniqF.
    eapply inscope_of_tmn__inscope_of_cmd_at_beginning in J1; eauto.

  destruct cs'.
  Case "cs'=nil".
    simpl.
    split; auto.
    split; auto.
      subst. simpl in J1. simpl_env in J1.
      eapply wf_defs_br_aux in Hswitch; intuition eauto.

  Case "cs'<>nil".
    assert (~ In (getCmdLoc c) (getPhiNodesIDs ps')) as Hnotin.
      apply uniqFdef__uniqBlockLocs in J; auto.
      simpl in J.
      eapply NoDup_disjoint in J; simpl; eauto.
    rewrite init_scope_spec1; auto.
    unfold cmds_dominates_cmd. simpl.
    destruct (eq_atom_dec (getCmdLoc c) (getCmdLoc c)) as [_ | n];
      try solve [contradict n; auto].
    split; auto.
    split; auto.
      subst. eapply wf_defs_br_aux in Hswitch; intuition eauto.
Qed.

Lemma inscope_of_tmn_br_uncond : forall S M F l3 ps cs ids0 ps' cs' tmn'
  l0 lc lc' bid TD gl,
isReachableFromEntry F (l3, stmts_intro ps cs (insn_br_uncond bid l0)) ->
wf_fdef S M F -> uniqFdef F ->
blockInFdefB (l3, stmts_intro ps cs (insn_br_uncond bid l0)) F = true ->
Some ids0 = inscope_of_tmn F (l3, stmts_intro ps cs (insn_br_uncond bid l0))
  (insn_br_uncond bid l0) ->
Some (stmts_intro ps' cs' tmn') = lookupBlockViaLabelFromFdef F l0 ->
switchToNewBasicBlock TD (l0, stmts_intro ps' cs' tmn')
  (l3, stmts_intro ps cs (insn_br_uncond bid l0)) gl lc = Some lc' ->
wf_defs TD gl F lc ids0 ->
exists ids0',
  match cs' with
  | nil => Some ids0' = inscope_of_tmn F (l0, stmts_intro ps' cs' tmn') tmn'
  | c'::_ => Some ids0' = inscope_of_cmd F (l0, stmts_intro ps' cs' tmn') c'
  end /\
  incl (ListSet.set_diff eq_atom_dec ids0' (getPhiNodesIDs ps')) ids0 /\
  wf_defs TD gl F lc' ids0'.
Proof.
  intros.
  eapply inscope_of_tmn_br_aux; eauto.
  simpl. auto.
Qed.

Lemma inscope_of_tmn_br : forall S M F l0 ps cs bid l1 l2 ids0 ps' cs'
  tmn' Cond c lc lc' gl TD,
isReachableFromEntry F (l0, stmts_intro ps cs (insn_br bid Cond l1 l2)) ->
wf_fdef S M F -> uniqFdef F ->
blockInFdefB (l0, stmts_intro ps cs (insn_br bid Cond l1 l2)) F = true ->
Some ids0 = inscope_of_tmn F (l0, stmts_intro ps cs (insn_br bid Cond l1 l2))
  (insn_br bid Cond l1 l2) ->
Some (stmts_intro ps' cs' tmn') =
       (if isGVZero TD c
        then lookupBlockViaLabelFromFdef F l2
        else lookupBlockViaLabelFromFdef F l1) ->
switchToNewBasicBlock TD (if isGVZero TD c then l2 else l1,
                          stmts_intro ps' cs' tmn')
  (l0, stmts_intro ps cs (insn_br bid Cond l1 l2)) gl lc = Some lc' ->
wf_defs TD gl F lc ids0 ->
exists ids0',
  match cs' with
  | nil => Some ids0' = inscope_of_tmn F (if isGVZero TD c then l2 else l1,
                                          stmts_intro ps' cs' tmn') tmn'
  | c'::_ => Some ids0' = inscope_of_cmd F (if isGVZero TD c then l2 else l1,
                                            stmts_intro ps' cs' tmn') c'
  end /\
  incl (ListSet.set_diff eq_atom_dec ids0' (getPhiNodesIDs ps')) ids0 /\
  wf_defs TD gl F lc' ids0'.
Proof.
  intros.
  remember (isGVZero TD c) as R.
  destruct R; eapply inscope_of_tmn_br_aux; eauto; simpl; auto.
Qed.

Lemma wf_defs_updateAddAL : forall S M g1 lc' ids1 ids2 F1 B1 l3 ps1
  cs tmn1 c TD gl (HinCs: In c cs)
  (Hreach: isReachableFromEntry F1 (l3, stmts_intro ps1 cs tmn1))
  (HBinF1: blockInFdefB (l3, stmts_intro ps1 cs tmn1) F1 = true)
  (HBinF2: blockInFdefB B1 F1 = true)
  (HwfF1 : wf_fdef S M F1) (HuniqF:uniqFdef F1)
  (HcInB : cmdInBlockB c B1 = true)
  (Hinscope : ret ids1 = inscope_of_id F1 B1 (getCmdLoc c)),
  wf_defs TD gl F1 lc' ids1 ->
  set_eq (getCmdLoc c::ids1) ids2 ->
  wf_GVs TD gl F1 lc' (getCmdLoc c) g1 ->
  wf_defs TD gl F1 (updateAddAL _ lc' (getCmdLoc c) g1) ids2.
Proof.
  intros S M g1 lc' ids1 ids2 F1 B1 l3 ps1 cs tmn1 c TD gl HinCs Hreach
    HBinF1 HBinF2 HwfF1 HuniqF HcInB HInscope HwfDefs Heq Hwfgvs.
  intros id1 gvs1 Hin Hlk.
  destruct Heq as [Hinc1 Hinc2].
  apply Hinc2 in Hin.
  simpl in Hin.
  intros c1 Hlkc1.
  assert (id1 = getCmdLoc c1) as EQ.
    apply lookupInsnViaIDFromFdef__eqid in Hlkc1. simpl in Hlkc1. auto.
  subst.
  assert (J:=Hlkc1).
  eapply wf_fdef__wf_insn_base in J; eauto.
  destruct J as [b1 HwfI].
  inv HwfI.
  destruct (eq_dec (getCmdLoc c) (getCmdLoc c1)).
  Case "1".
    rewrite e in *.
    rewrite lookupAL_updateAddAL_eq in Hlk; auto.
    find_wf_operand_list. subst.
    inv Hlk.
    destruct (@Hwfgvs c1) as [Heval Hreach']; auto.
    split; auto.
    apply eval_rhs_updateAddAL; auto.
      eapply cmd_doesnt_use_self; eauto.

  Case "2".
    destruct Hin as [Eq | Hin]; try solve [contradict n; auto].
    rewrite <- lookupAL_updateAddAL_neq in Hlk; auto.
    find_wf_operand_list. subst.
    assert (Hlk':=Hlk).
    apply HwfDefs in Hlk; auto.
    destruct (@Hlk c1) as [Heval Hreach']; auto.
    split; auto.
    apply eval_rhs_updateAddAL; auto.
      eapply cmd_doesnt_use_nondom_operands; eauto.
Qed.

(*********************************************)
(** * Preservation *)

Ltac destruct_wf :=
match goal with
| Hwfcfg: OpsemPP.wf_Config ?cfg, Hwfpp1: OpsemPP.wf_State ?cfg _ |- _ =>
  destruct Hwfcfg as [_ [_ [HwfSystem HmInS]]];
  destruct Hwfpp1 as
    [_ [[Hreach1 [HBinF1 [HFinPs1 [_ [_ [l3 [ps3 [cs3' Heq1]]]]]]]]
     [_ HwfCall]]]; subst
end.

Lemma preservation_pure_cmd_updated_case : forall
  (F : fdef)
  (B : block)
  (lc : GVsMap)
  (gv3 : GVs)
  (cs : list cmd)
  (tmn : terminator)
  id0 c0 los nts gl Mem0 als EC fs Ps S
  (Hid : Some id0 = getCmdID c0) (Hpure : pure_cmd c0)
  (Hwfgv : wf_GVs (los, nts) gl F lc id0 gv3) St Cfg
  (Hcfg: Cfg = {| CurSystem := S;
                CurTargetData := (los, nts);
                CurProducts := Ps;
                Globals := gl;
                FunTable := fs |})
  (Hst: St = {| ECS := {| CurFunction := F;
                            CurBB := B;
                            CurCmds := c0 :: cs;
                            Terminator := tmn;
                            Locals := lc;
                            Allocas := als |} :: EC;
                  Mem := Mem0 |})
   (Hwfcfg : OpsemPP.wf_Config Cfg) (Hwfpp1 : OpsemPP.wf_State Cfg St)
   (HwfS1 : wf_State Cfg St),
   wf_State Cfg
     {|
     ECS := {|
            CurFunction := F;
            CurBB := B;
            CurCmds := cs;
            Terminator := tmn;
            Locals := updateAddAL GVs lc id0 gv3;
            Allocas := als |} :: EC;
     Mem := Mem0 |}.
Proof.
  intros. subst. destruct_wf.
  destruct HwfS1 as [Hinscope1 HwfEC]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_cmd F (l3, stmts_intro ps3 (cs3' ++ c0 :: cs) tmn) c0)
    as R1.
  assert (HeqR1':=HeqR1).
  unfold inscope_of_cmd, inscope_of_id in HeqR1'.
  assert (uniqFdef F) as HuniqF.
    eapply wf_system__uniqFdef; eauto.
  destruct R1; try solve [inversion Hinscope1].
  repeat (split; try solve [auto | congruence]).
      assert (Hid':=Hid).
      symmetry in Hid.
      apply getCmdLoc_getCmdID in Hid.
      subst. unfold wf_ExecutionContext in *.
      assert (cmdInBlockB c0 (l3, stmts_intro ps3 (cs3' ++ c0 :: cs) tmn) = true)
        as Hin.
        simpl. apply In_InCmdsB. apply in_middle.
      assert (NoDup (getStmtsLocs (stmts_intro ps3 (cs3' ++ c0 :: cs) tmn)))
        as Hnotin.
        eapply wf_system__uniq_block with (f:=F) in HwfSystem; eauto.
      destruct cs; simpl_env in *.
      Case "1.1.1".
        apply inscope_of_cmd_tmn in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0])) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite <- Hid' in J2.
        assert (HwfF:=HFinPs1). eapply wf_system__wf_fdef in HwfF; eauto.
        eapply wf_defs_updateAddAL; eauto.

      Case "1.1.2".
        apply inscope_of_cmd_cmd in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0] ++ [c] ++ cs)) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite <- Hid' in J2.
        assert (HwfF:=HFinPs1). eapply wf_system__wf_fdef in HwfF; eauto.
        eapply wf_defs_updateAddAL; eauto.
Qed.

Lemma preservation_cmd_non_updated_case : forall
  (S : system)
  (los : layouts)
  (nts : namedts)
  (Ps : list product)
  (F : fdef)
  (B : block)
  (lc : GVsMap)
  (gl : GVMap)
  (fs : GVMap)
  (EC : list ExecutionContext)
  (cs : list cmd)
  (tmn : terminator)
  (Mem0 : mem)
  (als : list mblock)
  c0
  (Hid : getCmdID c0 = None) St Cfg
  (Hcfg: Cfg = {| CurSystem := S;
                CurTargetData := (los, nts);
                CurProducts := Ps;
                Globals := gl;
                FunTable := fs |})
  (Hst: St = {| ECS := {| CurFunction := F;
                            CurBB := B;
                            CurCmds := c0 :: cs;
                            Terminator := tmn;
                            Locals := lc;
                            Allocas := als |} :: EC;
                  Mem := Mem0 |})
  (Hwfcfg : OpsemPP.wf_Config Cfg) (Hwfpp1 : OpsemPP.wf_State Cfg St)
  (HwfS1 : wf_State Cfg St),
  wf_State Cfg
     {|
     ECS := {|
            CurFunction := F;
            CurBB := B;
            CurCmds := cs;
            Terminator := tmn;
            Locals := lc;
            Allocas := als |} :: EC;
     Mem := Mem0 |}.
Proof.
  intros. subst. destruct_wf.
  destruct HwfS1 as [Hinscope1 HwfEC]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_cmd F (l3, stmts_intro ps3 (cs3' ++ c0 :: cs) tmn) c0)
    as R1.
  destruct R1; try solve [inversion Hinscope1].
  repeat (split; try solve [auto | congruence]).
      assert (NoDup (getStmtsLocs (stmts_intro ps3 (cs3' ++ c0 :: cs) tmn)))
        as Hnotin.
        eapply wf_system__uniq_block with (f:=F) in HwfSystem; eauto.
      unfold wf_ExecutionContext in *.
      destruct cs; simpl_env in *.
      Case "1.1.1".
        apply inscope_of_cmd_tmn in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0])) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite Hid in J2.
        eapply wf_defs_eq; eauto.

      Case "1.1.2".
        apply inscope_of_cmd_cmd in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0] ++ [c] ++ cs)) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite Hid in J2.
        eapply wf_defs_eq ; eauto.
Qed.

Lemma preservation_dbCall_case : forall fid fa rt la va lb gvs los
  nts s lc Ps gl
  (Huniq: uniqFdef (fdef_intro (fheader_intro fa rt fid la va) lb))
  (HwfF: wf_fdef s (module_intro los nts Ps)
    (fdef_intro (fheader_intro fa rt fid la va) lb))
  (Hinit : initLocals (los,nts) la gvs = Some lc),
  wf_defs (los,nts) gl (fdef_intro (fheader_intro fa rt fid la va) lb) lc
    (getArgsIDs la).
Proof.
  intros.
  assert (incl nil (bound_blocks lb)) as J.
    intros x J. inv J.
  intros id1 gvs1 Hin Hlklc.
  intros x Hlkx.
  contradict Hin.
    apply getInsnLoc__notin__getArgsIDs' in Hlkx; auto.
Qed.

Lemma preservation_impure_cmd_updated_case : forall
  (F : fdef)
  (B : block)
  (lc : GVsMap)
  (gv3 : GVs)
  (cs : list cmd)
  (tmn : terminator)
  id0 c0 los nts gl Mem0 als EC fs Ps S
  (Hid : Some id0 = getCmdID c0) (Hinpure: ~ pure_cmd c0)
  (Hwfgv : wf_impure_id F id0) St Cfg
  (Hcfg: Cfg = {| CurSystem := S;
                CurTargetData := (los, nts);
                CurProducts := Ps;
                Globals := gl;
                FunTable := fs |})
  (Hst: St = {| ECS := {| CurFunction := F;
                            CurBB := B;
                            CurCmds := c0 :: cs;
                            Terminator := tmn;
                            Locals := lc;
                            Allocas := als |} :: EC;
                  Mem := Mem0 |})
  (Hwfcfg : OpsemPP.wf_Config Cfg) (Hwfpp1 : OpsemPP.wf_State Cfg St)
  (HwfS1 : wf_State Cfg St),
   wf_State Cfg
     {|
     ECS := {|
            CurFunction := F;
            CurBB := B;
            CurCmds := cs;
            Terminator := tmn;
            Locals := updateAddAL GVs lc id0 gv3;
            Allocas := als |} :: EC;
     Mem := Mem0 |}.
Proof.
  intros. subst. destruct_wf.
  destruct HwfS1 as [Hinscope1 HwfEC]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_cmd F (l3, stmts_intro ps3 (cs3' ++ c0 :: cs) tmn) c0)
    as R1.
  assert (HeqR1':=HeqR1).
  unfold inscope_of_cmd, inscope_of_id in HeqR1'.
  assert (uniqFdef F) as HuniqF.
    eapply wf_system__uniqFdef; eauto.
  destruct R1; try solve [inversion Hinscope1].
  repeat (split; try solve [auto | congruence]).
      assert (Hid':=Hid).
      symmetry in Hid.
      apply getCmdLoc_getCmdID in Hid.
      subst. unfold wf_ExecutionContext in *.
      assert (cmdInBlockB c0 (l3, stmts_intro ps3 (cs3' ++ c0 :: cs) tmn) = true)
        as Hin.
        simpl. apply In_InCmdsB. apply in_middle.
      assert (NoDup (getStmtsLocs (stmts_intro ps3 (cs3' ++ c0 :: cs) tmn)))
        as Hnotin.
        eapply wf_system__uniq_block with (f:=F) in HwfSystem; eauto.
      destruct cs; simpl_env in *.
      Case "1.1.1".
        apply inscope_of_cmd_tmn in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0])) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite <- Hid' in J2.
        assert (HwfF:=HFinPs1). eapply wf_system__wf_fdef in HwfF; eauto.
        eapply wf_defs_updateAddAL; eauto.
          eapply wf_impure_id__wf_gvs; eauto.

      Case "1.1.2".
        apply inscope_of_cmd_cmd in HeqR1; auto.
        destruct HeqR1 as [ids2 [J1 J2]].
        rewrite <- J1.
        assert (In c0 (cs3' ++ [c0] ++ [c] ++ cs)) as HinCs.
          apply in_or_app. right. simpl. auto.
        assert (Hwfc := HBinF1).
        eapply wf_system__wf_cmd with (c:=c0) in Hwfc;
          eauto.
        rewrite <- Hid' in J2.
        assert (HwfF:=HFinPs1). eapply wf_system__wf_fdef in HwfF; eauto.
        eapply wf_defs_updateAddAL; eauto.
          eapply wf_impure_id__wf_gvs; eauto.
Qed.

Lemma isReachableFromEntry_helper : forall F l1 ps1 cs1 c1 cs2 tmn1 c0 b1,
  uniqFdef F ->
  isReachableFromEntry F (l1, stmts_intro ps1 (cs1++c1::cs2) tmn1) ->
  blockInFdefB (l1, stmts_intro ps1 (cs1++c1::cs2) tmn1) F = true ->
  lookupInsnViaIDFromFdef F (getCmdLoc c1) = ret insn_cmd c0 ->
  cmdInFdefBlockB c0 F b1 = true ->
  isReachableFromEntry F b1.
Proof.
  intros.
  assert (b1 = (l1, stmts_intro ps1 (cs1++c1::cs2) tmn1)) as EQ.
    unfold cmdInFdefBlockB in H3.
    bdestruct H3 as J1 J2.
    apply lookupInsnViaIDFromFdef__eqid in H2. simpl in H2.
    apply cmdInBlockB__inGetBlockLocs in J1. rewrite H2 in J1.
    eapply block_eq2 with (id1:=getCmdLoc c1); eauto.
      simpl. apply in_or_app. right. apply in_or_app. left.
      apply InGetCmdsLocs_middle.
  subst. auto.
Qed.

Ltac preservation_pure_case_tac :=
match goal with
| HwfS1: wf_State _ _ |- _ =>
  eapply preservation_pure_cmd_updated_case in HwfS1; simpl; eauto;
               simpl; auto;
  destruct_wf;
  match goal with
  | HwfSystem: wf_system _ |- _ =>
    assert (HuniqF := HwfSystem);
    eapply wf_system__uniqFdef in HuniqF; eauto
  end
end.

Ltac preservation_impure_case_tac :=
match goal with
| HwfS1: wf_State _ _ |- _ =>
  eapply preservation_impure_cmd_updated_case in HwfS1; simpl; eauto;
               simpl; auto;
  destruct_wf;
  match goal with
  | HwfSystem: wf_system _,
    HFinPs1 : InProductsB _ _ = true |- _ =>
    assert (HuniqF := HwfSystem);
    eapply wf_system__uniqFdef in HuniqF; eauto;
    intros c0 Hlkc0 b1 J; eapply wf_system__uniqFdef in HFinPs1; eauto;
    eapply isReachableFromEntry_helper; eauto
  end
end.

Lemma preservation : forall cfg S1 S2 tr
  (Hwfcfg : OpsemPP.wf_Config cfg) (Hwfpp1 : OpsemPP.wf_State cfg S1),
  sInsn cfg S1 S2 tr -> wf_State cfg S1 -> wf_State cfg S2.
Proof.
  intros cfg S1 S2 tr Hwfcfg Hwfpp1 HsInsn HwfS1.
  (sInsn_cases (induction HsInsn) Case); destruct TD as [los nts].
Focus.
Case "sReturn".
  destruct Hwfcfg as [Hwftd [Hwfg [HwfSystem HmInS]]].
  destruct Hwfpp1 as
    [Hnonempty [
     [Hreach1 [HBinF1 [HFinPs1 [Hwflc1 [_ [l1 [ps1 [cs1' Heq1]]]]]]]]
     [
       [
         [Hreach2 [HBinF2 [HFinPs2 [Hwflc2 [_ [l2 [ps2 [cs2' Heq2]]]]]]]]
         [_ HwfCall]
       ]
       HwfCall'
     ]
    ]]; subst.
  destruct HwfS1 as [Hinscope1 [Hinscope2 HwfEC]]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_cmd F' (l2, stmts_intro ps2 (cs2' ++ c' :: cs') tmn') c')
    as R2.
  destruct R2; try solve [inversion Hinscope2].
  remember (inscope_of_tmn F
             (l1, stmts_intro ps1 (cs1' ++ nil)(insn_return rid RetTy Result))
             (insn_return rid RetTy Result)) as R1.
  destruct R1; try solve [inversion Hinscope1].
  split; auto.
  SCase "1".
    unfold wf_ExecutionContext.
    remember (getCmdID c') as R.
    destruct c' as [ | | | | | | | | | | | | | | | | i0 n c rt va v p];
      try solve [inversion H].
    assert (In (insn_call i0 n c rt va v p)
      (cs2'++[insn_call i0 n c rt va v p] ++ cs')) as HinCs.
      apply in_or_app. right. simpl. auto.
    assert (Hwfc := HBinF2).
    eapply wf_system__wf_cmd with (c:=insn_call i0 n c rt va v p) in Hwfc;
      eauto.
    assert (wf_fdef S (module_intro los nts Ps) F') as HwfF.
      eapply wf_system__wf_fdef; eauto.
    assert (uniqFdef F') as HuniqF.
      eapply wf_system__uniqFdef; eauto.

    SSCase "1.1".
      assert (NoDup (getStmtsLocs
                       (stmts_intro ps2
                          (cs2' ++ insn_call i0 n c rt va v p :: cs') tmn')))
        as Hnotin.
        eapply wf_system__uniq_block with (f:=F') in HwfSystem; eauto.
      destruct cs'; simpl_env in *.
      SSSCase "1.1.1".
        assert (HeqR2':=HeqR2).
        apply inscope_of_cmd_tmn in HeqR2; auto.
        destruct HeqR2 as [ids2 [J1 J2]].
        rewrite <- J1.
        unfold returnUpdateLocals in H1. simpl in H1.
        remember (getOperandValue (los,nts) Result lc gl) as R1.
        destruct R1; try solve [inv H1].
        destruct R.
          destruct n; inv HeqR.
          remember (GVsSig.(lift_op1) (fit_gv (los, nts) rt) g rt) as R2.
          destruct R2; inv H1.
          change i0 with
            (getCmdLoc (insn_call i0 false c rt va v p)); auto.
          eapply wf_defs_updateAddAL; eauto 1.
            simpl. apply In_InCmdsB. apply in_middle.
            eapply wf_impure_id__wf_gvs; eauto.
              simpl. intros c0 Hlkc0. intros b1 J.
              clear - Hreach2 J HuniqF Hlkc0 HBinF2.
              eapply isReachableFromEntry_helper; eauto.

              simpl. apply In_InCmdsB. solve_in_list.

          destruct n; inv HeqR. inv H1.
          simpl in J2.
          eapply wf_defs_eq; eauto.

      SSSCase "1.1.2".
        assert (HeqR2':=HeqR2).
        apply inscope_of_cmd_cmd in HeqR2; auto.
        destruct HeqR2 as [ids2 [J1 J2]].
        rewrite <- J1.
        unfold returnUpdateLocals in H1. simpl in H1.
        remember (getOperandValue (los,nts) Result lc gl) as R1.
        destruct R1; try solve [inv H1].
        destruct R.
          destruct n; inv HeqR.
          remember (GVsSig.(lift_op1) (fit_gv (los, nts) rt) g rt) as R2.
          destruct R2; inv H1.
          inv Hwfc. uniq_result.
          change i0 with
            (getCmdLoc (insn_call i0 false c rt va v
              (List.map
                 (fun p : typ * attributes * value =>
                   let '(typ_', attr, value_'') := p in
                    (typ_', attr, value_''))
                 typ'_attributes'_value''_list))); auto.
          eapply wf_defs_updateAddAL; eauto 2.
            simpl. apply In_InCmdsB. apply in_middle.
            eapply wf_impure_id__wf_gvs; eauto.
              simpl. intros c1 Hlkc1. intros b1 J.
              clear - Hreach2 J HuniqF Hlkc1 HBinF2.
              eapply isReachableFromEntry_helper with (cs2:=[c0]++cs')
                (cs1:=cs2')(c1:=insn_call i0 false c rt va v
                     (List.map
                        (fun p : typ * attributes * value =>
                          let '(typ_', attr, value_'') := p in
                            (typ_', attr, value_''))
                        typ'_attributes'_value''_list)) in Hreach2;
                 eauto.

              simpl. apply In_InCmdsB. solve_in_list.

          destruct n; inv HeqR. inv H1.
          simpl in J2.
          eapply wf_defs_eq; eauto.

Focus.
Case "sReturnVoid".
  destruct Hwfcfg as [Hwftd [Hwfg [HwfSystem HmInS]]].
  destruct Hwfpp1 as
    [Hnonempty [
     [Hreach1 [HBinF1 [HFinPs1 [Hwflc1 [_ [l1 [ps1 [cs1' Heq1]]]]]]]]
     [
       [
         [Hreach2 [HBinF2 [HFinPs2 [Hwflc2 [_ [l2 [ps2 [cs2' Heq2]]]]]]]]
         [_ HwfCall]
       ]
       HwfCall'
     ]
    ]]; subst.
  destruct HwfS1 as [Hinscope1 [Hinscope2 HwfEC]]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_cmd F' (l2, stmts_intro ps2 (cs2' ++ c' :: cs') tmn') c')
    as R2.
  destruct R2; try solve [inversion Hinscope2].
  remember (inscope_of_tmn F
             (l1, stmts_intro ps1 (cs1' ++ nil)(insn_return_void rid))
             (insn_return_void rid)) as R1.
  destruct R1; try solve [inversion Hinscope1].
  split; auto.
  SCase "1".
    unfold wf_ExecutionContext.
    SSCase "1.1".
      apply HwfCall' in HBinF1. simpl in HBinF1.
      assert (NoDup (getStmtsLocs
                       (stmts_intro ps2 (cs2' ++ c' :: cs') tmn')))
        as Hnotin.
        eapply wf_system__uniq_block with (f:=F') in HwfSystem; eauto.
      destruct cs'; simpl_env in *.
      SSSCase "1.1.1".
        clear - HeqR2 Hinscope2 H HwfCall' HBinF1 Hnotin H1.
        apply inscope_of_cmd_tmn in HeqR2; auto.
        destruct HeqR2 as [ids2 [J1 J2]].
        rewrite <- J1.
        remember (getCmdID c') as R.
        destruct_cmd c'; try solve [inversion H].
        destruct n; inversion H1.
        simpl in HeqR. subst R.
        eapply wf_defs_eq; eauto.

      SSSCase "1.1.2".
        clear - HeqR2 Hinscope2 H HwfCall' HBinF1 Hnotin H1.
        apply inscope_of_cmd_cmd in HeqR2; auto.
        destruct HeqR2 as [ids2 [J1 J2]].
        rewrite <- J1.
        remember (getCmdID c') as R.
        destruct_cmd c'; try solve [inversion H].
        destruct n; inversion H1.
        simpl in HeqR. subst R.
        eapply wf_defs_eq; eauto.

Case "sBranch".
  destruct Hwfcfg as [_ [_ [HwfSystem HmInS]]].
  destruct Hwfpp1 as
    [_ [[Hreach1 [HBinF1 [HFinPs1 [_ [_ [l3 [ps3 [cs3' Heq1]]]]]]]]
     [_ HwfCall]]]; subst.
  destruct HwfS1 as [Hinscope1 HwfEC]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_tmn F
             (l3, stmts_intro ps3 (cs3' ++ nil)(insn_br bid Cond l1 l2))
             (insn_br bid Cond l1 l2)) as R1.
  destruct R1; try solve [inversion Hinscope1].
  split; auto.
    assert (HwfF := HwfSystem).
    eapply wf_system__wf_fdef with (f:=F) in HwfF; eauto.
    assert (HuniqF := HwfSystem).
    eapply wf_system__uniqFdef with (f:=F) in HuniqF; eauto.
    unfold wf_ExecutionContext.
    clear - H2 HeqR1 H1 Hinscope1 HBinF1 HwfF HuniqF Hreach1.
    eapply inscope_of_tmn_br in HeqR1; eauto.
    destruct HeqR1 as [ids0' [HeqR1 [J1 J2]]].
    destruct cs'; rewrite <- HeqR1; auto.

Focus.
Case "sBranch_uncond".
  destruct Hwfcfg as [_ [_ [HwfSystem HmInS]]].
  destruct Hwfpp1 as
    [_ [[Hreach1 [HBinF1 [HFinPs1 [_ [_ [l3 [ps3 [cs3' Heq1]]]]]]]]
     [_ HwfCall]]]; subst.
  destruct HwfS1 as [Hinscope1 HwfEC]; subst.
  unfold wf_ExecutionContext in *.
  remember (inscope_of_tmn F
             (l3, stmts_intro ps3 (cs3' ++ nil)(insn_br_uncond bid l0))
             (insn_br_uncond bid l0)) as R1.
  destruct R1; try solve [inversion Hinscope1].
  split; auto.
    assert (HwfF := HwfSystem).
    eapply wf_system__wf_fdef with (f:=F) in HwfF; eauto.
    assert (HuniqF := HwfSystem).
    eapply wf_system__uniqFdef with (f:=F) in HuniqF; eauto.
    unfold wf_ExecutionContext.
    clear - H0 HeqR1 Hinscope1 H HBinF1 HwfF HuniqF Hreach1.
    assert (Hwds := HeqR1).
    eapply inscope_of_tmn_br_uncond with (cs':=cs')(ps':=ps')
      (tmn':=tmn') in HeqR1; eauto.
    destruct HeqR1 as [ids0' [HeqR1 [J1 J2]]].
    destruct cs'; rewrite <- HeqR1; auto.

Case "sBop".
  preservation_pure_case_tac.
  eapply BOP__wf_gvs; eauto.
Case "sFBop". preservation_pure_case_tac.
  eapply FBOP__wf_gvs; eauto.
Case "sExtractValue". preservation_pure_case_tac.
  eapply extractvalue__wf_gvs; eauto.
Case "sInsertValue". preservation_pure_case_tac.
  eapply insertvalue__wf_gvs in H1; eauto.
Case "sMalloc".  abstract preservation_impure_case_tac.
Case "sFree". eapply preservation_cmd_non_updated_case in HwfS1; simpl; eauto.
    simpl; auto.
Case "sAlloca". abstract preservation_impure_case_tac.
Case "sLoad".  abstract preservation_impure_case_tac.
Case "sStore". eapply preservation_cmd_non_updated_case in HwfS1; simpl; eauto;
    simpl; auto.
Case "sGEP".
  assert (J:=Hwfpp1). assert (Hwfcfg':=Hwfcfg).
  destruct_wf.
  assert (J:=HBinF1).
  eapply wf_system__wf_cmd with (c:=insn_gep id0 inbounds0 t v idxs t') in HBinF1;
    eauto using in_middle.
  inv HBinF1; eauto.
  eapply preservation_impure_cmd_updated_case in HwfS1;
    try solve [simpl; auto]; eauto.
  assert (HuniqF := HwfSystem).
  eapply wf_system__uniqFdef with (f:=F) in HuniqF; eauto.
  destruct F as [fh1 bs1].
  assert (lookupInsnViaIDFromBlocks bs1 id0 =
    Some (insn_cmd (insn_gep id0 inbounds0 t v idxs t'))) as Hlk1.
    apply uniqF__uniqBlocks in HuniqF. inv HuniqF.
    eapply InBlocksB__lookupInsnViaIDFromBlocks; eauto.
  intros c1 Hlkc1 b1 Hin.
  assert (c1 = insn_gep id0 inbounds0 t v idxs t') as EQ.
    eapply uniqFdef__lookupInsnViaIDFromBlocks in Hlk1; eauto.
  subst.
  assert ((l3, stmts_intro ps3 (cs3' ++ insn_gep id0 inbounds0 t v idxs t':: cs)
    tmn) = b1) as EQ.
    eapply blockInFdefB__cmdInFdefBlockB__eqBlock; eauto using in_middle.
  subst. auto.

Case "sTrunc". preservation_pure_case_tac.
  eapply TRUNC__wf_gvs; eauto.

Case "sExt". preservation_pure_case_tac.
  eapply EXT__wf_gvs; eauto.

Case "sCast". preservation_pure_case_tac.
  eapply CAST__wf_gvs; eauto.

Case "sIcmp". preservation_pure_case_tac.
  eapply ICMP__wf_gvs; eauto.

Case "sFcmp". preservation_pure_case_tac.
  eapply FCMP__wf_gvs; eauto.

Case "sSelect".
  assert (J:=Hwfpp1). assert (Hwfcfg':=Hwfcfg).
  destruct_wf.
  assert (J:=HBinF1).
  eapply wf_system__wf_cmd with (c:=insn_select id0 v0 t v1 v2) in HBinF1;
    eauto using in_middle.
  inv HBinF1; eauto.
  assert (wf_impure_id F id0) as W.
    assert (HuniqF := HwfSystem).
    eapply wf_system__uniqFdef with (f:=F) in HuniqF; eauto.
    destruct F as [fh1 bs1].
    assert (lookupInsnViaIDFromBlocks bs1 id0 =
      Some (insn_cmd (insn_select id0 v0 t v1 v2))) as Hlk1.
      apply uniqF__uniqBlocks in HuniqF. inv HuniqF.
      eapply InBlocksB__lookupInsnViaIDFromBlocks; eauto.
    intros c1 Hlkc1 b1 Hin.
    assert (c1 = insn_select id0 v0 t v1 v2) as EQ.
    eapply uniqFdef__lookupInsnViaIDFromBlocks in Hlk1; eauto.
    subst.
    assert ((l3, stmts_intro ps3 (cs3' ++ insn_select id0 v0 t v1 v2 :: cs)
      tmn) = b1) as EQ.
      eapply blockInFdefB__cmdInFdefBlockB__eqBlock; eauto using in_middle.
    subst. auto.
  destruct (isGVZero (los, nts) c);
    eapply preservation_impure_cmd_updated_case in HwfS1;
      try solve [simpl; auto]; eauto.

Focus.
Case "sCall".
  destruct_wf.
  assert (InProductsB (product_fdef (fdef_intro
    (fheader_intro fa rt fid la va) lb)) Ps = true) as HFinPs'.
    apply lookupFdefViaPtr_inversion in H1.
    destruct H1 as [fn [H11 H12]].
    eapply lookupFdefViaIDFromProducts_inv; eauto.
  split; auto.
  SCase "1".
    assert (uniqFdef (fdef_intro (fheader_intro fa rt fid la va) lb)) as Huniq.
      eapply wf_system__uniqFdef; eauto.
    assert (wf_fdef S (module_intro los nts Ps)
      (fdef_intro (fheader_intro fa rt fid la va) lb)) as HwfF.
      eapply wf_system__wf_fdef; eauto.

    assert (ps'=nil) as EQ.
      eapply entryBlock_has_no_phinodes with (s:=S); eauto.
    subst. unfold wf_ExecutionContext.
    apply AlgDom.dom_entrypoint in H2.
    destruct cs'.
      unfold inscope_of_tmn.
      rewrite H2. simpl.
      eapply preservation_dbCall_case; eauto.

      unfold inscope_of_cmd, inscope_of_id.
      rewrite init_scope_spec1; auto.
      rewrite H2. simpl.
      destruct (eq_atom_dec (getCmdLoc c) (getCmdLoc c)) as [|n];
        try solve [contradict n; auto].
      eapply preservation_dbCall_case; eauto.

Case "sExCall".
  match goal with
  | H6: exCallUpdateLocals _ _ _ _ _ _ = _ |- _ =>
      unfold exCallUpdateLocals in H6 end.
  destruct noret0.
    match goal with | H6: Some _ = Some _ |- _ => inv H6 end.
    eapply preservation_cmd_non_updated_case in HwfS1;
      try solve [simpl; auto]; eauto.

    match goal with
    | H6: match _ with
          | Some _ => _
          | None => _
          end = _ |- _ =>
      destruct oresult; tinv H6;
      remember (fit_gv (los, nts) rt1 g) as R;
      destruct R; inv H6
    end.
    abstract preservation_impure_case_tac.
Qed.

End OpsemDom. End OpsemDom.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export PBFTprepares_like_of_new_views_are_received.

Section PBFT_A_1_5.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context : PBFTcontext      }.
  Context { pbft_auth    : PBFTauth         }.
  Context { pbft_keys    : PBFTinitial_keys }.
  Context { pbft_hash    : PBFThash         }.

  Lemma prepared_info2request_data_equal_prepare_like2request_data_implies :
    forall pi pl,
      prepared_info2request_data pi = prepare_like2request_data pl
      -> prepared_info2seq pi = prepare_like2seq pl
         /\ prepared_info2view pi = prepare_like2view pl
         /\ prepared_info2digest pi = prepare_like2digest pl.
  Proof.
    introv e.
    destruct pi, pl as [p|p], p, b, prepared_info_pre_prepare, b; simpl in *;
      unfold prepared_info2request_data in *; simpl in *; ginv; tcsp.
  Qed.

  (* Invariant A.1.5 in PBFT PhD p.148 *)
  Lemma PBFT_A_1_5 :
    forall (eo : EventOrdering) (e : Event),
      AXIOM_authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> AXIOM_PBFTcorrect_keys eo
      -> AXIOM_exists_at_most_f_faulty [e] F
      ->
      forall (nv      : NewView)
             (p_info1 : PreparedInfo)
             (p_info2 : PreparedInfo)
             (slf     : Rep)
             (state   : PBFTstate),
        loc e = PBFTreplica slf
        -> state_sm_on_event (PBFTreplicaSM slf) e = Some state
        -> new_view_in_log nv (view_change_state state)
        -> In p_info1 (mergeP (new_view2cert nv))
        -> In p_info2 (mergeP (new_view2cert nv))
        -> info_is_prepared p_info1 = true
        -> info_is_prepared p_info2 = true
        -> prepared_info2view p_info1 = prepared_info2view p_info2
        -> prepared_info2seq p_info1 = prepared_info2seq p_info2
        -> prepared_info2digest p_info1 = prepared_info2digest p_info2.
  Proof.
    introv sentbyz ckeys fbyz;
      introv eqloc eqst in_nv in_e1 in_e2;
      introv ip1 ip2 eqv eqs.

    destruct (PBFTdigestdeq (prepared_info2digest p_info1) (prepared_info2digest p_info2)); auto;[].
    assert False; tcsp.

    assert (well_formed_log (log state)) as wf by eauto 2 with pbft;[].

    eapply prepared_as_pbft_knows_rd in ip1; try (exact eqst); try (exact in_nv); auto.
    eapply prepared_as_pbft_knows_rd in ip2; try (exact eqst); try (exact in_nv); auto.

    pose proof (local_knows_in_intersection1
                  e
                  (2 * F + 1)
                  (prepared_info2request_data p_info1)
                  (prepared_info2request_data p_info2)
                  one_pre_prepare
                  [e]
                  F) as q.
    repeat (autodimp q hyp); simpl; eauto 3 with pbft;
      try (complete (unfold num_replicas; try omega));[].
    exrepnd; unfold lak_data2owner in *; simpl in *; unfold pbft_pl_data2loc in *.

    apply (prepares_like_of_new_views_are_received0 _ _ _ correct) in q3; auto;[].
    apply (prepares_like_of_new_views_are_received0 _ _ _ correct) in q4; auto;[].
    destruct q3 as [e1 kna]; repnd.
    destruct q4 as [e2 knb]; repnd.

    apply pbft_knows_prepare_like_propagates in kna; allrw; eauto 3 with eo pbft;[].
    apply pbft_knows_prepare_like_propagates in knb; allrw; eauto 3 with eo pbft;[].

    destruct kna as [e'1 kna]; repnd.
    destruct knb as [e'2 knb]; repnd.

    apply prepared_info2request_data_equal_prepare_like2request_data_implies in q5; repnd.
    apply prepared_info2request_data_equal_prepare_like2request_data_implies in q6; repnd.
    pose proof (two_know_own_prepare_like eo e'1 e'2 d1 d2) as z.
    repeat (autodimp z hyp); eauto 2 with pbft; try congruence.
  Qed.

End PBFT_A_1_5.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Export PBFT_A_1_4.
Require Export PBFT_A_1_9.

Section PBFT_A_1_10.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context     : PBFTcontext      }.
  Context { pbft_auth        : PBFTauth         }.
  Context { pbft_keys        : PBFTinitial_keys }.
  Context { pbft_hash        : PBFThash         }.
  Context { pbft_hash_axioms : PBFThash_axioms  }.

  Definition more_than_F_have_prepared_before
             (eo : EventOrdering)
             (e  : Event)
             (R  : list Rep)
             (v  : View)
             (n  : SeqNum)
             (d  : PBFTdigest) :=
    no_repeats R
    /\ F < length R
    /\
    forall (k : Rep),
      In k R
      ->
      exists (e' : Event) (st' : PBFTstate),
        e' ≼ e
        /\ loc e' = PBFTreplica k
        /\ state_sm_on_event (PBFTreplicaSM k) e' = Some st'
        /\ prepared (request_data v n d) st' = true.

  Lemma more_than_F_have_prepared_before_implies :
    forall (eo : EventOrdering) (e : Event) R v n d,
      more_than_F_have_prepared_before eo e R v n d
      -> more_than_F_have_prepared eo R v n d.
  Proof.
    introv moreThanF.
    unfold more_than_F_have_prepared, more_than_F_have_prepared_before in *.
    repnd; dands; auto.
    introv i.
    applydup moreThanF in i; exrepnd.
    eexists; eexists; dands; eauto.
  Qed.
  Hint Resolve more_than_F_have_prepared_before_implies : pbft.

  Lemma A_1_10_lt :
    forall (eo    : EventOrdering)
           (e1 e2 : Event)
           (R1 R2 : list Rep)
           (n     : SeqNum)
           (v1 v2 : View)
           (d1 d2 : PBFTdigest),
      authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> PBFTcorrect_keys eo
      -> v1 < v2
      -> exists_at_most_f_faulty [e2] F
      -> nodes_have_correct_traces_before R1 [e2]
      -> more_than_F_have_prepared_before eo e1 R1 v1 n d1
      -> more_than_F_have_prepared_before eo e2 R2 v2 n d2
      -> d1 = d2.
  Proof.
    introv sendbyz corkeys ltv atmost ctraces moreThanF1 moreThanF2.

    unfold more_than_F_have_prepared in moreThanF2.
    destruct moreThanF2 as [norep2 [len2 moreThanF2]].

    destruct (PBFTdigestdeq d1 d2); auto.
    assert False; tcsp;[].

    pose proof (there_is_one_good_guy_before eo R2 [e2]) as h.
    repeat (autodimp h hyp); try omega;[].
    exrepnd.
    pose proof (moreThanF2 good) as prep; autodimp prep hyp.
    exrepnd.

    pose proof (PBFT_A_1_9 eo) as q; repeat (autodimp q hyp).
    pose proof (q R1 v1 n d1) as q; autodimp q hyp; eauto 3 with pbft;[].
    pose proof (q e' good st') as q.
    repeat (autodimp q hyp); eauto 3 with pbft eo;[].

    unfold prepared in prep1.
    eapply prepared_implies2 in prep1;[|eauto 3 with pbft].
    exrepnd.
    destruct pp, b; simpl in *; ginv; simpl in *.
    unfold pre_prepare2digest in *; simpl in *.
    fold (mk_pre_prepare v2 n d a) in *.

    hide_hyp prep1.

    pose proof (h0 e2) as h0; autodimp h0 hyp.

    pose proof (q v2 d a (requests2digest d)) as q.
    repeat (autodimp q hyp); eauto 3 with pbft eo.
  Qed.

  Lemma A_1_10 :
    forall (eo    : EventOrdering)
           (e1 e2 : Event)
           (R1 R2 : list Rep)
           (n     : SeqNum)
           (v1 v2 : View)
           (d1 d2 : PBFTdigest),
      authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> PBFTcorrect_keys eo
      -> exists_at_most_f_faulty [e1,e2] F
      -> nodes_have_correct_traces_before R1 [e2]
      -> nodes_have_correct_traces_before R2 [e1]
      -> more_than_F_have_prepared_before eo e1 R1 v1 n d1
      -> more_than_F_have_prepared_before eo e2 R2 v2 n d2
      -> d1 = d2.
  Proof.
    introv sendbyz corkeys atmost ctraces1 ctraces2 moreThanF1 moreThanF2.

    destruct (lt_dec v1 v2) as [e|e].

    { eapply A_1_10_lt; try exact moreThanF1; try exact moreThanF2; eauto 3 with pbft eo. }

    destruct (lt_dec v2 v1) as [f|f].

    { symmetry; eapply A_1_10_lt; eauto; eauto 3 with pbft eo. }

    assert (v1 = v2) as xx by (apply equal_nats_implies_equal_views; omega).
    subst.
    clear e f.

    destruct moreThanF1 as [norep1 [len1 moreThanF1]].
    destruct moreThanF2 as [norep2 [len2 moreThanF2]].

    pose proof (there_is_one_good_guy_before eo R1 [e1,e2]) as h.
    pose proof (there_is_one_good_guy_before eo R2 [e1,e2]) as q.
    repeat (autodimp h hyp); try omega;[].
    repeat (autodimp q hyp); try omega;[].
    exrepnd.

    applydup moreThanF1 in h1; exrepnd.
    applydup moreThanF2 in q1; exrepnd.

    pose proof (h0 e1) as h0; simpl in h0; autodimp h0 hyp; auto.
    pose proof (q0 e2) as q0; simpl in q0; autodimp q0 hyp; auto.

    eapply A_1_4; try (exact h2); try (exact q2); try (exact h5); try (exact q5);
      auto; allrw; eauto 3 with pbft eo.
  Qed.

End PBFT_A_1_10.

Hint Resolve more_than_F_have_prepared_before_implies : pbft.


Require Import ssreflect ssrfun ssrbool .

From Modules Require Import HomotopicalEquality FunctionalRelation InhabitRelation lib PreSyntaxOnlyContr WfSyntaxBrunerieOnlyContr gtype decl omegagroupoids.
Set Bullet Behavior "Strict Subproofs".

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Local Notation "⟦ X ⟧V" := (dTm (w_va X)).

Section TypeDecl.
  Variable (T: Type).
  Variable (fibT: Fib T).

  Definition typDecl   : Decl.
    unshelve refine
             (
               {| dC := fun Γ (wΓ : Γ ⊢ ) => C_TY (fC_C (semC fibT wΓ));
                  dTy := fun Γ A (wΓ : Γ ⊢ ) (wA : Γ ⊢ A)
                           (γ : C_TY (fC_C (semC fibT wΓ))) =>
                           G_of_T
                             (T_TY (fT_T (semT fibT wΓ wA)) (transport _ γ));
                  dTm :=
                    fun Γ A t (wΓ : Γ ⊢ )
                      (wt : Γ ⊢ t : A) (wA : Γ ⊢ A) (γ : C_TY (fC_C (semC fibT wΓ))) =>
                      t_t
                        (transport2 _ _ (ft_t (semt fibT wΓ wA wt)))
                        (transport _ γ);

                  dS := fun Γ Δ σ (wσ : Γ ⊢ σ ⇒ Δ) (wΓ : Γ ⊢ ) (wΔ : Δ ⊢ ) =>
                           S (transport2 _ _ (fS_S (semS fibT wΓ wΔ wσ) ))
                  |}
               ).
    - apply:eqf_CC_TC.
    - apply:eqf_tC_TC.
    - apply:eqf_tT_TT.
    - apply:eqf_SC1_CC.
    - apply:JMeq_from_eq.
      apply:eqf_SC2_CC.
Defined.

End TypeDecl.

(*

-- needed

-- définitionnel
    ⟦_⟧S-β1  : ∀{Γ}{γ : ⟦ Γ ⟧C}
             → ⟦ • ⟧S γ ≡ coerce ⟦_⟧C-β1 tt

    ⟦_⟧S-β2  : ∀{Γ Δ}{A : Ty Δ}{δ : Γ ⇒ Δ}{γ : ⟦ Γ ⟧C}
             {a : Tm (A [ δ ]T)} → ((⟦ δ , a ⟧S )γ )
             ≡ coerce (⟦_⟧C-β2) ((⟦ δ ⟧S γ) ,,
             subst ∣_∣ (semSb-T A δ γ) (⟦ a ⟧tm γ))
             -- needed
(* inutile car déjà compris dans sb non ? *)
    semWk-T  : ∀ {Γ A B}(γ : ⟦ Γ ⟧C)(v : ∣ ⟦ B ⟧T γ ∣)
             → ⟦ A +T B ⟧T (coerce ⟦_⟧C-β2 (γ ,, v)) ≡
             ⟦ A ⟧T γ

    semWk-S  : ∀ {Γ Δ B}{γ : ⟦ Γ ⟧C}{v : ∣ ⟦ B ⟧T γ ∣}
             → (δ : Γ ⇒ Δ) → ⟦ δ +S B ⟧S
             (coerce ⟦_⟧C-β2 (γ ,, v)) ≡ ⟦ δ ⟧S γ

-- needed
    semWk-tm : ∀ {Γ A B}(γ : ⟦ Γ ⟧C)(v : ∣ ⟦ B ⟧T γ ∣)
             → (a : Tm A) → subst ∣_∣ (semWk-T γ v)
               (⟦ a +tm B ⟧tm (coerce ⟦_⟧C-β2 (γ ,, v)))
                 ≡ (⟦ a ⟧tm γ)
(* intuile *)
    ⟦coh⟧  : ∀{Θ} → isContr Θ → (A : Ty Θ)
→ (θ : ⟦ Θ ⟧C) → ∣ ⟦ A ⟧T θ ∣
*)

(* TODO : utiliser cette tactique pour simplifier la preuve de sem* qui construit la fonction
vérifiant la relation fonctionelle *)
    Ltac clear_rc :=
      match goal with
        | x : rC ?U, x' : rC ?U |- _  =>
          have e : x = x' by apply:rl_hpC;
          (eassumption || (apply:rl_t_Cη;eassumption) ||(apply:rl_T_Cη; eassumption))
        | x : rT ?U, x' : rT ?U |- _  =>
          have e : x = x' by apply:π_eq_pTη;apply:rl_hpT;
          (eassumption || (apply:rl_t_Tη;eassumption) ||(apply:rl_V_Tη; eassumption))
        | x : rtm ?U, x' : rtm ?U |- _  =>
          have e : x = x' by apply:π_eq_ptη;apply:rl_hpt; eassumption
        | x : rS ?U ?V, x' : rS ?U ?V |- _  =>
          have e : x = x' by apply:π_eq_pSη;apply:rl_hpS; eassumption
      end.
Ltac clear_jmsigma' := clear_jmsigma.

Lemma type_is_omega (T : Type) (fibT : Fib T) : isOmegaGroupoid (G_of_T T) (typDecl fibT).
  unshelve econstructor.
  - (* the coherence *)
    move => Γ A wΓ wA γ.
    apply coh_in_ctx.
  - reflexivity.
  - move => Γ A u wΓ wA wu.
    cbn -[semt semT semC].
    move:(semC _ _) => fΓe.
    move:(semC _ _) => fΓ.
    move:(semT _ _ _) => fA.
    move:(semt _ _ _ _) => fu.
    move/fC_r:(fΓe).
    inversion 1.
    subst.
    repeat clear_hprop; repeat (clear_jmsigma; subst).

    rewrite /extΣ_G /=.
    destruct fu,fΓ,fA => /=.
    repeat (clear_rc; subst).
    repeat (erewrite (uip _ erefl);cbn).
    reflexivity.
  - move => Γ wΓ .
    cbn -[semt semT semC].
    move:(semC _ _ ) => fΓ.
    move:(semT _ _ _) => fstar.
    move/fT_r:(fstar).
    inversion 1; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    move => γ.
    destruct fΓ,fstar; simpl in *.
    repeat (clear_rc; subst).
    reflexivity.
  - move => Γ A t u wΓ wA wt wu .
    cbn -[semt semT semC].
    move:(semC _ _) => fΓ.
    move:(semT _ _ _) => far.
    move:(semT _ _ _) => fA.
    move:(semt _ _ _ _) => ft.
    move:(semt _ _ _ _) => fu.
    move => γ.
    move/fT_r:(far).
    inversion 1; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    destruct fΓ,far,fA,ft,fu; simpl in *; repeat (clear_rc; subst).
    repeat (erewrite (uip _ erefl);cbn).
    reflexivity.
  - intros.
    move:δ .
    cbn -[semt semT semC].
    move:(semC _ _) => fΓ.
    move:(semC _ _) => fΔ.
    move:(semT _ _ _) => fAσ.
    move:(semT _ _ _) => fA.
    move:(semt _ _ _ _) => fcoh.
    move:(semS _ _ _ _) => fσ.
    move/(ft_r):(fcoh) => I.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma'; subst).
    destruct fΓ,fΔ,fAσ,fA,fcoh,fσ ; simpl in *.
    repeat (move:(e in transport e) => /= ?; subst => /=;
    repeat (clear_jmsigma'; subst)).
    cbn.
    repeat (move:(e in transport e) => /= e; (destruct e || subst) => /=).
    repeat (move:(e in transport2 e) => /= e; (destruct e || subst) => /=).
    repeat (
      move:(e in JMeq_eq e) => /= e; have e' := JMeq_eq e ; destruct e';
      repeat (erewrite (uip _ erefl);cbn);
      clear e).

    repeat (clear_rc; subst).
    intro; apply:JMeq_refl.
  - cbn -[semt semT semC].
    move:(semC _ _) => fastar.
    move:(semT _ _ _) => fstar.
    move:(semt _ _ _ _) => fvstar.
    move/(ft_r):(fvstar).
    inversion 1; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    inversion X; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    destruct fstar,fastar,fvstar; simpl in *.
    move => γ.
     repeat (clear_rc; subst).
    simpl in *.
    (* TODO : adapter clear_jmsigma avec ça*)
    repeat (apply JM_projT2,JMeq_eq in H0; simpl in H0).
    subst.
    repeat (apply JM_projT2,JMeq_eq in H1; simpl in H1).
    subst.
    repeat (erewrite (uip _ erefl);cbn).
    set e := (e in transport e).
    exact (JMeq_transport γ e).
  - move => Γ A u wΓ wA wu wAe.
    cbn -[semT semC semt] in *.
    move:(semC _ _) => fΓe.
    move:(semC _ _) => fΓ.
    move:(semT _ _ _) => fA.
    move:(semT _ _ _) => fAe.
    move:(semt _ _ _ _) => fu.
    move:(semt _ _ _ _) => fv1.
    move/(ft_r):(fv1) => I.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    inversion X; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    destruct fΓe,fΓ,fA,fAe,fv1,fu; simpl in *.
    repeat (clear_rc; subst).
    cbn.
    intros.
    cbn.
    repeat (erewrite (uip _ erefl);cbn).
    move:(eqf_tC_TC _ _) => /= e.
    move:(eqf_tT_TT _ _) => /= e'.
    destruct e.
    cbn.
    move:(JMeq_eq _).
    have e'' := JMeq_eq e'.
    subst.
    move => h.
    move:sa sf H.
    repeat (erewrite (uip _ erefl);cbn).
    intros.
    have H' := JMeq_eq H.
    cbn.
    subst.
    (* clear H'. *)
     repeat (apply JM_projT2,JMeq_eq in H10; simpl in H10).
     repeat clear_hprop; repeat (clear_jmsigma; subst).
     apply:JMeq_refl.
  - move => Γ A u wΓ wA wu wAe wue.
    cbn -[semT semC semt semS].
    move :(semC _ _) => fΓe.
    move :(semC _ _) => fΓ.
    move :(semT _ _ _) => fA.
    move :(semT _ _ _) => fAe.
    move :(semt _ _ _ _) => fu.
    move :(semt _ _ _ _) => fv0.
    move/(ft_r):(fv0) => I.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    inversion X; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    destruct fΓe,fΓ,fA,fAe,fv0,fu; simpl in *.
    repeat (clear_rc; subst).
    cbn.
    intros.
    cbn.
    repeat (erewrite (uip _ erefl);cbn).
    move:(eqf_tC_TC _ _) => /= e.
    move:(eqf_tT_TT _ _) => /= e'.
    destruct e.
    cbn.
    move:(JMeq_eq _).
    have e'' := JMeq_eq e'.
    subst.
    move => h.
    move:sa sf H.
    repeat (erewrite (uip _ erefl);cbn).
    intros.
    have H' := JMeq_eq H.
    cbn.
    subst.
    (* clear H'. *)
     repeat (apply JM_projT2,JMeq_eq in H10; simpl in H10).
     repeat clear_hprop; repeat (clear_jmsigma; subst).
     apply:JMeq_refl.
  - move =>  Γ A u B x wΓ wA wu wB wBe wx.
    cbn -[semT semC semt semS].
    move :(semC _ _) => fΓe.
    move :(semC _ _) => fΓ.
    move :(semT _ _ _) => fA.
    move :(semT _ _ _) => fBe.
    move :(semT _ _ _) => fB.
    move :(semt _ _ _ _) => fu.
    move :(semt _ _ _ _) => fvwk.
    move :(semt _ _ _ _) => fx.
    move/(ft_r):(fvwk) => I.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    inversion X; subst; repeat clear_hprop; repeat (clear_jmsigma; subst).
    destruct fΓe,fΓ,fA,fBe,fB, fx,fvwk,fu; simpl in *.
    subst.
    repeat (clear_jmsigma'; subst).
    repeat (clear_rc; subst).
    repeat (erewrite (uip _ erefl);cbn).
    move:(eqf_tC_TC _ _) => /= e.
    destruct e => /=.
    move:(eqf_tT_TT _ _) => /= e.
    have e' := JMeq_eq e.
    destruct e'.
    repeat (erewrite (uip _ erefl);cbn).
    intros.
    have e' := JMeq_eq H.
    rewrite e' /=.
    apply:JMeq_from_eq.
    f_equal.
    apply:π_eq_ptη.
    apply:rl_hpt; try eassumption.
    constructor.
    assumption.
  - move => Γ t wΓ wt.
    cbn -[semT semC semt semS].
    move :(semC _ _) => fΓ.
    move :(semC _ _) => fast.
    move :(semT _ _ _) => fst.
    move :(semt _ _ _ _) => ft.
    move :(semS _ _ _ _) => ftost.
    move/(fS_r):(ftost) => I.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma'; subst).
    destruct fΓ,fast,fst,ft,ftost;  simpl in *.
    subst.
    repeat (clear_jmsigma'; subst).
    repeat (clear_rc; subst).
    repeat (erewrite (uip _ erefl);cbn).
    move:( eqf_SC2_CC _ _) => /= e.
    subst.
    repeat (erewrite (uip _ erefl);cbn).
    move => γ.
    have e : ft_T = r_rl_star fibT .
    {
      apply:π_eq_pTη.
    apply:rl_hpT; try eassumption.
    by constructor.
      }
    subst.
    apply:JMeq_from_eq.
    f_equal.
    apply:π_eq_ptη.
    apply:rl_hpt; try eassumption.
  - move => Δ Γ A u σ a f
             wΓ wA wu wAσ wuσ wΔ wσ wa wf .
    cbn -[semT semC semt semS].
    move :(semC _ _) => fΔ.
    move :(semC _ _) => fΓ.
    move :(semC _ _) => fΓe.
    move :(semT _ _ _) => fA.
    move :(semT _ _ _) => fAσ.
    move :(semT _ _ _) => far.
    move :(semt _ _ _ _) => fu.
    move :(semt _ _ _ _) => fa.
    move :(semt _ _ _ _) => ff.
    move :(semS _ _ _  _) => fσ.
    move :(semS _ _ _  _) => fσe.
    move/(fS_r):(fσe) => I.
    (* why sσ is not rl ? *)
    remember (mkpS (fS_S fσe)) as fσe' eqn:efσ'.
    inversion I; subst; repeat clear_hprop; repeat (clear_jmsigma'; subst).
    destruct fΔ,fΓ,fΓe, fA,fAσ,far,fu,fa,ff,fσ,fσe;  simpl in *.
    (* c'es tplus propre de faire comme ça que de bourriner
        avec clear_rc et et d'utiliser uip ensuite
     *)
    repeat (move:(e in transport e) => /= ?; subst => /=;
    repeat (clear_jmsigma'; subst)).
    repeat (move:(e in transport2 e) => /= ?; subst => /=;
    repeat (clear_jmsigma'; subst)).
    repeat (move:(e in JMeq_from_eq e) => /= ?;
    subst => /=; repeat (erewrite (uip _ erefl);cbn)).
    repeat (
    move:(e in JMeq_eq e) => /= e; have e' := JMeq_eq e ; destruct e';
    repeat (erewrite (uip _ erefl);cbn);
    clear e).
    case:H0 => ? ?;subst.
    intro h.
    repeat (clear_jmsigma'; subst).
    move => γ sa' suσ sf'.
    repeat (clear_rc; subst).
    (* ft_T1 *)
    inversion fT_r1.
    subst; repeat clear_hprop; repeat (clear_jmsigma'; subst).
    repeat (clear_rc; subst).
    (* move => ee; have ee' := JMeq_eq ee. *)
    (* h *)
    (* move/(@JMeq_eq _ _ _) => e. *)
    have h:sA0 = r_sbT sσ ft_T.
    {
      apply:π_eq_pTη.
      apply:rl_hpT; try eassumption.
      (apply:tp_rT1; first by reflexivity); last first.
      apply:rl_sbT.
      exact:X1.
      eassumption.
      reflexivity.
      }
    subst.
    have h:su0 = r_sbt sσ ft_t.
    {
      apply:π_eq_ptη.
      apply:rl_hpt; try eassumption.
      (apply:tp_rTm1; first by reflexivity); last first.
      apply:rl_sbt.
      exact:X2.
      eassumption.
      reflexivity.
      }
    subst.
    move/(@JMeq_eq _ _ _) => e.
    subst.
    move/(@JMeq_eq _ _ _) => e.
    move/(@JMeq_eq _ _ _) => ee.
    subst.
    cbn.
    simpl in *.
      try (match goal with
        | x : rtm ?U, x' : rtm ?U |- _  =>
          have e : x = x' by apply:π_eq_ptη;apply:rl_hpt; eassumption
      end).
      (* TODO : comprendre pourquoi clear_rc ne marche pas *)
      have ea : sa = ft_t0 by apply:π_eq_ptη; apply:rl_hpt; eassumption.
      subst.
      (* TODO : comprendre pourquoi clear_rc ne marche pas *)
      apply:JMeq_from_eq.
      f_equal.
      f_equal.
      apply:π_eq_ptη.
      apply:rl_hpt;eassumption.
Qed.


(** * Testcases for the 'reals' database
Authors:
    - Jim Portegies
Creation date: 30 Oct 2021

Testcases for (in)equality chains.
--------------------------------------------------------------------------------

This file is part of Waterproof-lib.

Waterproof-lib is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Waterproof-lib is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Waterproof-lib.  If not, see <https://www.gnu.org/licenses/>.
*)

(* Tests for (in)equality chains and the reals database *)

Require Import Waterproof.populate_database.waterproof_reals.
Require Import Waterproof.populate_database.waterproof_core.
(* Require Import Waterproof.populate_database.all_databases.*)
Require Import Waterproof.definitions.inequality_chains.

Require Import Reals.
(** TODO: eventuall rely on the reals database above *)
Open Scope R_scope.
(* Test 0: check if notations work. *)

Goal (& 3 < 4 <= 5).
auto with waterproof_core reals.
Qed.

Goal (& 3 = 3 = 3).
auto with waterproof_core reals.
Qed.
Open Scope R_scope.
(* Test 1: check if terms of a subset can be coerced to terms of the underlying set (here: [R]). *)
Goal forall x : R, (& x < 5 = 2 + 3) -> (x < 5).
intro x.
intro H.
auto with reals.
Qed.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

(* Why3 assumption *)
Definition unit  := unit.

(* Why3 assumption *)
Inductive ref (a:Type) {a_WT:WhyType a} :=
  | mk_ref : a -> ref a.
Axiom ref_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (ref a).
Existing Instance ref_WhyType.
Implicit Arguments mk_ref [[a] [a_WT]].

(* Why3 assumption *)
Definition contents {a:Type} {a_WT:WhyType a}(v:(ref a)): a :=
  match v with
  | (mk_ref x) => x
  end.

Axiom set : forall (a:Type) {a_WT:WhyType a}, Type.
Parameter set_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (set a).
Existing Instance set_WhyType.

Parameter mem: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> Prop.

(* Why3 assumption *)
Definition infix_eqeq {a:Type} {a_WT:WhyType a}(s1:(set a)) (s2:(set
  a)): Prop := forall (x:a), (mem x s1) <-> (mem x s2).

Axiom extensionality : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)), (infix_eqeq s1 s2) -> (s1 = s2).

(* Why3 assumption *)
Definition subset {a:Type} {a_WT:WhyType a}(s1:(set a)) (s2:(set a)): Prop :=
  forall (x:a), (mem x s1) -> (mem x s2).

Axiom subset_refl : forall {a:Type} {a_WT:WhyType a}, forall (s:(set a)),
  (subset s s).

Axiom subset_trans : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)) (s3:(set a)), (subset s1 s2) -> ((subset s2 s3) -> (subset s1
  s3)).

Parameter empty: forall {a:Type} {a_WT:WhyType a}, (set a).

(* Why3 assumption *)
Definition is_empty {a:Type} {a_WT:WhyType a}(s:(set a)): Prop :=
  forall (x:a), ~ (mem x s).

Axiom empty_def1 : forall {a:Type} {a_WT:WhyType a}, (is_empty (empty :(set
  a))).

Axiom mem_empty : forall {a:Type} {a_WT:WhyType a}, forall (x:a), ~ (mem x
  (empty :(set a))).

Parameter add: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> (set a).

Axiom add_def1 : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (y:a),
  forall (s:(set a)), (mem x (add y s)) <-> ((x = y) \/ (mem x s)).

Parameter remove: forall {a:Type} {a_WT:WhyType a}, a -> (set a) -> (set a).

Axiom remove_def1 : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (y:a)
  (s:(set a)), (mem x (remove y s)) <-> ((~ (x = y)) /\ (mem x s)).

Axiom subset_remove : forall {a:Type} {a_WT:WhyType a}, forall (x:a) (s:(set
  a)), (subset (remove x s) s).

Parameter union: forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> (set
  a).

Axiom union_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)) (x:a), (mem x (union s1 s2)) <-> ((mem x s1) \/ (mem x s2)).

Parameter inter: forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> (set
  a).

Axiom inter_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)) (x:a), (mem x (inter s1 s2)) <-> ((mem x s1) /\ (mem x s2)).

Parameter diff: forall {a:Type} {a_WT:WhyType a}, (set a) -> (set a) -> (set
  a).

Axiom diff_def1 : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)) (x:a), (mem x (diff s1 s2)) <-> ((mem x s1) /\ ~ (mem x s2)).

Axiom subset_diff : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)), (subset (diff s1 s2) s1).

Parameter choose: forall {a:Type} {a_WT:WhyType a}, (set a) -> a.

Axiom choose_def : forall {a:Type} {a_WT:WhyType a}, forall (s:(set a)),
  (~ (is_empty s)) -> (mem (choose s) s).

Parameter cardinal: forall {a:Type} {a_WT:WhyType a}, (set a) -> Z.

Axiom cardinal_nonneg : forall {a:Type} {a_WT:WhyType a}, forall (s:(set a)),
  (0%Z <= (cardinal s))%Z.

Axiom cardinal_empty : forall {a:Type} {a_WT:WhyType a}, forall (s:(set a)),
  ((cardinal s) = 0%Z) <-> (is_empty s).

Axiom cardinal_add : forall {a:Type} {a_WT:WhyType a}, forall (x:a),
  forall (s:(set a)), (~ (mem x s)) -> ((cardinal (add x
  s)) = (1%Z + (cardinal s))%Z).

Axiom cardinal_remove : forall {a:Type} {a_WT:WhyType a}, forall (x:a),
  forall (s:(set a)), (mem x s) -> ((cardinal s) = (1%Z + (cardinal (remove x
  s)))%Z).

Axiom cardinal_subset : forall {a:Type} {a_WT:WhyType a}, forall (s1:(set a))
  (s2:(set a)), (subset s1 s2) -> ((cardinal s1) <= (cardinal s2))%Z.

Axiom cardinal1 : forall {a:Type} {a_WT:WhyType a}, forall (s:(set a)),
  ((cardinal s) = 1%Z) -> forall (x:a), (mem x s) -> (x = (choose s)).

Axiom map : forall (a:Type) {a_WT:WhyType a} (b:Type) {b_WT:WhyType b}, Type.
Parameter map_WhyType : forall (a:Type) {a_WT:WhyType a}
  (b:Type) {b_WT:WhyType b}, WhyType (map a b).
Existing Instance map_WhyType.

Parameter get: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  (map a b) -> a -> b.

Parameter set1: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  (map a b) -> a -> b -> (map a b).

Axiom Select_eq : forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (m:(map a b)), forall (a1:a) (a2:a), forall (b1:b), (a1 = a2) ->
  ((get (set1 m a1 b1) a2) = b1).

Axiom Select_neq : forall {a:Type} {a_WT:WhyType a}
  {b:Type} {b_WT:WhyType b}, forall (m:(map a b)), forall (a1:a) (a2:a),
  forall (b1:b), (~ (a1 = a2)) -> ((get (set1 m a1 b1) a2) = (get m a2)).

Parameter const: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  b -> (map a b).

Axiom Const : forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
  forall (b1:b) (a1:a), ((get (const b1:(map a b)) a1) = b1).

Axiom vertex : Type.
Parameter vertex_WhyType : WhyType vertex.
Existing Instance vertex_WhyType.

Parameter v: (set vertex).

Parameter g_succ: vertex -> (set vertex).

Axiom G_succ_sound : forall (x:vertex), (subset (g_succ x) v).

Parameter weight: vertex -> vertex -> Z.

Axiom Weight_nonneg : forall (x:vertex) (y:vertex), (0%Z <= (weight x y))%Z.

(* Why3 assumption *)
Definition min(m:vertex) (q:(set vertex)) (d:(map vertex Z)): Prop := (mem m
  q) /\ forall (x:vertex), (mem x q) -> ((get d m) <= (get d x))%Z.

(* Why3 assumption *)
Inductive path : vertex -> vertex -> Z -> Prop :=
  | Path_nil : forall (x:vertex), (path x x 0%Z)
  | Path_cons : forall (x:vertex) (y:vertex) (z:vertex), forall (d:Z),
      (path x y d) -> ((mem z (g_succ y)) -> (path x z (d + (weight y z))%Z)).

(* Why3 goal *)
Theorem Length_nonneg : forall (x:vertex) (y:vertex), forall (d:Z), (path x y
  d) -> (0%Z <= d)%Z.
induction 1; try omega.
generalize (Weight_nonneg y z); omega.
Qed.


Require Import Clight.
Require Import Ctypes.
Require Import VST.veric.expr.
Require Import mc_reify.clight_expr_eq.
Require Import compcert.common.AST.
Require Import ExtLib.Core.RelDec.

Instance RelDec_ctype_beq: RelDec (@eq type) := { rel_dec := eqb_type }.

Instance RelDec_Correct_ctype_beq : RelDec_Correct RelDec_ctype_beq.
Proof.
  constructor.
  unfold rel_dec; simpl.
  exact eqb_type_spec.
Qed.

Instance RelDec_list_ctype_beq: RelDec (@eq (list type)) := List.RelDec_eq_list RelDec_ctype_beq.
Instance RelDec_Correct_list_ctype_beq: RelDec_Correct RelDec_list_ctype_beq :=
  List.RelDec_Correct_eq_list RelDec_Correct_ctype_beq.


(* Profiler_types: the types used by the profiler functions *)

Require Export specIR.

(* The different kinds of Optimizations passes the profiler wishes to make *)
Inductive optim_wish : Type :=
| AS_INS: list expr -> label -> optim_wish
| AS_INS_DELAY: list expr -> label -> optim_wish
| CST_PROP: optim_wish
| INLINE: label -> optim_wish
| LOWER: optim_wish.


Add LoadPath "." as Top0.
Require Import Top0.Definitions.
Require Import Top0.Heap.
Require Import Top0.Keys.
Require Import Top0.Nameless.
Require Import Coq.Program.Equality.
Require Import Coq.Sets.Ensembles.

(* Use these as constructors inside "Inductive Phi" *)
Axiom Phi_Seq_Nil_L : forall phi, Phi_Seq Phi_Nil phi = phi.
Axiom Phi_Seq_Nil_R : forall phi, Phi_Seq phi Phi_Nil = phi.
Axiom Phi_Par_Nil_R : forall phi, Phi_Par phi Phi_Nil = phi.
Axiom Phi_Par_Nil_L : forall phi, Phi_Par Phi_Nil phi = phi.

 (* both ec' and ee' and evaluated with the same context, but twice: inside Bs_Mu_App and BS_EffApp*)
Axiom MuAppAndEffAppShareArgument:
 forall h'' env rho ef env' rho' f x ec' ee' ea aheap v eff facts1 aacts1 bacts1,
   (forall fheap h' bacts facts v' aacts,
      (h'', env, rho, ef) ⇓ (fheap, Cls (env', rho', Mu f x ec' ee'), facts) ->
      (fheap, env, rho, ea) ⇓ (aheap, v, aacts) ->
      (aheap, update_rec_E (f, Cls (env', rho', Mu f x ec' ee')) (x, v) env', rho', ec') ⇓ (h', v', bacts) ->
      (h'', env, rho, Mu_App ef ea) ⇓ (h', v', Phi_Seq (Phi_Seq facts aacts)bacts)) ->
   (* above is the definition of the type constructor BS_Mu_App *)
   (h'', env, rho, Eff_App ef ea) ⇓ (h'', eff, Phi_Seq (Phi_Seq facts1 aacts1) bacts1) ->
   (aheap, update_rec_E (f, Cls (env', rho', Mu f x ec' ee')) (x, v) env', rho', ee') ⇓ (h'', eff, bacts1).

(* Assuming that MuAppIncludesEffectShareArgument is a "specification", this prove the necessary goal *)
Lemma EvaluationEffectFromEffApp:
 forall h'' env rho ef env' rho' f x ec' ee' ea aheap v eff facts1 aacts1 bacts1,
   (h'', env, rho, Eff_App ef ea) ⇓ (h'', eff, Phi_Seq (Phi_Seq facts1 aacts1) bacts1) ->
   (aheap, update_rec_E (f, Cls (env', rho', Mu f x ec' ee')) (x, v) env', rho', ee') ⇓ (h'', eff, bacts1).
Proof.
  intros.
  inversion H using MuAppAndEffAppShareArgument.
  intros. econstructor; eauto.
Qed.

(* Inside "BigStep" we still don't use "E.Equal" to pass around heaps.
   We need to resort to Coq equality when doing the proof for PairPar *)
Axiom ReadOnlyWalkSameHeap:
  forall acts_mu1 acts_mu2 h same_h,
    ReadOnlyPhi (Phi_Par acts_mu1 acts_mu2) ->
    (Phi_Par acts_mu1 acts_mu2, h) ==>* (Phi_Nil, same_h) ->
    (*H.Equal h same_h.*)
    h = same_h.

(* Induction principle for TcHeap when we know that previous heaps are
   consistent and the new ones are non-overlapping. *)
Axiom UnionTcHeap:
  forall hp hp' ef1 ea1 ef2 ea2 theta1 theta2 v1 v2 acts_eff1 acts_eff2 env rho
         heap heap_mu1 heap_mu2 heap_eff1 heap_eff2 sttym sttya acts_mu1 acts_mu2,
    (heap, env, rho, Eff_App ef1 ea1) ⇓ (heap_eff1, Eff theta1, acts_eff1) ->
    (heap, env, rho, Eff_App ef2 ea2) ⇓ (heap_eff2, Eff theta2, acts_eff2) ->
    Disjointness theta1 theta2 /\ ~ Conflictness theta1 theta2 ->
    (heap, env, rho, Mu_App ef1 ea1) ⇓ (heap_mu1, v1, acts_mu1) ->
    (heap, env, rho, Mu_App ef2 ea2) ⇓ (heap_mu2, v2, acts_mu2) ->
    (Phi_Par acts_mu1 acts_mu2, hp) ==>* (Phi_Nil, hp') ->
    TcHeap (heap_mu1, sttym) ->
    TcHeap (heap_mu2, sttya) ->
    TcHeap (hp', Functional_Map_Union sttya sttym).

Lemma TcValExtended_1 :
  forall stty sttya sttyb v rho ty,
    (forall (l : ST.key) (t' : tau),
       ST.find (elt:=tau) l stty = Some t' -> ST.find (elt:=tau) l sttya = Some t' ) ->
    (forall (l : ST.key) (t' : tau),
       ST.find (elt:=tau) l stty = Some t' -> ST.find (elt:=tau) l sttyb = Some t' ) ->
    TcVal (sttya, v, subst_rho rho ty) ->
    TcVal (Functional_Map_Union sttya sttyb, v, subst_rho rho ty).
Proof.
  intros stty sttya sttyb v rho ty H1 H2 H3.
  generalize dependent sttyb.
  generalize dependent stty.
  dependent induction H3; intros; try (solve [rewrite <- x; econstructor]).
  - rewrite <- x. econstructor; eauto.
    admit.
  - rewrite <- x. econstructor; eauto.
    admit.
  - rewrite <- x. econstructor.
    + (* goal is TcVal (Functional_Map_Union sttya sttyb, v1, ty1) *)
      (* but IH is TcVal (Functional_Map_Union sttya0 sttyb, v, subst_rho rho ty) *)
      admit.
    + admit.
Admitted.

Axiom TcValExtended_2 :
  forall stty sttya sttyb v rho ty,
    (forall (l : ST.key) (t' : tau),
       ST.find (elt:=tau) l stty = Some t' -> ST.find (elt:=tau) l sttya = Some t' ) ->
    (forall (l : ST.key) (t' : tau),
       ST.find (elt:=tau) l stty = Some t' -> ST.find (elt:=tau) l sttyb = Some t' ) ->
    TcVal (sttyb, v, subst_rho rho ty) ->
    TcVal (Functional_Map_Union sttya sttyb, v, subst_rho rho ty).

Axiom UnionStoreTyping:
  forall l sttya sttym t',
    ST.find (elt:=tau) l sttya = Some t' ->
    ST.find (elt:=tau) l sttym = Some t' ->
    ST.find (elt:=tau) l (Functional_Map_Union sttya sttym) = Some t'.

Require Import Coq.Logic.FunctionalExtensionality.
Axiom subst_rho_eps_aux_1 :
 forall rho rho' n x e e1 sa sa',
   lc_type_eps e ->
   lc_type_sa sa' ->
   (fold_subst_eps rho e1) = (fold_subst_eps rho' (closing_rgn_in_eps2 n x e)) ->
   fold_subst_sa rho sa = fold_subst_sa rho' (closing_rgn_in_sa2 n x sa') /\ e1 sa /\ e sa'.


Require Import Raft.
Require Import RaftRefinementInterface.

Section OneLeaderLogPerTerm.

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

  Definition one_leaderLog_per_term (net : network) : Prop :=
    forall h h' t ll ll',
      In (t, ll) (leaderLogs (fst (nwState net h))) ->
      In (t, ll') (leaderLogs (fst (nwState net h'))) ->
      h = h' /\ ll = ll'.

  (* convenience *)
  Definition one_leaderLog_per_term_log (net : network) : Prop :=
    forall h h' t ll ll',
      In (t, ll) (leaderLogs (fst (nwState net h))) ->
      In (t, ll') (leaderLogs (fst (nwState net h'))) ->
      ll = ll'.

  (* convenience *)
  Definition one_leaderLog_per_term_host (net : network) : Prop :=
    forall h h' t ll ll',
      In (t, ll) (leaderLogs (fst (nwState net h))) ->
      In (t, ll') (leaderLogs (fst (nwState net h'))) ->
      h = h'.

  Class one_leaderLog_per_term_interface : Prop :=
    {
      one_leaderLog_per_term_invariant :
        forall net,
          refined_raft_intermediate_reachable net ->
          one_leaderLog_per_term net;
      one_leaderLog_per_term_log_invariant :
        forall net,
          refined_raft_intermediate_reachable net ->
          one_leaderLog_per_term_log net;
      one_leaderLog_per_term_host_invariant :
        forall net,
          refined_raft_intermediate_reachable net ->
          one_leaderLog_per_term_host net
    }.
End OneLeaderLogPerTerm.