Require Import Bool.
Require Import List.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Basic.
Require Import Event.
From PromisingLib Require Import Language.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import Progress.

Require Import SimPromises.
Require Import Compatibility.
Require Import SimThread.

Require Import Syntax.
Require Import Semantics.

Set Implicit Arguments.

Lemma read_read_tview
      loc1 ts1 released1 ord1
      loc2 ts2 released2 ord2
      tview0
      (WF0: TView.wf tview0)
      (WF1: View.opt_wf released1)
      (WF2: View.opt_wf released2):
  TView.le
    (TView.read_tview
       (TView.read_tview tview0 loc2 ts2 released2 ord2)
       loc1 ts1 released1 ord1)
    (TView.read_tview
       (TView.read_tview tview0 loc1 ts1 released1 ord1)
       loc2 ts2 released2 ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (try by condtac; aggrtac).
Qed.

Lemma read_write_tview
      loc1 ts1 released1 ord1
      loc2 ts2 ord2
      tview0 sc0
      (WF0: TView.wf tview0)
      (WF1: View.opt_wf released1):
  TView.le
    (TView.read_tview
       (TView.write_tview tview0 sc0 loc2 ts2 ord2)
       loc1 ts1 released1 ord1)
    (TView.write_tview
       (TView.read_tview tview0 loc1 ts1 released1 ord1)
       sc0 loc2 ts2 ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (try by condtac; aggrtac).
  repeat condtac; aggrtac; try apply WF0.
Qed.

Lemma read_read_fence_tview
      loc1 ts1 released1 ord1
      ord2
      tview0
      (WF0: TView.wf tview0)
      (WF1: View.opt_wf released1):
  TView.le
    (TView.read_tview
       (TView.read_fence_tview tview0 ord2)
       loc1 ts1 released1 ord1)
    (TView.read_fence_tview
       (TView.read_tview tview0 loc1 ts1 released1 ord1)
       ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (try by condtac; aggrtac).
  - repeat condtac; aggrtac; try apply WF0.
  - repeat condtac; aggrtac; try apply WF0.
  - repeat condtac; aggrtac; try apply WF0.
    destruct ord1; inv COND; inv COND1.
Qed.

Lemma read_write_fence_tview
      loc1 ts1 released1 ord1
      ord2
      tview0 sc0
      (WF0: TView.wf tview0)
      (WF1: View.opt_wf released1):
  TView.le
    (TView.read_tview
       (TView.write_fence_tview tview0 sc0 ord2)
       loc1 ts1 released1 ord1)
    (TView.write_fence_tview
       (TView.read_tview tview0 loc1 ts1 released1 ord1)
       sc0 ord2).
Proof.
  unfold TView.write_fence_tview, TView.write_fence_sc.
  econs; repeat (try condtac; aggrtac; try apply WF0).
Qed.

Lemma write_read_tview
      loc1 ts1 ord1
      loc2 ts2 released2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0)
      (WF2: View.opt_wf released2):
  TView.le
    (TView.write_tview
       (TView.read_tview tview0 loc2 ts2 released2 ord2)
       sc0 loc1 ts1 ord1)
    (TView.read_tview
       (TView.write_tview tview0 sc0 loc1 ts1 ord1)
       loc2 ts2 released2 ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (try by condtac; aggrtac).
  condtac; aggrtac. condtac.
  - destruct ord1; inv ORD1; inv COND0.
  - aggrtac; try apply WF0.
Qed.

Lemma write_write_tview
      loc1 ts1 ord1
      loc2 ts2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0):
  TView.le
    (TView.write_tview
       (TView.write_tview tview0 sc0 loc2 ts2 ord2)
       sc0 loc1 ts1 ord1)
    (TView.write_tview
       (TView.write_tview tview0 sc0 loc1 ts1 ord1)
       sc0 loc2 ts2 ord2).
Proof.
  econs; repeat (try condtac; aggrtac).
  all: try by apply WF0.
Qed.

Lemma write_read_fence_tview
      loc1 ts1 ord1
      ord2
      tview0 sc0
      (ORD2: Ordering.le ord2 Ordering.relaxed)
      (WF0: TView.wf tview0):
  TView.le
    (TView.write_tview
       (TView.read_fence_tview tview0 ord2)
       sc0 loc1 ts1 ord1)
    (TView.read_fence_tview
       (TView.write_tview tview0 sc0 loc1 ts1 ord1)
       ord2).
Proof.
  econs; repeat (try condtac; aggrtac; try apply WF0).
Qed.

Lemma write_write_fence_tview
      loc1 ts1 ord1
      ord2
      tview0 sc0
      (ORD2: Ordering.le ord2 Ordering.acqrel)
      (WF0: TView.wf tview0):
  TView.le
    (TView.write_tview
       (TView.write_fence_tview tview0 sc0 ord2)
       (TView.write_fence_sc tview0 sc0 ord2)
       loc1 ts1 ord1)
    (TView.write_fence_tview
       (TView.write_tview tview0 sc0 loc1 ts1 ord1)
       sc0 ord2).
Proof.
  unfold TView.write_fence_tview, TView.write_fence_sc.
  econs; repeat (try condtac; aggrtac; try apply WF0).
Qed.

Lemma read_fence_read_tview
      ord1
      loc2 ts2 released2 ord2
      tview0
      (ORD2: Ordering.le ord2 Ordering.plain \/ Ordering.le Ordering.acqrel ord2)
      (WF0: TView.wf tview0):
  TView.le
    (TView.read_fence_tview
       (TView.read_tview tview0 loc2 ts2 released2 ord2)
       ord1)
    (TView.read_tview
       (TView.read_fence_tview tview0 ord1)
       loc2 ts2 released2 ord2).
Proof.
  econs; repeat (try condtac; aggrtac; try apply WF0).
  des; [|congr]. destruct ord2; inv ORD2; inv COND0.
Qed.

Lemma read_fence_write_tview
      ord1
      loc2 ts2 ord2
      tview0 sc0
      (WF0: TView.wf tview0):
  TView.le
    (TView.read_fence_tview
       (TView.write_tview tview0 sc0 loc2 ts2 ord2)
       ord1)
    (TView.write_tview
       (TView.read_fence_tview tview0 ord1)
       sc0 loc2 ts2 ord2).
Proof.
  econs; repeat (try condtac; aggrtac; try apply WF0).
Qed.

Lemma write_fence_read_tview
      ord1
      loc2 ts2 released2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0)
      (WF2: View.opt_wf released2):
  TView.le
    (TView.write_fence_tview
       (TView.read_tview tview0 loc2 ts2 released2 ord2) sc0 ord1)
    (TView.read_tview
       (TView.write_fence_tview tview0 sc0 ord1)
       loc2 ts2 released2 ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (repeat (condtac; aggrtac; try apply WF0)).
Qed.

Lemma write_fence_read_sc
      ord1
      loc2 ts2 released2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0):
  TimeMap.le
    (TView.write_fence_sc
       (TView.read_tview tview0 loc2 ts2 released2 ord2) sc0 ord1)
    (TView.write_fence_sc tview0 sc0 ord1).
Proof.
  ii. unfold TView.write_fence_sc.
  repeat condtac; aggrtac.
Qed.

Lemma write_fence_write_tview
      ord1
      loc2 ts2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0):
  TView.le
    (TView.write_fence_tview
       (TView.write_tview tview0 sc0 loc2 ts2 ord2)
       sc0 ord1)
    (TView.write_tview
       (TView.write_fence_tview tview0 sc0 ord1)
       sc0 loc2 ts2 ord2).
Proof.
  econs; aggrtac;
    (try by apply WF0);
    (repeat (condtac; aggrtac; try apply WF0)).
Qed.

Lemma write_fence_write_sc
      ord1
      loc2 ts2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord1 Ordering.relaxed)
      (WF0: TView.wf tview0):
  TimeMap.le
    (TView.write_fence_sc
       (TView.write_tview tview0 sc0 loc2 ts2 ord2)
       sc0 ord1)
    (TView.write_fence_sc tview0 sc0 ord1).
Proof.
  ii. unfold TView.write_fence_sc.
  repeat condtac; aggrtac.
Qed.

Lemma read_fence_write_fence_tview
      ord1
      ord2
      tview0 sc0
      (WF0: TView.wf tview0):
  TView.le
    (TView.read_fence_tview
       (TView.write_fence_tview tview0 sc0 ord2)
       ord1)
    (TView.write_fence_tview
       (TView.read_fence_tview tview0 ord1)
       sc0 ord2).
Proof.
  unfold TView.write_fence_tview, TView.write_fence_sc.
  econs; repeat (try condtac; aggrtac; try apply WF0).
  - rewrite <- TimeMap.join_r. apply WF0.
  - rewrite <- TimeMap.join_r. apply WF0.
  - rewrite <- TimeMap.join_r. apply WF0.
  - rewrite <- View.join_r. viewtac.
    rewrite <- TimeMap.join_r. apply WF0.
  - rewrite <- View.join_r. viewtac.
    rewrite <- TimeMap.join_r. apply WF0.
Qed.

Lemma read_write_tview_eq
      loc1 ts1 released1 ord1
      loc2 ts2 ord2
      tview0 sc0
      (ORD1: Ordering.le ord2 Ordering.relaxed)
      (WF0: TView.wf tview0)
      (WF1: View.opt_wf released1):
  (TView.read_tview
     (TView.write_tview tview0 sc0 loc2 ts2 ord2)
     loc1 ts1 released1 ord1) =
  (TView.write_tview
     (TView.read_tview tview0 loc1 ts1 released1 ord1)
     sc0 loc2 ts2 ord2).
Proof.
  apply TView.antisym.
  - apply read_write_tview; auto.
  - apply write_read_tview; auto.
Qed.


From iris.algebra Require Import auth list agree frac.
From iris.program_logic Require Import adequacy ectxi_language.
From iris_examples.logrel.F_mu_ref_conc Require Import soundness_binary.
From iris_examples.logrel.F_mu_ref_conc.examples Require Import lock.
From iris_examples.logrel.F_mu_ref_conc.examples.stack Require Import
  CGF_stack CGL_stack stack_rules.
From iris.proofmode Require Import tactics.

Definition stackN : namespace := nroot .@ "stack".

Section Stack_refinement.
  Context `{heapIG Σ, cfgSG Σ, inG Σ (authR stackUR), inG Σ stateUR}.
  Notation D := (prodO valO valO -n> iPropO Σ).
  Implicit Types Δ : listO D.

  Lemma CGL_CGF_counter_refinement :
    [] ⊨ CGL_stack ≤log≤ CGF_stack : TForall (TProd
           (TArrow (TVar 0) TUnit)
           (TArrow TUnit (TSum TUnit (TVar 0)))).
  Proof.
    iIntros (Δ [|] ?) "#[Hspec HΓ]"; iIntros (j K) "Hj"; last first.
    { iDestruct (interp_env_length with "HΓ") as %[=]. }
    iClear "HΓ".
    iAsimpl.
    iApply wp_value.
    iExists (TLamV _); iFrame "Hj".
    clear j K. iAlways. iIntros (τi) "%". iIntros (j K) "Hj /=".
    (** evaluate newlock and create stack *)
    (* L *)
    iApply wp_pure_step_later; auto;iNext;iAsimpl.
    iApply (wp_bind (fill [LetInCtx _])).
    iApply wp_newlock;first done;iNext;iIntros (lL) "HlL";iAsimpl.
    iApply wp_pure_step_later; first done; iNext;iAsimpl.
    iApply (wp_bind (fill [AllocCtx; LetInCtx _])).
    iApply wp_alloc;first done;iNext;iIntros (istkL) "HistkL";iAsimpl.
    iApply (wp_bind (fill [LetInCtx _])).
    iApply wp_alloc;first done;iNext;iIntros (stkL) "HstkL";iAsimpl.
    iApply wp_pure_step_later; auto; iNext; iAsimpl.
    (* F *)
    iMod (do_step_pure _ j K with "[$Hj]") as "Hj"; eauto.
    iMod (steps_newlock _ j (LetInCtx _ :: K)  with "[$Hj]") as (lF) "[Hj HlF]"; eauto;simpl.
    iMod (do_step_pure with "[$Hj]") as "Hj"; eauto;iAsimpl.
    iMod (step_alloc  _ j (LetInCtx _ :: K) with "[$Hj]") as (stkF) "[Hj HstkF]"; eauto;simpl.
    iMod (do_step_pure with "[$Hj]") as "Hj"; eauto;iAsimpl.
    (** alloc invariant*)
    iMod (own_alloc (● (∅ : stackUR))) as (γ) "Hemp"; first by apply auth_auth_valid.
    set (istkG := StackG _ _ γ).
    change γ with (@stack_name _ istkG).
    change H1 with (@stack_inG _ istkG).
    clearbody istkG. clear γ H1.
    (*?*)
    iAssert (@stack_owns _ istkG _ ∅) with "[Hemp]" as "Hoe".
    { rewrite /stack_owns big_sepM_empty fmap_empty. iFrame "Hemp"; trivial. }
    (*?*)
    iMod (stack_owns_alloc with "[$Hoe $HistkL]") as "[Hoe Hls]".
    iAssert (StackLink τi (LocV istkL, FoldV (InjLV UnitV))) with "[Hls]" as "HLKL".
    { rewrite StackLink_unfold.
      iExists _, _. iSplitR; simpl; trivial.
      iFrame "Hls". iLeft. iSplit; trivial. }
    iMod (own_alloc (newstate 1 istkL)) as (γ) "[Hγ1 Hγ2]";first done.
    iAssert ((∃ istkL v h b, (stack_owns h)
                         ∗ stkF ↦ₛ v
                         ∗ stkL ↦ᵢ (LocV istkL) ∗ γ ⤇[1/2] istkL
                         ∗ StackLink τi (LocV istkL, v)
                         ∗ lF ↦ₛ (#♭v false)
                         ∗ lL ↦ᵢ (#♭v b) ∗ ( ⌜b = true ⌝ ∨ ⌜b = false ⌝ ∗ γ ⤇[1/2] istkL)
             )%I) with "[Hoe HstkL HstkF HLKL HlF HlL Hγ1 Hγ2]" as "Hinv".
    { iExists istkL, _, _, false. iFrame "Hoe HstkL HstkF HLKL HlF HlL".  iFrame. iRight. iFrame. done. }
    iMod (inv_alloc stackN with "[Hinv]") as "#Hinv"; [iNext; iExact "Hinv"|].
    Opaque stack_owns.
    (** split into push and pop*)
    iApply wp_value.
    iExists (PairV (CGF_locked_pushV _ _)
                (CGF_locked_popV _ _)).
    simpl.
    rewrite CGF_locked_push_of_val CGF_locked_pop_of_val.
    iFrame "Hj".
    iExists (_, _), (_, _); iSplit; eauto.
    iSplit; iAlways; clear j K.
    - (* push *)
      iIntros ( [v1 v2] ) "#Hrel". iIntros (j K) "Hj /=".
      (* L *)
      iApply wp_pure_step_later; auto;iNext;iAsimpl.
      iApply (wp_bind (fill [SeqCtx _])).
      (* acquire*)
      Transparent acquire.
      rewrite /acquire.
      iLöb as "Hlob".
      iApply wp_pure_step_later; auto;iNext;iAsimpl.
      iApply (wp_bind (fill [IfCtx _ _])).
      (* open invariant *)
      iInv stackN as (istk2 v h b) "(Hoe & HstkF &  HstkL & Hγ & HLKL & HlF & >HlL & [> ->|[> -> Hγ2]])" "Hclose".
      + iApply (wp_cas_fail with "HlL"); auto; iNext; iIntros "HlL";iAsimpl.
        iMod ("Hclose" with "[-Hj]") as "_".
        { iNext. iExists istk2, _, _,true. iFrame. iLeft; done. }
        iModIntro.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply "Hlob".
        iFrame.
      + iApply (wp_cas_suc with "HlL"); auto; iNext; iIntros "HlL";iAsimpl.
        iMod ("Hclose" with "[-Hj Hγ]") as "_".
        { iNext. iExists istk2, _, _,true. iFrame. iLeft;done. }
        iModIntro.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply wp_value;iAsimpl.
        iClear "Hlob".
        clear v h.
        (* acquire succ! *)
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [LetInCtx _])).
        rewrite CGL_push_folding;iAsimpl.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [LetInCtx _])).
        (* open invariant *)
        iInv stackN as (istk2' v h b) "(Hoe & HstkF &  HstkL & Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
        iApply (wp_load with "HstkL"); iNext; iIntros "HstkL".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        iMod ("Hclose" with "[-Hj Hγ]") as "_".
        { iNext. iExists _, _, _,_. iFrame. }
        iModIntro;iAsimpl.
        clear  h b.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [StoreRCtx  (LocV _)])).
        iApply wp_alloc;first done;iNext;iIntros (tmp) "HtmpL";iAsimpl.
        iInv stackN as (istk2'' v' h b) "(Hoe & HstkF &  HstkL & Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
        iApply (wp_store with "HstkL"); iNext; iIntros "HstkL".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        iMod (makeElem_update _ _ _ tmp with "Hγ Hγ1") as "[Hγ Hγ1]".
        (* F *)
        iMod (steps_CGF_locked_push _ j K with "[Hj HlF HstkF]")
            as "[Hj [HstkF HlF]]"; first solve_ndisj.
        { rewrite CGF_locked_push_of_val. by iFrame "Hspec HstkF Hj". }
        iMod (stack_owns_alloc with "[$Hoe $HtmpL]") as "[Hoe HtmpL]".
        iDestruct "Hbool" as "[-> |[-> Hγ2]]".
        * (*b=true, release succ*)
          iMod ("Hclose" with "[-Hj  Hγ]") as "_".
        { iNext. iExists tmp,(FoldV (InjRV (PairV v2 v'))) , _,_. iFrame. iSplitL. do 2 rewrite StackLink_unfold. rewrite -StackLink_unfold. iExists tmp, _.  iFrame "HtmpL". simpl.  iSplitR. done. iRight. iExists v1,(LocV istk2),v2, v', istk2. iFrame "#". eauto. iLeft. done. }
        clear v v' h istk2.
        iApply (wp_bind (fill [LetInCtx _])).
        iModIntro.
        iApply wp_value;iAsimpl.
        iApply wp_pure_step_later; auto; simpl; iNext;iAsimpl.
        iApply (wp_bind (fill [SeqCtx _])).
        (** release *)
        Transparent release.
        rewrite /release.
        iApply wp_pure_step_later; auto; simpl; iNext.
        iInv stackN as (istk2 v h b) "(Hoe & HstkF &  HstkL & >Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        iApply (wp_store with "HlL");iNext;iIntros "HlL".
        iMod ("Hclose" with "[-Hj]") as "_".
        { iNext. iExists _, _, _,_. iFrame. iRight. iFrame. done. }
        iModIntro.
        iApply wp_pure_step_later; auto; simpl; iNext.
        iApply wp_value. iExists UnitV. iFrame. done.
        * (*b=false, FALSE*)
          iDestruct (makeElem_eq with "Hγ Hγ2") as %<-.
          iDestruct (makeElem_entail with "Hγ1 Hγ2") as "Hγγ".
          iDestruct (makeElem_entail with "Hγγ Hγ") as "Hγ".
          rewrite dummy.
          iDestruct (invalid with "Hγ") as %[].
    - (* pop *)
      iIntros ( ? [-> ->] ); simpl. iIntros (j K) "Hj /=".
      (* L *)
      iApply wp_pure_step_later; auto;iNext;iAsimpl.
      iApply (wp_bind (fill [SeqCtx _])).
      (* acquire*)
      iLöb as "Hlob".
      iApply wp_pure_step_later; auto;iNext;iAsimpl.
      iApply (wp_bind (fill [IfCtx _ _])).
      iInv stackN as (istk2 v h b) "(Hoe & HstkF &  HstkL & Hγ & HLKL & HlF & >HlL & [> ->|[> -> Hγ2]])" "Hclose".
      + iApply (wp_cas_fail with "HlL"); auto; iNext; iIntros "HlL";iAsimpl.
        iMod ("Hclose" with "[-Hj]") as "_".
        { iNext. iExists istk2, _, _,true. iFrame. iLeft; done. }
        iModIntro.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply "Hlob".
        iFrame.
      + iApply (wp_cas_suc with "HlL"); auto; iNext; iIntros "HlL";iAsimpl.
        iMod ("Hclose" with "[-Hj Hγ]") as "_".
        { iNext. iExists istk2, _, _,true. iFrame. iLeft;done. }
        iModIntro.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply wp_value;iAsimpl.
        iClear "Hlob".
        clear v h.
        (* acquire succ! *)
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [LetInCtx _])).
        rewrite CGL_pop_folding;iAsimpl.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [LetInCtx _])).
        iInv stackN as (istk2' v h b) "(Hoe & HstkF &  HstkL & Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
        iApply (wp_load with "HstkL"); iNext; iIntros "HstkL".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        iMod ("Hclose" with "[-Hj Hγ]") as "_".
        { iNext. iExists _, _, _,_. iFrame. }
        iModIntro;iAsimpl.
        clear  h b v.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [CaseCtx _ _])).
        iInv stackN as (istk2' v h b) "(Hoe & HstkF &  HstkL & >Hγ1 & #HLKLinv & HlF & >HlL & Hbool)" "Hclose".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        rewrite StackLink_unfold.
        iPoseProof "HLKLinv" as (istk2' tmp) "[>%  [>HistkL [>[% %]|H2]]]"; simplify_eq /=;
        iClear "HLKLinv".
        * (* stack is empty *)
        iDestruct (stack_owns_later_open_close with "Hoe HistkL") as "[>HistkL' Hoe]".
        iApply (wp_load with "HistkL'"); iNext; iIntros "HistkL'";iAsimpl.
        (* F *)
        rewrite CGF_locked_pop_of_val.
        iMod (steps_CGF_locked_pop_fail with "[$Hspec $HstkF $HlF $Hj]")
             as "[Hj [HstkF HlF]]"; first solve_ndisj.
        (* L *)
        iMod ("Hclose" with "[-Hj Hγ]") as "_".
        { iNext. iExists _, _, _,_.  iFrame. iSplitL. by iApply ("Hoe" with "HistkL'").  rewrite StackLink_unfold.  iExists istk2',_. eauto. }
        iModIntro;iAsimpl.
        clear  h b.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply wp_value;iAsimpl.
        iApply wp_pure_step_later; auto; iNext; iAsimpl.
        iApply (wp_bind (fill [SeqCtx _])).
        (* release *)
        iApply wp_pure_step_later; auto; simpl; iNext.
        iInv stackN as (istk2 v h b) "(Hoe & HstkF &  HstkL & >Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
        iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
        iApply (wp_store with "HlL");iNext;iIntros "HlL".
        iMod ("Hclose" with "[-Hj]") as "_".
        { iNext. iExists _, _, _,_. iFrame. iRight. iFrame. done. }
        iModIntro.
        iApply wp_pure_step_later; auto; simpl; iNext.
        iApply wp_value. iExists (InjLV UnitV). iFrame. iLeft. iExists (UnitV, UnitV).  eauto 10.
        * (* stack is not empty *)
          iDestruct (stack_owns_later_open_close with "Hoe HistkL") as "[>HistkL' Hoe]".
          iApply (wp_load with "HistkL'"); iNext; iIntros "HistkL'";iAsimpl.
          iDestruct "H2" as (v1 stkL' v2 stkF' stkL'v) "(% & % & % & ? & HLKL')".
          simplify_eq /=.
          iMod ("Hclose" with "[-Hj Hγ]") as "_".
          { iNext. iExists _, _, _,_. iFrame. iSplitL. iApply ("Hoe" with "HistkL'"). do 2 rewrite StackLink_unfold. rewrite -StackLink_unfold. iExists istk2', (InjRV (PairV v1 (FoldV (LocV stkL'v)))). iFrame "#".  iSplitR. eauto.  iRight. iExists v1, (LocV stkL'v), v2, stkF', stkL'v. simpl. iFrame"#". done. }
          clear h b.
          iModIntro.
          iApply wp_pure_step_later; auto; simpl; iNext.
          iApply (wp_bind (fill [UnfoldCtx; StoreRCtx (LocV stkL); SeqCtx _])).
          iApply wp_pure_step_later; auto; simpl; iNext.
          iApply wp_value;iAsimpl.
          iApply (wp_bind (fill [StoreRCtx (LocV stkL); SeqCtx _])).
          iApply wp_pure_step_later; auto; simpl; iNext.
          iApply wp_value;iAsimpl.
          iApply (wp_bind (fill [SeqCtx _])).
          iInv stackN as (istk2 v h b) "(Hoe & HstkF &  >HstkL & >Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
          iDestruct (makeElem_eq with "Hγ Hγ1") as %->.
          iApply (wp_store with "HstkL");iNext;iIntros "HstkL".
          do 2 rewrite StackLink_unfold. rewrite -StackLink_unfold.
          iPoseProof "HLKL" as (istk2' tmp) "[Heq [HistkL' [[% %]|H2]]]".
          -- (* empty *)simpl. iDestruct "Heq" as %[=].
             rewrite -H6.
             iDestruct (stack_mapstos_agree with "[HistkL HistkL']") as %?;
                                                                          first (iSplit; [iExact "HistkL"| iExact "HistkL'"]).
             rewrite H1 in H5.
             discriminate.
          -- simpl. iDestruct "Heq" as %[=].
             rewrite -H4.
             iDestruct (stack_mapstos_agree with "[HistkL HistkL']") as %?;
                                                                          first (iSplit; [iExact "HistkL"| iExact "HistkL'"]).

             simplify_eq /=.
             iClear "HLKL'".
             iDestruct "H2" as (v1' stkL'' v2' stkF'' stkL''v) "(% & % & % & #Hrel & HLKL')".
             simplify_eq /=.
             (* F *)
             rewrite CGF_locked_pop_of_val.
             iMod (steps_CGF_locked_pop_suc _ j K with "[$Hspec $HstkF $HlF $Hj]") as "[Hj [HstkF HlF]]"; first solve_ndisj.

             iMod (makeElem_update _ _ _ stkL''v with "Hγ Hγ1") as "[Hγ Hγ1]".
             iDestruct "Hbool" as "[-> |[-> Hγ2]]".
             ++ (*b=true, release succ*)
               iMod ("Hclose" with "[-Hj Hγ]") as "_".
               {iNext. iExists stkL''v, stkF'', h, true.  iFrame . iLeft. done. }
               clear h.
               iModIntro.
               iApply wp_pure_step_later; auto; simpl; iNext.
               iApply (wp_bind (fill [InjRCtx ])).
               iApply wp_pure_step_later; auto; simpl; iNext.
               iApply wp_value;iAsimpl.
               iApply wp_value;iAsimpl.
               iApply wp_pure_step_later; auto; simpl; iNext.
               iApply (wp_bind (fill [SeqCtx _ ])).
               (* release *)
               iApply wp_pure_step_later; auto; simpl; iNext.
               iInv stackN as (istk2 v h b) "(Hoe & HstkF &  HstkL & >Hγ1 & HLKL & HlF & >HlL & Hbool)" "Hclose".
               iDestruct (makeElem_eq with "Hγ Hγ1") as %<-.
               iApply (wp_store with "HlL");iNext;iIntros "HlL".
               iMod ("Hclose" with "[-Hj]") as "_".
               { iNext. iExists _, _, _,_. iFrame. iRight. iFrame. done. }
               iModIntro.
               iApply wp_pure_step_later; auto; simpl; iNext.
               iApply wp_value. iExists (InjRV v2'). iFrame. iRight. iExists (v1', v2').  eauto 10.
             ++ (*b=false, FALSE*)
               iDestruct (makeElem_eq with "Hγ Hγ2") as %<-.
               iDestruct (makeElem_entail with "Hγ1 Hγ2") as "Hγγ".
               iDestruct (makeElem_entail with "Hγγ Hγ") as "Hγ".
               rewrite dummy.
               iDestruct (invalid with "Hγ") as %[].
Qed.


Require Import Coq.Logic.Classical_Prop.

Require Import SpecCert.Address.
Require Import SpecCert.Cache.
Require Import SpecCert.Formalism.
Require Import SpecCert.Interval.
Require Import SpecCert.Memory.
Require Import SpecCert.Smm.Delta.Invariant.
Require Import SpecCert.Smm.Delta.Preserve.Architecture.
Require Import SpecCert.Smm.Software.
Require Import SpecCert.x86.

Lemma read_strat_uc
      (r:  R)
      (pa: PhysicalAddress)
      (v:  Value)
  : partial_preserve (Read r pa v)
                     (fun a => resolve_cache_strategy (proc a) pa = Uncachable)
                     inv.
Proof.
  unfold partial_preserve.
  intros a a' Hinv Hres Hpre Hpost.
  unfold x86_postcondition, read_post in Hpost.
  rewrite Hres in Hpost.
  unfold read_uncachable_post in Hpost.
  rewrite Hpost.
  exact Hinv.
Qed.

Lemma read_strat_sh
      (r:  R)
      (pa: PhysicalAddress)
      (v:  Value)
  : partial_preserve (Read r pa v)
                     (fun a => resolve_cache_strategy (proc a) pa = SmrrHit)
                     inv.
Proof.
  unfold partial_preserve.
  intros a a' Hinv Hres Hpre Hpost.
  unfold x86_postcondition, read_post in Hpost.
  rewrite Hres in Hpost.
  unfold read_smrrhit_post in Hpost.
  rewrite Hpost.
  exact Hinv.
Qed.

Lemma read_strat_smrr_wb
      (r:  R)
      (pa: PhysicalAddress)
      (v:  Value)
    : partial_preserve (Read r pa v)
                       (fun a => is_inside_smrr (proc a) pa
                                 /\ smm_strategy (smrr (proc a)) = WriteBack)
                       inv.
Proof.
  unfold partial_preserve.
  intros a a' Hinv [Hsmrr Hsmm] Hpre Hpost.
  unfold x86_postcondition, read_post, resolve_cache_strategy in Hpost.
  destruct is_inside_smrr_dec; [| intuition ].
  destruct is_in_smm_dec.
  + rewrite Hsmm in Hpost.
    unfold read_writeback_post in Hpost.
    destruct cache_hit_dec.
    * rewrite Hpost.
      exact Hinv.
    * assert (is_inside_smram pa -> is_in_smm (proc a)).
      intro H; exact i0.
      apply (load_in_cache_from_memory_preserves_inv a a' pa Hinv H Hpost).
  + unfold read_smrrhit_post in Hpost.
    rewrite Hpost.
    exact Hinv.
Qed.

Lemma read_strat_not_smrr
      (r:  R)
      (pa: PhysicalAddress)
      (v:  Value)
  : partial_preserve (Read r pa v)
                     (fun a => ~ is_inside_smrr (proc a) pa)
                     inv.
Proof.
  unfold partial_preserve.
  intros a a' Hinv Hnot_smrr Hpre Hpost.
  unfold x86_postcondition, read_post in Hpost.
  unfold resolve_cache_strategy in Hpost.
  destruct is_inside_smrr_dec; [ intuition |].
  case_eq (strategy (proc a)); intro Heqstrat; rewrite Heqstrat in Hpost.
  + unfold read_uncachable_post in Hpost.
    rewrite Hpost.
    exact Hinv.
  + unfold read_writeback_post in Hpost.
    destruct cache_hit_dec.
    * rewrite Hpost; exact Hinv.
    * assert (is_inside_smram pa -> is_in_smm (proc a)).
      intro H.
      destruct Hinv as [Hsmramc [Hsmram [Hsmrr Hclean]]].
      apply Hsmrr in H.
      intuition.
      apply (load_in_cache_from_memory_preserves_inv a a' pa Hinv H Hpost).
  + unfold read_smrrhit_post in Hpost.
    rewrite Hpost.
    exact Hinv.
Qed.

Lemma read_inv
      (r:  R)
      (pa: PhysicalAddress)
      (v:  Value)
  : preserve (Read r pa v) inv.
Proof.
  unfold preserve.
  intros a a' Hinv Hpre Hpost.
  case_eq (resolve_cache_strategy (proc a) pa); intro Heqstrat.
  + apply (read_strat_uc r pa v a a' Hinv Heqstrat Hpre Hpost).
  + destruct (is_inside_smrr_dec (proc a) pa).
    * unfold resolve_cache_strategy in Heqstrat.
      destruct is_inside_smrr_dec; [| intuition ].
      destruct is_in_smm_dec; [| discriminate ].
      assert (is_inside_smrr (proc a) pa /\ smm_strategy (smrr (proc a)) = WriteBack); [
          split; trivial
         |].
      apply (read_strat_smrr_wb r pa v a a' Hinv H Hpre Hpost).
    * apply (read_strat_not_smrr r pa v a a' Hinv n Hpre Hpost).
  + apply (read_strat_sh r pa v a a' Hinv Heqstrat Hpre Hpost).
Qed.


From Coq Require Import String Arith ZArith.

From Vyper Require Import Config Map.
From Vyper.L10 Require Import Base.
From Vyper.L50 Require Import Types AST Builtins Expr LocalVars DynError Stmt.

Fixpoint interpret_call {C: VyperConfig}
                        (max_call_depth: nat)
                        (max_loop_iterations: nat)
                        (builtins: string -> option yul_builtin)
                        (funs: string -> option fun_decl)
                        (f: fun_decl)
                        (world: world_state)
                        (arg_values: list dynamic_value)
{struct max_call_depth}
: world_state * option (expr_result (list dynamic_value))
:= let _ := string_map_impl in
   match max_call_depth with
   | O => (world, None)
   | S new_max_call_depth =>
        match bind_vars_to_values (fd_inputs f) arg_values Map.empty with
        | inl err =>
            (* since L10-L40 produce a slightly better error message than "too few values",
               namely "function called with too few arguments", it's better to repeat it here.
             *)
            (world, Some (expr_error
                            match err with
                            | DE_TooFewValues => "function called with too few arguments"
                            | DE_TooManyValues => "function called with too many arguments"
                            | _ => string_of_dynamic_error err
                            end))
        | inr loc_with_args_only =>
            match bind_vars_to_zeros (fd_outputs f) loc_with_args_only with
            | inl err => (world, Some (expr_error (string_of_dynamic_error err)))
            | inr loc =>
                let '(world', loc', result) :=
                        interpret_block max_loop_iterations builtins funs (Some f)
                                        (interpret_call new_max_call_depth max_loop_iterations
                                                        builtins funs)
                                        world loc nop (fd_body f)
                in (world', match result with
                            | None => None
                            | Some StmtSuccess =>
                                match get_vars_by_typenames (fd_outputs f) loc' with
                                | inl err => Some (expr_error (string_of_dynamic_error err))
                                | inr outputs => Some (ExprSuccess outputs)
                                end
                            | Some (StmtAbort AbortBreak)
                            | Some (StmtAbort AbortContinue) =>
                                Some (expr_error (string_of_dynamic_error DE_BreakContinueDisallowed))
                            | Some (StmtAbort a) => Some (ExprAbort a)
                            | Some (StmtReturnFromFunction x) => Some (ExprSuccess x)
                            end)
            end
        end
   end.

Definition interpret {C: VyperConfig}
                     (max_call_depth: nat)
                     (max_loop_iterations: nat)
                     (builtins: string -> option yul_builtin)
                     (funs: string -> option fun_decl)
                     (fun_name: string)
                     (world: world_state)
                     (args: list dynamic_value)
: world_state * option (expr_result (list dynamic_value))
:= match funs fun_name with
   | Some f => interpret_call max_call_depth max_loop_iterations builtins funs f world args
   | None => (world, Some (expr_error "declaration not found"))
   end.


(*
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

Require Import String.
Require Import List.
Require Import Arith.
Require Import Peano_dec.
Require Import EquivDec.
Require Import Decidable.
Require Import Utils.
Require Import DataSystem.
Require Import cNNRC.
Require Import cNNRCShadow.
Require Import TcNNRC.

Section TcNNRCShadow.
  Hint Constructors nnrc_core_type : qcert.

  Context {m:basic_model}.

  Lemma nnrc_core_type_remove_duplicate_env {τcenv} l v x l' x' l'' e τ:
    nnrc_core_type τcenv (l ++ (v,x)::l' ++ (v,x')::l'') e τ <->
    nnrc_core_type τcenv (l ++ (v,x)::l' ++ l'') e τ.
  Proof.
    apply nnrc_core_type_lookup_equiv_prop; trivial.
    apply lookup_remove_duplicate.
  Qed.

  Lemma nnrc_core_type_remove_free_env {τcenv} l v x l' e τ :
    ~ In v (nnrc_free_vars e) ->
    (nnrc_core_type τcenv (l ++ (v,x)::l') e τ <-> nnrc_core_type τcenv (l ++ l') e τ).
  Proof.
    split; revert l v x l' τ H;
      induction e; simpl; inversion 2; subst; intuition; eauto 3 with qcert.
    - constructor. erewrite <- lookup_remove_nin; eauto.
    - apply nin_app_or in H. intuition. qeauto.
    - apply nin_app_or in H. intuition.
      econstructor; eauto.
      destruct (equiv_dec v v0); unfold Equivalence.equiv in *; subst.
      + apply (nnrc_core_type_remove_duplicate_env nil v0 τ₁ l) in H7; eauto.
      + eapply (IHe2 ((v, τ₁) :: l)); eauto.
        intro; elim H2; apply remove_in_neq; eauto.
    - apply nin_app_or in H. intuition.
      econstructor; eauto.
      destruct (equiv_dec v v0); unfold Equivalence.equiv in *; subst.
      + apply (nnrc_core_type_remove_duplicate_env nil v0 τ₁ l) in H7; eauto.
      + eapply (IHe2 ((v, τ₁) :: l)); eauto.
        intro; elim H2; apply remove_in_neq; eauto.
    - apply nin_app_or in H; destruct H as [? HH]; apply nin_app_or in HH.
      intuition. qeauto.
    - apply nin_app_or in H. destruct H as [neq1 neq2].
      apply nin_app_or in neq2. destruct neq2 as [neq2 neq3].
      econstructor; eauto.
      + destruct (equiv_dec v v1); unfold Equivalence.equiv in *; subst.
        * apply (nnrc_core_type_remove_duplicate_env nil v1 τl l) in H9; eauto.
        * eapply (IHe2 ((v, τl) :: l)); eauto.
          rewrite <- remove_in_neq in neq2; intuition.
      + destruct (equiv_dec v0 v1); unfold Equivalence.equiv in *; subst.
        * apply (nnrc_core_type_remove_duplicate_env nil v1 τr l) in H10; eauto.
        * eapply (IHe3 ((v0, τr) :: l)); eauto.
          rewrite <- remove_in_neq in neq3; intuition.
    - constructor. erewrite lookup_remove_nin; eauto.
    - apply nin_app_or in H. intuition. qeauto.
    - apply nin_app_or in H. intuition.
      econstructor; eauto.
      destruct (equiv_dec v v0); unfold Equivalence.equiv in *; subst.
      + apply (nnrc_core_type_remove_duplicate_env nil v0 τ₁ l); eauto.
      + eapply (IHe2 ((v, τ₁) :: l)); eauto.
        intro; elim H2; apply remove_in_neq; eauto.
    - apply nin_app_or in H. intuition.
      econstructor; eauto.
      destruct (equiv_dec v v0); unfold Equivalence.equiv in *; subst.
      + apply (nnrc_core_type_remove_duplicate_env nil v0 τ₁ l); eauto.
      + eapply (IHe2 ((v, τ₁) :: l)); eauto.
        intro; elim H2; apply remove_in_neq; eauto.
    - apply nin_app_or in H; destruct H as [? HH]; apply nin_app_or in HH.
      intuition.
    - apply nin_app_or in H. destruct H as [neq1 neq2].
      apply nin_app_or in neq2; destruct neq2  as [neq2 neq3].
      econstructor; eauto.
      + destruct (equiv_dec v v1); unfold Equivalence.equiv in *; subst.
        * apply (nnrc_core_type_remove_duplicate_env nil v1 τl l); simpl; trivial.
        * eapply (IHe2 ((v, τl) :: l)); eauto.
          rewrite <- remove_in_neq in neq2; intuition.
      + destruct (equiv_dec v0 v1); unfold Equivalence.equiv in *; subst.
        * apply (nnrc_core_type_remove_duplicate_env nil v1 τr l); simpl; trivial.
        * eapply (IHe3 ((v0, τr) :: l)); eauto.
          rewrite <- remove_in_neq in neq3; intuition.
  Qed.

  Lemma nnrc_core_type_remove_disjoint_env {τcenv} l1 l2 l3 e τ :
    disjoint (domain l2) (nnrc_free_vars e) ->
    (nnrc_core_type τcenv (l1 ++ l2 ++ l3) e τ <-> nnrc_core_type τcenv (l1 ++ l3) e τ).
  Proof.
    revert l1 l3.
    induction l2; intros l1 l3 disj; simpl.
    - tauto.
    - simpl in disj.
      apply disjoint_cons_inv1 in disj.
      destruct disj as [disj nin].
      destruct a; simpl in *.
      rewrite nnrc_core_type_remove_free_env; trivial.
      eauto.
  Qed.

  Lemma nnrc_core_type_remove_almost_free_env {τcenv} l v x l' e τ :
    (In v (nnrc_free_vars e) -> In v (domain l)) ->
    (nnrc_core_type τcenv (l ++ (v,x)::l') e τ <-> nnrc_core_type τcenv (l ++ l') e τ).
  Proof.
    intros Hinn.
    destruct (in_dec string_dec v (nnrc_free_vars e)) as [inn|inn].
    - apply Hinn in inn.
      apply in_domain_in in inn.
      destruct inn as [? inn].
      destruct (in_split _ _ inn) as [? [? ?]]; subst.
      repeat rewrite app_ass; simpl.
      apply nnrc_core_type_remove_duplicate_env.
    - apply nnrc_core_type_remove_free_env; trivial.
  Qed.

  Lemma nnrc_core_type_remove_almost_disjoint_env {τcenv} l1 l2 l3 e τ :
    (forall x,
        In x (domain l2) ->
        In x (nnrc_free_vars e) -> In x (domain l1)) ->
    (nnrc_core_type τcenv (l1 ++ l2 ++ l3) e τ <-> nnrc_core_type τcenv (l1 ++ l3) e τ).
  Proof.
    revert l1 l3.
    induction l2; intros l1 l3 disj; simpl.
    - tauto.
    - simpl in disj.
      destruct a; simpl in *.
      rewrite nnrc_core_type_remove_almost_free_env; trivial.
      + eauto.
      + intuition.
  Qed.

  Lemma nnrc_core_type_swap_neq {τcenv} l1 v1 x1 v2 x2 l2 e τ :
    v1 <> v2 ->
    (nnrc_core_type τcenv (l1++(v1,x1)::(v2,x2)::l2) e τ <->
     nnrc_core_type τcenv (l1++(v2,x2)::(v1,x1)::l2) e τ).
  Proof.
    intros.
    apply nnrc_core_type_lookup_equiv_prop; trivial.
    apply lookup_swap_neq; trivial.
  Qed.

  Lemma nnrc_core_type_cons_subst {τcenv} e Γ v τ₀ v' τ :
    ~ (In v' (nnrc_free_vars e)) ->
    ~ (In v' (nnrc_bound_vars e)) ->
    (nnrc_core_type τcenv ((v',τ₀)::Γ) (nnrc_subst e v (NNRCVar v')) τ <->
     nnrc_core_type τcenv ((v,τ₀)::Γ) e τ).
  Proof.
    split; revert Γ v τ₀ v' τ H H0;
      induction e; simpl in *; unfold equiv_dec, string_eqdec;
        trivial; intros Γ v₀ τ₀ v' τ nfree nbound.
    - intuition.
      constructor.
      destruct (string_dec v v₀); simpl; subst; intuition; inversion H; subst; simpl in *; repeat dest_eqdec; intuition.
    - intuition.
      constructor.
      destruct (string_dec v v₀); simpl; subst; intuition; inversion H; subst; simpl in *; repeat dest_eqdec; intuition.
    - inversion 1; subst. qeauto.
    - inversion 1; subst.
      rewrite nin_app_or in nfree, nbound.
      intuition; qeauto.
    - inversion 1; subst. qeauto.
    - inversion 1; subst.
      rewrite nin_app_or in nfree. intuition.
      apply nin_app_or in H3. intuition.
      match_destr_in H; subst.
      + econstructor; eauto.
        apply (nnrc_core_type_remove_duplicate_env nil v₀ τ₁ nil); simpl.
        generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τ₁)::nil)); simpl; intros HH.
        apply HH in H6; eauto.
        intro; elim H1. apply remove_in_neq; eauto.
      + econstructor; eauto.
        apply (nnrc_core_type_swap_neq nil); eauto; simpl.
        eapply IHe2; eauto.
        * intro; elim H1.
          apply remove_in_neq; eauto.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
    - inversion 1; subst.
      rewrite nin_app_or in nfree. intuition.
      apply nin_app_or in H3. intuition.
      match_destr_in H6; subst.
      + econstructor; eauto.
        apply (nnrc_core_type_remove_duplicate_env nil v₀ τ₁ nil); simpl.
        generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τ₁)::nil)); simpl; intros HH.
        apply HH in H6; eauto.
        intro; elim H1. apply remove_in_neq; eauto.
      + econstructor; eauto.
        apply (nnrc_core_type_swap_neq nil); eauto; simpl.
        eapply IHe2; eauto.
        * intro; elim H1.
          apply remove_in_neq; eauto.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
    - inversion 1; subst.
      apply nin_app_or in nfree; destruct nfree as [? HH]; apply nin_app_or in HH.
      apply nin_app_or in nbound; destruct nbound as [? HHH]; apply nin_app_or in HHH.
      intuition; qeauto.
    - intro HH; inversion HH; subst; clear HH.
      apply not_or in nbound; destruct nbound as [nb1 nb2].
      apply not_or in nb2; destruct nb2 as [nb2 nb3].
      repeat rewrite nin_app_or in nb3, nfree.
      rewrite <- (remove_in_neq _ _ v) in nfree by congruence.
      rewrite <- (remove_in_neq _ _ v0) in nfree by congruence.
      econstructor.
      + eapply IHe1; eauto 2; intuition.
      + match_destr_in H7; subst.
        * generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τl)::nil)); simpl;
            intros re1; rewrite re1 in H7 by intuition.
          generalize (@nnrc_core_type_remove_duplicate_env τcenv nil v₀ τl nil); simpl;
            intros re2; rewrite re2 by intuition.
          trivial.
        * apply (nnrc_core_type_swap_neq nil); eauto 2; simpl.
          apply (nnrc_core_type_swap_neq nil) in H7; eauto 2; simpl in *.
          eapply IHe2; eauto 2; intuition.
      + match_destr_in H8; subst.
        * generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τr)::nil)); simpl;
            intros re1; rewrite re1 in H8 by intuition.
          generalize (@nnrc_core_type_remove_duplicate_env τcenv nil v₀ τr nil); simpl;
            intros re2; rewrite re2 by intuition.
          trivial.
        * apply (nnrc_core_type_swap_neq nil); eauto 2; simpl.
          apply (nnrc_core_type_swap_neq nil) in H8; eauto 2; simpl in *.
          eapply IHe3; eauto 2; intuition.
    - (* GroupBy Case: always fails for core? *)
      intros.
      inversion H.
    - intuition.
      destruct (string_dec v v₀); simpl; subst; intuition;
        inversion H; subst; simpl in *; repeat dest_eqdec; intuition;
          inversion H4; subst; constructor; simpl;
            repeat dest_eqdec; intuition.
    - intuition.
      destruct (string_dec v v₀); simpl; subst; intuition;
        inversion H; subst; simpl in *; repeat dest_eqdec; intuition;
          inversion H4; subst; constructor; simpl;
            repeat dest_eqdec; intuition.
    - inversion 1; subst. qeauto.
    - inversion 1; subst.
      rewrite nin_app_or in nfree, nbound.
      intuition; qeauto.
    - inversion 1; subst. qeauto.
    - inversion 1; subst.
      rewrite nin_app_or in nfree. intuition.
      apply nin_app_or in H3. intuition.
      match_destr; subst.
      + econstructor; eauto.
        apply (nnrc_core_type_remove_duplicate_env nil v₀ τ₁ nil) in H6;
          simpl in H6.
        generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τ₁)::nil)); simpl; intros HH.
        apply HH; eauto.
        intro; elim H1. apply remove_in_neq; eauto.
      + econstructor; eauto.
        apply (nnrc_core_type_swap_neq nil); eauto; simpl.
        eapply IHe2; eauto.
        * intro; elim H1.
          apply remove_in_neq; eauto.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
    - inversion 1; subst.
      rewrite nin_app_or in nfree. intuition.
      apply nin_app_or in H3. intuition.
      match_destr; subst.
      + econstructor; eauto.
        apply (nnrc_core_type_remove_duplicate_env nil v₀ τ₁ nil) in H6;
          simpl in H6.
        generalize (@nnrc_core_type_remove_free_env τcenv ((v₀,τ₁)::nil)); simpl; intros HH.
        apply HH; eauto.
        intro; elim H1. apply remove_in_neq; eauto.
      + econstructor; eauto.
        apply (nnrc_core_type_swap_neq nil); eauto; simpl.
        eapply IHe2; eauto.
        * intro; elim H1.
          apply remove_in_neq; eauto.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
    - inversion 1; subst.
      apply nin_app_or in nfree; destruct nfree as [? HH]; apply nin_app_or in HH.
      apply nin_app_or in nbound; destruct nbound as [? HHH]; apply nin_app_or in HHH.
      intuition; eauto.
    - apply not_or in nbound; destruct nbound as [nb1 nb2].
      apply not_or in nb2; destruct nb2 as [nb2 nb3].
      repeat rewrite nin_app_or in nb3, nfree.
      rewrite <- (remove_in_neq _ _ v) in nfree by congruence.
      rewrite <- (remove_in_neq _ _ v0) in nfree by congruence.
      intro HH; inversion HH; clear HH; subst.
      econstructor.
      + apply IHe1; eauto 2; intuition.
      + match_destr; subst.
        * generalize (@nnrc_core_type_remove_duplicate_env τcenv nil v₀ τl nil); simpl;
            intros re1; rewrite re1 in H7.
          apply (nnrc_core_type_remove_free_env ((v₀,τl)::nil)); intuition.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
          apply IHe2; eauto 2; intuition.
          apply (nnrc_core_type_swap_neq nil); eauto; simpl.
      + match_destr; subst.
        * generalize (@nnrc_core_type_remove_duplicate_env τcenv nil v₀ τr nil); simpl;
            intros re1; rewrite re1 in H8.
          apply (nnrc_core_type_remove_free_env ((v₀,τr)::nil)); intuition.
        * apply (nnrc_core_type_swap_neq nil); eauto; simpl.
          apply IHe3; eauto 2; intuition.
          apply (nnrc_core_type_swap_neq nil); eauto; simpl.
    - (* GroupBy Case: always fails for core? *)
      intros.
      inversion H.
  Qed.

  Lemma nnrc_core_type_cons_subst_disjoint {τcenv} e e' Γ v τ₀ τ :
    disjoint (nnrc_bound_vars e) (nnrc_free_vars e') ->
    nnrc_core_type τcenv Γ e' τ₀ ->
    nnrc_core_type τcenv ((v,τ₀)::Γ) e τ ->
    nnrc_core_type τcenv Γ (nnrc_subst e v e') τ.
  Proof.
    intros disj typ'.
    revert Γ e' v τ₀ τ disj typ'.
    nnrc_cases (induction e) Case; simpl in *;
      trivial; intros Γ v₀ τ₀ v' τ nfree nbound; simpl;
        intros typ; inversion typ; clear typ; subst;
          unfold equiv_dec in *; simpl in * .
    - Case "NNRCGetConstant"%string.
      qeauto.
    - Case "NNRCVar"%string.
      match_destr.
      + congruence.
      + qauto.
    - Case "NNRCConst"%string.
      econstructor; trivial.
    - Case "NNRCBinop"%string.
      apply disjoint_app_l in nfree.
      destruct nfree.
      econstructor; eauto 2.
    - Case "NNRCUnop"%string.
      econstructor; eauto.
    - Case "NNRCLet"%string.
      apply disjoint_cons_inv1 in nfree.
      destruct nfree as [disj nin].
      apply disjoint_app_l in disj.
      destruct disj as [disj1 disj2].
      econstructor; eauto 2.
      match_destr.
      + red in e; subst.
        generalize (@nnrc_core_type_remove_duplicate_env τcenv nil τ₀ τ₁ nil v' Γ);
          simpl; intros re1; apply re1; eauto.
      + eapply IHe2; eauto 2.
        * generalize (@nnrc_core_type_remove_free_env τcenv nil v τ₁ Γ v₀);
            simpl; intros re1; apply re1; eauto.
        * generalize (@nnrc_core_type_swap_neq τcenv nil τ₀ v' v τ₁ Γ e2 τ);
            simpl; intros re1; apply re1; eauto.
    - Case "NNRCFor"%string.
      apply disjoint_cons_inv1 in nfree.
      destruct nfree as [disj nin].
      apply disjoint_app_l in disj.
      destruct disj as [disj1 disj2].
      econstructor; eauto 2.
      match_destr.
      + red in e; subst.
        generalize (@nnrc_core_type_remove_duplicate_env τcenv nil τ₀ τ₁ nil v' Γ);
          simpl; intros re1; apply re1; eauto.
      + eapply IHe2; eauto 2.
        * generalize (@nnrc_core_type_remove_free_env τcenv nil v τ₁ Γ v₀);
            simpl; intros re1; apply re1; eauto.
        * generalize (@nnrc_core_type_swap_neq τcenv nil τ₀ v' v τ₁ Γ e2 τ₂);
            simpl; intros re1; apply re1; eauto.
    - Case "NNRCIf"%string.
      apply disjoint_app_l in nfree.
      destruct nfree as [disj1 disj2].
      apply disjoint_app_l in disj2.
      destruct disj2 as [disj2 disj3].
      econstructor; eauto 2.
    - Case "NNRCEither"%string.
      apply disjoint_cons_inv1 in nfree.
      destruct nfree as [disj nin].
      apply disjoint_cons_inv1 in disj.
      destruct disj as [disj nin2].
      apply disjoint_app_l in disj.
      destruct disj as [disj1 disj2].
      apply disjoint_app_l in disj2.
      destruct disj2 as [disj2 disj3].
      econstructor; eauto 2.
      + {
          match_destr.
          + red in e; subst.
            generalize (@nnrc_core_type_remove_duplicate_env τcenv nil τ₀ τl nil v' Γ);
              simpl; intros re1; apply re1; eauto.
          + eapply IHe2; eauto 2.
            * generalize (@nnrc_core_type_remove_free_env τcenv nil v τl Γ v₀);
                simpl; intros re1; apply re1; eauto.
            * generalize (@nnrc_core_type_swap_neq τcenv nil τ₀ v' v τl Γ e2 τ);
                simpl; intros re1; apply re1; eauto.
        }
      + {
          match_destr.
          + red in e; subst.
            generalize (@nnrc_core_type_remove_duplicate_env τcenv nil τ₀ τr nil v' Γ);
              simpl; intros re1; apply re1; eauto.
          + eapply IHe3; eauto 2.
            * generalize (@nnrc_core_type_remove_free_env τcenv nil v0 τr Γ v₀);
                simpl; intros re1; apply re1; eauto.
            * generalize (@nnrc_core_type_swap_neq τcenv nil τ₀ v' v0 τr Γ e3 τ);
                simpl; intros re1; apply re1; eauto.
        }
  Qed.

  Lemma nnrc_core_type_rename_pick_subst {τcenv} sep renamer avoid e Γ v τ₀ τ :
    (nnrc_core_type τcenv
                    ((nnrc_pick_name sep renamer avoid v e,τ₀)::Γ)
                    (nnrc_rename_lazy e v (nnrc_pick_name sep renamer avoid v e)) τ
     <->
     nnrc_core_type τcenv ((v,τ₀)::Γ) e τ).
  Proof.
    unfold nnrc_rename_lazy.
    match_destr.
    - rewrite <- e0.
      tauto.
    - rewrite nnrc_core_type_cons_subst; trivial.
      + tauto.
      + apply nnrc_pick_name_neq_nfree; trivial.
      + apply nnrc_pick_name_bound.
  Qed.

  Theorem nnrc_core_unshadow_type {τcenv} sep renamer avoid Γ n τ :
    nnrc_core_type τcenv Γ n τ <-> nnrc_core_type τcenv Γ (unshadow sep renamer avoid n) τ.
  Proof.
    Hint Resolve really_fresh_from_free  really_fresh_from_bound : qcert.
    split; revert Γ τ; induction n; simpl in *; inversion 1; subst; qeauto; simpl.
    - econstructor; [eauto|..].
      apply nnrc_core_type_rename_pick_subst.
      eauto.
    - econstructor; [eauto|..].
      apply nnrc_core_type_rename_pick_subst.
      eauto.
    - econstructor; [eauto|..].
      apply nnrc_core_type_rename_pick_subst.
      + eauto.
      + apply nnrc_core_type_rename_pick_subst.
        eauto.
    - econstructor; [eauto|..].
      apply nnrc_core_type_rename_pick_subst in H6.
      eauto.
    - econstructor; [eauto|..].
      apply nnrc_core_type_rename_pick_subst in H6.
      eauto.
    - econstructor; [eauto|..].
      + apply nnrc_core_type_rename_pick_subst in H8.
        eauto.
      + apply nnrc_core_type_rename_pick_subst in H9.
        eauto.
  Qed.

End TcNNRCShadow.


Require Import VST.sepcomp.semantics.

Require Import VST.veric.juicy_base.

Require Import VST.veric.juicy_mem.
Require Import VST.sepcomp.extspec.
Require Import VST.veric.ghost_PCM.
Require Import VST.veric.juicy_extspec.

Require Import VST.veric.res_predicates.
Require Import VST.veric.mpred.
Require Import VST.veric.seplog.

(*Require Import VST.veric.initial_world.
Require Import VST.veric.SeparationLogic.
 *)

(*********copied from initial_world***********)
Fixpoint find_id (id: ident) (G: funspecs) : option funspec  :=
 match G with
 | (id', f)::G' => if eq_dec id id' then Some f else find_id id G'
 | nil => None
 end.

Definition cond_approx_eq n A P1 P2 :=
  (forall ts,
      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P1 ts) =
      fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P2 ts)).

Definition func_at'' fsig cc A P Q :=
  pureat (SomeP (SpecTT A) (packPQ P Q)) (FUN fsig cc).
(*also copy lemmas on these from initial_world? or isolate in general file?*)

(**********************************************)

Module Type GENERAL_SEPARATION_LOGIC_SOUNDNESS.

(*Declare Module ExtSpec: EXTERNAL_SPEC. *)
(*Declare Module CSL: CLIGHT_SEPARATION_LOGIC.
Import CSL. for semax_prog*)

Parameter F T: Type. (*Clight instantiates := fundef V:=type*)
(*Record genv : Type := Build_genv { genv_genv : @Genv.t F T;  genv_cenv : composite_env }.

Parameter genv:Type.
*)
Definition genv:Type := Genv.t F T.

(*duplicated from tycontext to prevent specialization to Clight*)
Definition filter_genv (ge: genv) : genviron := Genv.find_symbol ge.
Definition empty_environ (ge: genv) := mkEnviron (filter_genv ge) (Map.empty _) (Map.empty _).

Parameter C: Type.
Parameter Sem: genv -> CoreSemantics C Memory.mem.

(*Definition genv_symb_injective {F V} (ge: Genv.t F V) : extspec.injective_PTree block.
Proof.
exists (Genv.genv_symb ge).
hnf; intros.
eapply Genv.genv_vars_inj; eauto.
Defined.*)
(*Parameter genv_symb_injective: forall {F V:Type} (ge: Genv.t F V), extspec.injective_PTree block.*)
Parameter genv_symb_injective: genv -> extspec.injective_PTree block.

Definition jsafeN {Z} (Hspec : juicy_ext_spec Z) (ge: genv) :=
  @jsafeN_ genv _ _ genv_symb_injective (*(genv_symb := fun ge: genv => Genv.genv_symb ge)*)
           (Sem ge) Hspec ge.

Definition matchfunspecs (ge : genv) (G : funspecs) (Phi : rmap) :=
forall (b : block) (fsig : compcert_rmaps.funsig)
  (cc : calling_convention) (A : TypeTree)
  (P
   Q : forall ts : list Type,
       (dependent_type_functor_rec ts (AssertTT A)) (pred rmap)),
(func_at'' fsig cc A P Q (b, 0)) Phi ->
exists
  (id : ident) (P'
                Q' : forall ts : list Type,
                     (dependent_type_functor_rec ts (AssertTT A)) mpred)
(P'_ne : super_non_expansive P') (Q'_ne : super_non_expansive Q'),
  Genv.find_symbol ge id = Some b /\
  find_id id G = Some (mk_funspec fsig cc A P' Q' P'_ne Q'_ne) /\
  cond_approx_eq (level Phi) A P P' /\ cond_approx_eq (level Phi) A Q Q'.

Definition EPoint_sound {Espec: OracleKind} FS m (h:nat) (entryPT:ident) (g:genv) :=
     { b : block & { q : C &
       (Genv.find_symbol g entryPT = Some b) *
       (forall jm, m_dry jm = m -> exists jm', semantics.initial_core (juicy_core_sem (Sem g)) h
                    jm q jm' (Vptr b Ptrofs.zero) nil) *
       forall n z,
         { jm |
           m_dry jm = m /\ level jm = n /\
           nth_error (ghost_of (m_phi jm)) 0 = Some (Some (ext_ghost z, NoneP)) /\
           jsafeN (@OK_spec Espec) g n z q jm /\
           res_predicates.no_locks (m_phi jm) /\
           matchfunspecs g FS (m_phi jm) /\
           app_pred (funspecs_assert (make_tycontext_s FS) (empty_environ g))  (m_phi jm) } } }%type.

(*maybe generalize from single EP ("main") to multiple entry points?
Axiom module_sound: forall Espec G m h entryPT g,
      @EPoint_sound Espec G m h entryPT g.

Definition prog_sound {Espec: OracleKind} CS prog :=
     @semax_prog Espec CS prog V G ->
     forall h m,
     @Genv.init_mem F T prog = Some m ->
     @EPoint_sound Espec G m h (prog_main prog)  (globalenv prog).
                                    *)

End GENERAL_SEPARATION_LOGIC_SOUNDNESS.