(* 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 weakenedWDRF.Base weakenedWDRF.Promising weakenedWDRF.DRF weakenedWDRF.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_ORACLE : forall t gt reg val tid
                    (Hgt : rel_global_trace t gt),
                    rel_global_trace
                        (t
                            <|executions := update (executions t) tid (ORACLE reg val :: (executions t tid)) |>
                        )
                        (GE tid (ORACLE reg val) :: 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.
        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.
        +   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.
        +   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.
        +   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.
        +   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.
        +   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.
        +   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.
        +   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.
        +   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.
        +   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.
    -   (* oracle *)
        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.
        set (r0 := update (rs tid) reg val).
        set (rs0 := update rs tid r0).
        esplit; simpl in *.
        +   apply Hpamem.
        +   instantiate (1:=rs0).
            intro. specialize Hpareg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same.
                unfold rs0. rewrite update_same.
                econstructor. apply Hpareg.
            *   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.
        +   simpl. apply Hms.
        +   simpl. intro. specialize Hreg with tid0.
            destruct (Peano_dec.eq_nat_dec tid tid0).
            *   subst tid0. rewrite update_same. rewrite Hreg.
                unfold rs0. rewrite update_same. easy.
            *   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.


Require Import sflib.

Require Import Axioms.
Require Import Basic.
Require Import DataStructure.
Require Import Loc.
Require Import Language.

Require Import Time.
Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import NPConfiguration.
Require Import ww_RF.
Require Import Behavior.
Require Import LocalSim.

Require Import LibTactics.

Require Import SemaEq.
Require Import wwRFEq.
Require Import Compositionality.
Require Import GlobSim.
Require Import NPBehavior.
Require Import wwRFPrsv.

Set Implicit Arguments.

(** * Framework Final Theorem *)

(** This file defines the final theorem of our framework. *)

(** The main result (theorem [Verif_implies_Correctness] in this file) is that:
    a verified optimizer is a correct optimizer. *)

(** * Correctness of Optimizer *)
Section Correct_Optimizer.
  Variable lang: language.

  (** ** Type of Optimizer *)
  Definition Optimizer :=
    forall (lo: Ordering.LocOrdMap) (code: Language.syntax lang), option (Language.syntax lang).

  (** ** Correctness of Optimizer *)
  (** An optimizer is correct if,

      for any optimization,
      if the source program is write-write race freedom [ww_rf] and safe [Configuration.safe],
      we have the refinement between the target program optimized and the source program,
      and the write-write race freedom and safety properties are preserved during optimization. *)
  Definition Correct (optimizer: Optimizer) :=
    forall (code_s code_t: Language.syntax lang) fs lo ctid
           (OPTIMIZE: optimizer lo code_s = Some code_t)
           (WWRF_S: ww_rf lo fs code_s ctid)
           (SAFE_S: Configuration.safe lo fs code_s ctid),
      <<REFINE: forall behs, prog_behaviors fs code_t ctid lo behs -> prog_behaviors fs code_s ctid lo behs>> /\
      <<WWRF_T: ww_rf lo fs code_t ctid>> /\ <<SAFE_T: Configuration.safe lo fs code_t ctid>>.

  (** ** Optimizers Linking *)
  (** It contructs an optimizer with two optimization phases. *)
  (** opt_link (optimizer1, optimizer) (code_s) =
       let code_m := optimizer2(code_s) in optimizer1(code_m)   *)
  Definition opt_link (optimizer1 optimizer2: Optimizer) : Optimizer :=
    fun (lo: Ordering.LocOrdMap) (code_s: Language.syntax lang) =>
      match (optimizer2 lo code_s) with
      | Some code_m => optimizer1 lo code_m
      | None => None
      end.

  (** ** Correctness of Optimizers Linking *)
  Lemma correct_optimizer_transitive:
    forall (optimizer1 optimizer2: Optimizer)
      (CORRECT1: Correct(optimizer1))
      (CORRECT2: Correct(optimizer2)),
      Correct(opt_link optimizer1 optimizer2).
  Proof.
    intros; unfolds Correct; intros.
    unfold opt_link in OPTIMIZE. destruct (optimizer2 lo code_s) eqn:H_OPTIMIZER2; simpls; tryfalse.
    eapply CORRECT2 in H_OPTIMIZER2; eauto.
    destruct H_OPTIMIZER2 as (Hrefine2 & Hww_rf2 & Hsafe2).
    eapply CORRECT1 in OPTIMIZE; eauto.
    destruct OPTIMIZE as (Hrefine1 & Hww_rf1 & Hsafe1).
    split; eauto.
  Qed.

  (** ** Verified Optimizer *)
  (** An optimizer is verified if we can establish the thread-local simulation [local_sim]
      between the target and source programs *)
  Definition Verif (optimizer: Optimizer): Prop :=
    forall (code_s code_t: Language.syntax lang) (lo: Ordering.LocOrdMap),
        optimizer lo code_s = Some code_t ->
          exists invariant index ord,
            @local_sim index ord lang invariant lo code_t code_s.

  (** The following lemma [Verif_opt_implies_localsim]
      shows that for a verified optimizer,
      the source program and the target program optimized
      are simulated by the thread-local simulation.

      Lemma [Verif_opt_implies_localsim] corresponds to
      the step 2 in Figure 6 (Our proof path) in our paper *)
  Lemma Verif_opt_implies_localsim
        optimizer code_s code_t lo
        (VERIF: Verif optimizer)
        (OPT: optimizer lo code_s = Some code_t):
    exists invariant index ord,
      @local_sim index ord lang invariant lo code_t code_s.
  Proof.
    eauto.
  Qed.

  (** ** A verified optimizer is correct *)
  Theorem Verif_implies_Correctness:
    forall (optimizer: Optimizer),
      Verif optimizer -> Correct optimizer.
  Proof.
    ii. renames H to WF_OPT.
    eapply Verif_opt_implies_localsim in WF_OPT; eauto.
    renames WF_OPT to LOCAL_SIM. des.
    lets GLOB_SIM: LOCAL_SIM.
    eapply compositionality in GLOB_SIM; eauto.
    Focus 2. eapply config_safe_eq; eauto.
    Focus 2. eapply ww_RF_eq; eauto.
    split.
    {
      ii. eapply sema_eq_ps_nps in H.
      eapply sema_eq_ps_nps.
      eapply glob_sim_implies_refinement; eauto.
    }
    split.
    {
      lets WW_RF: LOCAL_SIM.
      eapply ww_RF_preservation in WW_RF.
      eapply ww_RF_eq; eauto.
      eapply config_safe_eq; eauto.
      eapply ww_RF_eq; eauto.
    }
    {
      lets SAFE_S': SAFE_S.
      eapply safe_implies_not_abort_tr in SAFE_S'.
      eapply not_abort_tr_implies_safe. ii; des.
      contradiction SAFE_S'.
      eapply sema_eq_ps_nps in H.
      eapply glob_sim_implies_refinement in GLOB_SIM; eauto.
      eapply sema_eq_ps_nps in GLOB_SIM; eauto.
    }
  Qed.

End Correct_Optimizer.


Require Import Coq.ZArith.ZArith.
Require Import Coq.Lists.List.
Require Import Crypto.AbstractInterpretation.AbstractInterpretation.
Require Import Crypto.Bedrock.Field.Common.Types.
Require Import Crypto.Language.API.
Require Import Crypto.Util.Option.

Import Language.API.Compilers AbstractInterpretation.Compilers.
Import Types.Notations.
#[global]
Existing Instances rep.Z rep.listZ_mem.

Section with_parameters.
  Context
    {width BW word mem locals env ext_spec varname_gen error}
   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.

  Fixpoint list_lengths_repeat_base (n : nat) t : base_listonly nat t :=
    match t as t0 return base_listonly nat t0 with
    | base.type.prod a b =>
      (list_lengths_repeat_base n a, list_lengths_repeat_base n b)
    | base_listZ => n
    | _ => tt
    end.
  Fixpoint list_lengths_repeat_args (n : nat) t
    : type.for_each_lhs_of_arrow list_lengths t :=
    match t as t0 return type.for_each_lhs_of_arrow list_lengths t0 with
    | type.base b => tt
    | type.arrow (type.base s) d =>
      (list_lengths_repeat_base n s, list_lengths_repeat_args n d)
    | type.arrow s d => (tt, list_lengths_repeat_args n d)
    end.

  (* mostly a duplicate of list_lengths_from_value, just with ZRange interp *)
  Fixpoint list_lengths_from_bounds {t}
    : ZRange.type.base.option.interp t -> option (base_listonly nat t) :=
    match t as t0 return
          ZRange.type.base.option.interp t0 -> option (base_listonly nat t0) with
    | base.type.prod a b =>
      fun x =>
        (x1 <- list_lengths_from_bounds (fst x);
           x2 <- list_lengths_from_bounds (snd x);
           Some (x1, x2))%option
    | base_listZ =>
      fun x : option (list _) => option_map (@List.length _) x
    | _ => fun _ => Some tt
    end.
  Fixpoint list_lengths_from_argbounds {t}
    : type.for_each_lhs_of_arrow ZRange.type.option.interp t ->
      option (type.for_each_lhs_of_arrow list_lengths t) :=
    match t as t0 return
          type.for_each_lhs_of_arrow _ t0 ->
          option (type.for_each_lhs_of_arrow _ t0) with
    | type.base b => fun _ => Some tt
    | type.arrow (type.base a) b =>
      fun x =>
        (x1 <- list_lengths_from_bounds (fst x);
           x2 <- list_lengths_from_argbounds (snd x);
           Some (x1, x2))%option
    | type.arrow a b => fun _ => None
    end.
End with_parameters.


From PCC Require Import list_utils java_basic_defs expressions_assertions.
From Coq Require Import List Bool ZArith.
From PCC Require Import ssrexport.

Section ProgramModel.

Open Scope type_scope.

Definition ghost_update := ghostid * expr.

Inductive instr : Set :=
| aload (_: nat)
| astore (_: nat)
| athrow
| dup
| getfield (_: fieldid)
| getstatic (_: classid) (_: fieldid)
| goto (_: label)
| iadd
| iconst (_: Z)
| ifeq (_: label)
| invoke (_: classid) (_: methid)
| putstatic (_: classid) (_: fieldid)
| ldc (_: jvalue)
| exit
| ret
| nop
| ghost_instr (_: ghost_update).

(* Exception handler records (rows in the exception handler table) *)
Record eh_record : Set := {
  start_label  : label;
  end_label    : label;
  target_label : label;
  handled_classes : classid
}.

Definition eh_table := list eh_record.

(*
   A label function is used to look up successor-labels. It used to
   be 'S' (the nat successor-funciotn) but that quickly became insufficient
   when inserting ghost-instructions.
*)
Definition label_function := label -> label.

(*
   We're skipping the regular method definition and jump straight to the
   extended version which includes assertions.
*)
Record method := {
  code_of: label -> instr;
  annotations_of : label -> ast;
  eh_table_of: eh_table;
  label_function_of: label_function
}.

(*
   No field declarations at this point. Wi simply assume that all fields
   accessed by the program has been properly declared.
 *)
Definition class := methid -> method.

(* Local variables store. *)
Definition lstore := nat -> jvalue.

Definition emptylstore : lstore := fun x => undefval.

Definition upd (ls:lstore) (n:nat) (v:jvalue) : lstore :=
  fun x => if beq_nat x n then v else ls x.

(* A heap consists of a dynamic part (dheap) and static part (sheap). *)
Definition dheap := loc -> option object.

Definition sheap := classid -> fieldid -> option jvalue.

Definition heap := dheap * sheap.

Definition empty_heap : heap := (fun l => None, fun c f => None).

Definition upd_sheap (h:heap) (cid:classid) (fid:fieldid) (v:jvalue) : heap :=
  (fst h, fun c f => if beq_nat c cid && beq_nat f fid then Some v else (snd h) c f).

Notation "ls '[[' n '⟼' v ']]'" := (upd ls n v) (at level 90).

(* Activation records. *)
Inductive act_record : Set :=
| normal (_: classid) (_: methid) (_: label) (_: stack) (_: lstore)
| exceptional (_: loc).

Record program := {
  classes: classid -> class;
  inv: ast
}.

(* Main class and main method are assumed to be these constants. *)
Definition maincid : classid := O.

Definition mainmid : methid := O.

Definition ghost_valuation := ghostid -> value.

(* We assume that the default value for ghost variables is 0. (Since the undefval is
   reserved for the notion of "going wrong".) *)
Definition initial_gv : ghost_valuation := fun l => intval 0.

Definition upd_gv (gv: ghost_valuation) (var: ghostid) (val: value) : ghost_valuation :=
  (fun v => if beq_nat v var then val else gv v).

(* We go straight to extended configurations. *)
Definition conf := ghost_valuation * heap * (list act_record).

Definition execution := list conf.

(* Convenience access methods  *)
Definition instr_at (p: program) c m l : instr := code_of (classes p c m) l.

Definition minstr_at (m: method) l : instr := code_of m l.

Definition ast_at   (p: program) c m l : ast   := annotations_of (classes p c m) l.

Definition successor (p: program) c m l := label_function_of (classes p c m) l.

Definition stack_of (c: conf) : option stack :=
  match c with (_, _, (normal _ _ _ s _)::_) => Some s | _ => None end.

Definition lstore_of (c: conf) : option lstore :=
  match c with (_, _, (normal _ _ _ _ ls)::_) => Some ls | _ => None end.

Definition class_of (c: conf) : option classid :=
  match c with (_, _, (normal c _ _ _ _)::_) => Some c | _ => None end.

Definition meth_of (c: conf) : option methid :=
  match c with (_, _, (normal _ m _ _ _)::_) => Some m | _ => None end.

Definition heap_of (c: conf) : heap := snd (fst c).

Definition ars_of (c: conf) : (list act_record) := snd c.

Definition ghost_valuation_of (c: conf) : ghost_valuation := fst (fst c).

Definition current_instr (p: program) (cnf: conf) : option instr :=
  match cnf with (_, _, (normal c m pc _ _)::_) =>
    Some (instr_at p c m pc) | _ => None end.

Definition current_ast (p: program) (cnf: conf) : option ast :=
  match cnf with (_, _, (normal c m pc _ _)::_) =>
    Some (ast_at p c m pc) | _ => None end.

Definition current_label (cnf: conf) : option label :=
  match cnf with (_, _, (normal _ _ pc _ _)::_) => Some pc | _ => None end.

Lemma current_to_instr_at : forall pg p c m pc s l1 l i,
  current_instr pg (p, normal c m pc s l1 :: l) = Some i ->
  instr_at pg c m pc = i.
Proof.
move => pg p c m pc s l1 l i H.
inversion H as [H0].
move: p H H0; case => g h H H0.
by inversion H0.
Qed.

Lemma instr_at_to_current : forall pg p c m pc s l1 l i,
  instr_at pg c m pc = i -> current_instr pg (p, normal c m pc s l1 :: l) = Some i.
Proof.
move => pg p c m pc s l1 l i H.
rewrite /current_instr.
case: p => g h.
by rewrite H.
Qed.

(*
  To  show ∥wp(A)∥ C <-> ∥A∥ C' later on, we need a lemma (in the neg case)
  relating aeval and aeval_f in the following way:

  (aeval a c <-> aeval a' c') -> (aeval_f a c <-> aeval_f a' c')       (1)

  This fact requires more than just [aeval a c -> ~aeval_f a c] and vice versa,
  since if there is an undefined expression (s.t. [~aeval undef c] and
  [~ aeval_f undef c]) we get the following counter example:

  (aeval ff c <-> aeval undef c') -> (aeval_f ff c <-> aeval_f undef c')

  Fact (1) relies on a stronger fact that

  ~ (aeval a c <-> aeval_f a c)      (2)

  Showing (2) requires that aeval_f is true/defined for all cases in which
  aeval is not true/defined. For example, if the heap is ill-typed, this has
  to be taken into account in aeval_f.

  This in turn requires that all expressions can be evaluated to a value, no
  matter the context.
*)

Definition is_intval (v: value) : Prop := exists i, v = intval i.

Inductive eeval : expr -> conf -> value -> Prop :=
| e_val : forall c v, eeval (valexp v) c v
| e_nsfield : forall gv c e dh sh ars f l obj, c = (gv, (dh, sh), ars) ->
    eeval e c (refval l) -> dh l = Some obj -> eeval (nsfield e f) c (obj f)
| e_sfield : forall gv c dh sh ars cid f v, c = (gv, (dh, sh), ars) ->
    sh cid f = Some v -> eeval (sfield cid f) c v
| e_ghosterr : forall c, eeval ghost_errval c ghost_errval
| e_plus : forall c e1 e2 i j, eeval e1 c (intval i) ->
    eeval e2 c (intval j) -> eeval (plus e1 e2) c (intval (i + j))
| e_guard_true : forall c eg et ef v, eeval eg c (boolval true ) ->
    eeval et c v -> eeval (guarded eg et ef) c v
| e_guard_other : forall c eg et ef v, eeval eg c (boolval false) ->
    eeval ef c v -> eeval (guarded eg et ef) c v
| e_stack : forall c n s, stack_of c = Some s -> eeval (stackexp n) c (s[[n]])
| e_local : forall c n ls, lstore_of c = Some ls -> eeval (local n) c (ls n)
| e_ghostvar : forall c gvarid, eeval (ghost_var gvarid) c ((ghost_valuation_of c) gvarid)
| e_nsfield_err1 : forall c e v f, eeval e c v -> (forall l, v <> refval l) ->
    eeval (nsfield e f) c undefval
| e_nsfield_err2 : forall gv c e dh sh ars f l, c = (gv, (dh, sh), ars) ->
    eeval e c (refval l) -> dh l = None -> eeval (nsfield e f) c undefval
| e_sfield_err : forall gv c dh sh ars cid f, c = (gv, (dh, sh), ars) ->
    sh cid f = None -> eeval (sfield cid f) c undefval
| e_plus_err : forall c e1 e2 v1 v2, eeval e1 c v1 -> eeval e2 c v2 ->
    ~ is_intval v1 \/ ~ is_intval v2 -> eeval (plus e1 e2) c undefval
| e_guard_err : forall c eg et ef v, eeval eg c v -> (forall b, v <> boolval b) ->
    eeval (guarded eg et ef) c undefval.

(* Transitions (activation record related) *)
Inductive artrans : program -> act_record -> act_record -> Prop :=
| tr_aload : forall p c m pc n s ls ar1 ar2,
    instr_at p c m pc = aload n ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m (successor p c m pc) (ls n::s) ls ->
    artrans p ar1 ar2
| tr_astore : forall p c m pc s n ls v ar1 ar2,
    instr_at p c m pc = astore n ->
    ar1 = normal c m pc (v::s) ls ->
    ar2 = normal c m (successor p c m pc) s (ls[[n ⟼ v]]) ->
    artrans p ar1 ar2
| tr_dup : forall p c m pc s ls v ar1 ar2,
    instr_at p c m pc = dup ->
    ar1 = normal c m pc (v::s) ls ->
    ar2 = normal c m (successor p c m pc) (v::v::s) ls ->
    artrans p ar1 ar2
| tr_goto : forall p c m l pc s ls ar1 ar2,
    instr_at p c m pc = goto l ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m l  s ls ->
    artrans p ar1 ar2
| tr_iconst : forall p c m pc n ls s ar1 ar2,
    instr_at p c m pc = iconst n ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m (successor p c m pc) ((intval n)::s) ls ->
    artrans p ar1 ar2
| tr_ldc : forall p c m pc s ls v ar1 ar2,
    instr_at p c m pc = ldc v ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m (successor p c m pc) (v::s) ls ->
    artrans p ar1 ar2
| tr_ifeq_true : forall p c m pc s ls l v ar1 ar2,
    instr_at p c m pc = ifeq l ->
    v = boolval true ->
    ar1 = normal c m pc (v::s) ls ->
    ar2 = normal c m l s ls ->
    artrans p ar1 ar2
| tr_ifeq_false : forall p c m pc s ls l v ar1 ar2,
    instr_at p c m pc = ifeq l ->
    v = boolval false ->
    ar1 = normal c m pc (v::s) ls ->
    ar2 = normal c m l s ls ->
    artrans p ar1 ar2.

(* Transitions (heap releated) *)
Inductive htrans : program -> conf -> conf -> Prop :=
| tr_putstatic : forall p c cid fid ars m pc v s ls h c1 c2 ar1 ar2 gv,
    instr_at p c m pc = putstatic cid fid ->
    ar1 = normal c m pc (v::s) ls ->
    ar2 = normal c m (successor p c m pc) (v::s) ls ->
    c1 = (gv, h, ar1::ars) ->
    c2 = (gv, upd_sheap h cid fid v, ar2::ars) ->
    htrans p c1 c2
| tr_getstatic : forall p c cid fid ars m pc v s ls h c1 c2 ar1 ar2 gv,
    instr_at p c m pc = getstatic cid fid ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m (successor p c m pc) (v::s) ls ->
    c1 = (gv, h, ar1::ars) ->
    c2 = (gv, h, ar2::ars) ->
    htrans p c1 c2.

(* Ghost instruction transitions *)
(* Just a stub as of now. *)
Inductive g_eeval : expr -> ghost_valuation -> value -> Prop :=
| ge_val : forall s v, g_eeval (valexp v) s v
| ge_gv : forall gv gid, g_eeval (ghost_var gid) gv (gv gid)
| ge_nsfield : forall e f gv, g_eeval (nsfield e f) gv undefval
| ge_sfield : forall gv cid f, g_eeval (sfield cid f) gv undefval
| ge_stackexp : forall gv n, g_eeval (stackexp n) gv undefval
| ge_local : forall gv l, g_eeval (local l) gv undefval
| ge_plus : forall gv e1 e2, g_eeval (plus e1 e2) gv undefval
| ge_guarded : forall gv e1 e2 e3, g_eeval (guarded e1 e2 e3) gv undefval.

Inductive ghosttrans : program -> conf -> conf -> Prop :=
| tr_ghost_upd :
    forall h ars s ls p c m pc gvar e gv v,
      instr_at p c m pc = ghost_instr (gvar, e) -> g_eeval e gv v ->
    ghosttrans p (gv, h, (normal c m pc s ls) :: ars)
      (upd_gv gv gvar v, h, (normal c m (successor p c m pc) s ls) :: ars).

(* Transitions (invoke-related) *)
Inductive invtrans : program -> conf -> conf -> Prop :=
| tr_invoke : forall p c m pc cid mid s ls c1 c2 h ar1 ar2 ars gv,
    instr_at p c m pc = invoke cid mid ->
    ar1 = normal c m pc s ls ->
    ar2 = normal c m (successor p c m pc) s ls ->
    c1 = (gv, h, ar1::ars) ->
    c2 = (gv, h, (normal cid mid O emptystack emptylstore)::ar2::ars) ->
    invtrans p c1 c2.

(* Transitions (exceptional) *)
(* Not implemented as of now. *)

(* Transitions Combined (Only activation record related as of now.) *)
Inductive trans : program -> conf -> conf -> Prop :=
| tr_ar : forall prog ar1 ar2 ars h c1 c2 gv,
    c1 = (gv, h, ar1::ars) ->
    c2 = (gv, h, ar2::ars) ->
    artrans prog ar1 ar2 ->
    trans prog c1 c2
| tr_ghost : forall p c c', ghosttrans p c c' -> trans p c c'.

Inductive trans_star : program -> execution -> Prop :=
| tr_star_nil : forall p, trans_star p nil
| tr_star_sing : forall p c, trans_star p (c :: nil)
| tr_star_step : forall p c c' e, trans p c c' ->
    trans_star p (c' :: e) ->
    trans_star p (c :: c' :: e).

Lemma trans_star_seq : forall p c e1 e2,
  trans_star p (e1 ++ c :: nil) -> trans_star p (c :: e2) ->
  trans_star p (e1 ++ c :: e2).
Proof.
move => p c.
elim => [|c']; first by [].
case => [|c0 l] IH e2 H0 H1; rewrite -app_comm_cons /=.
- by apply tr_star_step; inversion H0.
- apply tr_star_step; first by inversion H0.
  rewrite /= in IH; apply IH; last by [].
  by inversion H0.
Qed.

Lemma trans_star_suff : forall p e e', trans_star p (e ++ e') -> trans_star p e'.
Proof.
move => p.
elim => [|c e IH e' H]; first by [].
by apply IH; inversion H; first by apply tr_star_nil.
Qed.

Definition initial_conf (c: conf) : Prop :=
  c = (initial_gv, empty_heap,
    (normal maincid mainmid O emptystack (fun n => undefval))::nil).

Inductive execution_of p : execution -> Prop :=
| exec_intros : forall exec,
    (forall c, head exec = Some c -> initial_conf c) ->
    (forall pref c c' suff, exec = pref ++ c :: c' :: suff -> trans p c c') ->
    execution_of p exec.

(*
   An alternative approach would have been to define execution as a dependent
   inductive type directly based on initial_conf and trans. Such approach,
   would be cleaner in many ways, but would unfortunately prevent us from
   using all the nice list lemmas and induction principles in the coq
   library.

   Same goes for the approach { ex : list conf | execution_of p ex } since
   elements of this type are not lists either.
*)

Definition max_execution_of p e : Prop :=
  execution_of p e /\ ~ exists c, execution_of p (e ++ c :: nil).

Lemma exec_nil : forall p, execution_of p nil.
Proof.
move => p.
apply exec_intros; first by [].
move => pref c c' suffx H.
by contradict H; auto with datatypes.
Qed.

Lemma exec_sing_impl_initial : forall p c, execution_of p (c :: nil) -> initial_conf c.
Proof.
move => p c H_exec.
inversion H_exec as [exec H_init H_trans H_eq].
by apply H_init.
Qed.

Lemma exec_append : forall p e c c', execution_of p (e ++ c :: nil) -> trans p c c' ->
  execution_of p (e ++ c :: c' :: nil).
Proof.
move => p e c c' H_exec H_trans.
inversion H_exec as [e' H_init H_suff H_eq].
apply exec_intros.
- pose proof (list_same_head e c c') as H_head.
  move => c0 H_some.
  rewrite -H_head in H_some.
  by apply H_init.
- move => pref c0 c1.
  case => [|c2 suffx] H_pref.
  * rewrite list_rearrange in H_pref.
    have H_re: pref ++ c0 :: c1 :: nil = (pref ++ c0 :: nil) ++ c1 :: nil.
      by rewrite list_rearrange.
    rewrite H_re {H_re} in H_pref.
    apply app_inj_tail in H_pref.
    move: H_pref => [H_pref H_cc'].
    apply app_inj_tail in H_pref.
    move: H_pref => [H_e H_c].
    by rewrite -H_cc' -H_c.
  * apply (H_suff pref c0 c1 (removelast (c2 :: suffx))).
    have H_rl : removelast (e ++ c :: c' :: nil) = removelast (pref ++ c0 :: c1 :: c2 :: suffx).
      by rewrite H_pref.
    have H_neq : c :: c' :: nil <> nil by [].
    rewrite (removelast_app e H_neq) /= {H_neq} in H_rl.
    have H_re: pref ++ c0 :: c1 :: c2 :: suffx = (pref ++ c0 :: c1 :: nil) ++ c2 :: suffx.
      by rewrite app_ass -app_comm_cons.
    rewrite H_re {H_re} in H_rl.
    have H_nnil: c2 :: suffx <> nil by [].
    rewrite (removelast_app (pref ++ c0 :: c1 :: nil) H_nnil) {H_nnil} in H_rl.
    by rewrite H_rl app_ass -app_comm_cons.
Qed.

Lemma exec_impl_trans_star : forall p e, execution_of p e -> trans_star p e.
Proof.
move => p e H_exec.
inversion H_exec as [e' H_init H_suff H_eq].
move: e H_suff {H_exec H_init H_eq e'}.
elim => [H_suff|c]; first by apply tr_star_nil.
case => [|c' l] H_suff H_pref; first by apply tr_star_sing.
apply tr_star_step; first by apply (H_pref nil c c' l).
apply H_suff => pref c0 c1 suffx H_eq.
apply H_pref with (pref := c :: pref) (suff := suffx).
by rewrite H_eq.
Qed.

Definition complete_execution_of p ex : Prop :=
  execution_of p ex /\ ~exists c', execution_of p (ex ++ c' :: nil).

Inductive normal_conf : conf -> Prop :=
| is_norm_conf : forall h c m pc s ls ars gv,
    normal_conf (gv, h, (normal c m pc s ls)::ars).

Inductive exceptional_conf : conf -> Prop :=
| is_exc_conf : forall h o ars gv, exceptional_conf (gv, h, (exceptional o)::ars).

Inductive calling_conf p : conf -> Prop :=
| call_conf : forall gv h c m pc l ls ars,
  trans p (gv, h, ars) (gv, h, (normal c m pc l ls)::ars) ->
  calling_conf p (gv, h, ars).

Inductive returning_conf p : conf -> Prop :=
| ret_norm_conf : forall h ar ars,
  trans p (h, ar::ars) (h, ars) ->
  returning_conf p (h, ar::ars).

Definition visible_conf p c : Prop :=
  calling_conf p c \/ returning_conf p c.

End ProgramModel.