(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*              Layers of VMM: Refinement proof for MAL                *)
(*                                                                     *)
(*          Refinement proof for MAL layer                             *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)

(** This file provide the contextual refinement proof between MALOp layer and MAL layer*)
Require Import Coqlib.
Require Import Errors.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Op.
Require Import Asm.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Values.
Require Import Memory.
Require Import Maps.
Require Import CommonTactic.
Require Import AuxLemma.
Require Import FlatMemory.
Require Import AuxStateDataType.
Require Import Constant.
Require Import GlobIdent.
Require Import RealParams.
Require Import LoadStoreSem1.
Require Import AsmImplLemma.
Require Import LAsm.
Require Import RefinementTactic.
Require Import PrimSemantics.

Require Import liblayers.logic.PTreeModules.
Require Import liblayers.logic.LayerLogicImpl.
Require Import liblayers.compcertx.Stencil.
Require Import liblayers.compcertx.MakeProgram.
Require Import liblayers.compat.CompatLayers.
Require Import liblayers.compat.CompatGenSem.
Require Import compcert.cfrontend.Ctypes.
Require Import LayerCalculusLemma.

Require Import MALT.
Require Import MALOp.
Require Import ALGenSpec.

Require Import AbstractDataType.

Local Open Scope string_scope.
Local Open Scope error_monad_scope.
Local Open Scope Z_scope.

(** * Definition of the refinement relation*)
Section Refinement.

  Context `{real_params: RealParams}.

  Notation HDATAOps := (cdata (cdata_ops := malt_data_ops) RData).
  Notation LDATAOps := (cdata (cdata_ops := malop_data_ops) RData).

  Section WITHMEM.

    Context `{Hstencil: Stencil}.
    Context `{Hmem: Mem.MemoryModel}.
    Context `{Hmwd: UseMemWithData mem}.

    (** ** Definition the refinement relation: relate_RData + match_RData *)
    Record relate_RData (f:meminj) (hadt: RData) (ladt: RData) :=
      mkrelate_RData {
          flatmem_re: FlatMem.flatmem_inj (HP hadt) (HP ladt);
          vmxinfo_re: vmxinfo hadt = vmxinfo ladt;
          devout_re: devout hadt = devout ladt;
          CR3_re:  CR3 hadt = CR3 ladt;
          ikern_re: ikern hadt = ikern ladt;
          pg_re: pg hadt = pg ladt;
          ihost_re: ihost hadt = ihost ladt;
          ti_fst_re: (fst (ti hadt)) = (fst (ti ladt));
          ti_snd_re: val_inject f (snd (ti hadt)) (snd (ti ladt));
          AT_re: AT hadt = AT ladt;
          nps_re: nps hadt = nps ladt;
          init_re: init hadt = init ladt
        }.

    Inductive match_RData: stencil -> RData -> mem -> meminj -> Prop :=
    | MATCH_RDATA: forall habd m f s, match_RData s habd m f.

    Local Hint Resolve MATCH_RDATA.

    Global Instance rel_ops: CompatRelOps HDATAOps LDATAOps :=
      {
        relate_AbData s f d1 d2 := relate_RData f d1 d2;
        match_AbData s d1 m f := match_RData s d1 m f;
        new_glbl := nil
      }.

    (** ** Properties of relations*)
    Section Rel_Property.

      (** Prove that after taking one step, the refinement relation still holds*)
      Lemma relate_incr:
        forall abd abd' f f',
          relate_RData f abd abd'
          -> inject_incr f f'
          -> relate_RData f' abd abd'.
      Proof.
        inversion 1; subst; intros; inv H; constructor; eauto.
      Qed.

      Lemma relate_kernel_mode:
        forall abd abd' f,
          relate_RData f abd abd'
          -> (kernel_mode abd <-> kernel_mode abd').
      Proof.
        inversion 1; simpl; split; congruence.
      Qed.

      Lemma relate_observe:
        forall p abd abd' f,
          relate_RData f abd abd' ->
          observe p abd = observe p abd'.
      Proof.
        inversion 1; simpl; unfold ObservationImpl.observe; congruence.
      Qed.

      Global Instance rel_prf: CompatRel HDATAOps LDATAOps.
      Proof.
        constructor; intros; simpl; trivial.
        eapply relate_incr; eauto.
        eapply relate_kernel_mode; eauto.
        eapply relate_observe; eauto.
      Qed.

    End Rel_Property.

    (** * Proofs the one-step forward simulations for the low level specifications*)
    Section OneStep_Forward_Relation.

      (** ** The low level specifications exist*)
      Section Exists.

        Lemma pfree_exist:
          forall habd habd' labd i f,
            ObjPMM.pfree'_spec i habd = Some habd'
            -> relate_RData f habd labd
            -> exists labd', pfree_spec i labd = Some labd' /\ relate_RData f habd' labd'
                             /\ kernel_mode labd.
        Proof.
          unfold pfree_spec, ObjPMM.pfree'_spec; intros until f. exist_simpl.
        Qed.

        Lemma palloc_exist:
          forall habd habd' labd i f,
            ObjPMM.palloc'_spec habd = Some (habd', i)
            -> relate_RData f habd labd
            -> exists labd', palloc_spec labd = Some (labd', i) /\ relate_RData f habd' labd'
                             /\ kernel_mode labd.
        Proof.
          unfold palloc_spec, ObjPMM.palloc'_spec; intros until f; exist_simpl.
        Qed.

        Lemma flatmem_store_exists:
          forall hadt ladt hadt' t addr v v' f,
            flatmem_store hadt t addr v = Some hadt'
            -> relate_RData f hadt ladt
            -> val_inject f v v'
            -> exists ladt',
                 flatmem_store' ladt t addr v' = Some ladt'
                 /\ relate_RData f hadt' ladt'.
        Proof.
          unfold flatmem_store', flatmem_store. intros.
          revert H. inv H0. subrewrite. subdestruct.
          inv HQ; simpl. refine_split'; eauto.
          constructor; trivial; simpl.
          eapply (FlatMem.store_mapped_inj f); trivial;
          assumption.
        Qed.

        Lemma fstore_exist:
          forall habd habd' labd i v f,
            fstore0_spec i v habd = Some habd'
            -> relate_RData f habd labd
            -> exists labd', fstore'_spec i v labd = Some labd' /\ relate_RData f habd' labd'.
        Proof.
          unfold fstore0_spec, fstore'_spec; intros.
          revert H. pose proof H0 as HR.
          inv H0. subrewrite. subdestruct.
          eapply flatmem_store_exists; eauto.
        Qed.

        Lemma flatmem_copy_exist:
          forall habd habd' labd i from to f,
            flatmem_copy0_spec i from to habd = Some habd'
            -> relate_RData f habd labd
            -> exists labd', flatmem_copy'_spec i from to labd = Some labd'
                             /\ relate_RData f habd' labd'.
        Proof.
          unfold flatmem_copy0_spec, flatmem_copy'_spec; intros.
          revert H. pose proof H0 as HR.
          inv H0. subrewrite. subdestruct.
          exploit flatmem_copy_aux_exists; eauto.
          intros (lh' & HCopy & Hinj).
          rewrite HCopy. refine_split'; trivial.
          inv HR.
          inv HQ; constructor; trivial; simpl.
        Qed.

        Lemma set_at_c_exist:
          forall habd habd' labd i z f,
            set_at_c0_spec i z habd = Some habd'
            -> relate_RData f habd labd
            -> exists labd', set_at_c_spec i z labd = Some labd' /\ relate_RData f habd' labd'.
        Proof.
          unfold set_at_c0_spec, set_at_c_spec; intros until f; exist_simpl; inv HR'.
        Qed.

      End Exists.

      Section FRESH_PRIM.

        Lemma pfree_spec_ref:
          compatsim (crel RData RData) (gensem ObjPMM.pfree'_spec) pfree_spec_low.
        Proof.
          compatsim_simpl (@match_AbData).
          exploit pfree_exist; eauto 1.
          intros [labd' [HP [HM Hkern]]].
          refine_split; try econstructor; eauto. constructor.
        Qed.

        Lemma palloc_spec_ref:
          compatsim (crel RData RData) (gensem ObjPMM.palloc'_spec) palloc_spec_low.
        Proof.
          compatsim_simpl (@match_AbData).
          exploit palloc_exist; eauto 1.
          intros [labd' [HP [HM Hkern]]].
          refine_split; try econstructor; eauto. constructor.
        Qed.

      End FRESH_PRIM.

      Section PASSTHROUGH_PRIM.

        Global Instance: (LoadStoreProp (hflatmem_store:= flatmem_store) (lflatmem_store:= flatmem_store')).
        Proof.
          accessor_prop_tac.
          - eapply flatmem_store_exists; eauto.
        Qed.

        Lemma passthrough_correct:
          sim (crel RData RData) malt_passthrough malop.
        Proof.
          sim_oplus.
          - apply fload'_sim.
          - (* fstore *)
            layer_sim_simpl; compatsim_simpl (@match_AbData); intros.
            exploit fstore_exist; eauto 1; intros [labd' [HP HM]].
            match_external_states_simpl.
          - (* flatmem_copy *)
            layer_sim_simpl; compatsim_simpl (@match_AbData); intros.
            exploit flatmem_copy_exist; eauto 1; intros [labd' [HP HM]].
            match_external_states_simpl.
          - apply vmxinfo_get_sim.
          - apply device_output_sim.
          - apply setPG0_sim.
          - apply clearCR2_sim.
          - apply setCR30_sim.
          - apply get_nps_sim.
          - apply is_at_norm_sim.
          - apply get_at_u_sim.
          - apply get_at_c_sim.
          - (* set_a_c *)
            layer_sim_simpl; compatsim_simpl (@match_AbData); intros.
            exploit set_at_c_exist; eauto 1. intros [labd' [HP HM]].
            match_external_states_simpl.
          - apply mem_init_sim.
          - apply trapin_sim.
          - apply trapout0_sim.
          - apply hostin_sim.
          - apply hostout_sim.
          - apply trap_info_get_sim.
          - apply trap_info_ret_sim.
          - layer_sim_simpl.
            + eapply load_correct1.
            + eapply store_correct1.
        Qed.

      End PASSTHROUGH_PRIM.

    End OneStep_Forward_Relation.

  End WITHMEM.

End Refinement.


(* SPDX-License-Identifier: GPL-2.0 *)
Require Import List.
Import ListNotations.
(* From RecordUpdate Require Import RecordSet.
)Import RecordSetNotations. *)
(* Require Import PeanoNat. *)

Require Import Psatz.

Require Import WDRF.Base WDRF.Promising WDRF.DRF WDRF.SC.

Definition get_view (e : Event) : option View :=
    match e with
    | LOAD _ v _ => Some v
    | ACQ v _ => Some v
    | STORE _ v _ => Some v
    | REL v _ => Some v
    | _ => None
    end.

(* construct sc trace from promising trace *)
Inductive rel_global_trace : Trace -> list GlobalEvent -> Prop :=
| GT_EMPTY : forall n lp
                (Hempty : forall p, p <= n -> lp p = None),
                rel_global_trace (mkTrace n lp (fun _ => [])) []
| GT_INTERNAL : forall t gt i tid
                    (Hgt : rel_global_trace t gt),
                    rel_global_trace
                        (t
                            <|executions := update (executions t) tid (INTERNAL i :: (executions t tid)) |>
                        )
                        (GE tid (INTERNAL i) :: gt)
| GT_LOAD : forall t gt addr view reg tid
                    (Hgt : rel_global_trace t gt)
                    (Hlast : forall ms, rel_replay_mem (promiselen t) (promiselist t) ms -> Some (ms addr) = get_value view (promiselist t)),
                    rel_global_trace
                        (t
                            <|executions := update (executions t) tid (LOAD addr view reg :: (executions t tid)) |>
                        )
                        (GE tid (LOAD addr view reg) :: gt)
| GT_STORE : forall t gt addr view reg tid val
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall ms, rel_replay_mem (promiselen t) (promiselist t) ms ->
                        rel_replay_mem (promiselen t) (update (promiselist t) view (Some (WRITE tid val addr)))
                            (update ms addr val)
                    )
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (WRITE tid val addr)) |>
                            <|executions := update (executions t) tid (STORE addr view reg :: (executions t tid)) |>
                        )
                        (GE tid (STORE addr view reg) :: gt)
(* ACQs and RELs are ignored in the global trace *)
| GT_ACQUIRE : forall t gt view addr tid
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall om n, rel_global_ownership n om (update (promiselist t) view (Some (PULL tid addr))) (fun _ => None) ->
                        exists om', rel_global_ownership n om' (promiselist t) (fun _ => None))
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (PULL tid addr)) |>
                            <|executions := update (executions t) tid (ACQ view addr :: (executions t tid)) |>
                        )
                        gt
| GT_RELEASE : forall t gt view addr tid
                    (Hgt : rel_global_trace t gt)
                    (Hmask : promiselist t view = None)
                    (Hlast : forall om n, rel_global_ownership n om (update (promiselist t) view (Some (PUSH tid addr))) (fun _ => None) ->
                        exists om', rel_global_ownership n om' (promiselist t) (fun _ => None))
                    (Hunused : forall e tid, In e (executions t tid) -> get_view e <> Some view),
                    rel_global_trace
                        (t
                            <|promiselist := update (promiselist t) view (Some (PUSH tid addr)) |>
                            <|executions := update (executions t) tid (REL view addr :: (executions t tid)) |>
                        )
                        gt.

Inductive same_result : Trace -> list GlobalEvent -> Prop :=
| SAME_RESULT : forall t gt ms gs rs
                    (Hpamem : rel_replay_mem (promiselen t) (promiselist t) ms)
                    (Hpareg : forall tid, rel_replay_reg (promiselist t) (executions t tid) (rs tid))
                    (Hsc : rel_replay_sc gt gs)
                    (Hms : memstate gs = ms)
                    (Hreg : forall tid, regstates gs tid = rs tid)
                    ,
                    same_result t gt.

Lemma replay_mem_exists : forall lp n, exists ms, rel_replay_mem n lp ms.
Proof.
    intro. induction n.
    -   esplit. constructor.
    -   destruct IHn as (ms & Hms). destruct (lp (S n)) eqn:Hsn.
        +   destruct p.
            *   esplit.
                eapply REPLAY_MEM_WRITE. apply Hms. apply Hsn.
            *   esplit.
                eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
            *   esplit.
                eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
        +   esplit. eapply REPLAY_MEM_OTHER. apply Hms. rewrite Hsn. easy.
Qed.

Lemma replay_sc_exists : forall gt, exists gs, rel_replay_sc gt gs.
Proof.
    intro. induction gt.
    -   esplit. constructor.
    -   destruct a.
        destruct e; destruct IHgt as (gs & Hgs).
        {
            specialize (execute_internal_exists i (regstates gs tid)). intro. destruct H  as (rs & Hrs).
            esplit. constructor. apply Hgs. apply Hrs.
        }
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
        esplit; constructor; try apply Hgs.
Qed.

Lemma empty_replay_mem :
        forall n lp
            (Hempty : forall p : nat, p <= n -> lp p = None),
            rel_replay_mem n lp (fun addr => 0).
Proof.
    induction n; intros.
    -   constructor.
    -   apply REPLAY_MEM_OTHER. apply IHn.
        intros. apply Hempty. lia.
        rewrite Hempty. easy. easy.
Qed.

Lemma nth_error_inv :
        forall {T} (l : list T) n a b, nth_error (a :: l) n = Some b ->
            (n = 0 /\ a = b) \/ (exists n', n = S n' /\ nth_error l n' = Some b).
Proof.
    intros.
    destruct n.
    left. simpl in *. inversion H. easy.
    right. simpl in *. exists n. split. easy.
    assumption.
Qed.

Lemma localstate_promise_unused_write :
    forall tid pl ex ls view val addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (WRITE tid' val addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma global_ownership_unused_write_aux :
    forall n omr pl view tid val addr om
        (Hmask : pl view = None)
        (Hom : rel_global_ownership n om (update pl view (Some (WRITE tid val addr))) omr),
        rel_global_ownership n om pl omr.
Proof.
    induction n; intros.
    -   inversion Hom. constructor.
    -   inversion Hom.
        +   constructor. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite <- Hlp0. rewrite update_not_same. easy.
            intro. subst. rewrite update_same in Hlp0. discriminate.
        +   econstructor. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite <- Hlp0. rewrite update_not_same. easy.
            intro. subst. rewrite update_same in Hlp0. discriminate.
        +   destruct (Peano_dec.eq_nat_dec view (S n)).
            *   apply GO_NONE. eapply IHn. apply Hmask. apply Hlp.
                subst. apply Hmask.
            *   eapply GO_WRITE. eapply IHn.
            apply Hmask. apply Hlp. apply Hown.
            rewrite update_not_same in Hlp0 by easy.
            apply Hlp0.
        +   destruct (Peano_dec.eq_nat_dec view (S n)).
            *   apply GO_NONE. eapply IHn. apply Hmask. apply Hlp.
                subst. apply Hmask.
            *   eapply GO_NONE. eapply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same in Hlp0 by easy.
            apply Hlp0.
Qed.

Lemma global_ownership_unused_write :
    forall n pl view tid val addr om
        (Hmask : pl view = None)
        (Hom : rel_global_ownership n om (update pl view (Some (WRITE tid val addr))) (fun _ => None)),
        rel_global_ownership n om pl (fun _ => None).
Proof.
    intros. eapply global_ownership_unused_write_aux.
    apply Hmask. apply Hom.
Qed.

Lemma local_ownership_unused_write :
    forall pl ex lo view val addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (WRITE tid' val addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma regstate_write_unchanged :
    forall pl ex view tid addr rs val
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (WRITE tid val addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma localstate_promise_unused_pull :
    forall tid pl ex ls view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (PULL tid' addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma local_ownership_unused_pull :
    forall pl ex lo view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (PULL tid' addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma memstate_pull_unchanged :
    forall n pl view ms tid addr
        (Hmask : pl view = None)
        (Hms : rel_replay_mem n pl ms),
        rel_replay_mem n (update pl view (Some (PULL tid addr))) ms.
Proof.
    induction n; intros.
    -   inversion Hms. constructor.
    -   inversion Hms.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same. apply Hwrite.
            intro. contradict Hwrite. subst. rewrite Hmask. easy.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            destruct (Peano_dec.eq_nat_dec view (S n)).
            *   subst. rewrite update_same. easy.
            *   rewrite update_not_same by easy. apply Hnotwrite.
Qed.

Lemma regstate_pull_unchanged :
    forall pl ex view tid addr rs
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (PULL tid addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma localstate_promise_unused_push :
    forall tid pl ex ls view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hls : rel_promising tid (update pl view (Some (PUSH tid' addr))) ex ls),
        rel_promising tid pl ex ls.
Proof.
    induction ex; intros.
    -   inversion Hls. constructor.
    -   inversion Hls.
        +   econstructor.
            eapply IHex.
            *   apply Hmask.
            *   intros. apply Hunused. simpl. auto.
            *   apply Hls0.
            *   apply Hexec.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. eapply Le.le_trans. apply previous_promise_incr.
            apply Hmask. apply Hbarrier.
            apply Hcoh.
            rewrite update_not_same in Hpromise. easy.
            specialize Hunused with a. intro. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   constructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. apply Hbarrier. apply Hcoh.
            rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
        +   econstructor.
            eapply IHex. apply Hmask.
            intros. apply Hunused. simpl. auto.
            apply Hls0. rewrite update_not_same in Hpromise. apply Hpromise.
            intro. specialize Hunused with a. destruct Hunused.
            simpl. auto. unfold get_view. subst a. rewrite H4. easy.
            apply Hbarrier.
Qed.

Lemma local_ownership_unused_push :
    forall pl ex lo view addr tid'
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hlo : rel_local_ownership (update pl view (Some (PUSH tid' addr))) ex lo),
        rel_local_ownership pl ex lo.
Proof.
    induction ex; intros.
    -   inversion Hlo. constructor.
    -   inversion Hlo.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0. apply Hown. apply Hview.
        +   constructor. eapply IHex.
            apply Hmask. intros. apply Hunused.
            simpl. right. easy.
            apply Hlo0.
Qed.

Lemma regstate_push_unchanged :
    forall pl ex view tid addr rs
        (Hmask : pl view = None)
        (Hunused : forall e, In e ex -> get_view e <> Some view)
        (Hrs : rel_replay_reg pl ex rs),
        rel_replay_reg (update pl view (Some (PUSH tid addr))) ex rs.
Proof.
    induction ex; intros.
    -   inversion Hrs. constructor.
    -   inversion Hrs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. apply Hinternal.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs. unfold get_value in *.
            rewrite update_not_same. apply Hval.
            intro. edestruct Hunused.
            simpl. left. reflexivity.
            subst a. simpl. subst. reflexivity.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
        +   econstructor. apply IHex.
            apply Hmask. intros. apply Hunused. simpl. right. easy.
            apply Hs.
Qed.

Lemma memstate_push_unchanged :
    forall n pl view ms tid addr
        (Hmask : pl view = None)
        (Hms : rel_replay_mem n pl ms),
        rel_replay_mem n (update pl view (Some (PUSH tid addr))) ms.
Proof.
    induction n; intros.
    -   inversion Hms. constructor.
    -   inversion Hms.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            rewrite update_not_same. apply Hwrite.
            intro. contradict Hwrite. subst. rewrite Hmask. easy.
        +   econstructor. apply IHn.
            apply Hmask. apply Hlp.
            destruct (Peano_dec.eq_nat_dec view (S n)).
            *   subst. rewrite update_same. easy.
            *   rewrite update_not_same by easy. apply Hnotwrite.
Qed.

Theorem same_mem :
    forall (t : Trace) (gt : list GlobalEvent)
        (Hsc : rel_global_trace t gt)
        (Hvalid : valid_trace t)
        (Hdrf : DRF t)
        ,
        same_result t gt.
Proof.
    intros. induction Hsc.
    -   (* empty *)
        esplit; simpl in *.
        +   apply empty_replay_mem. easy.
        +   intro. apply REPLAY_REG_EMPTY.
        +   apply SC_EMPTY.
        +   simpl. reflexivity.
        +   simpl. easy.
    -   (* internal *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v. apply Hfulfilled in Hp.
                    destruct Hp as (tid0 & e & n & Hp1 & Hp2 & Hp3).
                    destruct (promiselist t v) eqn: Heqp; try easy.
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hp1.
                        apply nth_error_inv in Hp1 as [|].
                        {   destruct H. subst.
                            destruct p; destruct Hp2; try easy.
                            destruct H0. easy.
                        }
                        {exists tid0, e.
                            destruct H as (n0 & Hn01 & Hn02).
                            exists n0.
                            split. easy. split. easy.
                            intros.
                            destruct (Peano_dec.eq_nat_dec tid0 tid').
                            - rewrite e0 in *.
                                specialize Hp3 with tid' (S n') e'.
                                rewrite update_same in Hp3. rewrite Hn01 in Hp3.
                                split; auto.
                                assert (S n0 = S n') by now apply Hp3.
                                inversion H. easy.
                            - specialize Hp3 with tid' n' e'.
                                rewrite update_not_same in Hp3 by lia.
                                apply Hp3  in He'; easy.
                        }
                    *   rewrite update_not_same in Hp1 by easy.
                        exists tid0, e, n. split. easy.
                        split. easy. intros.
                        destruct (Peano_dec.eq_nat_dec tid tid').
                        {   rewrite <- e0 in *.
                            specialize Hp3 with tid (S n') e'.
                            rewrite update_same in Hp3.
                            contradict n0. symmetry. apply Hp3.
                            simpl. easy. easy.
                        }
                        {   apply Hp3 with e'.
                            rewrite update_not_same by easy. easy. easy.

                        }
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hls1.
                        inversion Hls1; exists ls; easy.
                    *   rewrite update_not_same in Hls1 by easy.
                        exists ls1. easy.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit. apply Hglobal.
                intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                destruct (Peano_dec.eq_nat_dec tid tid0).
                  subst. rewrite update_same in Hlo.
                    inversion Hlo. exists lo. easy.
                  rewrite update_not_same in Hlo by easy.
                    exists lo. easy.
        }
        clear IHHsc. inversion IHsame.
        destruct (execute_internal_exists i (rs tid)) as (r0 & Hr0).
        set (rs0 := update rs tid r0).
        replace r0 with (rs0 tid) in Hr0 by now unfold rs0; rewrite update_same.
        esplit; simpl in *.
        +   apply Hpamem.
        +   intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same.
                econstructor. apply Hpareg.
                apply Hr0.
            *   rewrite update_not_same by easy.
                replace (rs0 tid0) with (rs tid0).
                apply Hpareg. unfold rs0. rewrite update_not_same by easy.
                reflexivity.
        +   constructor. apply Hsc0.
            rewrite Hreg. apply Hr0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same. reflexivity.
            *   unfold rs0.
                rewrite update_not_same by easy.
                rewrite update_not_same by easy.
                apply Hreg.
    -   (* LOAD *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            -   inversion Hvalid. constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v. apply Hfulfilled in Hp.
                    destruct Hp as (tid0 & e & n & Hp1 & Hp2 & Hp3).
                    destruct (promiselist t v) eqn: Heqp; try easy.
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hp1.
                        apply nth_error_inv in Hp1 as [|].
                          destruct H. subst.
                            destruct p; destruct Hp2; try easy.
                            destruct H0. easy.
                          exists tid0, e.
                            destruct H as (n0 & Hn01 & Hn02).
                            exists n0.
                            split. easy. split. easy.
                            intros.
                            destruct (Peano_dec.eq_nat_dec tid0 tid').
                             rewrite e0 in *.
                                specialize Hp3 with tid' (S n') e'.
                                rewrite update_same in Hp3. rewrite Hn01 in Hp3.
                                split; auto.
                                assert (S n0 = S n') by now apply Hp3.
                                inversion H. easy.
                             specialize Hp3 with tid' n' e'.
                                rewrite update_not_same in Hp3 by lia.
                                apply Hp3  in He'; easy.
                    *   rewrite update_not_same in Hp1 by easy.
                        exists tid0, e, n. split. easy.
                        split. easy. intros.
                        destruct (Peano_dec.eq_nat_dec tid tid').
                          rewrite <- e0 in *.
                            specialize Hp3 with tid (S n') e'.
                            rewrite update_same in Hp3.
                            contradict n0. symmetry. apply Hp3.
                            simpl. easy. easy.
                          apply Hp3 with e'.
                            rewrite update_not_same by easy. easy. easy.
                +   intro. simpl in *.
                    specialize Hconsistent with tid0. destruct Hconsistent as (ls & Hls).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                    *   subst. rewrite update_same in Hls.
                        inversion Hls. exists ls0. easy.
                    *   rewrite update_not_same in Hls by easy.
                        exists ls. easy.
            -   inversion Hdrf. simpl in *. esplit.
                apply Hglobal.
                intro. specialize Hlocal with tid0.
                destruct (Peano_dec.eq_nat_dec tid tid0).
                +   subst. rewrite update_same in Hlocal.
                    destruct Hlocal as (lo & Hlo).
                    inversion Hlo. exists lo. apply Hlo0.
                +   rewrite update_not_same in Hlocal by easy.
                    apply Hlocal.
        }
        clear IHHsc. inversion IHsame.
        inversion Hvalid.
        destruct (Hconsistent tid) as (ls & Hls). simpl in *.
        rewrite update_same in Hls.
        inversion Hls.
        set (rs0 := update rs tid (update (rs tid) reg val)).
        esplit; simpl in *.
        +   apply Hpamem.
        +   subst.
            instantiate (1:= update rs tid (update (rs tid) reg val)).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. simpl in *. rewrite update_same.
                unfold rs0. rewrite update_same.
                constructor. assumption.
                unfold get_value. rewrite Hpromise. easy.
            *   unfold rs0.
                repeat rewrite update_not_same by easy.
                easy.
        +   constructor. apply Hsc0.
        +   easy.
        +   simpl. intro.
            destruct (Peano_dec.eq_nat_dec tid tid1).
            *   rewrite Hreg. rewrite Hms.
                rewrite e.
                repeat rewrite update_same.
                assert (ms addr = val). (* last read *)
                {
                    apply Hlast in Hpamem.
                    unfold get_value in *. rewrite Hpromise in Hpamem.
                    inversion Hpamem. reflexivity.
                }
                subst. easy.
            *   subst.
                repeat rewrite update_not_same by easy. rewrite Hreg. easy.
    -   (* STORE *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg0 & Hreg).
                                inversion Hreg. contradict n. easy. easy.
                                destruct Hp1. discriminate.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_write.
                          apply Hmask.
                          intros. eapply Hunused. apply H6.
                          apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1.
                        eapply localstate_promise_unused_write.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eexists. eapply global_ownership_unused_write.
                    apply Hmask. apply H0. (* last write *)
                +   intro. specialize Hlocal with tid0. destruct Hlocal  as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_write. apply Hmask.
                        intros. eapply Hunused. apply H5. subst. apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo.
                        eapply local_ownership_unused_write. apply Hmask.
                        intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply Hlast. apply Hpamem.
        +   intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                apply REPLAY_REG_STORE.
                eapply regstate_write_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
                unfold get_value. rewrite update_same.
                inversion Hvalid.
                specialize Hconsistent with tid0. destruct Hconsistent.
                simpl in *. rewrite update_same in H0. inversion H0.
                rewrite update_same in Hpromise. inversion Hpromise.
                erewrite rel_promising_localstate. reflexivity.
                apply Hls. apply regstate_write_unchanged.
                apply Hmask. intro. apply Hunused. easy.
            *   rewrite update_not_same by easy.
                eapply regstate_write_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   constructor. apply Hsc0.
        +   simpl. rewrite Hreg. rewrite Hms.
            replace (rs tid reg) with val. easy.
            inversion Hvalid. specialize Hconsistent with tid.
            destruct Hconsistent. simpl in *. rewrite update_same in H2.
            inversion H2. rewrite update_same in Hpromise. inversion Hpromise.
            erewrite rel_promising_localstate. reflexivity.
            apply Hls. apply regstate_write_unchanged. apply Hmask.
            intro. eapply Hunused. easy.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
    -   (* ACQ *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg & Hreg). discriminate.
                                destruct Hp1. inversion H0. contradict n. easy. easy.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H5. apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1. eapply localstate_promise_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eapply Hlast. apply H0.
                +   intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H4.
                        apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo. eapply local_ownership_unused_pull.
                        apply Hmask. intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply memstate_pull_unchanged. apply Hmask. apply Hpamem.
        +   instantiate (1:= rs).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                constructor.
                apply regstate_pull_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
            *   rewrite update_not_same by easy.
                apply regstate_pull_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   apply Hsc0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
    -   (* REL *)
        assert (same_result t gt) as IHsame.
        {
            apply IHHsc.
            inversion Hvalid. simpl in *.
            -   constructor.
                +   unfold fulfilled in *. simpl in *. intros v Hp.
                    specialize Hfulfilled with v.
                    destruct (Peano_dec.eq_nat_dec v view).
                    *   rewrite e in *.
                        rewrite Hmask in *. destruct Hp. easy.
                    *   rewrite update_not_same in Hfulfilled by lia.
                        apply Hfulfilled in Hp.
                        destruct Hp as (tid0 & e & n0 & He & Hp1 & Hp2).
                        exists tid0, e.
                        destruct (Peano_dec.eq_nat_dec tid tid0).
                          rewrite <- e0 in *. rewrite update_same in He.
                            apply nth_error_inv in He as [|].
                              destruct H0. subst.
                                destruct (promiselist t v); try easy.
                                destruct p. destruct Hp1 as (_ & reg & Hreg). discriminate.
                                easy.
                                destruct Hp1. inversion H0. contradict n. easy.
                              destruct H0 as (n' & Hn'1 & Hn'2).
                                exists n'. split. easy. split. easy.
                                intros.
                                destruct (Peano_dec.eq_nat_dec tid tid').
                                  rewrite <- e1 in *.
                                    specialize Hp2 with tid (S n'0) e'.
                                    rewrite update_same in Hp2.
                                    rewrite Hn'1 in *.
                                    assert (S n' = S n'0) by now apply Hp2.
                                    auto.
                                  specialize Hp2 with tid' n'0 e'.
                                    rewrite update_not_same in Hp2 by lia.
                                    contradict n1. apply Hp2. easy. easy.
                          rewrite update_not_same in He by easy.
                            exists n0. split. easy. split. easy.
                            intros. destruct (Peano_dec.eq_nat_dec tid tid').
                              specialize Hp2 with tid (S n') e'. rewrite <- e0 in *.
                                rewrite update_same in Hp2.
                                contradict n1. symmetry. apply Hp2.
                                simpl. easy. easy.
                              specialize Hp2 with tid' n' e'.
                                rewrite update_not_same in Hp2 by easy.
                                apply Hp2. easy. easy.
                +   intro. specialize Hconsistent with tid0. destruct Hconsistent as (ls1 & Hls1).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hls1.
                        inversion Hls1. exists ls.
                        eapply localstate_promise_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H5. rewrite H1. apply Hls.
                      rewrite update_not_same in Hls1 by easy.
                        exists ls1. eapply localstate_promise_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H0. apply Hls1.
            -   (* DRF *)
                inversion Hdrf. simpl in *.
                esplit.
                +   inversion Hglobal. eapply Hlast. apply H0.
                +   intro. specialize Hlocal with tid0. destruct Hlocal as (lo & Hlo).
                    destruct (Peano_dec.eq_nat_dec tid tid0).
                      subst. rewrite update_same in Hlo.
                        inversion Hlo. exists lo0.
                        eapply local_ownership_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H4.
                        apply Hlo0.
                      rewrite update_not_same in Hlo by easy.
                        exists lo. eapply local_ownership_unused_push.
                        apply Hmask. intros. eapply Hunused. apply H0. subst. apply Hlo.
        }
        clear IHHsc. inversion IHsame.
        esplit; simpl in *.
        +   apply memstate_push_unchanged. apply Hmask. apply Hpamem.
        +   instantiate (1:=rs).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst. rewrite update_same.
                constructor.
                apply regstate_push_unchanged. apply Hmask.
                intros. eapply Hunused. apply H. apply Hpareg.
            *   rewrite update_not_same by easy.
                apply regstate_push_unchanged. apply Hmask.
                intros. eapply Hunused. apply H1. apply Hpareg.
        +   apply Hsc0.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            apply Hreg.
Qed.


(** * Classification of morphisms of the Grothendieck Construction of a functor to Set *)
Require Import Category.Core Functor.Core.
Require Import Category.Morphisms.
Require Import SetCategory.Core.
Require Import Grothendieck.ToSet.Core.
Require Import HoTT.Basics HoTT.Types.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope morphism_scope.

Section Grothendieck.
  Context `{Funext}.
  Context {C : PreCategory}
          {F : Functor C set_cat}.

  Definition isequiv_sigma_category_isomorphism {s d : category F}
  : (s <~=~> d)%category <~> { e : (s.(c) <~=~> d.(c))%category | (F _1 e s.(x) = d.(x))%category }.
  Proof.
    simple refine (equiv_adjointify _ _ _ _).
    { intro m.
      simple refine (_; _).
      { exists (m : morphism _ _ _).1.
        exists (m^-1).1.
        { exact (ap proj1 (@left_inverse _ _ _ m _)). }
        { exact (ap proj1 (@right_inverse _ _ _ m _)). } }
      { exact (m : morphism _ _ _).2. } }
    { intro m.
      exists (m.1 : morphism _ _ _ ; m.2).
      eexists (m.1^-1;
               ((ap (F _1 (m.1)^-1) m.2)^)
                 @ (ap10 ((((composition_of F _ _ _ _ _)^)
                             @ (ap (fun m => F _1 m) (@left_inverse _ _ _ m.1 _))
                             @ (identity_of F _))
                          : (F _1 (m.1 : morphism _ _ _)^-1) o F _1 m.1 = idmap) s.(x)));
        apply path_sigma_hprop.
      - exact left_inverse.
      - exact right_inverse. }
    { intro x; apply path_sigma_hprop; apply path_isomorphic.
      reflexivity. }
    { intro x; apply path_isomorphic; reflexivity. }
  Defined.
End Grothendieck.