From sflib Require Import sflib.
From Paco Require Import paco.
Require Export Coq.Strings.String.
Require Import Coq.Classes.RelationClasses.

From Fairness Require Export ITreeLib FairBeh Mod.
From Fairness Require Import pind.
From Fairness Require Import LPCM.

Set Implicit Arguments.

Section PRIMIVIESIM.
  Context `{M: URA.t}.

  Variable state_src: Type.
  Variable state_tgt: Type.

  Variable _ident_src: ID.
  Definition ident_src := sum_tid _ident_src.
  Variable _ident_tgt: ID.
  Definition ident_tgt := sum_tid _ident_tgt.

  Variable wf_src: WF.
  Variable wf_tgt: WF.

  Let srcE := programE _ident_src state_src.
  Let tgtE := programE _ident_tgt state_tgt.

  Definition shared :=
    (TIdSet.t *
       (@imap ident_src wf_src) *
       (@imap ident_tgt wf_tgt) *
       state_src *
       state_tgt)%type.

  Let shared_rel: Type := shared -> Prop.

  Variable I: shared -> URA.car -> Prop.

  Variant __lsim
          (tid: thread_id)
          (lsim: forall R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel), bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel)
          (_lsim: forall R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel),bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel)
          R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel)
    :
    bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel :=
  | lsim_ret
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      r_src r_tgt
      (LSIM: RR r_src r_tgt r_ctx (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (Ret r_src) (Ret r_tgt) (ths, im_src, im_tgt, st_src, st_tgt)

  | lsim_tauL
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      itr_src itr_tgt
      (LSIM: _lsim _ _ RR true f_tgt r_ctx itr_src itr_tgt (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (Tau itr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_chooseL
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      X ktr_src itr_tgt
      (LSIM: exists x, _lsim _ _ RR true f_tgt r_ctx (ktr_src x) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Choose X) >>= ktr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_rmwL
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      X rmw ktr_src itr_tgt
      (LSIM: _lsim _ _ RR true f_tgt r_ctx (ktr_src (snd (rmw st_src) : X)) itr_tgt (ths, im_src, im_tgt, fst (rmw st_src), st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Rmw rmw) >>= ktr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_tidL
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      ktr_src itr_tgt
      (LSIM: _lsim _ _ RR true f_tgt r_ctx (ktr_src tid) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (GetTid) >>= ktr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_UB
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      ktr_src itr_tgt
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Undefined) >>= ktr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_fairL
      f_src f_tgt r_ctx
      ths im_src0 im_tgt st_src st_tgt
      f ktr_src itr_tgt
      (LSIM: exists im_src1,
          (<<FAIR: fair_update im_src0 im_src1 (prism_fmap inrp f)>>) /\
            (<<LSIM: _lsim _ _ RR true f_tgt r_ctx (ktr_src tt) itr_tgt (ths, im_src1, im_tgt, st_src, st_tgt)>>))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Fair f) >>= ktr_src) itr_tgt (ths, im_src0, im_tgt, st_src, st_tgt)

  | lsim_tauR
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      itr_src itr_tgt
      (LSIM: _lsim _ _ RR f_src true r_ctx itr_src itr_tgt (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx itr_src (Tau itr_tgt) (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_chooseR
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      X itr_src ktr_tgt
      (LSIM: forall x, _lsim _ _ RR f_src true r_ctx itr_src (ktr_tgt x) (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx itr_src (trigger (Choose X) >>= ktr_tgt) (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_rmwR
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      X rmw itr_src ktr_tgt
      (LSIM: _lsim _ _ RR f_src true r_ctx itr_src (ktr_tgt (snd (rmw st_tgt) : X)) (ths, im_src, im_tgt, st_src, fst (rmw st_tgt)))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx itr_src (trigger (Rmw rmw) >>= ktr_tgt) (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_tidR
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      itr_src ktr_tgt
      (LSIM: _lsim _ _ RR f_src true r_ctx itr_src (ktr_tgt tid) (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx itr_src (trigger (GetTid) >>= ktr_tgt) (ths, im_src, im_tgt, st_src, st_tgt)
  | lsim_fairR
      f_src f_tgt r_ctx
      ths im_src im_tgt0 st_src st_tgt
      f itr_src ktr_tgt
      (LSIM: forall im_tgt1
                   (FAIR: fair_update im_tgt0 im_tgt1 (prism_fmap inrp f)),
          (<<LSIM: _lsim _ _ RR f_src true r_ctx itr_src (ktr_tgt tt) (ths, im_src, im_tgt1, st_src, st_tgt)>>))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx itr_src (trigger (Fair f) >>= ktr_tgt) (ths, im_src, im_tgt0, st_src, st_tgt)

  | lsim_observe
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      fn args ktr_src ktr_tgt
      (LSIM: forall ret,
          lsim _ _ RR true true r_ctx (ktr_src ret) (ktr_tgt ret) (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Observe fn args) >>= ktr_src) (trigger (Observe fn args) >>= ktr_tgt) (ths, im_src, im_tgt, st_src, st_tgt)

  | lsim_call
      f_src f_tgt r_ctx
      ths im_src im_tgt st_src st_tgt
      fn args ktr_src itr_tgt
    : __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Call fn args) >>= ktr_src) itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)

  | lsim_yieldL
      f_src f_tgt r_ctx
      ths im_src0 im_tgt st_src st_tgt
      ktr_src itr_tgt
      (LSIM: exists im_src1,
          (<<FAIR: fair_update im_src0 im_src1 (prism_fmap inlp (tids_fmap tid ths))>>) /\
            (<<LSIM: _lsim _ _ RR true f_tgt r_ctx (ktr_src tt) (trigger (Yield) >>= itr_tgt) (ths, im_src1, im_tgt, st_src, st_tgt)>>))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx (trigger (Yield) >>= ktr_src) (trigger (Yield) >>= itr_tgt) (ths, im_src0, im_tgt, st_src, st_tgt)
  | lsim_yieldR
      f_src f_tgt r_ctx0
      ths0 im_src0 im_tgt0 st_src0 st_tgt0
      r_own r_shared
      ktr_src ktr_tgt
      (INV: I (ths0, im_src0, im_tgt0, st_src0, st_tgt0) r_shared)
      (VALID: URA.wf (r_shared ⋅ r_own ⋅ r_ctx0))
      (LSIM: forall ths1 im_src1 im_tgt1 st_src1 st_tgt1 r_shared1 r_ctx1
                    (INV: I (ths1, im_src1, im_tgt1, st_src1, st_tgt1) r_shared1)
                    (VALID: URA.wf (r_shared1 ⋅ r_own ⋅ r_ctx1))
                    im_tgt2
                    (TGT: fair_update im_tgt1 im_tgt2 (prism_fmap inlp (tids_fmap tid ths1))),
          _lsim _ _ RR f_src true r_ctx1 (trigger (Yield) >>= ktr_src) (ktr_tgt tt) (ths1, im_src1, im_tgt2, st_src1, st_tgt1))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx0 (trigger (Yield) >>= ktr_src) (trigger (Yield) >>= ktr_tgt) (ths0, im_src0, im_tgt0, st_src0, st_tgt0)
  | lsim_sync
      f_src f_tgt r_ctx0
      ths0 im_src0 im_tgt0 st_src0 st_tgt0
      r_own r_shared
      ktr_src ktr_tgt
      (INV: I (ths0, im_src0, im_tgt0, st_src0, st_tgt0) r_shared)
      (VALID: URA.wf (r_shared ⋅ r_own ⋅ r_ctx0))
      (LSIM: forall ths1 im_src1 im_tgt1 st_src1 st_tgt1 r_shared1 r_ctx1
               (INV: I (ths1, im_src1, im_tgt1, st_src1, st_tgt1) r_shared1)
               (VALID: URA.wf (r_shared1 ⋅ r_own ⋅ r_ctx1))
               im_tgt2
               (TGT: fair_update im_tgt1 im_tgt2 (prism_fmap inlp (tids_fmap tid ths1))),
          (exists im_src2,
              (<<FAIR: fair_update im_src1 im_src2 (prism_fmap inlp (tids_fmap tid ths1))>>) /\
                (<<LSIM: lsim _ _ RR true true r_ctx1 (ktr_src tt) (ktr_tgt tt) (ths1, im_src2, im_tgt2, st_src1, st_tgt1)>>)))
    :
    __lsim tid lsim _lsim RR f_src f_tgt r_ctx0 (trigger (Yield) >>= ktr_src) (trigger (Yield) >>= ktr_tgt) (ths0, im_src0, im_tgt0, st_src0, st_tgt0)

  | lsim_progress
      r_ctx
      ths im_src im_tgt st_src st_tgt
      itr_src itr_tgt
      (LSIM: lsim _ _ RR false false r_ctx itr_src itr_tgt (ths, im_src, im_tgt, st_src, st_tgt))
    :
    __lsim tid lsim _lsim RR true true r_ctx itr_src itr_tgt (ths, im_src, im_tgt, st_src, st_tgt)
  .

  Definition lsim (tid: thread_id)
             R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel):
    bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel :=
    paco9 (fun r => pind9 (__lsim tid r) top9) bot9 R_src R_tgt RR.

  Lemma __lsim_mon tid:
    forall r r' (LE: r <9= r'), (__lsim tid r) <10= (__lsim tid r').
  Proof.
    ii. inv PR; try (econs; eauto; fail).
    eapply lsim_sync; eauto. i. hexploit LSIM. eapply INV0. eapply VALID0. all: eauto. i; des. esplits; eauto.
  Qed.

  Lemma _lsim_mon tid: forall r, monotone9 (__lsim tid r).
  Proof.
    ii. inv IN; try (econs; eauto; fail).
    { des. econs; eauto. }
    { des. econs; eauto. }
    { econs. i. eapply LE. eapply LSIM. eauto. }
    { des. econs; esplits; eauto. }
  Qed.

  Lemma lsim_mon tid: forall q, monotone9 (fun r => pind9 (__lsim tid r) q).
  Proof.
    ii. eapply pind9_mon_gen; eauto.
    ii. eapply __lsim_mon; eauto.
  Qed.

  Variant lsim_resetC
          (r: forall R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel), bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel)
          R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel)
    :
    bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel :=
    | lsim_resetC_intro
        src tgt shr r_ctx
        ps0 pt0 ps1 pt1
        (REL: r _ _ RR ps1 pt1 r_ctx src tgt shr)
        (SRC: ps1 = true -> ps0 = true)
        (TGT: pt1 = true -> pt0 = true)
      :
      lsim_resetC r RR ps0 pt0 r_ctx src tgt shr
  .

  Lemma lsim_resetC_spec tid
    :
    lsim_resetC <10= gupaco9 (fun r => pind9 (__lsim tid r) top9) (cpn9 (fun r => pind9 (__lsim tid r) top9)).
  Proof.
    eapply wrespect9_uclo; eauto with paco.
    { eapply lsim_mon. }
    econs.
    { ii. inv IN. econs; eauto. }
    i. inv PR. eapply GF in REL.
    eapply pind9_acc in REL.
    instantiate (1:= (fun R0 R1 (RR: R0 -> R1 -> URA.car -> shared_rel) ps1 pt1 r_ctx src tgt shr =>
                        forall ps0 pt0,
                          (ps1 = true -> ps0 = true) ->
                          (pt1 = true -> pt0 = true) ->
                          pind9 (__lsim tid (rclo9 lsim_resetC r)) top9 R0 R1 RR ps0 pt0 r_ctx src tgt shr)) in REL; eauto.
    ss. i. eapply pind9_unfold in PR.
    2:{ eapply _lsim_mon. }
    rename PR into LSIM. inv LSIM.

    { eapply pind9_fold. econs; eauto. }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      eapply pind9_fold. eapply lsim_tauL. split; ss.
      hexploit IH; eauto.
    }

    { des. eapply pind9_fold. eapply lsim_chooseL. esplits; eauto. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_rmwL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_tidL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_UB. }

    { des. eapply pind9_fold. eapply lsim_fairL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto.
    }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      eapply pind9_fold. eapply lsim_tauR. split; ss.
      hexploit IH. eauto. all: eauto.
    }

    { eapply pind9_fold. eapply lsim_chooseR. i. split; ss. specialize (LSIM0 x).
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_rmwR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_tidR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_fairR. i. split; ss. specialize (LSIM0 _ FAIR).
      des. destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_observe. i. eapply rclo9_base. auto. }

    { eapply pind9_fold. eapply lsim_call. }

    { des. eapply pind9_fold. eapply lsim_yieldL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_yieldR; eauto. i.
      hexploit LSIM0; eauto. clear LSIM0. intros LSIM0.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. split; ss; eauto.
    }

    { eapply pind9_fold. eapply lsim_sync; eauto. i.
      hexploit LSIM0. eapply INV0. eapply VALID0. all: eauto. i; des. esplits; eauto.
      eapply rclo9_base. auto.
    }

    { pclearbot. hexploit H; ss; i. hexploit H0; ss; i. clarify.
      eapply pind9_fold. eapply lsim_progress. eapply rclo9_base. auto. }
  Qed.

  Lemma lsim_reset_prog
        tid
        R0 R1 (RR: R0 -> R1 -> URA.car -> shared_rel)
        src tgt shr
        ps0 pt0 ps1 pt1 r_ctx
        (LSIM: lsim tid RR ps1 pt1 r_ctx src tgt shr)
        (SRC: ps1 = true -> ps0 = true)
        (TGT: pt1 = true -> pt0 = true)
    :
    lsim tid RR ps0 pt0 r_ctx src tgt shr.
  Proof.
    ginit.
    { eapply lsim_mon. }
    { eapply cpn9_wcompat. eapply lsim_mon. }
    guclo lsim_resetC_spec.
    { eapply lsim_mon. }
    econs; eauto. gfinal.
    { eapply lsim_mon. }
    right. auto.
  Qed.

  Lemma lsim_set_prog
        tid
        R0 R1 (RR: R0 -> R1 -> URA.car -> shared_rel)
        r_ctx src tgt shr
        (LSIM: lsim tid RR true true r_ctx src tgt shr)
    :
    forall ps pt, lsim tid RR ps pt r_ctx src tgt shr.
  Proof.
    i. revert_until tid. pcofix CIH. i.
    remember true as ps0 in LSIM at 1. remember true as pt0 in LSIM at 1.
    move LSIM before CIH. revert_until LSIM. punfold LSIM.
    2:{ eapply lsim_mon. }
    eapply pind9_acc in LSIM.

    { instantiate (1:= (fun R0 R1 (RR: R0 -> R1 -> URA.car -> shared_rel) ps0 pt0 r_ctx src tgt shr =>
                          ps0 = true ->
                          pt0 = true ->
                          forall ps pt,
                            paco9
                              (fun r0 =>
                                 pind9 (__lsim tid r0) top9) r R0 R1 RR ps pt r_ctx src tgt shr)) in LSIM; auto. }

    ss. clear ps0 pt0 r_ctx src tgt shr LSIM.
    intros rr DEC IH R0' R1' RR' gps gpt r_ctx src tgt shr LSIM. clear DEC.
    intros Egps Egpt ps pt.
    eapply pind9_unfold in LSIM.
    2:{ eapply _lsim_mon. }
    inv LSIM.

    { pfold. eapply pind9_fold. econs; eauto. }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      pfold. eapply pind9_fold. eapply lsim_tauL. split; ss.
      hexploit IH. eauto. all: eauto. i. punfold H. eapply lsim_mon.
    }

    { des. pfold. eapply pind9_fold. eapply lsim_chooseL. esplits; eauto. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_rmwL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_tidL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_UB. }

    { des. pfold. eapply pind9_fold. eapply lsim_fairL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      pfold. eapply pind9_fold. eapply lsim_tauR. split; ss.
      hexploit IH. eauto. all: eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_chooseR. i. split; ss. specialize (LSIM0 x).
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_rmwR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_tidR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_fairR. i. split; ss. specialize (LSIM0 _ FAIR).
      des. destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_observe. i. eapply upaco9_mon_bot; eauto. }

    { pfold. eapply pind9_fold. eapply lsim_call. }

    { des. pfold. eapply pind9_fold. eapply lsim_yieldL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto. i. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_yieldR; eauto. i.
      hexploit LSIM0; eauto. clear LSIM0. intros LSIM0.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. split; ss. punfold H. eapply lsim_mon.
    }

    { pfold. eapply pind9_fold. eapply lsim_sync; eauto. i.
      hexploit LSIM0. eapply INV0. eapply VALID0. all: eauto. i; des. esplits; eauto.
      eapply upaco9_mon_bot; eauto.
    }

    { pclearbot. eapply paco9_mon_bot. eapply lsim_reset_prog. eauto. all: ss. }

  Qed.

  Variant lsim_rrC
          (r: forall R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel), bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel)
          R_src R_tgt (RR: R_src -> R_tgt -> URA.car -> shared_rel)
    :
    bool -> bool -> URA.car -> itree srcE R_src -> itree tgtE R_tgt -> shared_rel :=
    | lsim_rrC_intro
        (RR0: R_src -> R_tgt -> URA.car -> shared_rel)
        src tgt shr r_ctx ps pt
        (REL: r _ _ RR0 ps pt r_ctx src tgt shr)
        (IMPL: forall r0 r1 r_ctx shr, (RR0 r0 r1 r_ctx shr) -> (RR r0 r1 r_ctx shr))
      :
      lsim_rrC r RR ps pt r_ctx src tgt shr
  .

  Lemma lsim_rrC_spec tid
    :
    lsim_rrC <10= gupaco9 (fun r => pind9 (__lsim tid r) top9) (cpn9 (fun r => pind9 (__lsim tid r) top9)).
  Proof.
    eapply wrespect9_uclo; eauto with paco.
    { eapply lsim_mon. }
    econs.
    { ii. inv IN. econs; eauto. }
    i. inv PR. eapply GF in REL.
    rename REL into LSIM.
    move LSIM before GF. revert_until LSIM.
    pattern x0, x1, RR0, x3, x4, x5, x6, x7, x8.
    revert x0 x1 RR0 x3 x4 x5 x6 x7 x8 LSIM. apply pind9_acc.
    intros rr _ IH. intros R0 R1 RR0 ps pt r_ctx src tgt shr LSIM.
    intros RR1. i.
    eapply pind9_unfold in LSIM.
    2:{ eapply _lsim_mon. }
    inv LSIM.

    { eapply pind9_fold. econs; eauto. }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      eapply pind9_fold. eapply lsim_tauL. split; ss.
      hexploit IH; eauto.
    }

    { des. eapply pind9_fold. eapply lsim_chooseL. esplits; eauto. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_rmwL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_tidL. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_UB. }

    { des. eapply pind9_fold. eapply lsim_fairL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto.
    }

    { destruct LSIM0 as [LSIM0 IND]. clear LSIM0.
      eapply pind9_fold. eapply lsim_tauR. split; ss.
      hexploit IH. eauto. all: eauto.
    }

    { eapply pind9_fold. eapply lsim_chooseR. i. split; ss. specialize (LSIM0 x).
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_rmwR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_tidR. split; ss.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_fairR. i. split; ss. specialize (LSIM0 _ FAIR).
      des. destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_observe. i.
      eapply rclo9_clo. econs; eauto. eapply rclo9_base; auto. }

    { eapply pind9_fold. eapply lsim_call. }

    { des. eapply pind9_fold. eapply lsim_yieldL. esplits; eauto. split; ss.
      destruct LSIM as [LSIM IND]. hexploit IH; eauto.
    }

    { eapply pind9_fold. eapply lsim_yieldR; eauto. i.
      hexploit LSIM0; eauto. clear LSIM0. intros LSIM0.
      destruct LSIM0 as [LSIM0 IND]. hexploit IH; eauto. i. split; ss; eauto.
    }

    { eapply pind9_fold. eapply lsim_sync; eauto. i.
      hexploit LSIM0. eapply INV0. eapply VALID0. all: eauto. i; des. esplits; eauto.
      eapply rclo9_clo. econs; eauto. eapply rclo9_base; auto.
    }

    { eapply pind9_fold. eapply lsim_progress.
      eapply rclo9_clo. econs; eauto. eapply rclo9_base; eauto.
    }

  Qed.

  Definition local_RR {R0 R1} (RR: R0 -> R1 -> Prop) tid:
    R0 -> R1 -> URA.car -> shared_rel :=
    fun (r_src: R0) (r_tgt: R1) (r_ctx: URA.car) '(ths2, im_src1, im_tgt1, st_src1, st_tgt1) =>
      (exists ths3 r_own r_shared,
          (<<THS: NatMap.remove tid ths2 = ths3>>) /\
            (<<VALID: URA.wf (r_shared ⋅ r_own ⋅ r_ctx)>>) /\
            (<<INV: I (ths3, im_src1, im_tgt1, st_src1, st_tgt1) r_shared>>) /\
            (<<RET: RR r_src r_tgt>>)).

  Definition local_sim {R0 R1} (RR: R0 -> R1 -> Prop) src tgt :=
    forall ths0 im_src0 im_tgt0 st_src0 st_tgt0 r_shared0 r_ctx0
           (INV: I (ths0, im_src0, im_tgt0, st_src0, st_tgt0) r_shared0)
           tid ths1
           (THS: TIdSet.add_new tid ths0 ths1)
           (VALID: URA.wf (r_shared0 ⋅ r_ctx0)),
    forall im_tgt0'
      (UPD: fair_update im_tgt0 im_tgt0' (prism_fmap inlp (fun t => if (tid_dec t tid) then Flag.success else Flag.emp))),
    exists r_shared1 r_own im_src0',
      (<<INV: I (ths1, im_src0', im_tgt0', st_src0, st_tgt0) r_shared1>>) /\
        (<<VALID: URA.wf (r_shared1 ⋅ r_own ⋅ r_ctx0)>>) /\
        (forall ths im_src1 im_tgt1 st_src st_tgt r_shared2 r_ctx2
                (INV: I (ths, im_src1, im_tgt1, st_src, st_tgt) r_shared2)
                (VALID: URA.wf (r_shared2 ⋅ r_own ⋅ r_ctx2)),
          forall im_tgt2 (TGT: fair_update im_tgt1 im_tgt2 (prism_fmap inlp (tids_fmap tid ths))),
          exists im_src2,
            (<<SRC: fair_update im_src1 im_src2 (prism_fmap inlp (tids_fmap tid ths))>>) /\
              (<<LSIM: forall fs ft,
                  lsim
                    tid
                    (@local_RR R0 R1 RR tid)
                    fs ft
                    r_ctx2
                    src tgt
                    (ths, im_src2, im_tgt2, st_src, st_tgt)
                    >>)).

  Definition local_sim_init {R0 R1} (RR: R0 -> R1 -> Prop) (r_own: URA.car) tid src tgt :=
    forall ths im_src im_tgt st_src st_tgt r_shared r_ctx
      (INV: I (ths, im_src, im_tgt, st_src, st_tgt) r_shared)
      (VALID: URA.wf (r_shared ⋅ r_own ⋅ r_ctx)),
    forall im_tgt1 (FAIR: fair_update im_tgt im_tgt1 (prism_fmap inlp (tids_fmap tid ths))),
    exists im_src1,
      (<<SRC: fair_update im_src im_src1 (prism_fmap inlp (tids_fmap tid ths))>>) /\
        forall fs ft,
          lsim
            tid
            (@local_RR R0 R1 RR tid)
            fs ft
            r_ctx
            src tgt
            (ths, im_src1, im_tgt1, st_src, st_tgt).

End PRIMIVIESIM.
#[export] Hint Constructors __lsim: core.
#[export] Hint Unfold lsim: core.
#[export] Hint Resolve __lsim_mon: paco.
#[export] Hint Resolve _lsim_mon: paco.
#[export] Hint Resolve lsim_mon: paco.

Module ModSim.
  Section MODSIM.

    Variable md_src: Mod.t.
    Variable md_tgt: Mod.t.

    Record mod_sim: Prop :=
      mk {
          wf_src : WF;
          wf_tgt : WF;
          wf_tgt_inhabited: inhabited wf_tgt.(T);
          wf_tgt_open: forall (o0: wf_tgt.(T)), exists o1, wf_tgt.(lt) o0 o1;

          world: URA.t;

          (* I: (@shared md_src.(Mod.state) md_tgt.(Mod.state) md_src.(Mod.ident) md_tgt.(Mod.ident) wf_src wf_tgt) -> world -> Prop; *)
          init: forall im_tgt,
          exists (I: (@shared md_src.(Mod.state) md_tgt.(Mod.state) md_src.(Mod.ident) md_tgt.(Mod.ident) wf_src wf_tgt) -> world -> Prop),
          (exists im_src r_shared,
            (I (NatSet.empty, im_src, im_tgt, md_src.(Mod.st_init), md_tgt.(Mod.st_init)) r_shared) /\
              (URA.wf r_shared)) /\
          (forall fn args, match md_src.(Mod.funs) fn, md_tgt.(Mod.funs) fn with
                           | Some ktr_src, Some ktr_tgt => local_sim I (@eq Any.t) (ktr_src args) (ktr_tgt args)
                           | None        , None         => True
                           | _           , _            => False
                           end);
        }.
  End MODSIM.
End ModSim.

From Fairness Require Import Concurrency.

Module UserSim.
  Section MODSIM.

    Variable md_src: Mod.t.
    Variable md_tgt: Mod.t.

    Record sim (p_src: Th.t _) (p_tgt: Th.t _) : Prop :=
      mk {
          wf_src : WF;
          wf_tgt : WF;
          wf_tgt_inhabited: inhabited wf_tgt.(T);
          wf_tgt_open: forall (o0: wf_tgt.(T)), exists o1, wf_tgt.(lt) o0 o1;

          world: URA.t;

          (* I: (@shared md_src.(Mod.state) md_tgt.(Mod.state) md_src.(Mod.ident) md_tgt.(Mod.ident) wf_src wf_tgt) -> world -> Prop; *)
          funs: forall im_tgt,
          exists (I: (@shared md_src.(Mod.state) md_tgt.(Mod.state) md_src.(Mod.ident) md_tgt.(Mod.ident) wf_src wf_tgt) -> world -> Prop),
          exists im_src rs r_shared,
            (<<INIT: I (key_set p_src, im_src, im_tgt, md_src.(Mod.st_init), md_tgt.(Mod.st_init)) r_shared>>) /\
              (<<SIM: Forall3
                        (fun '(t1, src) '(t2, tgt) '(t3, r) =>
                           t1 = t2 /\ t1 = t3 /\
                           @local_sim_init _ md_src.(Mod.state) md_tgt.(Mod.state) md_src.(Mod.ident) md_tgt.(Mod.ident) wf_src wf_tgt I _ _ (@eq Any.t) r t1 src tgt)
                        (Th.elements p_src) (Th.elements p_tgt) (NatMap.elements rs)>>) /\
              (<<WF: URA.wf (r_shared ⋅ NatMap.fold (fun _ r s => r ⋅ s) rs ε)>>)
        }.
  End MODSIM.
End UserSim.


Require Import List.
Import ListNotations.
Require Import Omega.

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

Require Import CommonTheorems.
Require Import CroniesCorrect.
Require Import VotesCorrect.
Require Import TermSanity.
Require Import CroniesTerm.

Require Import UpdateLemmas.
Local Arguments update {_} {_} {_} _ _ _ _ : simpl never.

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

  Definition candidateEntries e (sigma : name -> _) :=
    exists h,
      wonElection (dedup name_eq_dec (cronies (fst (sigma h)) (eTerm e))) = true /\
      (currentTerm (snd (sigma h)) = eTerm e ->
       type (snd (sigma h)) <> Candidate).

  Lemma candidateEntries_ext :
    forall e sigma sigma',
      (forall h, sigma' h = sigma h) ->
      candidateEntries e sigma ->
      candidateEntries e sigma'.
  Proof.
    unfold candidateEntries.
    firstorder.
    exists x; intuition;
    repeat find_higher_order_rewrite; auto.
  Qed.

  Definition candidateEntries_host_invariant sigma :=
    (forall h e, In e (log (snd (sigma h))) ->
                 candidateEntries e sigma).

  Definition candidateEntries_nw_invariant net :=
    forall p t leaderId prevLogIndex prevLogTerm entries leaderCommit,
      In p (nwPackets net) ->
      pBody p = AppendEntries t leaderId prevLogIndex prevLogTerm
                              entries leaderCommit ->
      forall e,
        In e entries ->
        candidateEntries e (nwState net).

  Definition CandidateEntries net : Prop :=
    candidateEntries_host_invariant (nwState net) /\ candidateEntries_nw_invariant net.

  Lemma handleClientRequest_spec :
    forall h d id c out d' l,
      handleClientRequest h d id c = (out, d', l) ->
      currentTerm d' = currentTerm d /\
      type d' = type d /\
      l = [] /\
      (forall e, In e (log d') ->
            (In e (log d) \/ (e = (mkEntry
                                     h
                                     id
                                     (S (maxIndex (log d)))
                                     (currentTerm d)
                                     c) /\ log d' = e :: log d /\ type d' = Leader))).
  Proof.
    intros. unfold handleClientRequest in *.
    break_match; find_inversion; intuition.
    simpl in *. intuition. subst. auto.
  Qed.

  Lemma candidateEntries_same :
    forall (st st' : name -> _) e,
      candidateEntries e st ->
      (forall h, cronies (fst (st' h)) = cronies (fst (st h))) ->
      (forall h, currentTerm (snd (st' h)) = currentTerm (snd (st h))) ->
      (forall h, type (snd (st' h)) = type (snd (st h))) ->
      candidateEntries e st'.
  Proof.
    unfold candidateEntries.
    firstorder. eexists.
    repeat find_higher_order_rewrite.
    eauto.
  Qed.

  Lemma candidate_entries_client_request :
    refined_raft_net_invariant_client_request CandidateEntries.
  Proof.
    unfold refined_raft_net_invariant_client_request, CandidateEntries.
    intros. subst.
    intuition.
    - unfold candidateEntries_host_invariant in *.
      intros; simpl in *.
      eapply candidateEntries_ext; try eassumption.
      repeat find_higher_order_rewrite.

      destruct (name_eq_dec h0 h); subst.
      + rewrite_update.
        simpl in *.
        find_apply_lem_hyp handleClientRequest_spec; intuition eauto.
        find_apply_hyp_hyp.
        intuition.
        * rewrite_update.
          eapply candidateEntries_same; eauto; intuition;
          destruct (name_eq_dec h0 h); subst; rewrite_update; auto.
        * find_apply_lem_hyp cronies_correct_invariant.
          unfold candidateEntries. exists h.
          intuition; rewrite_update; simpl in *; try congruence.
          repeat find_rewrite. simpl in *.
          eauto using won_election_cronies.
      + rewrite_update.
        find_apply_lem_hyp handleClientRequest_spec.
        eapply candidateEntries_same; eauto; intuition;
        destruct (name_eq_dec h1 h); subst; rewrite_update; auto.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *.
      eapply candidateEntries_ext; try eassumption.
      find_apply_lem_hyp handleClientRequest_spec.
      intuition.
      subst. simpl in *.

      eapply_prop_hyp candidateEntries AppendEntries; eauto.
      + eapply candidateEntries_same; eauto; intuition;
        destruct (name_eq_dec h h0); subst; rewrite_update; auto.
      + find_apply_hyp_hyp. intuition.
  Qed.

  Lemma update_elections_data_timeout_leader_cronies_same :
    forall sigma h,
      type (snd (sigma h)) = Leader ->
      cronies (update_elections_data_timeout h (sigma h)) =
      cronies (fst (sigma h)).
  Proof.
    unfold update_elections_data_timeout.
    intros.
    repeat break_match; subst; simpl in *; auto.
    unfold handleTimeout, tryToBecomeLeader in *.
    repeat break_match; try congruence; repeat find_inversion; simpl in *;
    unfold raft_data in *;
    congruence.
  Qed.

  Ltac update_destruct :=
    match goal with
    | [ |- context [ update _ ?y _ ?x ] ] => destruct (name_eq_dec y x)
    end.

  Lemma handleTimeout_only_sends_RequestVotes :
    forall h d out d' l p,
      handleTimeout h d = (out, d', l) ->
      In p l ->
      exists t h' maxi maxt,
        snd p = RequestVote t h' maxi maxt.
  Proof.
    unfold handleTimeout, tryToBecomeLeader.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; intuition;
    do_in_map; subst; simpl; eauto.
  Qed.

  Lemma handleTimeout_log_same :
    forall h d out d' l,
      handleTimeout h d = (out, d', l) ->
      log d' = log d.
  Proof.
    unfold handleTimeout, tryToBecomeLeader.
    intros.
    repeat break_match; repeat find_inversion; auto.
  Qed.

  Ltac find_rewrite_lem lem :=
    match goal with
    | [ H : _ |- _ ] =>
      rewrite lem in H; [idtac]
    end.

  Ltac find_rewrite_lem_by lem t :=
    match goal with
    | [ H : _ |- _ ] =>
      rewrite lem in H by t
    end.

  Lemma handleTimeout_not_leader_inc_term :
    forall h d out d' l,
      handleTimeout h d = (out, d', l) ->
      type d <> Leader ->
      currentTerm d' = S (currentTerm d).
  Proof.
    unfold handleTimeout, tryToBecomeLeader.
    intros. simpl in *.
    repeat break_match; try congruence; repeat find_inversion; auto.
  Qed.

  Lemma update_elections_data_timeout_cronies :
    forall h d out d' l t,
      handleTimeout h (snd d) = (out, d', l) ->
      cronies (update_elections_data_timeout h d) t = cronies (fst d) t \/
      (t = currentTerm d' /\
       cronies (update_elections_data_timeout h d) t = votesReceived d').
  Proof.
    unfold update_elections_data_timeout.
    intros.
    repeat break_match; repeat find_inversion; simpl; auto.
    break_match; auto.
  Qed.

  Lemma handleTimeout_preserves_candidateEntries :
    forall net h e out d l,
      refined_raft_intermediate_reachable net ->
      handleTimeout h (snd (nwState net h)) = (out, d, l) ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h (update_elections_data_timeout h (nwState net h), d)).
  Proof.
    intros.
    destruct (serverType_eq_dec (type (snd (A:=electionsData) (B:=raft_data) (nwState net h))) Leader).
      + (* Leader case *)
        unfold handleTimeout, tryToBecomeLeader in *. simpl in *.
        find_rewrite. find_inversion.

        eapply candidateEntries_same; eauto;
        intros;
        repeat (rewrite update_fun_comm; simpl in * );
        update_destruct; subst; rewrite_update;
        auto using update_elections_data_timeout_leader_cronies_same.
      + (* non-Leader case *)

        unfold candidateEntries in *.
        break_exists. break_and.
        exists x.
        rewrite update_fun_comm; simpl.
        rewrite update_fun_comm; simpl.
        rewrite update_fun_comm; simpl.
        rewrite update_fun_comm; simpl.
        rewrite update_fun_comm with (f := type); simpl.
        update_destruct; subst; rewrite_update; auto.
        split.
        * match goal with
          | [ H : handleTimeout _ _ = _ |- _ ] =>
            pose proof H;
              apply update_elections_data_timeout_cronies with (t := eTerm e) in H
          end.
          intuition; find_rewrite; auto.
          find_apply_lem_hyp wonElection_exists_voter.
          break_exists.
          find_apply_lem_hyp in_dedup_was_in.
          find_copy_apply_lem_hyp cronies_term_invariant; auto.
          find_copy_apply_lem_hyp handleTimeout_not_leader_inc_term; auto.
          simpl in *.
          omega.
        * intros.
          find_apply_lem_hyp wonElection_exists_voter.
          break_exists.
          find_apply_lem_hyp in_dedup_was_in.
          find_copy_apply_lem_hyp cronies_term_invariant; auto.
          find_copy_apply_lem_hyp handleTimeout_not_leader_inc_term; auto.
          simpl in *.
          omega.
  Qed.

  Lemma candidate_entries_timeout :
    refined_raft_net_invariant_timeout CandidateEntries.
  Proof.
    unfold refined_raft_net_invariant_timeout, CandidateEntries.
    intros. subst.
    intuition; simpl in *.
    - unfold candidateEntries_host_invariant in *.
      intros.
      eapply candidateEntries_ext; try eassumption.
      repeat find_higher_order_rewrite.

        find_rewrite_lem update_fun_comm. simpl in *.
        find_rewrite_lem update_fun_comm. simpl in *.
        erewrite handleTimeout_log_same in * by eauto.

        find_rewrite_lem_by update_nop_ext' auto.
        find_apply_hyp_hyp.
        eauto using handleTimeout_preserves_candidateEntries.
    - unfold candidateEntries_nw_invariant in *.
      intros.
      simpl in *.
      eapply candidateEntries_ext; eauto.
      find_apply_hyp_hyp.
      break_or_hyp.
      + eapply_prop_hyp pBody pBody; eauto.
        eauto using handleTimeout_preserves_candidateEntries.
      + do_in_map. subst. simpl in *.
        eapply handleTimeout_only_sends_RequestVotes in H8; eauto.
        break_exists. congruence.
  Qed.

  Lemma update_elections_data_appendEntries_cronies_same :
    forall h d t n pli plt es ci,
      cronies (update_elections_data_appendEntries h d t n pli plt es ci) =
      cronies (fst d).
  Proof.
    unfold update_elections_data_appendEntries.
    intros.
    repeat break_match; auto.
  Qed.

  Lemma handleAppendEntries_spec :
    forall h st t n pli plt es ci st' m,
      handleAppendEntries h st t n pli plt es ci = (st', m) ->
      (currentTerm st <= currentTerm st' /\
       (forall e,
          In e (log st') ->
          In e (log st) \/
          In e es /\ currentTerm st' = t) /\
       ~ is_append_entries m).
  Proof.
    intros.
    unfold handleAppendEntries, advanceCurrentTerm in *.
    repeat break_match; try find_inversion; subst; simpl in *; intuition;
    do_bool; intuition; try solve [break_exists; congruence];
    in_crush; eauto using removeAfterIndex_in.
  Qed.

  Lemma handleAppendEntries_term_same_or_type_follower :
    forall h t n pli plt es ci d m st,
      handleAppendEntries h st t n pli plt es ci = (d, m) ->
      (currentTerm d = currentTerm st /\ type d = type st) \/ type d = Follower.
  Proof.
    unfold handleAppendEntries in *.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence.
  Qed.

  Lemma handleAppendEntries_preserves_candidate_entries :
    forall net h t n pli plt es ci d m e,
      handleAppendEntries h (snd (nwState net h)) t n pli plt es ci = (d, m) ->
      refined_raft_intermediate_reachable net ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h
                                 (update_elections_data_appendEntries
                                    h
                                    (nwState net h) t n pli plt es ci, d)).
  Proof.
    unfold candidateEntries.
    intros. break_exists. break_and.
    exists x.
    split.
    - rewrite update_fun_comm. simpl.
      rewrite update_fun_comm. simpl.
      rewrite update_elections_data_appendEntries_cronies_same.
      destruct (name_eq_dec x h); subst; rewrite_update; auto.
    - intros.
      rewrite update_fun_comm. simpl.
      find_rewrite_lem update_fun_comm. simpl in *.
      destruct (name_eq_dec x h); subst; rewrite_update; auto.
      find_apply_lem_hyp handleAppendEntries_term_same_or_type_follower.
      intro; intuition;
      repeat find_rewrite; auto; discriminate.
  Qed.

  Ltac my_update_destruct :=
    match goal with
    | [ |- context [ update _ ?y _ ?x ] ] => destruct (name_eq_dec y x)
    | [ H : context [ update _ ?y _ ?x ] |- _ ] => destruct (name_eq_dec y x)
    end.

  Lemma is_append_entries_intro :
    forall t n plt pli es ci,
      is_append_entries (AppendEntries t n pli plt es ci).
  Proof.
    eauto 20.
  Qed.

  Lemma candidate_entries_append_entries :
    refined_raft_net_invariant_append_entries CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros. subst.
    intuition; simpl in *.
    - unfold candidateEntries_host_invariant in *.
      intros.
      eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      find_rewrite_lem update_fun_comm. simpl in *.
      my_update_destruct; subst; rewrite_update;
      eapply handleAppendEntries_preserves_candidate_entries; eauto.
      find_copy_apply_lem_hyp handleAppendEntries_spec. break_and.
      find_apply_hyp_hyp. intuition eauto.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *.
      eapply candidateEntries_ext; eauto.
      find_apply_hyp_hyp.
      intuition.
      + eapply handleAppendEntries_preserves_candidate_entries; eauto.
      + subst. simpl in *. find_apply_lem_hyp handleAppendEntries_spec.
        break_and.
        subst.
        exfalso.
        eauto using is_append_entries_intro.
  Qed.

  Lemma handleAppendEntriesReply_spec :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      log st' = log st /\
      ((currentTerm st' = currentTerm st /\ type st' = type st)
       \/ type st' = Follower) /\
      (forall m, In m ms -> ~ is_append_entries (snd m)).
  Proof.
    intros.
    unfold handleAppendEntriesReply, advanceCurrentTerm in *.
    repeat break_match; try find_inversion; subst; simpl in *; intuition;
    do_bool; intuition.
  Qed.

  Lemma handleAppendEntriesReply_preserves_candidate_entries :
    forall net h h' t es r st' ms e,
      handleAppendEntriesReply h (snd (nwState net h)) h' t es r = (st', ms) ->
      refined_raft_intermediate_reachable net ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h (fst (nwState net h), st')).
  Proof.
    unfold candidateEntries.
    intros. break_exists. break_and.
    exists x.
    split.
    - rewrite update_fun_comm. simpl.
      rewrite update_fun_comm. simpl.
      my_update_destruct; subst; rewrite_update; auto.
    - intros. my_update_destruct; subst; rewrite_update; auto.
      simpl in *.
      find_apply_lem_hyp handleAppendEntriesReply_spec.
      intuition; repeat find_rewrite; intuition.
      congruence.
  Qed.

  Ltac prove_in :=
    match goal with
      | [ _ : nwPackets ?net = _,
              _ : In (?p : packet) _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; do_in_app; intuition)
      | [ _ : nwPackets ?net = _,
              _ : pBody ?p = _ |- _] =>
        assert (In p (nwPackets net)) by (repeat find_rewrite; intuition)
    end.

  Lemma candidate_entries_append_entries_reply :
    refined_raft_net_invariant_append_entries_reply CandidateEntries.
  Proof.
    red. unfold CandidateEntries. intros. intuition.
    - unfold candidateEntries_host_invariant in *.
      intros. simpl in *. eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      find_rewrite_lem update_fun_comm. simpl in *.
      my_update_destruct.
      + subst. rewrite_update.
        unfold candidateEntries in *.
        find_apply_lem_hyp handleAppendEntriesReply_spec. break_and.
        repeat find_rewrite.
        find_apply_hyp_hyp.
        break_exists; exists x; eauto.
        my_update_destruct; intuition; subst; rewrite_update; simpl in *; auto;
        repeat find_rewrite; intuition; congruence.
      + rewrite_update. find_apply_hyp_hyp.
        eauto using handleAppendEntriesReply_preserves_candidate_entries.
    - unfold candidateEntries_nw_invariant in *. intros. simpl in *.
      find_apply_hyp_hyp. intuition.
      + (* packet already in nw *)
        prove_in.
        eapply candidateEntries_ext; eauto.
        find_eapply_lem_hyp handleAppendEntriesReply_preserves_candidate_entries; eauto.
        subst. auto.
      + exfalso.
        do_in_map.
        find_eapply_lem_hyp handleAppendEntriesReply_spec; eauto.
        subst. simpl in *. find_rewrite.
        match goal with
          | H : ~ is_append_entries _ |- _ => apply H
        end.
        repeat eexists; eauto.
  Qed.

  Lemma update_elections_data_requestVote_cronies_same :
    forall h h' t lli llt st,
      cronies (update_elections_data_requestVote h h' t h' lli llt st) =
      cronies (fst st).
  Proof.
    unfold update_elections_data_requestVote.
    intros.
    repeat break_match; auto.
  Qed.

  Lemma advanceCurrentTerm_same_or_type_follower :
    forall st t,
      advanceCurrentTerm st t = st \/
      type (advanceCurrentTerm st t) = Follower.
  Proof.
    unfold advanceCurrentTerm.
    intros. repeat break_match; auto.
  Qed.

  Lemma handleRV_advanceCurrentTerm_preserves_candidateEntries :
    forall net h h' t lli llt e,
      candidateEntries e (nwState net) ->
      candidateEntries e
                       (update (nwState net) h
                               (update_elections_data_requestVote h h' t h' lli llt (nwState net h),
                                advanceCurrentTerm (snd (nwState net h)) t)).
  Proof.
    intros.
    unfold candidateEntries in *.
    break_exists.  break_and.
    exists x.
    split; update_destruct; subst; rewrite_update; auto; simpl.
    + rewrite update_elections_data_requestVote_cronies_same. auto.
    + intros.
      match goal with
      | [ |- context [advanceCurrentTerm ?st ?t] ] =>
        pose proof advanceCurrentTerm_same_or_type_follower st t
      end.
      intuition; try congruence.
      repeat find_rewrite. auto.
  Qed.

  Lemma handleRequestVote_preserves_candidateEntries :
    forall net h h' t lli llt d e m,
      handleRequestVote h (snd (nwState net h)) t h' lli llt = (d, m) ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h
                                 (update_elections_data_requestVote
                                    h h' t h' lli llt (nwState net h), d)).
  Proof.
    unfold handleRequestVote.
    intros.
    repeat break_match; repeat find_inversion;
    auto using handleRV_advanceCurrentTerm_preserves_candidateEntries.
    - eapply candidateEntries_same; eauto;
        intros;
        repeat (rewrite update_fun_comm; simpl in * );
        update_destruct; subst; rewrite_update;
        auto using update_elections_data_requestVote_cronies_same.
    - unfold candidateEntries in *. break_exists. break_and. exists x.
      simpl.
      split.
      + rewrite update_fun_comm with (f := fst). simpl.
        rewrite update_fun_comm with (f := cronies). simpl.
        rewrite update_elections_data_requestVote_cronies_same.
        update_destruct; subst; rewrite_update; auto.
      + rewrite update_fun_comm with (f := snd). simpl.
        rewrite update_fun_comm with (f := currentTerm). simpl.
        rewrite update_fun_comm with (f := type). simpl.
        update_destruct; subst; rewrite_update; auto.
        match goal with
        | [ |- context [advanceCurrentTerm ?st ?t] ] =>
          pose proof advanceCurrentTerm_same_or_type_follower st t
        end.
        intuition; try congruence.
        repeat find_rewrite. auto.
  Qed.

  Lemma handleRequestVote_only_sends_RVR :
    forall d h h' t lli llt d' m,
      handleRequestVote h d t h' lli llt = (d', m) ->
      is_request_vote_reply m.
  Proof.
    unfold handleRequestVote.
    intros.
    repeat break_match; repeat find_inversion; eauto.
  Qed.

  Ltac find_erewrite_lem lem :=
    match goal with
    | [ H : _ |- _] => erewrite lem in H by eauto
    end.

  Lemma candidate_entries_request_vote :
    refined_raft_net_invariant_request_vote CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros. subst.
    intuition; simpl in *.
    - unfold candidateEntries_host_invariant in *.
      intros.
      eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      find_rewrite_lem update_fun_comm. simpl in *.
      my_update_destruct; subst; rewrite_update; simpl in *;
      try find_erewrite_lem handleRequestVote_same_log;
      eapply handleRequestVote_preserves_candidateEntries; eauto.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *.
      eapply candidateEntries_ext; eauto.
      find_apply_hyp_hyp. intuition.
      + eauto using handleRequestVote_preserves_candidateEntries.
      + subst. simpl in *.
        find_apply_lem_hyp handleRequestVote_only_sends_RVR.
        subst. break_exists. discriminate.
  Qed.

  Lemma handleRequestVoteReply_spec :
    forall h st h' t r st',
      st' = handleRequestVoteReply h st h' t r ->
      log st' = log st /\
      (forall v, In v (votesReceived st) -> In v (votesReceived st')) /\
      ((currentTerm st' = currentTerm st /\ type st' = type st)
       \/ type st' <> Candidate) /\
      (type st <> Leader /\ type st' = Leader ->
       (type st = Candidate /\ wonElection (dedup name_eq_dec
                                                  (votesReceived st')) = true)).
  Proof.
    intros.
    unfold handleRequestVoteReply, advanceCurrentTerm in *.
    repeat break_match; try find_inversion; subst; simpl in *; intuition;
    do_bool; intuition; try right; congruence.
  Qed.

  Lemma handleRequestVoteReply_preserves_candidate_entries :
    forall net h h' t r st' e,
      st' = handleRequestVoteReply h (snd (nwState net h)) h' t r ->
      refined_raft_intermediate_reachable net ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h
                               (update_elections_data_requestVoteReply h h' t r (nwState net h),
                                st')).
  Proof.
  unfold candidateEntries.
    intros. break_exists. break_and.
    exists x.
    split.
    - rewrite update_fun_comm. simpl.
      rewrite update_fun_comm. simpl.
      my_update_destruct; subst; rewrite_update; auto.
      unfold update_elections_data_requestVoteReply in *.
      repeat break_match; simpl in *; auto.
      + break_if; simpl in *; repeat find_rewrite; auto.
         match goal with
          | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
            remember (handleRequestVoteReply h st h' t r) as new_state
         end. find_apply_lem_hyp handleRequestVoteReply_spec. intuition.
         repeat find_rewrite. intuition.
      + break_if; simpl in *; find_rewrite; auto.
        match goal with
          | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
            remember (handleRequestVoteReply h st h' t r) as new_state
        end. find_apply_lem_hyp handleRequestVoteReply_spec. intuition.
        repeat find_rewrite. intuition.
      +  break_if; simpl in *; find_rewrite; auto.
        match goal with
          | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
            remember (handleRequestVoteReply h st h' t r) as new_state
        end. find_apply_lem_hyp handleRequestVoteReply_spec. intuition.
        repeat find_rewrite. intuition.
        * find_apply_lem_hyp cronies_correct_invariant.
          unfold cronies_correct in *. intuition.
          unfold votes_received_leaders in *.
          match goal with
            | H :  Leader = _ |- _ =>
              symmetry in H
          end. find_apply_hyp_hyp.
          eapply wonElection_no_dup_in;
            eauto using NoDup_dedup, in_dedup_was_in, dedup_In.
        * destruct (serverType_eq_dec (type (snd (nwState net x))) Leader); intuition.
          find_apply_lem_hyp cronies_correct_invariant; auto.
          eapply wonElection_no_dup_in;
            eauto using NoDup_dedup, in_dedup_was_in, dedup_In.
    - rewrite update_fun_comm. simpl.
      rewrite update_fun_comm. simpl.
      my_update_destruct; subst; rewrite_update; auto.
      match goal with
          | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
            remember (handleRequestVoteReply h st h' t r) as new_state
      end. find_apply_lem_hyp handleRequestVoteReply_spec. intuition.
      repeat find_rewrite. intuition.
  Qed.

  Lemma candidate_entries_request_vote_reply :
    refined_raft_net_invariant_request_vote_reply CandidateEntries.
    red. unfold CandidateEntries. intros. intuition.
    - unfold candidateEntries_host_invariant in *.
      intros. simpl in *. eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      find_rewrite_lem update_fun_comm. simpl in *.
      my_update_destruct.
      + subst. rewrite_update.
        match goal with
          | |- context [handleRequestVoteReply ?h ?st ?h' ?t ?r] =>
            remember (handleRequestVoteReply h st h' t r) as new_state
        end.
        find_copy_apply_lem_hyp handleRequestVoteReply_spec. break_and.
        match goal with
          | H : log _ = log _ |- _ => rewrite H in *
        end.
        find_apply_hyp_hyp.
        eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
      + rewrite_update.
        eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *. eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
  Qed.

  Lemma doLeader_preserves_candidateEntries :
    forall net gd d h os d' ms e,
      nwState net h = (gd, d) ->
      doLeader d h = (os, d', ms) ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h (gd, d')).
  Proof.
    intros.
    eapply candidateEntries_same; eauto;
    intros;
    repeat (rewrite update_fun_comm; simpl in * );
    update_destruct; subst; rewrite_update; auto;
    repeat find_rewrite; simpl; auto;
    find_apply_lem_hyp doLeader_st; intuition.
  Qed.

  Lemma doLeader_in_entries :
    forall (h : name) d h os d' ms m t li pli plt es ci e,
      doLeader d h = (os, d', ms) ->
      snd m = AppendEntries t li pli plt es ci ->
      In m ms ->
      In e es ->
      In e (log d).
  Proof.
    unfold doLeader.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; intuition.
    do_in_map.

    unfold replicaMessage in *. simpl in *. subst. simpl in *.
    find_inversion.
    eauto using findGtIndex_in.
  Qed.

  Lemma candidate_entries_do_leader :
    refined_raft_net_invariant_do_leader CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros.
    intuition; simpl in *.
    - unfold candidateEntries_host_invariant in *.
      intros.
      eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      my_update_destruct; subst; rewrite_update.
      + simpl in *.
        find_erewrite_lem doLeader_same_log.
        repeat match goal with
        | [ H : nwState ?net ?h = (_, ?d), H' : context [ log ?d ] |- _ ] =>
          replace (log d) with (log (snd (nwState net h))) in H' by (repeat find_rewrite; auto)
        end.
        eauto using doLeader_preserves_candidateEntries.
      + eauto using doLeader_preserves_candidateEntries.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *.
      eapply candidateEntries_ext; eauto.
      find_apply_hyp_hyp.
      intuition.
      + eauto using doLeader_preserves_candidateEntries.
      + do_in_map. subst. simpl in *.
        eapply doLeader_preserves_candidateEntries; eauto.
        eapply_prop candidateEntries_host_invariant.
        match goal with
        | [ H : _ |- _ ] => rewrite H
        end.
        simpl.
        eauto using doLeader_in_entries.
  Qed.

  Lemma doGenericServer_same_type :
    forall h d os d' ms,
      doGenericServer h d = (os, d', ms) ->
      type d' = type d.
  Proof.
    unfold doGenericServer.
    intros.
    repeat break_match; repeat find_inversion; auto.
  Qed.

  Lemma doGenericServer_preserves_candidateEntries :
    forall net gd d h os d' ms e,
      nwState net h = (gd, d) ->
      doGenericServer h d = (os, d', ms) ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h (gd, d')).
  Proof.
    intros.
    eapply candidateEntries_same; eauto;
    intros;
    repeat (rewrite update_fun_comm; simpl in * );
    update_destruct; subst; rewrite_update; auto;
    repeat find_rewrite; simpl; auto.
    - find_copy_apply_lem_hyp TermSanity.doGenericServer_spec. break_and. auto.
    - eauto using doGenericServer_same_type.
  Qed.

  Lemma candidate_entries_do_generic_server :
    refined_raft_net_invariant_do_generic_server CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros.
    intuition; simpl in *.
    - unfold candidateEntries_host_invariant in *.
      intros.
      eapply candidateEntries_ext; eauto.
      repeat find_higher_order_rewrite.
      my_update_destruct; subst; rewrite_update.
      + simpl in *.
        find_copy_apply_lem_hyp TermSanity.doGenericServer_spec. break_and.
        find_rewrite.
        repeat match goal with
        | [ H : nwState ?net ?h = (_, ?d), H' : context [ log ?d ] |- _ ] =>
          replace (log d) with (log (snd (nwState net h))) in H' by (repeat find_rewrite; auto)
        end.
        eauto using doGenericServer_preserves_candidateEntries.
      + eauto using doGenericServer_preserves_candidateEntries.
    - unfold candidateEntries_nw_invariant in *.
      intros. simpl in *.
      eapply candidateEntries_ext; eauto.
      find_apply_hyp_hyp.
      intuition.
      + eauto using doGenericServer_preserves_candidateEntries.
      + do_in_map.
        find_copy_apply_lem_hyp TermSanity.doGenericServer_spec. break_and.
        subst. simpl in *.
        find_apply_hyp_hyp.
        exfalso.
        find_rewrite. eauto 20.
  Qed.

  Lemma candidate_entries_state_same_packet_subset :
    refined_raft_net_invariant_state_same_packet_subset CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros.
    intuition.
    - unfold candidateEntries_host_invariant in *.
      intros.
      repeat find_reverse_higher_order_rewrite.
      apply candidateEntries_ext with (sigma := nwState net); eauto.
    - unfold candidateEntries_nw_invariant in *.
      intros.
      find_apply_hyp_hyp.
      eapply_prop_hyp In In; eauto.
      apply candidateEntries_ext with (sigma := nwState net); eauto.
  Qed.

  Lemma reboot_log_same :
    forall d,
      log (reboot d) = log d.
  Proof.
    unfold reboot.
    auto.
  Qed.

  Lemma reboot_preservers_candidateEntries :
    forall net h d gd e,
      nwState net h = (gd, d) ->
      candidateEntries e (nwState net) ->
      candidateEntries e (update (nwState net) h (gd, reboot d)).
  Proof.
    unfold reboot, candidateEntries.
    intros.
    break_exists.
    exists x.
    break_and.
    rewrite update_fun_comm. simpl in *.
    my_update_destruct; subst; rewrite_update; auto.
    repeat find_rewrite. simpl in *. intuition. discriminate.
  Qed.

  Lemma candidate_entries_reboot :
    refined_raft_net_invariant_reboot CandidateEntries.
  Proof.
    red. unfold CandidateEntries.
    intros.
    intuition.
    - unfold candidateEntries_host_invariant in *.
      intros.
      repeat find_higher_order_rewrite.
      eapply candidateEntries_ext; eauto.
      subst.
      find_rewrite_lem update_fun_comm. simpl in *.
      find_rewrite_lem update_fun_comm. simpl in *.
      my_update_destruct; subst; rewrite_update.
      + repeat match goal with
        | [ H : nwState ?net ?h = (_, ?d), H' : context [ log ?d ] |- _ ] =>
          replace (log d) with (log (snd (nwState net h))) in H' by (repeat find_rewrite; auto)
        end.
        find_apply_hyp_hyp.
        eauto using reboot_preservers_candidateEntries.
      + eauto using reboot_preservers_candidateEntries.
    - unfold candidateEntries_nw_invariant in *.
      intros.
      repeat find_reverse_rewrite.
      eapply_prop_hyp In In; eauto.
      eapply candidateEntries_ext; eauto.
      eauto using reboot_preservers_candidateEntries.
  Qed.

  Lemma candidate_entries_init :
    refined_raft_net_invariant_init CandidateEntries.
  Proof.
    red.
    unfold CandidateEntries.
    unfold candidateEntries_host_invariant, candidateEntries_nw_invariant.
    intuition;
     repeat match goal with
            | [ H : In _ _ |- _ ] => compute in H
            end;
    intuition.
  Qed.

  Theorem candidate_entries_invariant :
    forall (net : network),
      refined_raft_intermediate_reachable net ->
      CandidateEntries net.
  Proof.
    intros.
    eapply refined_raft_net_invariant; eauto.
    - apply candidate_entries_init.
    - apply candidate_entries_client_request.
    - apply candidate_entries_timeout.
    - apply candidate_entries_append_entries.
    - apply candidate_entries_append_entries_reply.
    - apply candidate_entries_request_vote.
    - apply candidate_entries_request_vote_reply.
    - apply candidate_entries_do_leader.
    - apply candidate_entries_do_generic_server.
    - apply candidate_entries_state_same_packet_subset.
    - apply candidate_entries_reboot.
  Qed.
End CandidateEntries.


Require Import List.
Require Import Bool.
Require Import BinNat.
Require Import Omega.
Require Import sflib.

Require Import Common.
Require Import Memory.
Require Import Value.
Require Import Lang.
Require Import State.
Require Import LoadStore.
Require Import Behaviors.
Require Import SmallStep.
Require Import SmallStepAux.

Import SmallStep.
Import Ir.
Import Ir.SmallStep.
Import SmallStepAux.
Import Ir.
Import Ir.SmallStep.

Module Ir.

Module SmallStep.

(****************************************************
        Theorems about sstep of instruction.
 ****************************************************)

Lemma incrpc_wf:
  forall md c c'
         (HWF:Ir.Config.wf md c)
         (HC':c' = incrpc md c),
    Ir.Config.wf md c'.
Proof.
  (* High-level proof: incrpc changes stack frame only, and
     next_trivial_pc satisfies valid_pc. *)
  intros.
  unfold incrpc in HC'.
  destruct (Ir.Config.cur_fdef_pc md c) eqn:HC.
  - destruct p as [fdef pc0].
    remember (Ir.IRFunction.next_trivial_pc pc0 fdef) as pc_next.
    destruct pc_next as [pc_next | ].
    unfold Ir.Config.update_pc in HC'.
    remember (Ir.Config.s c) as s'.
    destruct s' as [ | [cid [pc0' r0']] st] .
    + congruence.
    + (* show that pc0' = pc0 *)
      unfold Ir.Config.cur_fdef_pc in HC.
      rewrite <- Heqs' in HC.
      remember (Ir.Config.get_funid c cid) as ofunid.
      destruct ofunid as [funid | ]; try (inversion HC; fail).
      remember (Ir.IRModule.getf funid md) as ofdef'.
      destruct ofdef' as [fdef' | ]; try (inversion HC; fail).
      inversion HC.
      rewrite H0, H1 in *.
      clear H0 H1 HC.
      (* Now prove Ir.Config.wf c' *)
      rewrite HC'.
      inversion HWF.
      split.
      * assumption.
      * assumption.
      * assumption.
      * simpl.
        intros.
        rewrite <- Heqs' in wf_stack.
        simpl in wf_stack.
        destruct HIN.
        -- inversion H. rewrite H1, H2, H3 in *. clear H H1 H2 H3.
           apply Ir.IRFunction.next_trivial_pc_valid with (pc1 := pc0).
           apply wf_stack with (curcid0 := curcid) (funid := funid0) (curregfile0 := curregfile).
           left. reflexivity.
           eassumption. assumption.
           assert (HINCID:Some funid0 = Ir.Config.get_funid c curcid).
           { eapply Ir.Config.cid_to_f_In_get_funid. eassumption. assumption. }
           rewrite <- Heqofunid in HINCID.
           inversion HINCID.
           rewrite H0 in HF. rewrite <- HF in Heqofdef'.
           inversion Heqofdef'. rewrite <- H1. congruence.
         -- apply wf_stack with (curcid := curcid) (funid := funid0) (curregfile := curregfile).
            right. assumption. assumption. assumption.
      * simpl. intros.
        eapply wf_ptr. erewrite <- get_val_incrpc with (md := md).
        unfold incrpc. unfold Ir.Config.cur_fdef_pc. rewrite <- Heqs'.
        rewrite <- Heqofunid. rewrite <- Heqofdef'.
        rewrite <- Heqpc_next. unfold Ir.Config.update_pc.
        rewrite <- Heqs'. eassumption.
      * simpl. intros. eapply wf_ptr_mem.
        eassumption. eassumption. eassumption.
    + congruence.
  - congruence.
Qed.

Lemma update_rval_wf:
  forall md c c' r v
         (HWF:Ir.Config.wf md c)
         (HC':c' = Ir.Config.update_rval c r v)
         (HPTRWF:forall p, v = Ir.ptr p -> Ir.Config.ptr_wf p (Ir.Config.m c)),
    Ir.Config.wf md c'.
Proof.
  intros.
  inversion HWF.
  unfold Ir.Config.update_rval in HC'.
  rewrite HC'. clear HC'.
  destruct (Ir.Config.s c) as [ | [cid0 [pc0 reg0]] s'] eqn:Hs.
  { split; try assumption.
    intros. rewrite Hs in HIN. inversion HIN. }
  { split; try (simpl; assumption).
    simpl. intros.
    destruct HIN.
    - inversion H.
      destruct curregfile; inversion H3.
      rewrite H1, H2 in *. clear H1 H2.
      eapply wf_stack with (curcid0 := curcid). simpl. left. reflexivity.
      eassumption. assumption.
    - eapply wf_stack.
      simpl. right. eassumption. eassumption. assumption.
    - simpl. intros.
      unfold Ir.Config.get_val in HGETVAL.
      unfold Ir.Config.get_rval in HGETVAL.
      simpl in HGETVAL.
      destruct op eqn:Hop.
      + eapply wf_ptr with (op := op). unfold Ir.Config.get_val.
        des_ifs.
      + destruct (Nat.eqb r r0) eqn:Hreg.
        { apply HPTRWF with (p := p).
          rewrite Nat.eqb_eq in Hreg. subst r0.
          rewrite Ir.Regfile.get_update in HGETVAL. congruence. }
        { rewrite Nat.eqb_neq in Hreg.
          rewrite Ir.Regfile.get_update2 in HGETVAL; try congruence.
          eapply wf_ptr with (op := Ir.opreg r0).
          unfold Ir.Config.get_val. unfold Ir.Config.get_rval.
          des_ifs. }
  }
Qed.

Lemma update_reg_and_incrpc_wf:
  forall md c c' v r
         (HWF:Ir.Config.wf md c)
         (HC':c' = update_reg_and_incrpc md c r v)
         (HPTRWF:forall p, v = Ir.ptr p -> Ir.Config.ptr_wf p (Ir.Config.m c)),
    Ir.Config.wf md c'.
Proof.
  intros.
  unfold update_reg_and_incrpc in HC'.
  assert (Ir.Config.wf md (Ir.Config.update_rval c r v)).
  { eapply update_rval_wf. eassumption. reflexivity.  eassumption. }
  rewrite HC'.
  eapply incrpc_wf.
  eapply H. reflexivity.
Qed.

(* terminator small step preserves wellformedness. *)
Lemma t_step_wf:
  forall md c c' e
         (HWF:Ir.Config.wf md c)
         (HSTEP:t_step md c = sr_success e c'),
    Ir.Config.wf md c'.
Proof.
  intros.
  inv HWF.
  unfold t_step in HSTEP.
  des_ifs.
  { unfold br in HSTEP.
    des_ifs.
    split; try (unfold Ir.Config.update_pc; des_ifs; done).
    { unfold Ir.Config.update_pc.
      simpl in wf_stack. simpl.
      intros.
      destruct (Ir.Config.s c) eqn:HS.
      { rewrite HS in HIN. inv HIN. }
      destruct p1. destruct p1. simpl in *.
      destruct HIN.
      { inv H.
        unfold Ir.Config.cur_fdef_pc in Heq0.
        rewrite HS in Heq0.
        unfold Ir.Config.get_funid in Heq0.
        des_ifs.
        apply list_find_key_In in HIN2.
        rewrite Heq0 in HIN2.
        assert (List.length (p::l) < 2).
        { eapply list_find_key_NoDup.
          eapply wf_cid_to_f.
          rewrite Heq0. reflexivity. }
        destruct l.
        { inv HIN2; try inv H0.
          simpl in Heq3. rewrite Heq3 in HF. inv HF.
          eapply Ir.IRFunction.get_begin_pc_bb_valid.
          eassumption.
        }
        { simpl in H. omega. }
      }
      { eapply wf_stack.
        { right. eassumption. }
        { eassumption. }
        { eassumption. }
      }
    }
    { simpl. intros.
      rewrite Ir.Config.m_update_pc. rewrite Ir.Config.get_val_update_pc in HGETVAL.
      eapply wf_ptr. eassumption. }
  }
  { unfold br in HSTEP.
    des_ifs.
    split; try (unfold Ir.Config.update_pc; des_ifs; done).
    { unfold Ir.Config.update_pc.
      simpl in wf_stack. simpl.
      intros.
      destruct (Ir.Config.s c) eqn:HS.
      { rewrite HS in HIN. inv HIN. }
      destruct p1. destruct p1. simpl in *.
      destruct HIN.
      { inv H.
        unfold Ir.Config.cur_fdef_pc in Heq0.
        rewrite HS in Heq0.
        unfold Ir.Config.get_funid in Heq0.
        des_ifs.
        apply list_find_key_In in HIN2.
        rewrite Heq0 in HIN2.
        assert (List.length (p::l) < 2).
        { eapply list_find_key_NoDup.
          eapply wf_cid_to_f.
          rewrite Heq0. reflexivity. }
        destruct l.
        { inv HIN2; try inv H0.
          simpl in Heq5. rewrite Heq5 in HF. inv HF.
          eapply Ir.IRFunction.get_begin_pc_bb_valid.
          eassumption.
        }
        { simpl in H. omega. }
      }
      { eapply wf_stack.
        { right. eassumption. }
        { eassumption. }
        { eassumption. }
      }
    }
    { simpl. intros.
      rewrite Ir.Config.m_update_pc. rewrite Ir.Config.get_val_update_pc in HGETVAL.
      eapply wf_ptr. eassumption. }
  }
  { unfold br in HSTEP.
    des_ifs.
    split; try (unfold Ir.Config.update_pc; des_ifs; done).
    { unfold Ir.Config.update_pc.
      simpl in wf_stack. simpl.
      intros.
      destruct (Ir.Config.s c) eqn:HS.
      { rewrite HS in HIN. inv HIN. }
      destruct p1. destruct p1. simpl in *.
      destruct HIN.
      { inv H.
        unfold Ir.Config.cur_fdef_pc in Heq0.
        rewrite HS in Heq0.
        unfold Ir.Config.get_funid in Heq0.
        des_ifs.
        apply list_find_key_In in HIN2.
        rewrite Heq0 in HIN2.
        assert (List.length (p::l) < 2).
        { eapply list_find_key_NoDup.
          eapply wf_cid_to_f.
          rewrite Heq0. reflexivity. }
        destruct l.
        { inv HIN2; try inv H0.
          simpl in Heq5. rewrite Heq5 in HF. inv HF.
          eapply Ir.IRFunction.get_begin_pc_bb_valid.
          eassumption.
        }
        { simpl in H. omega. }
      }
      { eapply wf_stack.
        { right. eassumption. }
        { eassumption. }
        { eassumption. }
      }
    }
    { simpl. intros.
      rewrite Ir.Config.m_update_pc. rewrite Ir.Config.get_val_update_pc in HGETVAL.
      eapply wf_ptr. eassumption. }
  }
Qed.

Ltac thats_it := eapply update_reg_and_incrpc_wf; eauto.
Ltac des_op c op op' HINV :=
  destruct (Ir.Config.get_val c op) as [op' | ]; try (inversion HINV; fail).
Ltac des_inv v HINV :=
  destruct (v); try (inversion HINV; fail).
Ltac try_wf :=
  des_ifs; try (eapply update_reg_and_incrpc_wf; try eassumption;
                try reflexivity; try congruence; fail).

Lemma gep_wf:
  forall p n t m inb p0
         (HGEP:gep p n t m inb = Ir.ptr p0)
         (HMWF:Ir.Memory.wf m)
         (HPWF:Ir.Config.ptr_wf p m),
    Ir.Config.ptr_wf p0 m.
Proof.
  intros.
  unfold gep in HGEP.
  inv HPWF.
  des_ifs.
  { exploit H. ss. intros HH. inv HH. inv H2.
    rewrite Heq in H3. inv H3.
    split.
    { intros. inv H2.
      split.
      apply twos_compl_add_lt.
      eauto.
    }
    { intros. ss. }
  }
  { exploit H. ss. intros HH. inv HH. inv H2.
    split.
    { intros. inv H2. split.
      apply twos_compl_add_lt.
      eauto. }
    { intros. ss. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. ss. }
    { intros. inv H1.
      apply twos_compl_add_lt. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. ss. }
    { intros. inv H1.
      apply twos_compl_add_lt. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. ss. }
    { intros. inv H1.
      apply twos_compl_add_lt. }
  }
Qed.

Lemma getpbits_ptr_in_byte:
  forall x p n
    (HPBITS:Ir.Byte.getpbits x = Some (p, n)),
    Ir.Config.ptr_in_byte p n x.
Proof.
  intros.
  unfold Ir.Byte.getpbits in HPBITS.
  unfold Ir.Config.ptr_in_byte.
  des_ifs.
  eauto.
Qed.

Lemma load_val_ptr_wf:
  forall md st p retty p0
         (HLOAD:Ir.load_val (Ir.Config.m st) p retty = Ir.ptr p0)
         (HWF:Ir.Config.wf md st)
         (HPWF:Ir.Config.ptr_wf p (Ir.Config.m st)),
    Ir.Config.ptr_wf p0 (Ir.Config.m st).
Proof.
  intros.
  unfold Ir.load_val in HLOAD.
  des_ifs.
  unfold Ir.Byte.getptr in Heq.
  unfold Ir.ty_bytesz in Heq.
  unfold Ir.ty_bitsz in Heq.
  rewrite Ir.PTRSZ_def in Heq.
  simpl in Heq.
  des_ifs.
  unfold Ir.load_bytes in Heq1.
  des_ifs.
  dup Heq.
  apply Ir.get_deref_singleton in Heq4. inv Heq4; try congruence.
  inv H. inv H0. inv H. simpl in H1.
  assert (exists x, l = x::nil).
  {
    destruct l; simpl in Heq0; try( inv Heq0; fail).
    rewrite Nat.eqb_eq in Heq0.
    destruct l. simpl in Heq0. eexists. reflexivity.
    simpl in Heq0. omega.
  }
  inv H. simpl in Heq0.
  simpl in Heq3. des_ifs.
  inv HWF.
  exploit wf_ptr_mem.
  { rewrite H1.  reflexivity. }
  { eapply Ir.MemBlock.bytes_In_c. eassumption.
    assert (In t0 [t0;x]). left. ss. eapply H. }
  { eapply getpbits_ptr_in_byte. eassumption. }
  intros. ss.
  { inv HWF. ss. }
  omega.
Qed.

Lemma store_val_ptr_wf:
  forall md p0 c p v valty
         (HWF:Ir.Config.wf md c)
         (HPWF:Ir.Config.ptr_wf p0 (Ir.Config.m c)),
  Ir.Config.ptr_wf p0 (Ir.store_val (Ir.Config.m c) p v valty).
Proof.
  intros.
  inv HPWF.
  destruct p0.
  { exploit H. ss. intros HH. inv HH. inv H2.
    split.
    { intros. inv H2. split. ss.
      unfold Ir.store_val. des_ifs; eauto.
      { unfold Ir.store_bytes.
        des_ifs; eauto.
        destruct (b =? l) eqn:HEQ.
        { rewrite Nat.eqb_eq in HEQ. subst b.
          erewrite Ir.Memory.get_set_id_short; try eassumption.
          eexists. ss. inv HWF. ss. }
        { rewrite Ir.Memory.get_set_diff_short. eexists. eassumption.
          inv HWF. ss. rewrite Nat.eqb_neq in HEQ. congruence. }
      }
      { unfold Ir.store_bytes.
        des_ifs; eauto.
        destruct (b =? l) eqn:HEQ.
        { rewrite Nat.eqb_eq in HEQ. subst b.
          erewrite Ir.Memory.get_set_id_short; try eassumption.
          eexists. ss. inv HWF. ss. }
        { rewrite Ir.Memory.get_set_diff_short. eexists. eassumption.
          inv HWF. ss. rewrite Nat.eqb_neq in HEQ. congruence. }
      }
    }
    { intros. congruence. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. congruence. }
    { intros. inv H1. ss. }
  }
Qed.

Lemma In_ofint_not_ptr_in_byte:
  forall n1 len b p0 ofs
         (HIN:In b (Ir.Byte.ofint n1 len)),
    ~ Ir.Config.ptr_in_byte p0 ofs b.
Proof.
  intros.
  unfold Ir.Byte.ofint in HIN.
  remember (Ir.Bit.add_hzerobits (Ir.Bit.N_to_bits n1) (len - length (Ir.Bit.N_to_bits n1)))
           as bits.
  assert (List.Forall (fun b => forall p ofs, b <> Ir.Bit.baddr p ofs) bits).
  { rewrite Heqbits.
    eapply Ir.Byte.add_hzerobits_notbaddr.
    rewrite Forall_forall.
    intros.
    eapply Ir.Byte.N_to_bits_notbaddr. eassumption.
  }
  eapply Ir.Byte.from_bits_notbaddr in H.
  rewrite Forall_forall in H.
  apply H with (p := p0) (ofs := ofs) in HIN.
  intros HH.
  unfold Ir.Config.ptr_in_byte in HH.
  intuition.
Qed.

Lemma ptr_wf_set:
  forall p1 c b mb'
    (HMWF:Ir.Memory.wf (Ir.Config.m c))
    (HPTRWF:Ir.Config.ptr_wf p1 (Ir.Config.m c)),
    Ir.Config.ptr_wf p1 (Ir.Memory.set (Ir.Config.m c) b mb').
Proof.
  intros.
  destruct p1.
  { inv HPTRWF. exploit H. ss. intros HH. inv HH.
    inv H2.
    split.
    { intros. inv H2. split. ss.
      destruct (l =? b) eqn:HEQ.
      { rewrite Nat.eqb_eq in HEQ. subst l.
        erewrite Ir.Memory.get_set_id_short. eexists. ss.
        ss. eassumption. }
      { erewrite Ir.Memory.get_set_diff_short. eexists. eassumption.
        ss. rewrite Nat.eqb_neq in HEQ. congruence.
      }
    }
    { intros. congruence. }
  }
  { inv HPTRWF. exploit H0. ss. intros HH.
    split.
    { intros. congruence. }
    { intros. inv H1. eauto. }
  }
Qed.

Lemma store_val_ptr_mem_wf:
  forall md c opptr mb p v valty bid byt p0 ofs mb0
         (HWF:Ir.Config.wf md c)
         (HOPVAL:Ir.Config.get_val c opptr = Some v)
         (HGET0:Some mb0 = Ir.Memory.get (Ir.Config.m c) bid)
         (HGET:Some mb = Ir.Memory.get (Ir.store_val (Ir.Config.m c) p v valty) bid)
         (HIN:In byt (Ir.MemBlock.c mb))
         (HPTR:Ir.Config.ptr_in_byte p0 ofs byt),
    Ir.Config.ptr_wf p0 (Ir.store_val (Ir.Config.m c) p v valty).
Proof.
  intros.
  unfold Ir.store_val in *.
  des_ifs; try (inv HWF; eapply wf_ptr_mem; eassumption).
  { unfold Ir.store_bytes in *.
    des_ifs;
      try (inv HWF; eapply wf_ptr_mem; eassumption).
    eapply Ir.get_deref_singleton in Heq0.
    destruct Heq0; try congruence.
    destruct H. destruct H. inv H. simpl in H0.
    destruct (b =? bid) eqn:HBID.
    { rewrite Nat.eqb_eq in HBID. subst bid.
      erewrite Ir.Memory.get_set_id in HGET.
      3: rewrite <- HGET0; reflexivity.
      3: reflexivity.
      inv HGET.
      unfold Ir.MemBlock.set_bytes in HIN.
      simpl in HIN.
      apply List.in_app_or in HIN.
      destruct HIN.
      { (* unchanged part *)
        inv HWF.
        eapply ptr_wf_set. ss. eapply wf_ptr_mem.
        rewrite H0. ss.
        eapply firstn_In. ss. eassumption. eassumption.
      }
      apply List.in_app_or in H.
      destruct H.
      { (* changed part! but it's integer. *)
        eapply In_ofint_not_ptr_in_byte in H.
        eapply H in HPTR. inv HPTR.
      }
      { (* unchanged part. *)
        inv HWF.
        eapply ptr_wf_set. ss. eapply wf_ptr_mem.
        rewrite H0. ss.
        eapply skipn_In. ss. eassumption. eassumption.
      }
      { inv HWF. ss. }
    }
    { (* b <> bid *)
      rewrite Ir.Memory.get_set_diff_short in HGET.
      inv HWF.
      eapply ptr_wf_set. ss. eapply wf_ptr_mem.
      rewrite HGET. ss. eassumption. eassumption.
      inv HWF. ss.
      rewrite Nat.eqb_neq in HBID. congruence.
    }
    inv HWF. ss.
    rewrite Nat.eqb_eq in Heq. rewrite <- Heq.
    apply Ir.ty_bytesz_pos.
  }
  { (* stored value is ptr. *)
    unfold Ir.store_bytes in *.
    des_ifs; try (inv HWF; eauto; fail).
    eapply Ir.get_deref_singleton in Heq0.
    destruct Heq0; try congruence.
    inv H. inv H0. inv H. simpl in H1.
    destruct (b =? bid) eqn:HBID.
    { rewrite Nat.eqb_eq in HBID. subst bid.
      erewrite Ir.Memory.get_set_id in HGET.
      3: eapply H1. 3: reflexivity.
      inv HGET.
      unfold Ir.MemBlock.set_bytes in *.
      simpl in *.
      eapply List.in_app_or in HIN.
      destruct HIN.
      { (* unchangd part *)
        inv HWF.
        eapply ptr_wf_set. ss. eapply wf_ptr_mem.
        rewrite H1. ss. eapply firstn_In. ss. eassumption. eassumption.
      }
      unfold Ir.Byte.ofptr in H.
      rewrite Ir.PTRSZ_def in H.
      simpl in H.
      destruct H.
      { (* changed part 1 *)
        (* should use ptr_wf *)
        rewrite <- H in HPTR.
        unfold Ir.Config.ptr_in_byte in HPTR. simpl in HPTR.
        inv HWF. dup HOPVAL.
        apply wf_ptr in HOPVAL.
        assert (HP0P1:p0 = p1).
        { destruct HPTR. congruence.
          repeat (destruct H; try congruence). }
        subst p0.
        eapply ptr_wf_set. ss. eapply wf_ptr. eassumption.
      }
      destruct H. (* one more time *)
      {
        (* should use ptr_wf *)
        rewrite <- H in HPTR.
        unfold Ir.Config.ptr_in_byte in HPTR. simpl in HPTR.
        inv HWF. dup HOPVAL.
        apply wf_ptr in HOPVAL.
        assert (HP0P1:p0 = p1).
        { destruct HPTR. congruence.
          repeat (destruct H; try congruence). }
        subst p0.
        eapply ptr_wf_set. ss. eapply wf_ptr. eassumption.
      }
      (* unchanged part *)
      inv HWF.
      eapply ptr_wf_set. ss. eapply wf_ptr_mem. rewrite H1. ss.
      eapply skipn_In. ss. eassumption. eassumption.
      inv HWF. ss.
    }
    { (* b <> bid *)
      rewrite Ir.Memory.get_set_diff_short in HGET.
      inv HWF.
      eapply ptr_wf_set. ss. eapply wf_ptr_mem.
      rewrite HGET. ss. eassumption. eassumption.
      inv HWF. ss.
      rewrite Nat.eqb_neq in HBID. congruence.
    }
    inv HWF. ss.
    rewrite Nat.eqb_eq in Heq. rewrite <- Heq.
    apply Ir.ty_bytesz_pos.
  }
Qed.

Lemma free_ptr_wf:
  forall c b t p
    (HMWF:Ir.Memory.wf (Ir.Config.m c))
    (HFREE: Ir.Memory.free (Ir.Config.m c) b = Some t)
    (HWF:Ir.Config.ptr_wf p (Ir.Config.m c)),
    Ir.Config.ptr_wf p t.
Proof.
  intros.
  inv HWF.
  unfold Ir.Memory.free in HFREE.
  des_ifs.
  destruct p.
  { exploit H. ss. intros HH. inv HH. inv H2.
    split.
    { intros. inv H2. split. ss.
      destruct (b =? l) eqn:HEQ.
      { rewrite Nat.eqb_eq in HEQ.  subst b.
        erewrite Ir.Memory.get_set_id_short. eexists. ss.
        eapply Ir.Memory.incr_time_wf. eassumption.
        ss.
        rewrite Ir.Memory.get_incr_time_id. eassumption.
      }
      { rewrite Ir.Memory.get_set_diff_short.
        rewrite Ir.Memory.get_incr_time_id. eexists. eassumption.
        eapply Ir.Memory.incr_time_wf. eassumption. ss.
        rewrite Nat.eqb_neq in HEQ. congruence.
      }
    }
    { intros. congruence. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. congruence. }
    { intros. inv H1. ss. }
  }
Qed.

(* Lemma: inst_det_step preserves well-formedness of configuration. *)
Lemma inst_det_step_wf:
  forall md c c' i e
         (HWF:Ir.Config.wf md c)
         (HCUR:Some i = Ir.Config.cur_inst md c)
         (HNEXT:Some (sr_success e c') = inst_det_step md c),
    Ir.Config.wf md c'.
Proof.
    intros.
    unfold inst_det_step in HNEXT. (* ibinop. *)
    rewrite <- HCUR in HNEXT.
    destruct i as [r retty bopc op1 op2 (* ibinop *)
                  |r op1 retty (* ifreeze *)
                  |r opcond condty op1 op2 opty (* iselect *)
                  |r retty ptrty opptr1 opptr2 (* ipsub *)
                  |r retty opptr opidx inb (* igep *)
                  |r retty opptr (* iload *)
                  |valty opval opptr (* istore *)
                  |(* imalloc *)
                  |opptr (* ifree *)
                  |r opval retty (* ibitcast *)
                  |r opptr retty (* iptrtoint *)
                  |r opint retty (* iinttoptr *)
                  |opval (* ievent *)
                  |r opty op1 op2 (* iicmp_eq *)
                  |r opty op1 op2 (* iicmp_ule *)
                  ] eqn:HINST; try (inversion HNEXT; fail).
    + destruct bopc; try_wf.
    + (* ifreeze. *) try_wf.
    + (* iselect. *) try_wf.
      eapply update_reg_and_incrpc_wf. eassumption. ss. inv HWF.
      intros. destruct v; try discriminate. inv H. eapply wf_ptr. eassumption.
      eapply update_reg_and_incrpc_wf. eassumption. ss. inv HWF.
      intros. destruct v0; try discriminate. inv H. eapply wf_ptr. eassumption.
    + (* ipsub. *) unfold psub in HNEXT. try_wf.
    + (* igep. *) try_wf.
      eapply update_reg_and_incrpc_wf; try reflexivity.
      eassumption.
      intros. eapply gep_wf; try eassumption.
      inv HWF. assumption. inv HWF. eapply wf_ptr; eassumption.
    + (* iload. *) try_wf.
      eapply update_reg_and_incrpc_wf. eassumption. reflexivity.
      intros. dup HWF. inv HWF.
      eapply load_val_ptr_wf. eassumption. eassumption.
      eapply wf_ptr. eassumption.
    + (* istore. *) try_wf; try (eapply incrpc_wf; try eassumption; try reflexivity; fail).
      apply incrpc_wf with (c := Ir.Config.update_m c (Ir.store_val (Ir.Config.m c) p v valty)).
      dup HWF. destruct HWF.
      split; simpl; try assumption. eapply Ir.store_val_wf. eassumption.
      eapply Ir.ty_bytesz_pos. congruence.
      * intros. rewrite Ir.Config.get_val_update_m in HGETVAL.
        eapply store_val_ptr_wf. eassumption.
        eapply wf_ptr in HGETVAL. ss.
      * (* wf_ptr_mem *)
        intros.
        assert (exists mb', Some mb' = Ir.Memory.get (Ir.Config.m c) bid).
        { unfold Ir.store_val in HBLK. unfold Ir.store_bytes in HBLK.
          des_ifs; try (eexists; rewrite HBLK; reflexivity).
          eapply Ir.Memory.get_set_exists. eassumption.
          eapply Ir.Memory.get_set_exists. eassumption.
        }
        inv H.
        eapply store_val_ptr_mem_wf; try eassumption.
      * ss.
    + (* ifree *) try_wf; try (eapply incrpc_wf; try eassumption; try reflexivity; fail).
      apply incrpc_wf with (c := Ir.Config.update_m c t); try reflexivity.
      unfold free in Heq0.
      destruct HWF.
      des_ifs.
      * split.
        -- eapply Ir.Memory.free_wf. eassumption.
           rewrite Heq0. unfold Ir.Config.update_m. reflexivity.
        -- unfold Ir.Config.cid_to_f in *. des_ifs.
        -- intros. apply wf_cid_to_f2. unfold Ir.Config.cid_to_f in *. des_ifs.
        -- intros. rewrite Ir.Config.s_update_m in HIN. eauto.
        -- intros.
           rewrite Ir.Config.get_val_update_m in HGETVAL.
           rewrite Ir.Config.m_update_m.
           apply wf_ptr in HGETVAL.
           eapply free_ptr_wf; eassumption.
        -- intros. rewrite Ir.Config.m_update_m in *.
           dup HBLK. symmetry in HBLK.
           eapply Ir.Memory.get_free_some_inv in HBLK; try eauto.
           inv HBLK.
           erewrite <- Ir.Memory.get_free_c in HBYTE.
           3: eauto. 4: eauto. 3: eauto. 2: eauto.
           eapply free_ptr_wf. eassumption. eauto.
           eapply wf_ptr_mem. rewrite H. eauto. eauto. eauto.
      * split.
        -- eapply Ir.Memory.free_wf. eassumption.
           rewrite Heq0. unfold Ir.Config.update_m. reflexivity.
        -- unfold Ir.Config.cid_to_f in *. des_ifs.
        -- intros. apply wf_cid_to_f2. unfold Ir.Config.cid_to_f in *. des_ifs.
        -- intros.
           apply wf_stack with (curcid := curcid) (funid := funid) (curregfile := curregfile).
           assumption. unfold Ir.Config.cid_to_f in *.
           unfold Ir.Config.update_m in HIN2. destruct c. simpl in *. assumption.
           assumption.
        -- intros.
           rewrite Ir.Config.get_val_update_m in HGETVAL.
           rewrite Ir.Config.m_update_m.
           apply wf_ptr in HGETVAL.
           eapply free_ptr_wf; eassumption.
        -- intros. rewrite Ir.Config.m_update_m in *.
           dup HBLK. symmetry in HBLK.
           eapply Ir.Memory.get_free_some_inv in HBLK; try eauto.
           inv HBLK.
           eapply free_ptr_wf. eassumption. eassumption.
           eapply wf_ptr_mem.
           3: eapply HBIT.
           rewrite H. reflexivity.
           erewrite <- Ir.Memory.get_free_c in HBYTE. 3:eauto. 4:eauto. 3:eauto. 2:eauto.
           eauto.
    + (* ibitcast. *) try_wf.
      eapply update_reg_and_incrpc_wf. eassumption.
      reflexivity.
      intros. inv H.
      inv HWF. eapply wf_ptr. eassumption.
    + (* iptrtoint. *) try_wf.
    + (* iinttoptr *) try_wf.
      eapply update_reg_and_incrpc_wf; try eassumption.
      reflexivity.
      intros. inv H.
      split. intros. congruence.
      intros. inv H.
      eapply twos_compl_lt.
    + (* ievent *)
      rename HNEXT into H2. simpl in H2.
      des_op c opval opv H2. des_inv opv H2.
      inversion H2. eapply incrpc_wf. eassumption. reflexivity.
    + (* iicmp_eq, det *)
      rename HNEXT into HC'. simpl in HC'.
      des_op c op1 op1v HC'.
      { des_ifs;
        try (eapply update_reg_and_incrpc_wf;
             [ eassumption | ss | intros H1 H2; unfold to_num in H2; congruence ]).
      }
      { des_ifs;
        try (eapply update_reg_and_incrpc_wf;
             [ eassumption | ss | intros H1 H2; unfold to_num in H2; congruence ]).
      }
    + (* iicmp_ule, det *)
      rename HNEXT into HC'. simpl in HC'.
      des_op c op1 op1v HC'.
      { des_inv op1v HC';
          des_op c op2 op2v HC'; try (inv HC'; try_wf).
        try (eapply update_reg_and_incrpc_wf;
             [ eassumption | ss | intros H1 H2; unfold to_num in H2; congruence ]).
        try (eapply update_reg_and_incrpc_wf;
             [ eassumption | ss | intros H1 H2; unfold to_num in H2; congruence ]).
      }
      { des_ifs; try_wf. }
Qed.

Lemma new_ptr_wf:
  forall md c p m' nsz contents P l
         (HWF:Ir.Config.wf md c)
         (HSZ:nsz > 0)
         (HGET:Ir.Config.ptr_wf p (Ir.Config.m c))
         (HDISJ:Ir.Memory.allocatable (Ir.Config.m c)
                                      (map (fun addr : nat => (addr, nsz)) P) = true)
         (HMBWF : forall begt : Ir.time,
          Ir.MemBlock.wf
            {|
            Ir.MemBlock.bt := Ir.heap;
            Ir.MemBlock.r := (begt, None);
            Ir.MemBlock.n := nsz;
            Ir.MemBlock.a := Ir.SYSALIGN;
            Ir.MemBlock.c := contents;
            Ir.MemBlock.P := P |})
         (HNEW:(m', l) = Ir.Memory.new (Ir.Config.m c) Ir.heap nsz Ir.SYSALIGN contents P),
    Ir.Config.ptr_wf p m'.
Proof.
  intros.
  inv HGET.
  destruct p.
  { exploit H. ss. intros HH. inv HH. inv H2.
    split.
    { intros. inv H2. split. ss.
      eapply Ir.Memory.get_new in HNEW. rewrite HNEW. eexists. eassumption.
      inv HWF. ss. ss. ss.
      ss.
      exploit H. ss. intros HH. inv HH.
      inv HWF. inv wf_m.
      eapply forallb_In in wf_newid.
      rewrite Nat.ltb_lt in wf_newid. eassumption.
      inv H4. symmetry in H5. eapply Ir.Memory.get_In_key in H5. eassumption.
      ss.
    }
    { intros. congruence. }
  }
  { exploit H0. ss. intros HH.
    split.
    { intros. congruence. }
    { intros. inv H1. omega. }
  }
Qed.

Lemma poison_not_ptr_in_byte:
  forall nsz byt ofs p
         (HIN:In byt (repeat Ir.Byte.poison nsz)),
    ~Ir.Config.ptr_in_byte p ofs byt.
Proof.
  intros.
  intros HH.
  unfold Ir.Config.ptr_in_byte in HH.
  assert (byt = Ir.Byte.poison).
  { apply repeat_spec in HIN. subst.
    unfold Ir.Byte.poison in *.
    simpl in *. reflexivity.
  }
  subst byt.
  unfold Ir.Byte.poison. simpl in *.
  repeat (destruct HH as [Ha | HH]; try inv Ha).
  inv HH.
Qed.

(* Lemma: inst_step preserves well-formedness of configuration. *)
Lemma inst_step_wf:
  forall md c c' e
         (HWF:Ir.Config.wf md c)
         (HSTEP:inst_step md c (sr_success e c')),
    Ir.Config.wf md c'.
Proof.
  intros.
  inversion HSTEP.
  - unfold inst_det_step in HNEXT.
    destruct (Ir.Config.cur_inst md c) as [i0|] eqn:Hcur.
    eapply inst_det_step_wf. eassumption.
    rewrite Hcur. reflexivity. unfold inst_det_step.
    rewrite Hcur. eassumption.
    inversion HNEXT.
  - (* freeze *)
    thats_it. intros. ss.
  - (* imalloc returning null *)
    thats_it. unfold Ir.NULL.
    intros. inv H0.
    split. intros. congruence.
    intros. inv H. apply Ir.MEMSZ_pos.
  - (* imalloc, succeed *)
    eapply update_reg_and_incrpc_wf with (c := Ir.Config.update_m c m').
    + inversion HWF.
      split; try (simpl; assumption).
      * simpl. eapply Ir.Memory.new_wf.
        eapply wf_m.
        eassumption.
        eassumption.
        eassumption.
      * intros.
        rewrite Ir.Config.get_val_update_m in HGETVAL.
        rewrite Ir.Config.m_update_m.
        apply wf_ptr in HGETVAL.
        eapply new_ptr_wf; eassumption.
      * intros. rewrite Ir.Config.m_update_m in *.
        destruct (bid =? l) eqn:HEQ.
        { (* the newly allocated block - all poison. *)
          rewrite Nat.eqb_eq in HEQ.
          subst.
          eapply Ir.Memory.get_new_c_poison in HBLK; try eassumption.
          rewrite HBLK in HBYTE.
          eapply poison_not_ptr_in_byte in HBYTE.
          eapply HBYTE in HBIT. inv HBIT.
        }
        { (* old blocks *)
          assert (bid < l).
          { eapply Ir.Memory.get_In_key in HBLK; try reflexivity.
            assert (wf':Ir.Memory.wf m').
            { eapply Ir.Memory.new_wf. eapply wf_m. eassumption.
              ss. eassumption. }
            inv wf'.
            eapply forallb_In with (i := bid) in wf_newid; try assumption.
            unfold Ir.Memory.new in HNEW.
            inv HNEW.
            simpl in *.
            rewrite Nat.ltb_lt in wf_newid.
            rewrite Nat.eqb_neq in HEQ.
            omega.
          }
          assert (HBLK':Some mb = Ir.Memory.get (Ir.Config.m c) bid).
          { unfold Ir.Memory.new in HNEW.
            inv HNEW.
            unfold Ir.Memory.get in HBLK.
            simpl in HBLK.
            rewrite Nat.eqb_sym in HEQ.
            rewrite HEQ in HBLK.
            unfold Ir.Memory.get.
            ss.
          }
          exploit wf_ptr_mem.
          eapply HBLK'. eassumption. eassumption.
          intros HH.
          eapply new_ptr_wf; eassumption.
        }
    + reflexivity.
    + intros. inv H0.
      split.
      { intros. inv H. split. apply Ir.MEMSZ_pos.
        unfold Ir.Memory.new in HNEW. inv HNEW.
        simpl. unfold Ir.Memory.get. simpl. rewrite Nat.eqb_refl.
        eexists. ss.
      }
      { intros. congruence. }
  - (* iicmp_eq, nondet *)
    eapply update_reg_and_incrpc_wf.
    eassumption.
    reflexivity.
    intros. congruence.
  - (* icmp_ule, nondet *)
    eapply update_reg_and_incrpc_wf. eassumption. reflexivity.
    intros. congruence.
Qed.

Lemma phi_step_wf:
  forall md c c' bef_bbid
         (HWF:Ir.Config.wf md c)
         (HSTEP:phi_step md bef_bbid c = Some c'),
    Ir.Config.wf md c'.
Proof.
  intros.
  unfold phi_step in HSTEP.
  des_ifs.
  eapply update_reg_and_incrpc_wf. eassumption.
  ss.
  intros.
  inv HWF.
  eapply wf_ptr. eassumption.
Qed.

Lemma phi_bigstep_wf:
  forall md c c' bef_bbid
         (HWF:Ir.Config.wf md c)
         (HSTEP:phi_bigstep md bef_bbid c c'),
    Ir.Config.wf md c'.
Proof.
  intros.
  induction HSTEP.
  { eapply phi_step_wf; eassumption. }
  { apply IHHSTEP in HWF.
    eapply phi_step_wf. eassumption. eassumption.
  }
Qed.

(* Theorem: small step preserves well-formedness of configuration. *)
Theorem sstep_wf:
  forall md c c' e
         (HWF:Ir.Config.wf md c)
         (HSTEP:sstep md c (sr_success e c')),
    Ir.Config.wf md c'.
Proof.
  intros.
  inv HSTEP.
  { eapply inst_step_wf. eassumption. eassumption. }
  { assert (Ir.Config.wf md st').
    { eapply t_step_wf. eassumption. eassumption. }
    eapply phi_bigstep_wf; eassumption.
  }
Qed.

(****************************************************
   Theorems regarding categorization of instruction.
 ****************************************************)

Lemma no_mem_change_after_incrpc:
  forall md c,
    Ir.Config.m c = Ir.Config.m (incrpc md c).
Proof.
  intros.
  unfold incrpc.
  destruct (Ir.Config.cur_fdef_pc md c).
  destruct p.
  { des_ifs. unfold Ir.Config.update_pc.
    des_ifs. }
  reflexivity.
Qed.

Lemma no_mem_change_after_update:
  forall md c r v,
    Ir.Config.m c = Ir.Config.m (update_reg_and_incrpc md c r v).
Proof.
  intros.
  unfold update_reg_and_incrpc.
  rewrite <- no_mem_change_after_incrpc.
  unfold Ir.Config.update_rval.
  des_ifs.
Qed.

(* Lemma: inst_det_step preserves well-formedness of configuration. *)
Ltac thats_it2 := apply no_mem_change_after_update.

Lemma changes_mem_spec_det:
  forall md c c' i e
         (HWF:Ir.Config.wf md c)
         (HCUR:Some i = Ir.Config.cur_inst md c)
         (HNOMEMCHG:changes_mem i = false)
         (HNEXT:Some (sr_success e c') = inst_det_step md c),
    c.(Ir.Config.m) = c'.(Ir.Config.m).
Proof.
    intros.
    unfold inst_det_step in HNEXT. (* ibinop. *)
    rewrite <- HCUR in HNEXT.
    destruct i as [r retty bopc op1 op2 (* ibinop *)
                  |r op1 retty (* ifreeze *)
                  |r opcond condty op1 op2 opty (* iselect *)
                  |r retty ptrty opptr1 opptr2 (* ipsub *)
                  |r retty opptr opidx inb (* igep *)
                  |r retty opptr (* iload *)
                  |valty opval opptr (* istore *)
                  |(* imalloc *)
                  |opptr (* ifree *)
                  |r opval retty (* ibitcast *)
                  |r opptr retty (* iptrtoint *)
                  |r opint retty (* iinttoptr *)
                  |opval (* ievent *)
                  |r opty op1 op2 (* iicmp_eq *)
                  |r opty op1 op2 (* iicmp_ule *)
                  ] eqn:HINST; try (inversion HNEXT; fail);
      try (inversion HNOMEMCHG; fail);
      try (des_ifs; thats_it2; fail).
    + (* ievent *)
      rename HNEXT into H2. simpl in H2.
      des_op c opval opv H2. des_inv opv H2.
      inversion H2. eapply no_mem_change_after_incrpc.
Qed.

(* Theorem: if changes_mem returns false, memory isn't
   changed after inst_step.
   This includes ptrtoint/inttoptr/psub/gep/icmp. *)
Theorem changes_mem_spec:
  forall md c i c' e
         (HWF:Ir.Config.wf md c)
         (HCUR:Some i = Ir.Config.cur_inst md c)
         (HNOMEMCHG:changes_mem i = false)
         (HSTEP:inst_step md c (sr_success e c')),
    c.(Ir.Config.m) = c'.(Ir.Config.m).
Proof.
  intros.
  inversion HSTEP.
  - eapply changes_mem_spec_det. eassumption.
    eassumption. assumption. eassumption.
  - (* freeze *)
    apply no_mem_change_after_update.
  - (* malloc, NULL *)
    apply no_mem_change_after_update.
  - (* malloc *)
    rewrite <- HCUR in HCUR0. inversion HCUR0. rewrite H3 in HINST.
    rewrite HINST in HNOMEMCHG. inversion HNOMEMCHG.
  - (* iicmp_eq, nondet *) apply no_mem_change_after_update.
  - (* icmp_ule, nondet *) apply no_mem_change_after_update.
Qed.

End SmallStep.

End Ir.