(*

  Copyright 2014 Cornell University

  This file is part of CFGV project.

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

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

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

  Website: http://nuprl.org/html/CFGVLFMTP2014/
  Authors: Abhishek Anand & Vincent Rahli

*)
Set Implicit Arguments.
Require Export AlphaEqProps.

Ltac EqDecRefl :=
  let dec:= fresh "dec" in
  let HH:= fresh "Hrefl" in
repeat match goal with
[pp : @eq ?T ?ta ?tb |- _ ] =>
  assert (Deq T) as dec by eauto with Deq;
  pose proof (UIPReflDeq dec _ pp) as HH;
  try rewrite HH; clear HH dec
end.

Ltac EqDec ta tb :=
  let dec:= fresh "dec" in
  let Heq:= fresh "Heq" ta tb in
  let Hneq:= fresh "Hneq" ta tb in
  let T := type of ta in
  assert (Deq T) as dec by eauto with Deq;
  destruct (dec ta tb) as [Heq| Hneq]; clear dec.

Definition tAlphaEqG {G} (sa sb : GSym G)
  (vc: VarSym G ) (ta : Term sa) (tb : Term sb):=
match (deqGSym sa sb) with
| left eqq => tAlphaEq vc (transport eqq ta) tb
| right eqq => False
end.

Definition pAlphaEqG {G} (sa sb : GSym G)
  (vc: VarSym G ) (ta : Pattern sa) (tb : Pattern sb):=
match (deqGSym sa sb) with
| left eqq => pAlphaEq vc (transport eqq ta) tb
| right eqq => False
end.

Ltac notAlpha :=
  let Halc := fresh "Halc" in
  let AlphaTac := introv Halc;
    inverts Halc;
    EqDecSndEq;
    subst;
    contradiction in
  let Hseq := fresh  "Hseq" in
  let Hseqd := fresh  "Hseqd" in
  try(AlphaTac);
  unfold  tAlphaEqG; unfold  pAlphaEqG;
  match goal with
  [|- context [deqGSym ?l ?l]] =>
    rewrite DeqTrue; simpl; AlphaTac
  | [|- context [deqGSym ?l ?r]] =>
    destruct (deqGSym l r) as [Hseq |?]; cpx;
    duplicate Hseq as Hseqd;
    inverts Hseq; cpx ; try subst; cpx
  end.

Lemma decideAbsT {G} (vc : VarSym G)
  (sa : GSym G) (ta: Term sa)
(Hdt : forall phnew : Term sa,
      tSize phnew <= tSize ta ->
      forall (sb : GSym G) (tb : Term sb),
     decidable (tAlphaEqG vc phnew tb))
(sb : GSym G) (tb: Term sa)
(la lb :(list (vType vc))) :
decidable (AlphaEqAbs (termAbs vc la ta) (termAbs vc lb tb)).
Proof.
  remember (beq_nat (length la) (length lb)) as blen.
  destruct blen;
    [
        applysym beq_nat_true in Heqblen
      |
        right ;
        applysym beq_nat_false in Heqblen;
        introv Hal; inverts Hal;
        EqDecSndEq; omega
    ].
  remember (GFreshVars (la++lb
              ++ tAllVars ta++tAllVars tb) la) as lvn.
  remember (tSwap ta (combine la lvn)) as phnew.
  pose proof (tcase
        (@swapPreservesSize G vc (combine la lvn)) _ ta) as Hs.
  specialize (Hdt (tSwap ta (combine la lvn))).
  rewrite Hs in Hdt.
  dimp Hdt. apply Hdt with
        (tb:= (tSwap tb (combine lb lvn))) in hyp.
  unfold tAlphaEqG in hyp.
  rewrite DeqTrue in hyp. allsimpl.
  clear Hs  Hdt.
  clear dependent phnew.
  destruct hyp as [? | Hnal];[left| right];
  pose proof (FreshDistVarsSpec
      (la ++ lb ++ tAllVars ta ++ tAllVars tb) la ) as XX;
  rewrite <- Heqlvn in XX;
  simpl in XX; repnd; dands;
  symmetry in XX.
  - apply alAbT with (lbnew:=lvn);
        cpx; try congruence;
    unfold tFresh; allsimpl; repeat(disjoint_reasoning).
  - introv Hal. apply Hnal. clear Hnal. clear Heqlvn.
    apply betterAbsTElim
    with (lvAvoid:= lvn) in Hal.
     allsimpl. exrepnd.
    apply tAlphaEqEquivariantRev with
    (sw := combine lvn lbnew).
    autorewrite with SwapAppR.
    unfold tFresh in Hal3.
    allsimpl. repnd.
    symmetry in XX.
    autorewrite with slow; try congruence;
    cpx; repeat (disjoint_reasoning);
    repeat match goal with
    [ H : disjoint _ _ |- _ ] => clear H
    | [ H : no_repeats _ _ |- _ ] => clear H
    end.
Defined.

Lemma decideAbsP {G} (vc : VarSym G)
  (sa : GSym G) (ta: Pattern sa)
(Hdt : forall phnew : Pattern sa,
      pSize phnew <= pSize ta ->
      forall (sb : GSym G) (tb : Pattern sb),
        decidable (pAlphaEqG vc phnew tb))
(sb : GSym G) (tb: Pattern sa)
(la lb :(list (vType vc))) :
decidable (AlphaEqAbs (patAbs vc la ta) (patAbs vc lb tb)).
Proof.
  remember (beq_nat (length la) (length lb)) as blen.
  destruct blen;
    [
        applysym beq_nat_true in Heqblen
      |
        right ;
        applysym beq_nat_false in Heqblen;
        introv Hal; inverts Hal;
        EqDecSndEq; omega
    ].
  remember (GFreshVars (la++lb
              ++ pAllVars ta++pAllVars tb) la) as lvn.
  remember (pSwap ta (combine la lvn)) as phnew.
  pose proof (pcase
        (@swapPreservesSize G vc (combine la lvn)) _ ta) as Hs.
  specialize (Hdt (pSwap ta (combine la lvn))).
  rewrite Hs in Hdt.
  dimp Hdt. apply Hdt with
        (tb:= (pSwap tb (combine lb lvn))) in hyp.
  unfold pAlphaEqG in hyp.
  rewrite DeqTrue in hyp. allsimpl.
  clear Hs  Hdt.
  clear dependent phnew.
  destruct hyp as [? | Hnal];[left| right];
  pose proof (FreshDistVarsSpec
      (la ++ lb ++ pAllVars ta ++ pAllVars tb) la ) as XX;
  rewrite <- Heqlvn in XX;
  simpl in XX; repnd; dands;
  symmetry in XX.
  - apply alAbP with (lbnew:=lvn);
        cpx; try congruence;
    unfold pFresh; allsimpl; repeat(disjoint_reasoning).
  - introv Hal. apply Hnal. clear Hnal. clear Heqlvn.
    apply betterAbsPElim
    with (lvAvoid:= lvn) in Hal.
     allsimpl. exrepnd.
    apply pAlphaEqEquivariantRev with
    (sw := combine lvn lbnew).
    autorewrite with SwapAppR.
    unfold pFresh in Hal3.
    allsimpl. repnd.
    symmetry in XX.
    autorewrite with slow; try congruence;
    cpx; repeat (disjoint_reasoning);
    repeat match goal with
    [ H : disjoint _ _ |- _ ] => clear H
    | [ H : no_repeats _ _ |- _ ] => clear H
    end.
Defined.

Definition diffVarClasses{G} {sa : GSym G} (ta: Term sa)
            {sb: GSym G} (tb : Term sb) :=
match (ta, tb) with
| (vleaf vca va, vleaf vcb vb)
    => match (DeqVarSym vca vcb) with
      |left _ => False
      |right _ => True
      end
| _ => False
end.

Definition diffPVarClasses{G}
        {sa : GSym G} (ta: Pattern sa)
        {sb: GSym G} (tb : Pattern sb) :=
match (ta, tb) with
| (pvleaf vca va, pvleaf vcb vb)
    => match (DeqVarSym vca vcb) with
      |left _ => False
      |right _ => True
      end
| _ => False
end.

Definition diffTProdsNode {G} {sa : GSym G} (ta: Term sa)
            {sb: GSym G} (tb : Term sb) :=
match (ta, tb) with
| (tnode pa va, tnode pb vb)
    => match (deqPr G pa pb) with
      |left _ => False
      |right _ => True
      end
| _ => False
end.

Definition diffPProdsNode {G} {sa : GSym G}
        (ta: Pattern sa)
            {sb: GSym G} (tb : Pattern sb) :=
match (ta, tb) with
| (pnode pa va, pnode pb vb)
    => match (deqPPr G pa pb) with
      |left _ => False
      |right _ => True
      end
| _ => False
end.

Definition diffEmbedNode {G} {sa : GSym G}
        (ta: Pattern sa)
            {sb: GSym G} (tb : Pattern sb) :=
match (ta, tb) with
| (embed pa va, embed pb vb)
    => match (deqEm G pa pb) with
      |left _ => False
      |right _ => True
      end
| _ => False
end.

Definition isVLeaf {G} {sa : GSym G} (ta: Term sa) :=
match ta with
| vleaf vca va
    => True
| _ => False
end.

Definition isPNode {G} {sa : GSym G}
  (ta: Pattern sa) :=
match ta with
| pnode vca va
    => True
| _ => False
end.

Definition isEmbed {G} {sa : GSym G}
  (ta: Pattern sa) :=
match ta with
| embed vca va
    => True
| _ => False
end.

Lemma alphaEqDecidable : forall {G} (vc : VarSym G),
     (  (forall (sa : GSym G) (ta: Term sa)
            (sb: GSym G) (tb : Term sb),
           decidable (tAlphaEqG vc ta tb))
         *
        (forall (sa : GSym G) (ta: Pattern sa)
            (sb: GSym G) (tb : Pattern sb),
            decidable (pAlphaEqG vc ta tb))
         *
        (forall (l : MixtureParam) (ma mb : Mixture l)
        (lbva : list (list (vType vc)))
        (lbvb : list (list (vType vc))),
           decidable
              (lAlphaEqAbs (MakeAbstractions vc ma lbva)
                           (MakeAbstractions vc mb lbvb)))).
Proof.
  intros.
  GInductionS; introns Hyp; intros;  allsimpl.
- Case "tleaf".
  destruct tb;[ | right; notAlpha | right; notAlpha];[].

  EqDec T T0; [| right; notAlpha]; subst.
  EqDec t t0; [left|right]; subst;
  unfold tAlphaEqG; try rewrite DeqTrue; allsimpl;
  eauto with Alpha;[]; notAlpha.

- Case "vleaf".
  destruct tb; [right; notAlpha | |].
  + EqDec vc0 vc1;[| right]; subst; try EqDecRefl; simpl.
    * EqDec v v0; [left|right]; subst; unfolds_base;
      try rewrite DeqTrue;
      eauto with Alpha.
      notAlpha.

    * notAlpha.
      revert Hseqd0.
      remember (vleaf vc0 v) as vvl.
      remember (vleaf vc1 v0) as vvr.
      assert ( diffVarClasses vvl vvr) as Hdd
       by (subst; unfold diffVarClasses;
          cases_if; cpx).
      clear Heqvvr Heqvvl.
      remember (vSubstType G vc0).
      remember (vSubstType G vc1).
      generalize dependent vvl.
      generalize dependent vvr.
      rewrite H0.
      intros. allsimpl.
      EqDecRefl. simpl.
      clear dependent t.
      clear Hneqvc0vc1.
      clear v0 v vc0 Heqt0 Hseqd0 vc1. introv Hc; inverts Hc;
      EqDecSndEq; subst vvl; subst vvr; repnud Hdd; allsimpl; cpx.
      rewrite DeqTrue in Hdd.
      trivial.
  + right. notAlpha.
    introv Hal. inverts Hal.
    EqDecSndEq.
    GC. clear H6. clear X. clear H0.
    generalize dependent H3.
    remember (vleaf vc0 v) as xx.
    assert (isVLeaf xx) as Hxx by (subst;simpl; auto).
    clear Heqxx.
    generalize dependent xx.
    rewrite Hseqd0.
    allsimpl.
    introv Hisv Heq.
    inverts Heq.
    cpx.
- Case "tnode".
  destruct tb; [right; notAlpha;fail | |].

    right. notAlpha;
    remember (vleaf vc0 v) as xx.
    assert (isVLeaf xx) as Hxx by (subst;simpl; auto).
    clear Heqxx.
    generalize dependent xx.
    rewrite <- Hseqd0.
    allsimpl.
    introv Hisv Heq.
    inverts Heq. EqDecSndEq. subst xx.
    cpx; fail.

    EqDec p p0;[| right].
    Focus 2. notAlpha.
    introv Hal.

    remember (tnode p m) as vvl.
    remember (tnode p0 m0) as vvr.
    assert (diffTProdsNode vvl vvr) as Hdd
     by (subst; unfold diffTProdsNode;
        cases_if; cpx).
    clear Heqvvr Heqvvl.
    remember (tpLhs G p).
    remember (tpLhs G p0).
    generalize dependent vvl.
    generalize dependent vvr.
    generalize Hseqd0.
    rewrite H0.
    introv. allsimpl.
    EqDecRefl. simpl.
    clear dependent t.
    introv Hta Hdd.
    clear Hseqd1 Heqt0  Hneqpp0 m0 Hyp m.
    inverts Hta;
    EqDecSndEq;
    subst vvl; subst vvr; repnud Hdd; allsimpl; cpx.
    rewrite DeqTrue in Hdd;
    trivial; fail.

  (* back to the real business *)
  subst p0. unfold tAlphaEqG.
  rewrite DeqTrue.
  simpl. rename m0 into mb.
  destruct (Hyp mb (allBndngVars vc p m) (allBndngVars vc p mb)) as
    [Hleq | Hnleq];[left; constructor;auto | right; notAlpha].

- Case "ptleaf".
  destruct tb;[ | right; notAlpha
                | right; notAlpha
                | right; notAlpha]; [].

  EqDec T T0; [| right; notAlpha]; subst;[].
  EqDec t t0; [left|right]; subst;
  unfold pAlphaEqG; try rewrite DeqTrue; allsimpl;
  eauto with Alpha;[]; notAlpha.

- Case "pvleaf".
  destruct tb;[ right; notAlpha |
                | right; notAlpha
                | right; notAlpha]; [].
  EqDec vc0 vc1;[ left;subst; try EqDecRefl; simpl;
                  unfold pAlphaEqG; rewrite DeqTrue
                  ; constructor; fail
                | right; notAlpha].

- Case "pembed".
  destruct tb;[ right; notAlpha
                | right; notAlpha |
                | right; notAlpha].

  Focus 2.
    introv Hal. inverts Hal.
    EqDecSndEq.
    GC. clear H6. clear X. clear H0.
    generalize dependent H3.
    remember (embed p t) as xx.
    assert (isEmbed xx) as Hxx by (subst;simpl; auto).
    clear Heqxx.
    generalize dependent xx.
    rewrite Hseqd0.
    allsimpl.
    introv Hisv Heq.
    inverts Heq.
    cpx; fail.

  EqDec p p0;[ subst p0; unfold pAlphaEqG; rewrite DeqTrue
               | right; notAlpha].
  Focus 2.
    remember (embed p t) as vvl.
    remember (embed p0 t0) as vvr.
    assert (diffEmbedNode vvl vvr) as Hdd
     by (subst; unfold diffEmbedNode;
        cases_if; cpx).
    clear Heqvvr Heqvvl.
    remember (epLhs G p).
    remember (epLhs G p0).
    generalize dependent vvl.
    generalize dependent vvr.
    generalize Hseqd0.
    rewrite H0.
    introv. allsimpl.
    EqDecRefl. simpl.
    clear dependent p.
    introv Hta Hdd.
    clear H0 Hseqd1 Hseqd0 Heqp2 p1 t0 p0.
    inverts Hdd;
    EqDecSndEq;
    subst vvl; subst vvr; repnud Hta; allsimpl; cpx.
    rewrite DeqTrue in Hta;
    trivial; fail.

  (* back to the real business *)
  simpl.
  pose proof (Hyp _ t0) as Hd.
  unfold tAlphaEqG in Hd.
  rewrite DeqTrue in Hd.
  simpl in Hd.
  destruct Hd;[left; constructor; trivial | right; notAlpha].

- Case "pnode".
  destruct tb;[ right; notAlpha
                | right; notAlpha
                | right; notAlpha| ].

    introv Hal. inverts Hal.
    EqDecSndEq.
    GC. clear H6. clear X. clear H0.
    generalize dependent H3.
    remember (pnode p m) as xx.
    assert (isPNode xx) as Hxx by (subst;simpl; auto).
    clear Heqxx.
    generalize dependent xx.
    rewrite Hseqd0.
    allsimpl.
    introv Hisv Heq.
    inverts Heq.
    cpx; fail.

    EqDec p p0;[| right].
    Focus 2. notAlpha.
    remember (pnode p m) as vvl.
    remember (pnode p0 m0) as vvr.
    assert (diffPProdsNode vvl vvr) as Hdd
     by (subst; unfold diffPProdsNode;
        cases_if; cpx).
    clear Heqvvr Heqvvl.
    remember (ppLhs G p).
    remember (ppLhs G p0).
    generalize dependent vvl.
    generalize dependent vvr.
    generalize Hseqd0.
    rewrite H0.
    introv. allsimpl.
    EqDecRefl. simpl.
    clear dependent p.
    introv Hta Hdd.
    clear H0 Hseqd1 Hseqd0 Heqp2 p1 m0 p0.
    inverts Hdd;
    EqDecSndEq;
    subst vvl; subst vvr; repnud Hta; allsimpl; cpx.
    rewrite DeqTrue in Hta;
    trivial; fail.

    (* back to the real business *)
  subst p0. unfold pAlphaEqG.
  rewrite DeqTrue.
  simpl. rename m0 into mb.
  destruct (Hyp mb [] []) as
  [Hleq | Hnleq];[left; constructor;auto | right; notAlpha].

- Case "mnil".
  dependent inversion mb. simpl. left.
  constructor.

- Case "mtcons".
  dependent inversion mb. simpl.
  subst.
  remember (lhead lbva) as lha.
  remember (lhead lbvb) as lhb.
  remember (tail lbva) as lta.
  remember (tail lbvb) as ltb.
  clear Heqlha Heqlhb Heqlta Heqltb.
  specialize (Hyp0 m lta ltb).
  destruct (Hyp0); [| right ; notAlpha].
  destruct (decideAbsT vc ph Hyp h t lha lhb);
    [left; constructor; auto| right; notAlpha].

- Case "mpcons".
  dependent inversion mb. simpl.
  subst.
  remember (lhead lbva) as lha.
  remember (lhead lbvb) as lhb.
  remember (tail lbva) as lta.
  remember (tail lbvb) as ltb.
  clear Heqlha Heqlhb Heqlta Heqltb.
  specialize (Hyp0 m lta ltb).
  destruct (Hyp0); [| right ; notAlpha].
  destruct (decideAbsP vc ph Hyp h p lha lhb);
    [left; constructor; auto| right; notAlpha].
Defined.

Lemma tAlphaEqDecidable : forall {G} (vc : VarSym G)
     {s : GSym G} (ta: Term s) (tb : Term s),
          decidable (tAlphaEqG vc ta tb).
Proof.
  intros. apply (tcase (alphaEqDecidable vc)).
Defined.

(** need (cnstructive) finiteness of [VarSym G] for [tAlphaEqual]
    to be decidable *)


Require Import Bool List String Peano_dec.
Require Import Common FMap IndexSupport HVector Syntax Topology Semantics SemFacts StepM.
Require Import Invariant TrsInv Simulation Serial SerialFacts.
Require Import RqRsLang RqRsCorrect.

Require Import Ex.Spec Ex.SpecInds Ex.Template.
Require Import Ex.Mesi Ex.Mesi.Mesi Ex.Mesi.MesiTopo.
Require Import Ex.Mesi.MesiInvOk.

Set Implicit Arguments.

Import PropMonadNotations.
Import CaseNotations.

Local Open Scope list.
Local Open Scope hvec.
Local Open Scope fmap.

Lemma InvExcl_excl_invalid:
  forall topo cifc st (He: InvExcl topo cifc st) msgs eidx eost,
    st_msgs st = msgs ->
    (st_oss st)@[eidx] = Some eost ->
    NoRsI eidx msgs ->
    mesiE <= eost#[status] ->
    forall oidx ost,
      eidx <> oidx ->
      (st_oss st)@[oidx] = Some ost ->
      ObjInvalid oidx ost msgs.
Proof.
  intros; subst.
  specialize (He eidx).
  disc_rule_conds_ex.
  red in H.
  unfold ObjExcl0 in H; simpl in H.
  specialize (H (conj H2 H1)); dest.
  specialize (H _ H3).
  rewrite H4 in H; auto.
Qed.

Section Sim.
  Variable (tr: tree).
  Hypothesis (Htr: tr <> Node nil).

  Let topo := fst (tree2Topo tr 0).
  Let cifc := snd (tree2Topo tr 0).
  Let impl := Mesi.impl Htr.

  Local Definition spec :=
    @SpecInds.spec (c_l1_indices cifc) (tree2Topo_l1_NoPrefix tr 0).

  Existing Instance Mesi.ImplOStateIfc.

  (** NOTE: simulation only states about coherent values.
   * Exclusiveness is stated and proven as an invariant. *)

  Section ObjCoh.
    Variables (cv: nat)
              (cidx: IdxT)
              (cost: OState)
              (msgs: MessagePool Msg).

    Definition cohMsgs: list (MSig * (Id Msg -> Prop)) :=
      (| (downTo cidx, (MRs, mesiRsS)): fun idm => (valOf idm).(msg_value) = cv
       | (downTo cidx, (MRs, mesiRsE)): fun idm => (valOf idm).(msg_value) = cv
       | (rsUpFrom cidx, (MRs, mesiDownRsS)): fun idm => (valOf idm).(msg_value) = cv)%cases.

    Definition MsgCoh := MsgP cohMsgs.
    Definition MsgsCoh := MsgsP cohMsgs msgs.

    Definition ObjCoh :=
      ImplOStateMESI cidx cost msgs cv /\ MsgsCoh.

  End ObjCoh.

  Section ObjCohFacts.

    Lemma ObjInvalid_ObjCoh:
      forall oidx orq ost msgs
             (Hrsi: RsDownConflicts oidx orq msgs),
        ObjInvalid oidx ost msgs ->
        forall cv, ObjCoh cv oidx ost msgs.
    Proof.
      unfold ObjInvalid, ObjCoh; intros.
      destruct H.
      - red in H; dest; repeat ssplit.
        + red; intros; solve_mesi.
        + do 2 red; intros.
          specialize (H1 _ H2); red in H1.
          red; unfold cohMsgs, map, caseDec, fst in *.
          repeat (find_if_inside; [exfalso; auto; fail|]).
          destruct (sig_dec _ (_, (MRs, mesiRsM))); [exfalso; auto|].
          repeat (find_if_inside; [exfalso; auto; fail|]).
          auto.

      - repeat ssplit.
        + red; intros.
          exfalso; eapply NoRsI_MsgExistsSig_InvRs_false; eauto.
        + destruct H as [idm [? ?]].
          red; intros.
          specialize (Hrsi idm ltac:(rewrite H0; reflexivity)
                                      ltac:(rewrite H0; reflexivity) H); dest.
          red; intros.
          red; unfold cohMsgs, map, caseDec, fst.
          repeat find_if_inside; [..|auto].
          * exfalso; eapply (H3 idm0); try rewrite H0; try rewrite e; auto.
            destruct idm as [midx msg], idm0 as [midx0 msg0].
            simpl in *; inv H0; inv e.
            intro; subst; rewrite H11 in H12; discriminate.
          * exfalso; eapply (H3 idm0); try rewrite H0; try rewrite e; auto.
            destruct idm as [midx msg], idm0 as [midx0 msg0].
            simpl in *; inv H0; inv e.
            intro; subst; rewrite H11 in H12; discriminate.
          * exfalso; eapply H6; try rewrite e; eauto.
    Qed.

    Lemma NoCohMsgs_MsgsCoh:
      forall oidx msgs,
        NoCohMsgs oidx msgs ->
        forall cv, MsgsCoh cv oidx msgs.
    Proof.
      intros.
      do 2 red; intros.
      specialize (H _ H0); red in H.
      red; unfold cohMsgs, map, caseDec, fst in *.
      repeat (find_if_inside; [exfalso; auto; fail|]).
      destruct (sig_dec _ (_, (MRs, mesiRsM))); [exfalso; auto|].
      repeat (find_if_inside; [exfalso; auto; fail|]).
      auto.
    Qed.

    Lemma ObjExcl0_ObjCoh:
      forall oidx ost oss msgs,
        InvObjExcl0 oidx ost oss msgs ->
        ObjExcl0 oidx ost msgs ->
        ObjCoh ost#[val] oidx ost msgs.
    Proof.
      intros.
      specialize (H H0); dest.
      repeat split.
      apply NoCohMsgs_MsgsCoh; assumption.
    Qed.

    Lemma MsgsCoh_enqMP:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall midx msg,
          MsgCoh cv cidx (midx, msg) ->
          MsgsCoh cv cidx (enqMP midx msg msgs).
    Proof.
      intros; apply MsgsP_enqMP; auto.
    Qed.

    Lemma MsgsCoh_other_midx_enqMP:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall midx msg,
          ~ In midx [rqUpFrom cidx; rsUpFrom cidx; downTo cidx] ->
          MsgsCoh cv cidx (enqMP midx msg msgs).
    Proof.
      intros.
      apply MsgsP_other_midx_enqMP; auto.
      intro Hx; elim H0; dest_in; simpl; tauto.
    Qed.

    Lemma MsgsCoh_other_midx_enqMsgs:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall eins,
          DisjList (idsOf eins) [rqUpFrom cidx; rsUpFrom cidx; downTo cidx] ->
          MsgsCoh cv cidx (enqMsgs eins msgs).
    Proof.
      intros.
      apply MsgsP_other_midx_enqMsgs; auto.
      simpl.
      eapply DisjList_comm, DisjList_SubList;
        [|apply DisjList_comm; eassumption].
      solve_SubList.
    Qed.

    Lemma MsgsCoh_other_msg_id_enqMP:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall midx msg,
          ~ In (msg_id msg) [mesiRsS; mesiRsE; mesiDownRsS] ->
          MsgsCoh cv cidx (enqMP midx msg msgs).
    Proof.
      intros; apply MsgsP_other_msg_id_enqMP; auto.
    Qed.

    Lemma MsgsCoh_other_msg_id_enqMsgs:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall eins,
          DisjList (map (fun idm => msg_id (valOf idm)) eins)
                   [mesiRsS; mesiRsE; mesiDownRsS] ->
          MsgsCoh cv cidx (enqMsgs eins msgs).
    Proof.
      intros; apply MsgsP_other_msg_id_enqMsgs; auto.
    Qed.

    Lemma MsgsCoh_deqMP:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall midx,
          MsgsCoh cv cidx (deqMP midx msgs).
    Proof.
      intros; apply MsgsP_deqMP; auto.
    Qed.

    Lemma MsgsCoh_deqMsgs:
      forall cv cidx msgs,
        MsgsCoh cv cidx msgs ->
        forall minds,
          MsgsCoh cv cidx (deqMsgs minds msgs).
    Proof.
      intros; apply MsgsP_deqMsgs; auto.
    Qed.

  End ObjCohFacts.

  Definition ImplStateCoh (cv: nat) (st: State): Prop :=
    Forall (fun oidx =>
              ost <-- (st_oss st)@[oidx];
                _ <-- (st_orqs st)@[oidx];
                ObjCoh cv oidx ost (st_msgs st))
           (c_li_indices cifc ++ c_l1_indices cifc).

  Definition SpecStateCoh (cv: nat) (st: @State SpecInds.NatDecValue SpecOStateIfc): Prop :=
    sost <-- (st_oss st)@[specIdx];
      sorq <-- (st_orqs st)@[specIdx];
      sost#[specValueIdx] = cv.

  Inductive SimState: State -> @State SpecInds.NatDecValue SpecOStateIfc -> Prop :=
  | SimStateIntro:
      forall cv ist sst,
        SpecStateCoh cv sst ->
        ImplStateCoh cv ist ->
        SimState ist sst.

  Definition SimMESI (ist: State) (sst: @State SpecInds.NatDecValue SpecOStateIfc): Prop :=
    SimState ist sst /\
    SimExtMP (c_l1_indices cifc) ist.(st_msgs) ist.(st_orqs) sst.(st_msgs).

  Hint Unfold ObjCoh ImplStateCoh: RuleConds.

  Lemma mesi_sim_init:
    SimMESI (initsOf impl) (initsOf spec).
  Proof.
    split.
    - apply SimStateIntro with (cv:= 0).
      + reflexivity.
      + apply Forall_forall; intros oidx ?.
        subst cifc; rewrite c_li_indices_head_rootOf in H by assumption.
        simpl in H; icase oidx.
        * simpl; rewrite implOStatesInit_value_root by assumption.
          unfold implORqsInit; simpl.
          rewrite initORqs_value
            by (rewrite c_li_indices_head_rootOf by assumption; left; reflexivity).
          simpl; repeat split.
          do 3 red; intros.
          do 2 red in H0; dest_in.
        * simpl; rewrite implOStatesInit_value_non_root by assumption.
          unfold implORqsInit; simpl.
          rewrite initORqs_value
            by (rewrite c_li_indices_head_rootOf by assumption; right; assumption).
          simpl; repeat split.
          do 3 red; intros.
          do 2 red in H0; dest_in.
    - red; apply Forall_forall; intros oidx ?.
      repeat split.
      simpl; unfold implORqsInit.
      rewrite initORqs_value; [|apply in_or_app; auto].
      simpl; mred.
  Qed.

  Lemma mesi_sim_silent:
    forall ist sst1,
      SimMESI ist sst1 ->
      exists slbl sst2,
        getLabel RlblEmpty = getLabel slbl /\
        step_m spec sst1 slbl sst2 /\ SimMESI ist sst2.
  Proof.
    simpl; intros.
    exists RlblEmpty; eexists.
    repeat ssplit; eauto.
    constructor.
  Qed.

  Lemma mesi_sim_ext_in:
    forall oss orqs msgs sst1,
      SimMESI {| st_oss := oss; st_orqs := orqs; st_msgs := msgs |} sst1 ->
      forall eins,
        eins <> nil -> ValidMsgsExtIn impl eins ->
        exists slbl sst2,
          getLabel (RlblIns eins) = getLabel slbl /\
          step_m spec sst1 slbl sst2 /\
          SimMESI {| st_oss := oss;
                     st_orqs := orqs;
                     st_msgs := enqMsgs eins msgs |} sst2.
  Proof.
    destruct sst1 as [soss1 sorqs1 smsgs1]; simpl; intros.
    red in H; simpl in *; dest.
    exists (RlblIns eins); eexists.
    repeat ssplit.
    + reflexivity.
    + eapply SmIns; eauto.
      destruct H1; split; [|assumption].
      simpl in *; rewrite c_merqs_l1_rqUpFrom in H1.
      assumption.
    + split.
      * inv H.
        apply SimStateIntro with (cv:= cv); [assumption|].
        red in H4; simpl in H4.
        apply Forall_forall; intros oidx ?.
        rewrite Forall_forall in H4; specialize (H4 _ H).
        disc_rule_conds_ex.
        repeat split.
        { intros; apply H4; auto.
          eapply MsgsP_enqMsgs_inv; eauto.
        }
        { apply MsgsCoh_other_midx_enqMsgs; [assumption|].
          destruct H1; simpl in H1.
          eapply DisjList_SubList; [eassumption|].
          apply DisjList_comm, DisjList_SubList with (l1:= c_minds (snd (tree2Topo tr 0))).
          { apply tree2Topo_obj_chns_minds_SubList; auto. }
          { apply tree2Topo_minds_merqs_disj. }
        }
      * apply SimExtMP_enqMsgs; auto.
        apply H1.
  Qed.

  Lemma mesi_sim_ext_out:
    forall oss orqs msgs sst1,
      SimMESI {| st_oss := oss; st_orqs := orqs; st_msgs := msgs |} sst1 ->
      forall eouts: list (Id Msg),
        eouts <> nil ->
        Forall (FirstMPI msgs) eouts ->
        ValidMsgsExtOut impl eouts ->
        exists slbl sst2,
          getLabel (RlblOuts eouts) = getLabel slbl /\
          step_m spec sst1 slbl sst2 /\
          SimMESI {| st_oss := oss;
                     st_orqs := orqs;
                     st_msgs := deqMsgs (idsOf eouts) msgs |} sst2.
  Proof.
    destruct sst1 as [soss1 sorqs1 smsgs1]; simpl; intros.
    red in H; simpl in *; dest.
    destruct H2; unfold impl in H2; simpl in H2.
    exists (RlblOuts eouts); eexists.
    repeat ssplit.
    - reflexivity.
    - rewrite c_merss_l1_downTo in H2.
      eapply SmOuts with (msgs0:= smsgs1); eauto.
      + eapply SimExtMP_ext_outs_FirstMPI; eauto.
      + split; assumption.
    - split.
      + inv H.
        apply SimStateIntro with (cv:= cv); [assumption|].
        red in H6; simpl in H6.
        apply Forall_forall; intros oidx ?.
        rewrite Forall_forall in H6; specialize (H6 _ H).
        disc_rule_conds_ex.
        repeat split.
        { intros; apply H6; auto.
          eapply MsgsP_other_midx_deqMsgs_inv; [eassumption|].
          simpl.
          apply DisjList_comm, DisjList_SubList with (l1:= c_minds (snd (tree2Topo tr 0))).
          { eapply SubList_trans;
              [|apply tree2Topo_obj_chns_minds_SubList; eauto].
            solve_SubList.
          }
          { eapply DisjList_comm, DisjList_SubList; [eassumption|].
            apply DisjList_comm, tree2Topo_minds_merss_disj.
          }
        }
        { apply MsgsCoh_deqMsgs; assumption. }
      + rewrite c_merss_l1_downTo in H2.
        apply SimExtMP_ext_outs_deqMsgs; auto.
  Qed.

  Ltac disc_MsgsCoh_by_FirstMP Hd Hf :=
    specialize (Hd _ (FirstMP_InMP Hf));
    red in Hd;
    cbv [map cohMsgs] in Hd;
    cbv [sigOf idOf valOf fst snd] in Hd;
    match type of Hf with
    | FirstMPI _ (_, ?msg) =>
      match goal with
      | [H1: msg_id ?msg = _, H2: msg_type ?msg = _ |- _] =>
        rewrite H1, H2 in Hd
      end
    end;
    disc_caseDec Hd.

  Ltac disc_rule_custom ::=
    repeat
      match goal with
      (* get simulation propositions for the current impl. state *)
      | [Hf: Forall _ (c_li_indices ?cifc ++ c_l1_indices ?cifc),
             Hin: In ?oidx (c_li_indices ?cifc)
         |- context[SimMESI {| st_oss := _ +[?oidx <- _] |} _]] =>
        rewrite Forall_forall in Hf;
        pose proof (Hf _ (in_or_app _ _ _ (or_introl Hin)))
      | [Hf: Forall _ (c_li_indices ?cifc ++ c_l1_indices ?cifc),
             Hin: In ?oidx (tl (c_li_indices ?cifc))
         |- context[SimMESI {| st_oss := _ +[?oidx <- _] |} _]] =>
        rewrite Forall_forall in Hf;
        pose proof (Hf _ (in_or_app _ _ _ (or_introl (tl_In _ _ Hin))))
      | [Hf: Forall _ (c_li_indices ?cifc ++ c_l1_indices ?cifc),
             Hin: In ?oidx (c_l1_indices ?cifc)
         |- context[SimMESI {| st_oss := _ +[?oidx <- _] |} _]] =>
        rewrite Forall_forall in Hf;
        pose proof (Hf _ (in_or_app _ _ _ (or_intror Hin)))
      (* rewrite a coherent value *)
      | [H: fst ?ost = fst _ |- context[fst ?ost] ] => rewrite H in *
      (* rewrite inputs/outputs message ids *)
      | [H: msg_id ?rmsg = _ |- context[msg_id ?rmsg] ] => rewrite H
      end.

  (*! Prove [SimMESI] for internal steps *)

  Ltac solve_ImplStateCoh :=
    idtac.

  Ltac solve_SpecStateCoh :=
    eapply SimStateIntro; [solve_rule_conds_ex|].

  Ltac solve_sim_mesi_ext_mp :=
    red; simpl; split; [|solve_sim_ext_mp].

  Ltac solve_sim_mesi :=
    solve_sim_mesi_ext_mp;
    solve_SpecStateCoh;
    solve_ImplStateCoh.

  Ltac solve_ImplOStateMESI :=
    intros;
    try match goal with
        | [H: context [invalidate ?st] |- _] =>
          pose proof (invalidate_sound st)
        | |- context [invalidate ?st] =>
          pose proof (invalidate_sound st)
        end;
    auto; try solve_mesi; (* check if the goal is solved automatically *)
    match goal with
    | [H: _ -> ?P |- ?P] => apply H; auto
    | [H: _ -> _ -> ?P |- ?P] => apply H; auto
    end;
    try match goal with
        | H:MsgsP ?P _ |- MsgsP ?P _ => disc_MsgsP H; assumption
        end;
    try solve_mesi.

  Ltac solve_MsgsCoh :=
    repeat
      (try match goal with
           | |- MsgsCoh _ _ (enqMP _ _ _) =>
             apply MsgsCoh_other_midx_enqMP;
             [|solve_chn_not_in; auto; fail]
           | |- MsgsCoh _ _ (enqMP _ _ _) =>
             apply MsgsCoh_other_msg_id_enqMP; [|solve_not_in]
           | |- MsgsCoh _ _ (enqMP _ _ _) =>
             apply MsgsCoh_enqMP;
             [|do 2 red; cbv [map cohMsgs]; solve_caseDec; reflexivity]
           | |- MsgsCoh _ _ (enqMsgs _ _) =>
             apply MsgsCoh_other_msg_id_enqMsgs; [|solve_DisjList_ex idx_dec]
           | |- MsgsCoh _ _ (deqMP _ _) => apply MsgsCoh_deqMP
           | |- MsgsCoh _ _ (deqMsgs _ _) => apply MsgsCoh_deqMsgs
           end; try eassumption).

  Ltac derive_input_msg_coherent :=
    match goal with
    | [Hcoh: MsgsCoh ?cv _ _, Hfmp: FirstMPI _ (_, ?cmsg) |- _] =>
      let Ha := fresh "H" in
      assert (msg_value cmsg = cv)
        as Ha by (disc_MsgsCoh_by_FirstMP Hcoh Hfmp; assumption);
      rewrite Ha in *
    end.

  Ltac derive_obj_coherent oidx :=
    match goal with
    | [Hcoh: _ -> _ -> fst ?ost = ?cv, Host: ?oss@[oidx] = Some ?ost |- _] =>
      let Ha := fresh "H" in
      assert (fst ost = cv) as Ha by (apply Hcoh; auto; solve_mesi);
      rewrite Ha in *
    end.

  Ltac derive_coherence_of oidx :=
    match goal with
    | [Hf: forall _, In _ ?l -> _, He: In oidx ?l |- _] =>
      pose proof (Hf _ He); disc_rule_conds_ex
    end.

  Theorem mesi_sim_ok:
    InvSim step_m step_m (MesiInvOk.InvForSim tr) SimMESI impl spec.
  Proof. (* SKIP_PROOF_ON
    red; intros.

    pose proof (footprints_ok
                  (mesi_GoodORqsInit Htr)
                  (mesi_GoodRqRsSys Htr) H) as Hftinv.
    pose proof (upLockInv_ok
                  (mesi_GoodORqsInit Htr)
                  (mesi_GoodRqRsSys Htr)
                  (mesi_RqRsDTree Htr) H) as Hpulinv.
    pose proof (upLockInv_ok
                  (mesi_GoodORqsInit Htr)
                  (mesi_GoodRqRsSys Htr)
                  (mesi_RqRsDTree Htr)
                  (reachable_steps H (steps_singleton H2))) as Hnulinv.
    pose proof (mesi_RootChnInv_ok H) as Hprc.
    pose proof (mesi_MsgConflictsInv
                  (@mesi_RootChnInv_ok _ Htr) H) as Hpmcf.
    pose proof (mesi_MsgConflictsInv
                  (@mesi_RootChnInv_ok _ Htr)
                  (reachable_steps H (steps_singleton H2))) as Hnmcf.

    inv H2;
      [apply mesi_sim_silent; assumption
      |apply mesi_sim_ext_in; assumption
      |apply mesi_sim_ext_out; assumption
      |].

    destruct sst1 as [soss1 sorqs1 smsgs1].
    destruct H0; simpl in H0, H2; simpl.
    inv H0.
    red in H15; simpl in H15.
    red in H6; simpl in H6.
    destruct (soss1@[specIdx]) as [sost|] eqn:Hsost; simpl in *; [|exfalso; auto].
    destruct (sorqs1@[specIdx]) as [sorq|] eqn:Hsorq; simpl in *; [|exfalso; auto].
    subst.
    simpl in H4; destruct H4; [subst|apply in_app_or in H0; destruct H0].

    - (*! Cases for the main memory *)
      Ltac solve_ImplStateCoh_mem_me :=
        disc_rule_conds_ex;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac solve_ImplStateCoh_mem_others lidx :=
        match goal with
        | [Hf: forall _, In _ ?l -> _, He: In lidx ?l |- _] =>
          specialize (Hf _ He); disc_rule_conds_ex
        end;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac case_ImplStateCoh_mem_me_others lidx :=
        match goal with
        | |- ImplStateCoh _ {| st_oss := _ +[?oidx <- _] |} =>
          red; simpl;
          apply Forall_forall;
          intros lidx ?; destruct (idx_dec lidx oidx); subst
        end.

      Ltac solve_ImplStateCoh ::=
        let lidx := fresh "lidx" in
        case_ImplStateCoh_mem_me_others lidx;
        [solve_ImplStateCoh_mem_me|solve_ImplStateCoh_mem_others lidx].

      (** Derive some properties of the root *)
      pose proof (tree2Topo_TreeTopoNode tr 0) as Htn.

      assert (In (rootOf (fst (tree2Topo tr 0))) (c_li_indices (snd (tree2Topo tr 0)))).
      { rewrite c_li_indices_head_rootOf by assumption.
        left; reflexivity.
      }

      assert (~ In (rootOf (fst (tree2Topo tr 0))) (c_l1_indices (snd (tree2Topo tr 0)))).
      { pose proof (tree2Topo_WfCIfc tr 0) as [? _].
        apply (DisjList_NoDup idx_dec) in H4.
        eapply DisjList_In_2; eassumption.
      }

      disc_rule_conds_ex.
      pose proof (RootChnInv_root_NoRsI Hprc) as Hnrsi.
      pose proof (RootChnInv_root_NoRqI Hprc) as Hnrqi.
      unfold topo in Hnrsi, Hnrqi; simpl in Hnrsi, Hnrqi.

      assert (rsEdgeUpFrom topo (rootOf (fst (tree2Topo tr 0))) = None).
      { destruct (rsEdgeUpFrom _ _) eqn:Hrs; [|reflexivity].
        exfalso.
        apply rsEdgeUpFrom_Some in Hrs; [|apply mesi_RqRsChnsOnDTree].
        destruct Hrs as [rqUp [down [pidx ?]]]; dest.
        apply parentIdxOf_child_not_root in H29; [|subst topo; auto].
        auto.
      }

      (** Abstract the root. *)
      remember (rootOf (fst (tree2Topo tr 0))) as oidx; clear Heqoidx.
      disc_rule_conds_ex.

      (** Do case analysis per a rule. *)
      apply concat_In in H5; destruct H5 as [crls [? ?]].
      apply in_map_iff in H5; destruct H5 as [cidx [? ?]]; subst.

      (** Derive that the child has the parent. *)
      assert (parentIdxOf (fst (tree2Topo tr 0)) cidx = Some oidx)
        by (apply subtreeChildrenIndsOf_parentIdxOf; auto).

      dest_in.

      { (* [liGetSImmME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        derive_obj_coherent oidx.
        solve_sim_mesi.
        destruct (idx_dec lidx cidx); subst; solve_MsgsCoh.
      }

      { (* [liGetMImm] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        solve_sim_mesi.
      }

      { (* [liInvImmE] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_chns cidx.
        derive_child_idx_in cidx.

        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_mem_me_others lidx.
        { disc_rule_conds_ex; split.
          { intros.
            derive_coherence_of cidx.
            disc_getDir.
            derive_ObjDirE oidx cidx.
            derive_ObjInvRq cidx.
            match goal with | [H: _ = cidx |- _] => clear H end.
            disc_InvNWB cidx H23.
            congruence.
          }
          { solve_MsgsCoh. }
        }
        { solve_ImplStateCoh_mem_others lidx. }
      }

      { (* [liInvImmWBME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_chns cidx.
        derive_child_idx_in cidx.

        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_mem_me_others lidx.
        { disc_rule_conds_ex; split.
          { intros.
            derive_coherence_of cidx.
            disc_getDir.
            derive_ObjDirME oidx cidx.
            derive_ObjInvWRq cidx.
            match goal with | [H: _ = cidx |- _] => clear H end.
            assert (NoRsI cidx msgs)
              by (solve_NoRsI_base; solve_NoRsI_by_rqUp cidx).
            disc_InvWB cidx H22.
            disc_InvWBCoh_inv cidx H21.
            congruence.
          }
          { solve_MsgsCoh. }
        }
        { solve_ImplStateCoh_mem_others lidx. }
      }

    - (*! Cases for Li caches *)
      Ltac solve_ImplStateCoh_li_me :=
        disc_rule_conds_ex;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac solve_ImplStateCoh_li_others lidx :=
        match goal with
        | [Hf: forall _, In _ ?l -> _, He: In lidx ?l |- _] =>
          specialize (Hf _ He); disc_rule_conds_ex
        end;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac case_ImplStateCoh_li_me_others lidx :=
        match goal with
        | |- ImplStateCoh _ {| st_oss := _ +[?oidx <- _] |} =>
          red; simpl;
          apply Forall_forall;
          intros lidx ?; destruct (idx_dec lidx oidx); subst
        end.

      Ltac solve_ImplStateCoh ::=
        let lidx := fresh "lidx" in
        case_ImplStateCoh_li_me_others lidx;
        [solve_ImplStateCoh_li_me|solve_ImplStateCoh_li_others lidx].

      apply in_map_iff in H0; destruct H0 as [oidx [? ?]]; subst; simpl in *.

      (** Derive some necessary information: 1) each Li has a parent. *)
      pose proof (tree2Topo_TreeTopoNode tr 0) as Htn.
      pose proof (c_li_indices_tail_has_parent Htr _ _ H4).
      destruct H0 as [pidx [? ?]].
      pose proof (Htn _ _ H6); dest.

      (** 2) The object index does not belong to [c_l1_indices]. *)
      assert (~ In oidx (c_l1_indices (snd (tree2Topo tr 0)))).
      { pose proof (tree2Topo_WfCIfc tr 0) as [? _].
        apply (DisjList_NoDup idx_dec) in H19.
        eapply DisjList_In_2; [eassumption|].
        apply tl_In; assumption.
      }

      disc_rule_conds_ex.
      (** Do case analysis per a rule. *)
      apply in_app_or in H5; destruct H5.

      1: { (** Rules per a child *)
        apply concat_In in H5; destruct H5 as [crls [? ?]].
        apply in_map_iff in H5; destruct H5 as [cidx [? ?]]; subst.

        (** 3) The child has the parent. *)
        assert (parentIdxOf (fst (tree2Topo tr 0)) cidx = Some oidx)
          by (apply subtreeChildrenIndsOf_parentIdxOf; auto).

        dest_in.

        { (* [liGetSImmS] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          assert (NoRsI oidx msgs)
            by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
          derive_obj_coherent oidx.
          solve_sim_mesi.
          destruct (idx_dec lidx cidx); subst; solve_MsgsCoh.
        }

        { (* [liGetSImmME] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          assert (NoRsI oidx msgs)
            by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
          derive_obj_coherent oidx.
          solve_sim_mesi.
          destruct (idx_dec lidx cidx); subst; solve_MsgsCoh.
        }

        { (* [liGetSRqUpUp] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liGetSRqUpDownME] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          derive_child_idx_in (dir_excl (fst (snd (snd (snd pos))))).
          solve_sim_mesi.
        }

        { (* [liGetMImm] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liGetMRqUpUp] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liGetMRqUpDownME] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          derive_child_idx_in (dir_excl (fst (snd (snd (snd pos))))).
          solve_sim_mesi.
        }

        { (* [liGetMRqUpDownS] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmI] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmS00] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmS01] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmS1] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmE] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.

          solve_sim_mesi_ext_mp.
          solve_SpecStateCoh.
          case_ImplStateCoh_li_me_others lidx.
          { disc_rule_conds_ex; split.
            { intros.
              derive_coherence_of cidx.
              disc_getDir.
              derive_ObjDirE oidx cidx.
              derive_ObjInvRq cidx.
              match goal with | [H: _ = cidx |- _] => clear H end.
              disc_InvNWB cidx H28.
              congruence.
            }
            { solve_MsgsCoh. }
          }
          { solve_ImplStateCoh_li_others lidx. }
        }

        { (* [liInvImmWBI] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmWBS0] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmWBS1] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmWBS] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          solve_sim_mesi.
        }

        { (* [liInvImmWBME] *)
          disc_rule_conds_ex; spec_case_silent.
          derive_child_chns cidx.
          derive_child_idx_in cidx.
          assert (NoRqI oidx msgs)
            by (solve_NoRqI_base; solve_NoRqI_by_no_locks oidx).

          solve_sim_mesi_ext_mp.
          solve_SpecStateCoh.
          case_ImplStateCoh_li_me_others lidx.
          { disc_rule_conds_ex; split.
            { intros.
              derive_coherence_of cidx.
              disc_getDir.
              derive_ObjDirME oidx cidx.
              derive_ObjInvWRq cidx.
              match goal with | [H: _ = cidx |- _] => clear H end.
              assert (NoRsI cidx msgs)
                by (solve_NoRsI_base; solve_NoRsI_by_rqUp cidx).
              disc_InvWB cidx H27.
              disc_InvWBCoh_inv cidx H26.
              congruence.
            }
            { solve_MsgsCoh. }
          }
          { solve_ImplStateCoh_li_others lidx. }
        }
      }

      dest_in.

      { (* [liGetSRsDownDownS] *)
        disc_rule_conds_ex; spec_case_silent.

        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        derive_input_msg_coherent.
        disc_rule_conds_ex.
        assert (NoRqI oidx msgs)
          by (solve_NoRqI_base; solve_NoRqI_by_rsDown oidx).

        solve_sim_mesi.
        destruct (idx_dec lidx cidx); subst; solve_MsgsCoh.
      }

      { (* [liGetSRsDownDownE] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        derive_input_msg_coherent.
        disc_rule_conds_ex.
        assert (NoRqI oidx msgs)
          by (solve_NoRqI_base; solve_NoRqI_by_rsDown oidx).

        solve_sim_mesi.
        destruct (idx_dec lidx cidx); subst; solve_MsgsCoh.
      }

      { (* [liDownSRsUpDownME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [|disc_MesiDownLockInv oidx H29].
        derive_child_chns upCIdx.
        derive_child_idx_in upCIdx.
        disc_responses_from.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        derive_coherence_of cidx.
        derive_input_msg_coherent.

        solve_sim_mesi.
        destruct (idx_dec lidx (obj_idx upCObj)); subst; solve_MsgsCoh.
      }

      { (* [liDownSImm] *)
        disc_rule_conds_ex.
        spec_case_silent.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_rqDown oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDownSRqDownDownME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_idx_in (dir_excl (fst (snd (snd (snd pos))))).
        solve_sim_mesi.
      }

      { (* [liDownSRsUpUp] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [disc_MesiDownLockInv oidx H29|].
        disc_responses_from.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        derive_coherence_of cidx.
        derive_input_msg_coherent.
        solve_sim_mesi.
      }

      { (* [liGetMRsDownDownDirI] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        derive_child_idx_in cidx.
        disc_rule_conds_ex.
        assert (NoRqI oidx msgs)
          by (solve_NoRqI_base; solve_NoRqI_by_rsDown oidx).
        solve_sim_mesi.
      }

      { (* [liGetMRsDownRqDownDirS] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx.
        solve_sim_mesi.
      }

      { (* [liDownIRsUpDownS] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [|disc_MesiDownLockInv oidx H29].
        derive_child_chns upCIdx.
        derive_child_idx_in upCIdx.
        disc_responses_from.
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDownIRsUpDownME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [|disc_MesiDownLockInv oidx H29].
        derive_child_chns upCIdx.
        derive_child_idx_in upCIdx.
        disc_responses_from.
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDownIImmS] *)
        disc_rule_conds_ex.
        spec_case_silent.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_rqDown oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDownIImmME] *)
        disc_rule_conds_ex.
        spec_case_silent.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_rqDown oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDownIRqDownDownDirS] *)
        disc_rule_conds_ex; spec_case_silent.
        solve_sim_mesi.
      }

      { (* [liDownIRqDownDownDirME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_child_idx_in (dir_excl (fst (snd (snd (snd pos))))).
        solve_sim_mesi.
      }

      { (* [liDownIRqDownDownDirMES] *)
        disc_rule_conds_ex; spec_case_silent.
        solve_sim_mesi.
      }

      { (* [liDownIRsUpUpS] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [disc_MesiDownLockInv oidx H29|].
        disc_responses_from.
        solve_sim_mesi.
      }

      { (* [liDownIRsUpUpME] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [disc_MesiDownLockInv oidx H29|].
        disc_responses_from.
        solve_sim_mesi.
      }

      { (* [liDownIRsUpUpMES] *)
        disc_rule_conds_ex; spec_case_silent.
        derive_footprint_info_basis oidx;
          [disc_MesiDownLockInv oidx H29|].
        disc_responses_from.
        solve_sim_mesi.
      }

      { (* [liInvRqUpUp] *)
        disc_rule_conds_ex; spec_case_silent.
        solve_sim_mesi.
      }

      { (* [liInvRqUpUpWB] *)
        disc_rule_conds_ex; spec_case_silent.
        solve_sim_mesi.
      }

      { (* [liInvRsDownDown] *)
        disc_rule_conds_ex.
        spec_case_silent.
        derive_footprint_info_basis oidx.
        disc_rule_conds_ex.
        solve_sim_mesi.
      }

      { (* [liDropImm] *)
        disc_rule_conds_ex; spec_case_silent.
        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_li_me_others lidx.
        { solve_ImplStateCoh_li_me. }
        { specialize (H15 _ H12); disc_rule_conds_ex. }
      }

    - (*! Cases for L1 caches *)
      apply in_map_iff in H0; destruct H0 as [oidx [? ?]]; subst.

      Ltac solve_ImplStateCoh_l1_me :=
        disc_rule_conds_ex;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac solve_ImplStateCoh_l1_others :=
        try match goal with
            | [H: MsgsCoh _ ?oidx _, Hin: In ?oidx _ |- _] => clear Hin
            end;
        match goal with
        | [Hf: forall _, In _ ?l -> _, He: In _ ?l |- _] =>
          specialize (Hf _ He); disc_rule_conds_ex
        end;
        split; [solve_ImplOStateMESI|solve_MsgsCoh].

      Ltac case_ImplStateCoh_l1_me_others :=
        red; simpl;
        match goal with
        | [H: MsgsCoh _ ?oidx _ |- Forall _ _] =>
          let lidx := fresh "lidx" in
          apply Forall_forall;
          intros lidx ?; destruct (idx_dec lidx oidx); subst
        end.

      Ltac solve_ImplStateCoh ::=
        case_ImplStateCoh_l1_me_others;
        [solve_ImplStateCoh_l1_me|solve_ImplStateCoh_l1_others].

      (** Derive some necessary information: each L1 has a parent. *)
      pose proof (tree2Topo_TreeTopoNode tr 0) as Htn.
      pose proof (c_l1_indices_has_parent Htr _ _ H4).
      destruct H0 as [pidx [? ?]].
      pose proof (Htn _ _ H6); dest.

      Opaque In.
      disc_rule_conds_ex.
      Transparent In.
      (** Do case analysis per a rule. *)
      dest_in.

      + (* [l1GetSImm] *)
        disc_rule_conds_ex.
        spec_case_get oidx.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.

      + (* [l1GetSRqUpUp] *)
        disc_rule_conds_ex.
        spec_case_silent.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.

      + (* [l1GetSRsDownDownS] *)
        disc_rule_conds_ex.
        spec_case_get oidx.

        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        derive_input_msg_coherent.
        disc_rule_conds_ex.
        assert (NoRqI oidx msgs)
          by (solve_NoRqI_base; solve_NoRqI_by_rsDown oidx).

        solve_sim_mesi.

      + (* [l1GetSRsDownDownE] *)
        disc_rule_conds_ex.
        spec_case_get oidx.

        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        derive_input_msg_coherent.
        disc_rule_conds_ex.
        assert (NoRqI oidx msgs)
          by (solve_NoRqI_base; solve_NoRqI_by_rsDown oidx).

        solve_sim_mesi.

      + (* [l1DownSImm] *)
        disc_rule_conds_ex.
        spec_case_silent.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_rqDown oidx).
        disc_rule_conds_ex.
        solve_sim_mesi.

      + (* [l1GetMImmE] *)
        disc_rule_conds_ex.
        spec_case_set oidx.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
        disc_rule_conds_ex.

        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_l1_me_others.
        * mred; simpl.
          eapply ObjExcl0_ObjCoh.
          { specialize (H3 oidx); repeat (simpl in H3; mred); dest.
            eassumption.
          }
          { split; [simpl; solve_mesi|solve_MsgsP]. }

        * clear H4. (* In oidx .. *)
          mred; simpl.
          assert (exists lost lorq, oss@[lidx] = Some lost /\
                                    orqs@[lidx] = Some lorq).
          { specialize (H15 _ H11).
            solve_rule_conds_ex.
          }
          destruct H4 as [lost [lorq [? ?]]]; rewrite H4, H12; simpl.
          eapply ObjInvalid_ObjCoh.
          { apply Hnmcf; [|simpl; mred].
            assumption.
          }
          { eapply InvExcl_excl_invalid with (eidx:= oidx); [eapply H3|..];
              try eassumption; try reflexivity; try (simpl; mred); try solve_mesi; auto.
            solve_MsgsP.
          }

      + (* [l1GetMImmM] *)
        disc_rule_conds_ex.
        spec_case_set oidx.
        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_no_uplock oidx).
        disc_rule_conds_ex.

        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_l1_me_others.
        * mred; simpl.
          eapply ObjExcl0_ObjCoh.
          { specialize (H3 oidx); repeat (simpl in H3; mred); dest.
            eassumption.
          }
          { split; [simpl; solve_mesi|solve_MsgsP]. }

        * clear H4. (* In oidx .. *)
          mred; simpl.
          assert (exists lost lorq, oss@[lidx] = Some lost /\
                                    orqs@[lidx] = Some lorq).
          { specialize (H15 _ H11).
            solve_rule_conds_ex.
          }
          destruct H4 as [lost [lorq [? ?]]]; rewrite H4, H12; simpl.
          eapply ObjInvalid_ObjCoh.
          { apply Hnmcf; [|simpl; mred].
            assumption.
          }
          { eapply InvExcl_excl_invalid with (eidx:= oidx); [eapply H3|..];
              try eassumption; try reflexivity; try (simpl; mred); try solve_mesi; auto.
            solve_MsgsP.
          }

      + (* [l1GetMRqUpUp] *)
        disc_rule_conds_ex.
        spec_case_silent.
        solve_sim_mesi.

      + (* [l1GetMRsDownDown] *)
        disc_rule_conds_ex.
        spec_case_set oidx.

        derive_footprint_info_basis oidx.
        derive_child_chns cidx.
        disc_rule_conds_ex.

        assert (NoRsI oidx msgs)
          by (solve_NoRsI_base; solve_NoRsI_by_rsDown oidx).
        disc_rule_conds_ex.

        solve_sim_mesi_ext_mp.
        solve_SpecStateCoh.
        case_ImplStateCoh_l1_me_others.
        * mred; simpl.
          eapply ObjExcl0_ObjCoh.
          { specialize (H3 oidx); repeat (simpl in H3; mred); dest.
            eassumption.
          }
          { split; [simpl; solve_mesi|solve_MsgsP]. }

        * clear H4. (* In oidx .. *)
          mred; simpl.
          assert (exists lost lorq, oss@[lidx] = Some lost /\
                                    orqs@[lidx] = Some lorq).
          { specialize (H15 _ H33).
            solve_rule_conds_ex.
          }
          destruct H4 as [lost [lorq [? ?]]]; rewrite H4, H42; simpl.
          eapply ObjInvalid_ObjCoh.
          { apply Hnmcf; [assumption|simpl; mred]. }
          { eapply InvExcl_excl_invalid with (eidx:= oidx); [eapply H3|..];
              try eassumption; try reflexivity; try (simpl; mred); try solve_mesi; auto.
            solve_MsgsP.
          }

      + (* [l1DownIImmS] *)
        disc_rule_conds_ex.
        spec_case_silent.
        solve_sim_mesi.

      + (* [l1DownIImmME] *)
        disc_rule_conds_ex.
        spec_case_silent.
        solve_sim_mesi.

      + (* [l1InvRqUpUp] *)
        disc_rule_conds_ex.
        spec_case_silent.
        solve_sim_mesi.

      + (* [l1InvRqUpUpM] *)
        disc_rule_conds_ex.
        spec_case_silent.
        solve_sim_mesi.

      + (* [l1InvRsDownDown] *)
        disc_rule_conds_ex.
        spec_case_silent.
        derive_footprint_info_basis oidx.
        disc_rule_conds_ex.
        solve_sim_mesi.

        Unshelve.
        all: eassumption.

        END_SKIP_PROOF_ON *) admit.
  Qed.

  Theorem mesi_ok:
    (steps step_m) # (steps step_m) |-- impl ⊑ spec.
  Proof.
    apply invRSim_implies_refinement
      with (ginv:= MesiInvOk.InvForSim tr) (sim:= SimMESI).
    - apply mesi_InvForSim_ok.
    - apply mesi_sim_init.
    - apply mesi_sim_ok.
  Qed.

End Sim.


From RecordUpdate Require Import RecordSet.
Import RecordSetNotations.

From Perennial.algebra Require Import liftable auth_map.
From Perennial.Helpers Require Import Transitions.
From Perennial.program_proof Require Import disk_prelude.

From Goose.github_com.mit_pdos.go_nfsd Require Import simple.
From Perennial.program_proof Require Import obj.obj_proof marshal_proof addr_proof crash_lockmap_proof addr.addr_proof buf.buf_proof.
From Perennial.program_proof Require Import jrnl.sep_jrnl_proof.
From Perennial.program_proof Require Import disk_prelude.
From Perennial.program_proof Require Import disk_lib.
From Perennial.Helpers Require Import NamedProps Map List range_set.
From Perennial.program_logic Require Import spec_assert.
From Perennial.goose_lang.lib Require Import slice.typed_slice into_val.
From Perennial.program_proof Require Import simple.spec simple.invariant.

Section heap.
Context `{!heapGS Σ}.
Context `{!simpleG Σ}.
Implicit Types (stk:stuckness) (E: coPset).

Theorem wp_inum2Addr (inum : u64) :
  {{{ ⌜ int.nat inum < NumInodes ⌝ }}}
    inum2Addr #inum
  {{{ RET (addr2val (inum2addr inum)); True }}}.
Proof.
  iIntros (Φ) "% HΦ".
  wp_call.
  wp_call.
  rewrite /addr2val /inum2addr /=.
  rewrite /LogSz /InodeSz.

  rewrite /NumInodes /InodeSz in H.
  replace (4096 `div` 128) with (32) in H by reflexivity.

  replace (word.add (word.divu (word.sub 4096 8) 8) 2)%Z with (U64 513) by reflexivity.
  replace (word.mul (word.mul inum 128) 8)%Z with (U64 (int.nat inum * 128 * 8)%nat).
  { iApply "HΦ". done. }

  assert (int.Z (word.mul (word.mul inum 128) 8) = int.Z inum * 1024)%Z.
  { rewrite word.unsigned_mul.
    rewrite word.unsigned_mul. word. }

  word.
Qed.

Theorem wp_block2addr bn :
  {{{ True }}}
    block2addr #bn
  {{{ RET (addr2val (blk2addr bn)); True }}}.
Proof.
  iIntros (Φ) "% HΦ".
  wp_call.
  wp_call.
  iApply "HΦ". done.
Qed.

Opaque slice_val.

Theorem wp_fh2ino s i :
  {{{ is_fh s i }}}
    fh2ino (slice_val s, #())%V
  {{{ RET #i; True }}}.
Proof.
  iIntros (Φ) "Hfh HΦ".
  iNamed "Hfh".
  iMod (readonly_load with "Hfh_slice") as (q) "Hslice".
  wp_call.
  wp_call.
  wp_apply (wp_new_dec with "Hslice"); first by eauto.
  iIntros (dec) "Hdec".
  wp_apply (wp_Dec__GetInt with "Hdec").
  iIntros "Hdec".
  wp_pures.
  iApply "HΦ".
  done.
Qed.

Theorem wp_Fh__MakeFh3 inum :
  {{{ True }}}
    Fh__MakeFh3 (#inum, #())%V
  {{{ s, RET (slice_val s, #()); is_fh s inum }}}.
Proof.
  iIntros (Φ) "_ HΦ".
  wp_pures.
  wp_call.
  wp_apply wp_new_enc.
  iIntros (enc) "Henc".
  wp_apply (wp_Enc__PutInt with "Henc"); first by word.
  iIntros "Henc".
  wp_apply (wp_Enc__Finish with "Henc").
  iIntros (s data) "(%Henc & %Hlen & Hs)".
  iDestruct (is_slice_to_small with "Hs") as "Hs".
  iMod (readonly_alloc_1 with "Hs") as "Hs".
  wp_pures.
  iApply "HΦ".
  iExists _. iFrame. done.
Qed.

Lemma elem_of_covered_inodes (x:u64) :
  x ∈ covered_inodes ↔ (2 ≤ int.Z x < 32)%Z.
Proof.
  rewrite /covered_inodes.
  rewrite rangeSet_lookup //.
Qed.

Theorem wp_validInum (i : u64) :
  {{{ True }}}
    validInum #i
  {{{ (valid : bool), RET #valid; ⌜ valid = true <-> i ∈ covered_inodes ⌝ }}}.
Proof.
  iIntros (Φ) "_ HΦ".
  wp_call.
  wp_if_destruct.
  { iApply "HΦ". rewrite elem_of_covered_inodes.
    iPureIntro.
    split; [ inversion 1 | intros ].
    move: H; word. }
  wp_if_destruct.
  { iApply "HΦ". rewrite elem_of_covered_inodes.
    iPureIntro.
    split; [ inversion 1 | intros ].
    move: H; word. }
  wp_call.
  change (int.Z (word.divu _ _)) with 32%Z.
  wp_if_destruct.
  { iApply "HΦ". rewrite elem_of_covered_inodes.
    iPureIntro.
    split; [ inversion 1 | intros ].
    word. }
  iApply "HΦ".
  iPureIntro. intuition.
  rewrite elem_of_covered_inodes.
  split; [ | word ].
  assert (i ≠ U64 0) as Hnot_0%(not_inj (f:=int.Z)) by congruence.
  assert (i ≠ U64 1) as Hnot_1%(not_inj (f:=int.Z)) by congruence.
  change (int.Z 0%Z) with 0%Z in *.
  change (int.Z 1%Z) with 1%Z in *.
  word.
Qed.

Lemma is_inode_crash_next γsrc γnext fh state blk :
  fh [[γsrc]]↦ state ∗
  ( is_inode fh state (durable_mapsto_own γnext)
    ∨ is_inode_enc fh (length state) blk (durable_mapsto_own γnext)
    ∗ is_inode_data (length state) blk state (durable_mapsto_own γnext) )
  -∗ is_inode_stable γsrc γnext fh.
Proof.
  iIntros "[Hfh Hi]".
  iExists _. iFrame.
  iDestruct "Hi" as "[$|[He Hd]]".
  iExists _. iFrame.
Qed.

Lemma is_inode_crash_prev γsrc γprev γnext fh state blk :
  txn_cinv Njrnl γprev γnext -∗
  fh [[γsrc]]↦ state ∗
  ( is_inode fh state (durable_mapsto γprev)
    ∨ is_inode_enc fh (length state) blk (durable_mapsto γprev)
    ∗ is_inode_data (length state) blk state (durable_mapsto γprev) )
  -∗
  |C={⊤}=>
  is_inode_stable γsrc γnext fh.
Proof.
  iIntros "#Hcinv [Hfh H]".

  iDestruct (@liftable _ _ _ _ _ (λ m, is_inode fh state m ∨ is_inode_enc fh (length state) blk m ∗ is_inode_data (length state) blk state m)%I with "H") as (mlift) "[H #Hrestore]".

  iMod (exchange_durable_mapsto with "[$Hcinv $H]") as "H".
  iDestruct ("Hrestore" with "H") as "H".

  iModIntro.
  iApply is_inode_crash_next; iFrame.
Qed.

Lemma is_inode_crash_prev_own γsrc γprev γnext fh state blk :
  txn_cinv Njrnl γprev γnext -∗
  fh [[γsrc]]↦ state ∗
  ( is_inode fh state (durable_mapsto_own γprev)
    ∨ is_inode_enc fh (length state) blk (durable_mapsto_own γprev)
    ∗ is_inode_data (length state) blk state (durable_mapsto_own γprev) )
  -∗
  |C={⊤}=>
  is_inode_stable γsrc γnext fh.
Proof.
  iIntros "#Hcinv [Hfh H]".

  iDestruct (liftable_mono (Φ := λ m, is_inode fh state m
      ∨ is_inode_enc fh (length state) blk m
        ∗ is_inode_data (length state) blk state m)%I
    _ (durable_mapsto γprev) with "H") as "H".
  { iIntros (??) "[_ $]". }

  iApply (is_inode_crash_prev with "Hcinv"). iFrame.
Qed.

Lemma is_inode_stable_crash γsrc γprev γnext fh :
  txn_cinv Njrnl γprev γnext -∗
  is_inode_stable γsrc γprev fh
  -∗
  |C={⊤}=>
  is_inode_stable γsrc γnext fh.
Proof.
  iIntros "#Hcinv".
  rewrite /is_inode_stable.
  iDestruct 1 as (?) "(H1&H2)".
  iApply is_inode_crash_prev_own; iFrame "∗#".
  Unshelve.
  exact (U64 0).
Qed.

End heap.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition find_lock_rec_spec0 (g_rd: Pointer) (rec_list: Pointer) (rec_idx: Z64) (adt: RData) : option (RData * Pointer) :=
    match g_rd, rec_list, rec_idx with
    | (_g_rd_base, _g_rd_ofst), (_rec_list_base, _rec_list_ofst), VZ64 _rec_idx =>
      rely is_int64 _rec_idx;
      when'' _g_rec_base, _g_rec_ofst, adt == realm_get_rec_entry_spec (VZ64 _rec_idx) (_rec_list_base, _rec_list_ofst) adt;
      rely is_int _g_rec_ofst;
      when _t'10 == is_null_spec (_g_rec_base, _g_rec_ofst) adt;
      rely is_int _t'10;
      if (_t'10 =? 1) then
        Some (adt, (_g_rec_base, _g_rec_ofst))
      else
        when adt == granule_lock_spec (_g_rec_base, _g_rec_ofst) adt;
        when _t'9, adt == granule_get_state_spec (_g_rec_base, _g_rec_ofst) adt;
        rely is_int _t'9;
        if (_t'9 =? 3) then
          when'' _t'3_base, _t'3_ofst == get_g_rec_rd_spec (_g_rec_base, _g_rec_ofst) adt;
          rely is_int _t'3_ofst;
          when _t'4 == ptr_eq_spec (_t'3_base, _t'3_ofst) (_g_rd_base, _g_rd_ofst) adt;
          rely is_int _t'4;
          if (_t'4 =? 1) then
            when'' _t'6_base, _t'6_ofst, adt == realm_get_rec_entry_spec (VZ64 _rec_idx) (_rec_list_base, _rec_list_ofst) adt;
            rely is_int _t'6_ofst;
            when _t'7 == ptr_eq_spec (_t'6_base, _t'6_ofst) (_g_rec_base, _g_rec_ofst) adt;
            rely is_int _t'7;
            let _t'5 := (_t'7 =? 1) in
            if _t'5 then
              Some (adt, (_g_rec_base, _g_rec_ofst))
            else
              when adt == granule_unlock_spec (_g_rec_base, _g_rec_ofst) adt;
              when'' _t'2_base, _t'2_ofst == null_ptr_spec  adt;
              rely is_int _t'2_ofst;
              Some (adt, (_t'2_base, _t'2_ofst))
          else
            let _t'5 := 0 in
            when adt == granule_unlock_spec (_g_rec_base, _g_rec_ofst) adt;
            when'' _t'2_base, _t'2_ofst == null_ptr_spec  adt;
            rely is_int _t'2_ofst;
            Some (adt, (_t'2_base, _t'2_ofst))
        else
          when adt == granule_unlock_spec (_g_rec_base, _g_rec_ofst) adt;
          when'' _t'8_base, _t'8_ofst == null_ptr_spec  adt;
          rely is_int _t'8_ofst;
          Some (adt, (_t'8_base, _t'8_ofst))
     end
    .

End SpecLow.


Require Import CertiGraph.lib.Ensembles_ext.
Require Import Coq.Lists.List.
Require Import VST.msl.seplog.
Require Import VST.msl.log_normalize.
Require Import VST.msl.Coqlib2.
Require Import CertiGraph.lib.Coqlib.
Require Import CertiGraph.lib.EquivDec_ext.
Require Import CertiGraph.lib.relation_list.
Require Import CertiGraph.msl_ext.log_normalize.
Require Import CertiGraph.msl_ext.iter_sepcon.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.path_lemmas.
Require Import CertiGraph.graph.reachable_computable.
Require Import CertiGraph.graph.reachable_ind.
Require Import CertiGraph.graph.subgraph2.
Require Import CertiGraph.graph.graph_gen.
Require Import CertiGraph.graph.dag.
Require Import CertiGraph.graph.weak_mark_lemmas.
Require Import CertiGraph.msl_application.Graph.
Require Import CertiGraph.msl_application.Graph_Mark.
Require Import CertiGraph.msl_application.GraphBi.
Require Import Coq.Logic.Classical.

Open Scope logic.

Section PointwiseGraph_Mark_Bi.

Context {pSGG_Bi: pPointwiseGraph_Graph_Bi}.
Context {sSGG_Bi: sPointwiseGraph_Graph_Bi bool unit}.

Local Coercion Graph_LGraph: Graph >-> LGraph.
Local Coercion LGraph_SGraph: LGraph >-> SGraph.
Local Identity Coercion Graph_GeneralGraph: Graph >-> GeneralGraph.
Local Identity Coercion LGraph_LabeledGraph: LGraph >-> LabeledGraph.
Local Identity Coercion SGraph_PointwiseGraph: SGraph >-> PointwiseGraph.
Local Coercion pg_lg: LabeledGraph >-> PreGraph.

Notation Graph := (@Graph pSGG_Bi bool unit unit).

(* TODO: move this lemma into Graph_Mark.v. *)
Lemma vlabel_eq: forall (g1 g2: Graph) x1 x2, (WeakMarkGraph.marked g1 x1 <-> WeakMarkGraph.marked g2 x2) -> vlabel g1 x1 = vlabel g2 x2.
Proof.
  intros.
  simpl in H.
  destruct H.
  destruct (vlabel g1 x1), (vlabel g2 x2); try congruence.
  + tauto.
  + symmetry; tauto.
Qed.

Lemma mark_null_refl: forall (g: Graph), mark null g g.
Proof. intros. apply mark_invalid_refl, invalid_null. Qed.

Lemma mark_vgamma_true_refl: forall (g: Graph) root d l r, vgamma g root = (d, l, r) -> d = true -> mark root g g.
Proof.
  intros.
  apply mark_marked_root_refl.
  inversion H.
  simpl; congruence.
Qed.

Lemma Graph_vgen_true_mark1: forall (G: Graph) (x: addr) l r,
  vgamma G x = (false, l, r) ->
  vvalid G x ->
  mark1 x (G: LabeledGraph _ _ _ _ _) (Graph_vgen G x true: LabeledGraph _ _ _ _ _).
Proof.
  intros.
  apply WeakMarkGraph.vertex_update_mark1.
  inversion H; simpl; auto.
Qed.

Lemma left_weak_valid: forall (G G1: Graph) (x l r: addr),
  vgamma G x = (false, l, r) ->
  vvalid G x ->
  mark1 x G G1 ->
  @weak_valid _ _ _ _ G1 _ (maGraph _) l.
Proof.
  intros.
  destruct H1 as [? _].
  eapply weak_valid_si; [symmetry; exact H1 |].
  eapply gamma_left_weak_valid; eauto.
Qed.

Lemma right_weak_valid: forall (G G1 G2: Graph) (x l r: addr),
  vgamma G x = (false, l, r) ->
  vvalid G x ->
  mark1 x G G1 ->
  mark l G1 G2 ->
  @weak_valid _ _ _ _ G2 _ (maGraph _) r.
Proof.
  intros.
  destruct H1 as [? _].
  destruct H2 as [_ ?].
  eapply weak_valid_si; [symmetry; transitivity G1; [exact H1 | exact H2] |].
  eapply gamma_right_weak_valid; eauto.
Qed.

Lemma root_stable_ramify: forall (g: Graph) (x: addr) (gx: bool * addr * addr),
  vgamma g x = gx ->
  vvalid g x ->
  @derives pred _
    (reachable_vertices_at x g)
    (vertex_at x gx *
      (vertex_at x gx -* reachable_vertices_at x g)).
Proof. intros; apply va_reachable_root_stable_ramify; auto. Qed.

Lemma root_update_ramify: forall (g: Graph) (x: addr) (lx: bool) (gx gx': bool * addr * addr),
  vgamma g x = gx ->
  vgamma (Graph_vgen g x lx) x = gx' ->
  vvalid g x ->
  @derives pred _
    (reachable_vertices_at x g)
    (vertex_at x gx *
      (vertex_at x gx' -* reachable_vertices_at x (Graph_vgen g x lx))).
Proof. intros; apply va_reachable_root_update_ramify; auto. Qed.

Lemma graph_ramify_left: forall (g g1: Graph) x l r,
  vvalid g x ->
  vgamma g x = (false, l, r) ->
  mark1 x g g1 ->
  @derives pred _
    (reachable_vertices_at x g1)
    (reachable_vertices_at l g1 *
      (ALL g': Graph,
        !! (mark l g1 g') -->
        (reachable_vertices_at l g' -* reachable_vertices_at x g'))).
Proof.
  intros.
  apply (mark_list_mark_ramify g g1 _ _ nil _ (r :: nil)); auto.
  + intros; apply classic.
  + simpl.
    eapply gamma_step_list; eauto.
  + split_relation_list ((lg_gg g1) :: nil); auto.
    reflexivity.
  + unfold Included, Ensembles.In; intros.
    apply vvalid_vguard.
    rewrite Intersection_spec in H2; destruct H2.
    apply reachable_foot_valid in H2; auto.
  + unfold Included, Ensembles.In; intros.
    apply vvalid_vguard.
    rewrite Intersection_spec in H3; destruct H3.
    apply reachable_foot_valid in H3.
    destruct H2 as [_ [? _]].
    rewrite <- H2; auto.
Qed.

Lemma graph_ramify_right: forall (g g1 g2: Graph) x l r,
  vvalid g x ->
  vgamma g x = (false, l, r) ->
  mark1 x g g1 ->
  mark l g1 g2 ->
  (reachable_vertices_at x g2: pred) |-- reachable_vertices_at r g2 *
   (ALL g': Graph,
     !! (mark r g2 g') -->
     (reachable_vertices_at r g' -* reachable_vertices_at x g')).
Proof.
  intros.
  apply (mark_list_mark_ramify g g2 _ _ (l :: nil) _ nil); auto.
  + intros; apply classic.
  + simpl.
    eapply gamma_step_list; eauto.
  + split_relation_list ((lg_gg g1) :: nil); auto.
    unfold mark_list. simpl map.
    split_relation_list (@nil (LabeledGraph _ _ bool unit unit)); auto.
  + unfold Included, Ensembles.In; intros.
    apply vvalid_vguard.
    rewrite Intersection_spec in H3; destruct H3.
    apply reachable_foot_valid in H3; auto.
  + unfold Included, Ensembles.In; intros.
    apply vvalid_vguard.
    rewrite Intersection_spec in H4; destruct H4.
    apply reachable_foot_valid in H4.
    destruct H3 as [_ [? _]].
    rewrite <- H3; auto.
Qed.

Lemma mark1_mark_left_mark_right: forall (g1 g2 g3 g4: Graph) root l r,
  vvalid g1 root ->
  vgamma g1 root = (false, l, r) ->
  mark1 root g1 g2 ->
  mark l g2 g3 ->
  mark r g3 g4 ->
  mark root g1 g4.
Proof.
  intros.
  apply (mark1_mark_list_mark root (l :: r :: nil)); auto.
  + intros; simpl.
    inversion H0.
    unfold Complement, Ensembles.In.
    rewrite H5; congruence.
  + hnf; intros.
    apply gamma_step with (y := n') in H0; auto.
    rewrite H0; simpl.
    pose proof eq_sym_iff n' l.
    pose proof eq_sym_iff n' r.
    tauto.
  + split_relation_list ((lg_gg g2) :: nil); eauto.
    unfold mark_list.
    simpl map.
    split_relation_list ((lg_gg g3) :: nil); eauto.
Qed.

End PointwiseGraph_Mark_Bi.


Require Import Coqlib.
Require Import Maps.

Require Import Integers.
Require Import LibTactics.
Open Scope Z_scope.
Import ListNotations.

Set Implicit Arguments.
Unset Strict Implicit.

(* Word *)
Definition Word := int.

(* Address *)
Definition Address := prod Z int.

(* Val *)
Inductive Val: Type := W: Word -> Val | Ptr: Address -> Val.

(*** Definition of Registers **)
(* General Registers *)
Inductive GenReg: Type :=
  | r0: GenReg  | r1: GenReg  | r2: GenReg  | r3: GenReg  | r4: GenReg  | r5: GenReg  | r6: GenReg  | r7: GenReg
  | r8: GenReg  | r9: GenReg  | r10: GenReg | r11: GenReg | r12: GenReg | r13: GenReg | r14: GenReg | r15: GenReg
  | r16: GenReg | r17: GenReg | r18: GenReg | r19: GenReg | r20: GenReg | r21: GenReg | r22: GenReg | r23: GenReg
  | r24: GenReg | r25: GenReg | r26: GenReg | r27: GenReg | r28: GenReg | r29: GenReg | r30: GenReg | r31: GenReg.

(* Auxiliary Registers *)
Inductive AsReg: Type :=
  | asr0: AsReg  | asr1: AsReg  | asr2: AsReg  | asr3: AsReg  | asr4: AsReg  | asr5: AsReg  | asr6: AsReg  | asr7: AsReg
  | asr8: AsReg  | asr9: AsReg  | asr10: AsReg | asr11: AsReg | asr12: AsReg | asr13: AsReg | asr14: AsReg | asr15: AsReg
  | asr16: AsReg | asr17: AsReg | asr18: AsReg | asr19: AsReg | asr20: AsReg | asr21: AsReg | asr22: AsReg | asr23: AsReg
  | asr24: AsReg | asr25: AsReg | asr26: AsReg | asr27: AsReg | asr28: AsReg | asr29: AsReg | asr30: AsReg | asr31: AsReg.

(* PSR *)
Inductive PsrReg: Type :=
| n : PsrReg
| z : PsrReg
| cwp : PsrReg.

(* Special Registers *)
Inductive SpReg: Type :=
| Rwim : SpReg
| Ry : SpReg
| Rasr : AsReg -> SpReg.
Coercion Rasr : AsReg >-> SpReg.

(* Register Name *)
Inductive RegName: Type :=
| Rr : GenReg -> RegName
| Rpsr : PsrReg -> RegName
| Rsp : SpReg -> RegName.
Coercion Rr : GenReg >-> RegName.
Coercion Rpsr : PsrReg >-> RegName.
Coercion Rsp : SpReg >-> RegName.

Lemma RegName_eq: forall (x y : RegName),
    {x = y} + {x <> y}.
Proof.
  repeat decide equality.
Qed.

Module RegNameEq.
  Definition t := RegName.
  Definition eq := RegName_eq.
End RegNameEq.

Module RegMap := EMap(RegNameEq).
Definition RegFile := RegMap.t (option Val).

(*** Window Register  **)
(* Frame *)
Inductive Frame : Type :=
  consfm : Val -> Val -> Val -> Val -> Val -> Val -> Val -> Val -> Frame.
Notation " '[[' v0 , v1 , v2 , v3 , v4 , v5 , v6 , v7 ']]'" :=
  (consfm v0 v1 v2 v3 v4 v5 v6 v7) (at level 200): code_scope.

(* Frame List *)
Definition FrameList : Type := list Frame.

(* RState *)
Definition RState : Type := RegFile * FrameList.

(*** Delay List **)
(* DelayCycle *)
Definition DelayCycle := nat.

(* DelayItem *)
Definition DelayItem : Type := DelayCycle * SpReg * Word.

(* DelayList *)
Definition DelayList : Type := list DelayItem.

(* DelayTime *)
Definition X := 3%nat.

(* set_delay *)
Definition set_delay (rsp : SpReg) (w : Word) (D : DelayList) :=
  (X, rsp, w) :: D.

(* getRegs *)
Fixpoint getRegs (D : DelayList) :=
  match D with
  | (_, rsp, _) :: D' => rsp :: (getRegs D')
  | _ => nil
  end.

(*** Program State **)
(* Operation Expression *)
Inductive OpExp : Type :=
| Or : GenReg -> OpExp
| Ow : Word -> OpExp.

(* Address Expression *)
Inductive AddrExp : Type :=
| Ao : OpExp -> AddrExp
| Aro : GenReg -> OpExp -> AddrExp.

Lemma Address_eq: forall (x y : Address),
    {x = y} + {x <> y}.
Proof.
  intros; destruct x, y.
  destruct (Z.eq_dec z0 z1); destruct (Int.eq_dec i i0); subst; eauto;
    try solve [right; intro; tryfalse].
Qed.

(* memory *)
Module AddrEq.
  Definition t := Address.
  Definition eq := Address_eq.
End AddrEq.

Module MemMap := EMap(AddrEq).
Definition Memory := MemMap.t (option Val).

(* Some Operations for memory *)
(* disjoint *)
Definition disjoint {tp tp': Type} (M1 : tp -> option tp') (M2 : tp -> option tp') : Prop :=
  forall (x : tp),
    match M1 x, M2 x with
    | Some _, Some _ => False
    | Some _, None => True
    | None, Some _ => True
    | None, None => True
    end.
Notation "M1 '⊥' M2" := (disjoint M1 M2) (at level 39) : mem_scope.

(* in dom *)
Definition indom {tp tp': Type} (x : tp) (M : tp -> option tp') :=
  exists v, M x = Some v.

(* is in dom *)
Definition is_indom {tp tp' : Type} (x : tp) (M : tp -> option tp') :=
  match M x with
  | Some _ => true
  | None => false
  end.

(* merge *)
Definition merge {tp tp': Type} (M1 : tp -> option tp') (M2 : tp -> option tp') :=
  fun x => match M1 x with
        | None => M2 x
        | Some b => Some b
        end.
Notation "M1 '⊎' M2" := (merge M1 M2) (at level 39) : mem_scope.

(* emp memory *)
Definition empM : Memory := fun (x : Address) => None.
(* emp register *)
Definition empR : RegFile := fun (rn : RegName) => None.

(* Label f *)
Definition Label: Type := Word.

(* Program State *)
Definition State: Type := Memory * RState * DelayList.

(*** Expression Evalution *)
Notation "$ n" := (Int.repr n)(at level 1) : code_scope.
Notation "a <<ᵢ b" := (Int.shl a b)(at level 1) : code_scope.
Notation "a >>ᵢ b" := (Int.shru a b)(at level 1) : code_scope.
Notation "a &ᵢ b" := (Int.and a b)(at level 1) : code_scope.
Notation "a |ᵢ b" := (Int.or a b)(at level 1) : code_scope.
Notation "a +ᵢ b" := (Int.add a b)(at level 1) : code_scope.
Notation "a -ᵢ b" := (Int.sub a b)(at level 1) : code_scope.
Notation "a =ᵢ b" := (Int.eq a b)(at level 1) : code_scope.
Notation "a <ᵢ b" := (Int.lt a b)(at level 1) : code_scope.
Notation "a >ᵢ b" := (Int.lt b a)(at level 1) : code_scope.
Notation "a <=ᵢ b" := (orb(Int.lt a b)(Int.eq a b))(at level 1) : code_scope.
Notation "a >=ᵢ b" := (orb(Int.lt b a)(Int.eq a b))(at level 1) : code_scope.
Notation "a !=ᵢ b" := (negb(Int.eq a b))(at level 1) : code_scope.
Notation "a 'modu' b" := (Int.modu a b)(at level 1) : code_scope.
Notation "a 'xor' b" := (Int.xor a b)(at level 1) : code_scope.

Definition int_le a b :=
  Int.lt a b || Int.eq a b.
Notation "A <ᵢ B <ᵢ C" := (Int.lt A B && Int.lt B C = true)
                            (at level 2, B at next level) : code_scope.
Notation "A <ᵢ B <=ᵢ C" := (Int.lt A B && int_le B C = true)
                             (at level 2, B at next level) : code_scope.
Notation "A <=ᵢ B <ᵢ C" := (int_le A B && Int.lt B C = true)
                             (at level 2, B at next level) : code_scope.
Notation "A <=ᵢ B <=ᵢ C" := (int_le A B && int_le B C = true)
                              (at level 2, B at next level) : code_scope.

Definition int_leu a b :=
  Int.ltu a b || Int.eq a b.

Notation "A <ᵤᵢ B <ᵤᵢ C" := (Int.ltu A B && Int.ltu B C = true)
                              (at level 2, B at next level) : code_scope.
Notation "A <ᵤᵢ B <=ᵤᵢ C" := (Int.ltu A B && int_leu B C = true)
                               (at level 2, B at next level) : code_scope.
Notation "A <=ᵤᵢ B <ᵤᵢ C" := (int_leu A B && Int.ltu B C = true)
                               (at level 2, B at next level) : code_scope.
Notation "A <=ᵤᵢ B <=ᵤᵢ C" := (int_leu A B && int_leu B C = true)
                                (at level 2, B at next level) : code_scope.
Notation "A <ᵤᵢ B" := (Int.ltu A B = true)
                        (at level 2, no associativity) : code_scope.
Notation "A <=ᵤᵢ B" := (int_leu A B = true)
                         (at level 2, no associativity) : code_scope.

Open Scope code_scope.

Definition get_R (R : RegFile) (rn : RegName) :=
  match (R rn) with
  | Some v => match rn with
             | Rr r0 => Some (W ($ 0))
             | _ => Some v
             end
  | None => None
  end.

Definition eval_opexp (R : RegFile) (o : OpExp) :=
  match o with
  | Or r => get_R R r
  | Ow w =>
    if andb (($-4096) <=ᵢ w) (w <=ᵢ ($4095)) then
      Some (W w)
    else
      None
  end.

Definition val_add (v1 v2 : Val) :=
  match v1, v2 with
  | W w1, W w2 => Some (W (w1 +ᵢ w2))
  | Ptr (b, ofs), W w => Some (Ptr (b, ofs +ᵢ w))
  | _, _ => None
  end.

Definition val_sub (v1 v2 : Val) :=
  match v1, v2 with
  | W w1, W w2 => Some (W (w1 -ᵢ w2))
  | Ptr (b, ofs), W w => Some (Ptr (b, ofs -ᵢ w))
  | _, _ => None
  end.

Definition eval_addrexp (R : RegFile) (a : AddrExp) :=
  match a with
  | Ao o => eval_opexp R o
  | Aro r o =>
    match get_R R r with
    | Some v1 =>
      match (eval_opexp R o) with
      | Some v2 => val_add v1 v2
      | None => None
      end
    | None => None
    end
  end.

(* set_R set a value in Register *)
Definition set_R (R : RegFile) (rn : RegName) (v : Val) :=
  if is_indom rn R then
    RegMap.set rn (Some v) R
  else
    R.

(* fetch *)
Definition fetch_frame {tp} (R : tp -> option Val) (rr0 rr1 rr2 rr3 rr4 rr5 rr6 rr7 : tp) :
  option Frame :=
  match (R rr0), (R rr1), (R rr2),
        (R rr3), (R rr4), (R rr5), (R rr6), (R rr7) with
  | Some v0, Some v1, Some v2, Some v3, Some v4, Some v5, Some v6, Some v7 =>
    Some ([[v0, v1, v2, v3, v4, v5, v6, v7]])
  | _, _, _, _, _, _, _, _ => None
  end.

Definition fetch (R : RegFile) :=
  match (fetch_frame R r8 r9 r10 r11 r12 r13 r14 r15),
        (fetch_frame R r16 r17 r18 r19 r20 r21 r22 r23),
        (fetch_frame R r24 r25 r26 r27 r28 r29 r30 r31) with
  | Some fmo, Some fml, Some fmi =>
    Some (fmo :: fml :: fmi :: nil)
  | _, _, _ => None
  end.

(* exe_delay *)
Fixpoint exe_delay (R : RegFile) (D : DelayList) : RegFile * DelayList :=
  match D with
  | (0%nat, rsp, w) :: D =>
    let (R', D') := exe_delay R D in
    (set_R R' rsp (W w), D')
  | (S k, rsp, w) :: D =>
    let (R', D') := exe_delay R D in
    (R', (k, rsp, w) :: D')
  | nil => (R, D)
  end.


(** This file collects facts on proof irrelevant types/propositions. *)
From stdpp Require Export base.
From stdpp Require Import options.

Global Hint Extern 200 (ProofIrrel _) => progress (lazy beta) : typeclass_instances.

Instance True_pi: ProofIrrel True.
Proof. intros [] []; reflexivity. Qed.
Instance False_pi: ProofIrrel False.
Proof. intros []. Qed.
Instance unit_pi: ProofIrrel ().
Proof. intros [] []; reflexivity. Qed.
Instance and_pi (A B : Prop) :
  ProofIrrel A → ProofIrrel B → ProofIrrel (A ∧ B).
Proof. intros ?? [??] [??]. f_equal; trivial. Qed.
Instance prod_pi (A B : Type) :
  ProofIrrel A → ProofIrrel B → ProofIrrel (A * B).
Proof. intros ?? [??] [??]. f_equal; trivial. Qed.
Instance eq_pi {A} (x : A) `{∀ z, Decision (x = z)} (y : A) :
  ProofIrrel (x = y).
Proof.
  set (f z (H : x = z) :=
    match decide (x = z) return x = z with
    | left H => H | right H' => False_rect _ (H' H)
    end).
  assert (∀ z (H : x = z),
    eq_trans (eq_sym (f x (eq_refl x))) (f z H) = H) as help.
  { intros ? []. destruct (f x eq_refl); tauto. }
  intros p q. rewrite <-(help _ p), <-(help _ q).
  unfold f at 2 4. destruct (decide _); [reflexivity|]. exfalso; tauto.
Qed.
Instance Is_true_pi (b : bool) : ProofIrrel (Is_true b).
Proof. destruct b; simpl; apply _. Qed.
Lemma sig_eq_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)}
  (x y : sig P) : x = y ↔ `x = `y.
Proof.
  split; [intros <-; reflexivity|].
  destruct x as [x Hx], y as [y Hy]; simpl; intros; subst.
  f_equal. apply proof_irrel.
Qed.
Instance proj1_sig_inj `(P : A → Prop) `{∀ x, ProofIrrel (P x)} :
  Inj (=) (=) (proj1_sig (P:=P)).
Proof. intros ??. apply (sig_eq_pi P). Qed.
Lemma exists_proj1_pi `(P : A → Prop) `{∀ x, ProofIrrel (P x)}
  (x : sig P) p : `x ↾ p = x.
Proof. apply (sig_eq_pi _); reflexivity. Qed.


(***************************************************************************
* Functional Translation of a Calculus of Capabilities - Definitions       *
* Arthur Charguéraud, January 2009, Coq v8.1                               *
***************************************************************************)

Set Implicit Arguments.
Require Export Eff_Definitions LibClosure.
Implicit Types x : var.

(* ********************************************************************** *)
(** ** Instanciation of tactics *)

(** Tactic [gather_vars] returns a set of variables occurring in
    the context of proofs, including domain of environments and
    free variables in terms mentionned in the context. *)

Ltac gather_vars :=
  let A := gather_vars_with (fun x : vars => x) in
  let B := gather_vars_with (fun x : var => {{ x }}) in
  let C := gather_vars_with (fun x : ctx => dom x) in
(*   let D := gather_vars_with (fun x : trm => fv x) in
  let D := gather_vars_with (fun x : trm => fv x) in *)
  constr:(A \u B \u C).

(** Tactic [pick_fresh x] adds to the context a new variable x
    and a proof that it is fresh from all of the other variables
    gathered by tactic [gather_vars]. *)

Ltac pick_fresh Y :=
  let L := gather_vars in (pick_fresh_gen L Y).

(** Tactic [apply_fresh T as y] takes a lemma T of the form
    [forall L ..., (forall x, x \notin L, P x) -> ... -> Q.]
    instanciate L to be the set of variables occuring in the
    context (by [gather_vars]), then introduces for the premise
    with the cofinite quantification the name x as "y" (the second
    parameter of the tactic), and the proof that x is not in L. *)

Tactic Notation "apply_fresh" constr(T) "as" ident(x) :=
  apply_fresh_base T gather_vars x.
Tactic Notation "apply_fresh" "*" constr(T) "as" ident(x) :=
  apply_fresh T as x; auto_star.
Tactic Notation "apply_fresh" constr(T) :=
  apply_fresh_base T gather_vars ltac_no_arg.
Tactic Notation "apply_fresh" "*" constr(T) :=
  apply_fresh T; auto_star.

(* ********************************************************************** *)
(** ** Induction Schemes *)

Scheme term_induct := Induction for term Sort Prop
  with value_induct := Induction for value Sort Prop.
Combined Scheme term_value_induct
  from term_induct, value_induct.

Scheme tval_induct := Induction for tval Sort Prop
  with ttrm_induct := Induction for ttrm Sort Prop.
Combined Scheme tval_ttrm_induct
  from tval_induct, ttrm_induct.

(* ********************************************************************** *)
(** ** Regularity lemmas *)


Require Export Iron.Language.SystemF2Effect.Step.Frame.
Require Export Iron.Language.SystemF2Effect.Store.Bind.

(********************************************************************)
(* All region handles in this effect have corresponding
   FUse frames in the frame stack. *)
Definition LiveEs (fs : stack) (es : list ty)
 := Forall (fun e1 => forall p2,  handleOfEffect e1 = Some p2
                   -> (exists m1, In (FPriv m1 p2) fs))
           es.

Definition LiveE  (fs : stack) (e : ty)
 := LiveEs fs (flattenT e).

(*******************************************************************)
Lemma liveEs_equivTs
 :  forall  ke sp es1 es2 fs
 ,  EquivTs ke sp es1 es2 KEffect
 -> LiveEs  fs es1
 -> LiveEs  fs es2.
Proof.
 intros. inverts H.
 unfold LiveEs in *.
 snorm.
 apply  H4 in H.
 eapply H0 in H; eauto.
Qed.

Lemma liveE_equivT_left
 :  forall ke sp e1 e2 fs
 ,  EquivT ke sp e1 e2 KEffect
 -> LiveE  fs e2
 -> LiveE  fs e1.
Proof.
 intros.
 unfold LiveE in *.
 eapply liveEs_equivTs.
 - eapply equivT_equivTs; auto.
   eapply EqSym.
   + eauto.
   + have (KindT ke sp e2 KEffect).
     eauto.
   + auto.
 - auto.
Qed.

Lemma liveE_equivT_right
 :  forall ke sp e1 e2 fs
 ,  EquivT ke sp e1 e2 KEffect
 -> LiveE  fs e1
 -> LiveE  fs e2.
Proof.
 intros.
 unfold LiveE in *.
 eapply liveEs_equivTs.
 - eapply equivT_equivTs; eauto.
 - auto.
Qed.

(*******************************************************************)
Lemma liveEs_subsTs
 :  forall ke sp es1 es2 fs
 ,  SubsTs ke sp es1 es2 KEffect
 -> LiveEs fs es1
 -> LiveEs fs es2.
Proof.
 intros. inverts H.
 unfold LiveEs in *.
 snorm.
 eapply H0; eauto.
Qed.

Lemma liveE_subsT
 :  forall ke sp e1 e2 fs
 ,  SubsT ke sp e1 e2 KEffect
 -> LiveE fs e1
 -> LiveE fs e2.
Proof.
 intros.
 unfold LiveE in *.
 eapply liveEs_subsTs.
 - eapply subsT_subsTs in H; eauto.
 - auto.
Qed.
Hint Resolve liveE_subsT.

(********************************************************************)
Lemma liveE_sum_above
 :  forall e1 e2 fs
 ,  LiveE  fs e1 -> LiveE fs e2
 -> LiveE  fs (TSum e1 e2).
Proof.
 intros.
 unfold LiveE. simpl.
 unfold LiveEs.
 eapply Forall_app; eauto.
Qed.
Hint Resolve liveE_sum_above.

Lemma liveE_sum_above_left
 :  forall fs e1 e2
 ,  LiveE fs (TSum e1 e2)
 -> LiveE fs e1.
Proof.
 intros.
 unfold LiveE  in *.
 unfold LiveEs in *.
 snorm. eauto.
Qed.
Hint Resolve liveE_sum_above_left.

Lemma liveE_sum_above_right
 :  forall fs e1 e2
 ,  LiveE fs (TSum e1 e2)
 -> LiveE fs e2.
Proof.
 intros.
 unfold LiveE  in *.
 unfold LiveEs in *.
 snorm. eauto.
Qed.

(********************************************************************)
Lemma liveE_frame_cons
 :  forall fs f e
 ,  LiveE  fs        e
 -> LiveE  (fs :> f) e.
Proof.
 intros.
 unfold LiveE in *.
 unfold LiveEs in *.
 snorm. firstorder.
Qed.
Hint Resolve liveE_frame_cons.

Lemma liveE_pop_flet
 :  forall fs t x e
 ,  LiveE  (fs :> FLet t x) e
 -> LiveE  fs e.
Proof.
 intros.
 unfold LiveE in *.
 unfold LiveEs in *.
 snorm.
 spec H x0. rip.
 spec H p2. rip.
 firstorder. nope.
Qed.

Lemma liveE_maskOnVarT
 :  forall fs e n
 ,  LiveE  fs (maskOnVarT n e)
 -> LiveE  fs e.
Proof.
 intros.
 unfold LiveE in *.
 unfold LiveEs in *.
 snorm.
 spec H x.
 apply handleOfEffect_form_some in H1.
 destruct H1 as [tc]. rip.
 eapply maskOnVar_effect_remains in H0.
 - eapply H in H0; eauto.
   snorm. nope.
 - eauto.
Qed.

Lemma liveE_phase_change
 :  forall fs m1 p e
 ,  LiveE (fs :> FPriv m1 p) e
 -> LiveE (fs :> FPriv m1 p) (substTT 0 (TRgn p) e).
Proof.
 intros.
 induction e; snorm;
  try (solve [unfold LiveE in *;
              unfold LiveEs in *;
              snorm; inverts H0; nope]).

 - Case "TSum".
   eapply liveE_sum_above.
   + eapply liveE_sum_above_left  in H; eauto.
   + eapply liveE_sum_above_right in H; eauto.

 - Case "TCon1".
   destruct e;
    unfold LiveE; unfold LiveEs; snorm;
    try (solve [inverts H0; snorm; nope]).
   exists m1.
   inverts H0.
   + snorm.
   + nope.
Qed.

Lemma liveE_fpriv_in
 :  forall e p2 fs
 ,  LiveE fs e
 -> handleOfEffect e = Some p2
 -> (exists m1, In (FPriv m1 p2) fs).
Proof.
 intros.
 unfold LiveE  in *.
 unfold LiveEs in *.
 snorm.
 eapply handleOfEffect_form_some in H0.
 destruct H0 as [tc]. rip.
 snorm.
 lets D: H (TCon1 tc (TRgn p2)). clear H.
 eapply D. snorm. snorm. nope.
Qed.

Global Opaque LiveE.