Require Import compcert.lib.Coqlib.
Require Import compcert.lib.Maps.
Require Import compcert.lib.Integers.
Require Import compcert.common.Values.
Require Import compcert.common.Memory.
Require Import compcert.common.Events.
Require Import compcert.common.AST.
Require Import compcert.common.Globalenvs.

Require Import msl.Extensionality.
Require Import sepcomp.mem_lemmas.
Require Import sepcomp.semantics.
Require Import sepcomp.semantics_lemmas.

(** * Semantics annotated with Owens-style trace*)
Inductive mem_event :=
  Write : forall (b : block) (ofs : Z) (bytes : list memval), mem_event
| Read : forall (b:block) (ofs n:Z) (bytes: list memval), mem_event
| Alloc: forall (b:block)(lo hi:Z), mem_event
(*| Lock: drf_event
| Unlock: drf_event  -- these events are not generated by core steps*)
| Free: forall (l: list (block * Z * Z)), mem_event.

Fixpoint ev_elim (m:mem) (T: list mem_event) (m':mem):Prop :=
  match T with
   nil => m'=m
 | (Read b ofs n bytes :: R) => Mem.loadbytes m b ofs n = Some bytes /\ ev_elim m R m'
 | (Write b ofs bytes :: R) => exists m'', Mem.storebytes m b ofs bytes = Some m'' /\ ev_elim m'' R m'
 | (Alloc b lo hi :: R) => exists m'', Mem.alloc m lo hi = (m'',b) /\ ev_elim m'' R m'
 | (Free l :: R) => exists m'', Mem.free_list m l = Some m'' /\ ev_elim m'' R m'
  end.

Definition pmax (popt qopt: option permission): option permission :=
  match popt, qopt with
    _, None => popt
  | None, _ => qopt
  | Some p, Some q => if Mem.perm_order_dec p q then Some p else Some q
  end.

Lemma po_pmax_I p q1 q2:
  Mem.perm_order'' p q1 -> Mem.perm_order'' p q2 -> Mem.perm_order'' p (pmax q1 q2).
Proof.
  intros. destruct q1; destruct q2; simpl in *; trivial.
  destruct (Mem.perm_order_dec p0 p1); trivial.
Qed.

Fixpoint cur_perm (l: block * Z) (T: list mem_event): option permission :=
  match T with
      nil => None
    | (mu :: R) =>
          let popt := cur_perm l R in
          match mu, l with
            | (Read b ofs n bytes), (b',ofs') =>
                 pmax (if eq_block b b' && zle ofs ofs' && zlt ofs' (ofs+n)
                       then Some Readable else None) popt
            | (Write b ofs bytes), (b',ofs') =>
                 pmax (if eq_block b b' && zle ofs ofs' && zlt ofs' (ofs+ Zlength bytes)
                       then Some Writable else None) popt
            | (Alloc b lo hi), (b',ofs') =>  (*we don't add a constraint relating lo/hi/ofs*)
                 if eq_block b b' then None else popt
            | (Free l), (b',ofs') =>
                 List.fold_right (fun tr qopt => match tr with (b,lo,hi) =>
                                                   if eq_block b b' && zle lo ofs' && zlt ofs' hi
                                                   then Some Freeable else qopt
                                                end)
                                 popt l
          end
  end.

Lemma po_None popt: Mem.perm_order'' popt None.
Proof. destruct popt; simpl; trivial. Qed.

Lemma ev_perm b ofs: forall T m m', ev_elim m T m' ->
      Mem.perm_order'' ((Mem.mem_access m) !! b ofs Cur) (cur_perm (b,ofs) T).
Proof.
induction T; simpl; intros.
+ subst. apply po_None.
+ destruct a.
  - (*Store*)
     destruct H as [m'' [SB EV]]. specialize (IHT _ _ EV); clear EV.
     rewrite (Mem.storebytes_access _ _ _ _ _ SB) in *.
     eapply po_pmax_I; try eassumption.
     remember (eq_block b0 b && zle ofs0 ofs && zlt ofs (ofs0 + Zlength bytes)) as d.
     destruct d; try solve [apply po_None].
     destruct (eq_block b0 b); simpl in *; try discriminate.
     destruct (zle ofs0 ofs); simpl in *; try discriminate.
     destruct (zlt ofs (ofs0 + Zlength bytes)); simpl in *; try discriminate.
     rewrite Zlength_correct in *.
     apply Mem.storebytes_range_perm in SB.
     exploit (SB ofs); try omega.
     intros; subst; assumption.
  - (*Load*)
     destruct H as [LB EV]. specialize (IHT _ _ EV); clear EV.
     eapply po_pmax_I; try eassumption.
     remember (eq_block b0 b && zle ofs0 ofs && zlt ofs (ofs0 + n)) as d.
     destruct d; try solve [apply po_None].
     destruct (eq_block b0 b); simpl in *; try discriminate.
     destruct (zle ofs0 ofs); simpl in *; try discriminate.
     destruct (zlt ofs (ofs0 + n)); simpl in *; try discriminate.
     apply Mem.loadbytes_range_perm in LB.
     exploit (LB ofs); try omega.
     intros; subst; assumption.
  - (*Alloc*)
     destruct H as [m'' [ALLOC EV]]. specialize (IHT _ _ EV); clear EV.
     destruct (eq_block b0 b); subst; try solve [apply po_None].
     eapply po_trans; try eassumption.
     remember ((Mem.mem_access m'') !! b ofs Cur) as d.
     destruct d; try solve [apply po_None].
     symmetry in Heqd.
     apply (Mem.perm_alloc_4 _ _ _ _ _ ALLOC b ofs Cur p).
     * unfold Mem.perm; rewrite Heqd. destruct p; simpl; constructor.
     * intros N; subst; elim n; trivial.
  - (*Free*)
     destruct H as [m'' [FR EV]]. specialize (IHT _ _ EV); clear EV.
     generalize dependent m.
     induction l; simpl; intros.
     * inv FR. assumption.
     * destruct a as [[bb lo] hi].
       remember (Mem.free m bb lo hi) as p.
       destruct p; inv FR; symmetry in Heqp. specialize (IHl _ H0).
       remember (eq_block bb b && zle lo ofs && zlt ofs hi) as d.
       destruct d.
       { clear - Heqp Heqd. apply Mem.free_range_perm in Heqp.
         destruct (eq_block bb b); simpl in Heqd; inv Heqd.
         exploit (Heqp ofs); clear Heqp; trivial.
         destruct (zle lo ofs); try discriminate.
         destruct (zlt ofs hi); try discriminate. omega. }
       { eapply po_trans; try eassumption. clear - Heqp.
         remember ((Mem.mem_access m0) !! b ofs Cur) as perm2.
         destruct perm2; try solve [apply po_None].
         exploit (Mem.perm_free_3 _ _ _ _ _ Heqp); unfold Mem.perm.
            rewrite <- Heqperm2. apply perm_refl.
         simpl; trivial. }
Qed.

Lemma ev_elim_app: forall T1 m1 m2 (EV1:ev_elim m1 T1 m2) T2 m3  (EV2: ev_elim m2 T2 m3), ev_elim m1 (T1++T2) m3.
Proof.
  induction T1; simpl; intros; subst; trivial.
  destruct a.
+ destruct EV1 as [mm [SB EV]]. specialize (IHT1 _ _ EV _ _ EV2).
  exists mm; split; trivial.
+ destruct EV1 as [LB EV]. specialize (IHT1 _ _ EV _ _ EV2).
  split; trivial.
+ destruct EV1 as [mm [AL EV]]. specialize (IHT1 _ _ EV _ _ EV2).
  exists mm; split; trivial.
+ destruct EV1 as [mm [FL EV]]. specialize (IHT1 _ _ EV _ _ EV2).
  exists mm; split; trivial.
Qed.

Lemma ev_elim_split: forall T1 T2 m1 m3 (EV1:ev_elim m1 (T1++T2) m3),
      exists m2, ev_elim m1 T1 m2 /\ ev_elim m2 T2 m3.
Proof.
  induction T1; simpl; intros.
+ exists m1; split; trivial.
+ destruct a.
  - destruct EV1 as [mm [SB EV]]. destruct (IHT1 _ _ _ EV) as [m2 [EV1 EV2]].
    exists m2; split; trivial. exists mm; split; trivial.
  - destruct EV1 as [LB EV]. destruct (IHT1 _ _ _ EV) as [m2 [EV1 EV2]].
    exists m2; split; trivial. split; trivial.
  - destruct EV1 as [mm [AL EV]]. destruct (IHT1 _ _ _ EV) as [m2 [EV1 EV2]].
    exists m2; split; trivial. exists mm; split; trivial.
  - destruct EV1 as [mm [SB EV]]. destruct (IHT1 _ _ _ EV) as [m2 [EV1 EV2]].
    exists m2; split; trivial. exists mm; split; trivial.
Qed.

(** Similar to effect semantics, event semantics augment memory semantics with suitable effects, in the form
    of a set of memory access traces associated with each internal
    step of the semantics. *)

Record EvSem {G C} :=
  { (** [sem] is a memory semantics. *)
    msem :> @MemSem G C

    (** The step relation of the new semantics. *)
  ; ev_step: G -> C -> mem -> list mem_event -> C -> mem -> Prop

    (** The next four fields axiomatize [drfstep] and its relation to the
        underlying step relation of [msem]. *)
  ; ev_step_ax1: forall g c m T c' m',
       ev_step g c m T c' m' ->
            corestep msem g c m c' m'
  ; ev_step_ax2: forall g c m c' m',
       corestep msem g c m c' m' ->
       exists T, ev_step g c m T c' m'
  ; ev_step_fun: forall g c m T' c' m' T'' c'' m'',
       ev_step g c m T' c' m' -> ev_step g c m T'' c'' m'' -> T'=T''
(*  ; ev_step_elim: forall g c m T c' m',
       ev_step g c m T c' m' -> ev_elim m T m'*)
  ; ev_step_elim: forall g c m T c' m' (STEP: ev_step g c m T c' m'),
       ev_elim m T m' /\
       (forall mm mm', ev_elim mm T mm' -> exists cc', ev_step g c mm T cc' mm')
  }.

Lemma Ev_sem_cur_perm {G C} (R: @EvSem G C) g c m T c' m' b ofs (D: ev_step R g c m T c' m'):
      Mem.perm_order'' ((Mem.mem_access m) !! b ofs Cur) (cur_perm (b,ofs) T).
Proof. eapply ev_perm. eapply ev_step_elim; eassumption. Qed.
(*
Arguments EvSem G C.
*)

Require Import List.
Import ListNotations.

Definition in_free_list (b : block) ofs xs :=
  exists x, List.In x xs /\
       let '(b', lo, hi) := x in
       b = b' /\
       (lo <= ofs < hi)%Z.

Fixpoint in_free_list_trace (b : block) ofs es :=
  match es with
  | Free l :: es =>
    in_free_list b ofs l \/ in_free_list_trace b ofs es
  | _ :: es =>
    in_free_list_trace b ofs es
  | nil =>
    False
  end.

(*not needed later - not sure it's useful*)
Lemma EFLT_char es: forall b ofs, in_free_list_trace b ofs es <->
                             exists l lo hi, In (Free l) es /\ In ((b, lo), hi) l /\ lo <= ofs < hi.
Proof. induction es; simpl.
       + split; intros; try contradiction. destruct H as [? [? [? [? ?]]]]. contradiction.
       + intros.
       - destruct a.
         * destruct (IHes b ofs).
           split; intros.
           ++ destruct (H H1) as [? [? [? [? ?]]]]. eexists; eexists; eexists. split. right. apply H2. apply H3.
           ++ destruct H1 as [? [? [? [? ?]]]].
              destruct H1. discriminate. apply H0.  eexists; eexists; eexists. split. eassumption. apply H2.
         * destruct (IHes b ofs).
           split; intros.
           ++ destruct (H H1) as [? [? [? [? ?]]]]. eexists; eexists; eexists. split. right. apply H2. apply H3.
           ++ destruct H1 as [? [? [? [? ?]]]].
              destruct H1. discriminate. apply H0.  eexists; eexists; eexists. split. eassumption. apply H2.
         * destruct (IHes b ofs).
           split; intros.
           ++ destruct (H H1) as [? [? [? [? ?]]]]. eexists; eexists; eexists. split. right. apply H2. apply H3.
           ++ destruct H1 as [? [? [? [? ?]]]].
              destruct H1. discriminate. apply H0.  eexists; eexists; eexists. split. eassumption. apply H2.
         * destruct (IHes b ofs).
           split; intros.
           ++ destruct H1. destruct H1 as [[[? ?] ?] [? [? ?]]]; subst b0. exists l, z, z0. split; eauto.
              destruct (H H1) as [? [? [? [? ?]]]]. eexists; eexists; eexists. split. right. apply H2. apply H3.
           ++ destruct H1 as [? [? [? [? [? ?]]]]].
              destruct H1. inv H1. left. red. exists ((b,x0),x1). split; trivial. split; trivial.
              right. apply H0. exists x, x0 , x1. split; trivial. split; trivial.
Qed.

Lemma freelist_mem_access_1 b ofs p: forall l m (ACC:(Mem.mem_access m) !! b ofs Cur = Some p)
                                       m1 (FL: Mem.free_list m1 l = Some m), (Mem.mem_access m1) !! b ofs Cur = Some p.
Proof. induction l; simpl; intros. inv FL; trivial.
       destruct a. destruct p0.
       case_eq (Mem.free m1 b0 z0 z); intros; rewrite H in FL; try discriminate.
       eapply free_access_inv; eauto.
Qed.

Lemma freelist_access_2 b ofs: forall l  (FL: in_free_list b ofs l)
                                 m m' (FR : Mem.free_list m l = Some m'),
    (Mem.mem_access m') !! b ofs Cur = None /\ Mem.valid_block m' b.
Proof. intros l FL. destruct FL as [[[? ?] ?] [? [? ?]]]; subst b0.
       induction l; simpl; intros.
       - inv H.
       - destruct H.
         * subst. case_eq (Mem.free m b z z0); intros; rewrite H in FR; try discriminate.
           clear IHl. case_eq ((Mem.mem_access m') !! b ofs Cur); intros; trivial.
           ++ exploit freelist_mem_access_1. eassumption. eassumption. intros XX.
              exfalso. apply Mem.free_result in H. subst m0. simpl in XX.
              rewrite PMap.gss in XX. case_eq (zle z ofs && zlt ofs z0); intros; rewrite H in *; try discriminate.
              destruct (zle z ofs); try omega; simpl  in *. destruct ( zlt ofs z0); try omega. inv H.
           ++ split; trivial. eapply freelist_forward; eauto.
              exploit Mem.free_range_perm. eassumption. eassumption. intros.
              eapply Mem.valid_block_free_1; try eassumption. eapply Mem.perm_valid_block; eauto.
         * destruct a. destruct p.
           case_eq (Mem.free m b0 z2 z1); intros; rewrite H0 in FR; try discriminate. eauto.
Qed.

Lemma freelist_access_3 b ofs: forall l m (ACC: (Mem.mem_access m) !! b ofs Cur = None)
                                 (VB: Mem.valid_block m b) m' (FL: Mem.free_list m l = Some m'),
    (Mem.mem_access m') !! b ofs Cur = None.
Proof. induction l; simpl; intros.
       + inv FL; trivial.
       + destruct a as [[? ?] ?].
         case_eq (Mem.free m b0 z z0); intros; rewrite H in FL; try discriminate.
         eapply (IHl m0); trivial.
       - destruct (eq_block b0 b); subst. apply Mem.free_result in H. subst. simpl. rewrite PMap.gss, ACC. destruct (zle z ofs && zlt ofs z0); trivial.
         apply Mem.free_result in H. subst. simpl. rewrite PMap.gso; eauto.
       - eapply Mem.valid_block_free_1; eauto.
Qed.

Lemma ev_elim_accessNone b ofs: forall ev m' m'' (EV:ev_elim m'' ev m')
                                  (ACC: (Mem.mem_access m'') !! b ofs Cur = None)
                                  (VB: Mem.valid_block m'' b), (Mem.mem_access m') !! b ofs Cur = None.
Proof.  induction ev; simpl; intros. subst; trivial.
        destruct a.
        - destruct EV as [? [? EV]]. exploit Mem.storebytes_valid_block_1; eauto. intros.
          apply Mem.storebytes_access in H. rewrite <- H in *; clear H.
          apply (IHev _ _ EV ACC H0).
        - destruct EV as [? EV]. eauto.
        - destruct EV as [? [? EV]].
          apply (IHev _ _ EV); clear IHev EV.
          + Transparent Mem.alloc.
            unfold Mem.alloc in H. Opaque Mem.alloc.  inv H. simpl. rewrite PMap.gso; trivial. unfold Mem.valid_block in VB. xomega.
          + eapply Mem.valid_block_alloc; eauto.
        - destruct EV as [? [? EV]]. apply (IHev _ _ EV); clear IHev.
          2: eapply freelist_forward; eauto.
          clear EV ev m'.
          eapply freelist_access_3; eassumption.
Qed.

Lemma ev_elim_valid_block: forall ev m m' (EV: ev_elim m ev m') b
                             (VB : Mem.valid_block m b), Mem.valid_block m' b.
Proof. induction ev; simpl; intros; subst; trivial.
       destruct a.
       + destruct EV as [? [? EV]]. exploit Mem.storebytes_valid_block_1. apply H. eassumption. eauto.
       + destruct EV as [? EV]. eauto.
       + destruct EV as [? [? EV]]. exploit Mem.valid_block_alloc. apply H. eassumption. eauto.
       + destruct EV as [? [? EV]]. exploit freelist_forward; eauto. intros [? _]. eauto.
Qed.

(** If (b, ofs) is in the list of freed addresses then the
         permission was Freeable and became None or it was not allocated*)
Lemma ev_elim_free_1 b ofs:
  forall ev m m',
    ev_elim m ev m' ->
    in_free_list_trace b ofs ev ->
    (Mem.perm m b ofs Cur Freeable \/
     ~ Mem.valid_block m b) /\
    (Mem.mem_access m') !! b ofs Cur = None /\
    Mem.valid_block m' b /\
    exists e, List.In e ev /\
         match e with
         | Free _ => True
         | _ => False
         end.
Proof.
  induction ev; simpl; intros; try contradiction.
  destruct a.
  + destruct H as [m'' [ST EV]].
    specialize (Mem.storebytes_access _ _ _ _ _ ST); intros ACCESS.
    destruct (eq_block b0 b); subst.
  - destruct (IHev _ _ EV H0) as [IHa [IHb [IHc [e [E HE]]]]]; clear IHev.
    split. { destruct IHa. left. eapply Mem.perm_storebytes_2; eauto.
             right. intros N. apply H. eapply Mem.storebytes_valid_block_1; eauto. }
           split; trivial.
    split; trivial.
    exists e. split; trivial. right; trivial.
  - destruct (IHev _ _ EV H0) as [IHa [IHb [IHc [e [E HE]]]]]; clear IHev.
    split. { destruct IHa. left. eapply Mem.perm_storebytes_2; eassumption.
             right; intros N. apply H. eapply Mem.storebytes_valid_block_1; eauto. }
           split. trivial.
    split; trivial. exists e. split; trivial. right; trivial.
    + destruct H.
      destruct (IHev _ _ H1 H0) as [IHa [IHb [IHc [e [E HE]]]]]; clear IHev.
      split; trivial.
      split; trivial.
      split; trivial.
      exists e. split; trivial. right; trivial.
    + destruct H as [m'' [ALLOC EV]].
      destruct (IHev _ _ EV H0) as [IHa [IHb [IHc [e [E HE]]]]]; clear IHev.
      destruct (eq_block b0 b); subst.
  - split. right. eapply Mem.fresh_block_alloc. eauto.
    split; trivial.
    split; trivial.
    exists e.
    split; trivial. right; trivial.
  - split. { destruct IHa. left. eapply Mem.perm_alloc_4; eauto.
             right; intros N. apply H. eapply Mem.valid_block_alloc; eauto. }
           split; trivial.
    split; trivial.
    exists e. split; trivial. right; trivial.
    + destruct H as [m'' [FR EV]].
      destruct H0.
  - clear IHev.
    split. { destruct (valid_block_dec m b). 2: right; trivial. left.
             clear EV m'. generalize dependent m''. generalize dependent m.
             destruct H as [[[bb lo] hi] [X [? Y]]]; subst bb.
             induction l; simpl in *; intros. contradiction.
             destruct X; subst.
             + case_eq (Mem.free m b lo hi); intros; rewrite H in FR; try discriminate.
               eapply Mem.free_range_perm; eassumption.
             + destruct a. destruct p.
               case_eq (Mem.free m b0 z0 z); intros; rewrite H0 in FR; try discriminate.
               eapply Mem.perm_free_3. eassumption.
               eapply IHl; try eassumption.
               eapply Mem.valid_block_free_1; eauto. }
           split. { exploit freelist_access_2. eassumption. eassumption.
                    intros [ACC VB].  clear FR m l H.
                    eapply ev_elim_accessNone; eauto. }
                  split. { exploit freelist_access_2; eauto. intros [ACC VB].
                           eapply ev_elim_valid_block; eauto. }
                         exists (Free l). intuition.
  - destruct (IHev _ _ EV H) as [IHa [IHb [IHc [e [E HE]]]]]; clear IHev.
    split. { destruct IHa. left. eapply perm_freelist; eauto.
             right; intros N. apply H0. eapply freelist_forward; eauto. }
           split; trivial.
    split; trivial.
    exists e. split; trivial. right; trivial.
Qed.

Lemma perm_order_pp_refl p: Mem.perm_order'' p p.
Proof. unfold Mem.perm_order''. destruct p; trivial. apply perm_refl. Qed.

Lemma in_free_list_dec b ofs xs: {in_free_list b ofs xs} + {~in_free_list b ofs xs}.
Proof. unfold in_free_list.
       induction xs; simpl. right. intros N. destruct N as [[[? ?] ?] [? _]]. trivial.
       destruct IHxs.
       + left. destruct e as [? [? ?]]. exists x. split; eauto.
       + destruct a as [[? ?] ?].
         destruct (eq_block b0 b); subst.
       - destruct (zle z ofs).
         * destruct (zlt ofs z0). -- left. exists (b, z, z0). split; eauto.
           -- right. intros [[[? ?] ?] [? [? ?]]]. subst b0.
              destruct H. inv H. omega. apply n; clear n.
              exists (b, z1, z2). split; eauto.
         * right. intros [[[? ?] ?] [? [? ?]]]. subst b0.
           destruct H. inv H. omega. apply n; clear n.
           exists (b, z1, z2). split; eauto.
       - right. intros [[[? ?] ?] [? [? ?]]]. subst b1.
         destruct H. inv H. congruence.
         apply n; clear n. exists (b, z1, z2). split; eauto.
Qed.

Lemma in_free_list_trace_dec b ofs: forall es, {in_free_list_trace b ofs es} + {~in_free_list_trace b ofs es}.
Proof.
  induction es; simpl. right; intros N; trivial.
  destruct IHes.
  + destruct a; try solve [left; eauto].
  + destruct a; try solve [right; eauto].
    destruct (in_free_list_dec b ofs l). left; left; trivial.
    right; intros N. destruct N; contradiction.
Qed.

Lemma freelist_access_1 b ofs: forall l,
    ~ in_free_list b ofs l ->
    forall m m' : mem, Mem.free_list m l = Some m' -> (Mem.mem_access m') !! b ofs Cur = (Mem.mem_access m) !! b ofs Cur.
Proof.
  induction l; simpl; intros. inv H0. trivial.
  destruct a as [[? ?] ?].
  remember (Mem.free m b0 z z0) as q; destruct q; try discriminate. symmetry in Heqq.
  assert (~ in_free_list b ofs l). { intros N. elim H. destruct N as [? [? ?]]. exists x. split; eauto. right; trivial. }
                                   rewrite (IHl H1 _ _ H0). clear IHl H0.
  Transparent Mem.free. unfold Mem.free in Heqq.
  remember (Mem.range_perm_dec m b0 z z0 Cur Freeable).
  destruct s; inv Heqq; clear Heqs. simpl.
  rewrite PMap.gsspec. destruct (peq b b0); subst; trivial.
  destruct (zle z ofs); simpl; trivial.
  destruct (zlt ofs z0); simpl; trivial.
  elim H. unfold in_free_list. exists (b0, z, z0). split; eauto. left; trivial.
Qed.

(** If (b, ofs) is not in the list of freed locations then its permissions
cannot decrease*)
Lemma ev_elim_free_2 b ofs:
  forall ev m m' (EV: ev_elim m ev m')
    (T: ~ in_free_list_trace b ofs ev),
    Mem.perm_order'' ((Mem.mem_access m') !! b ofs Cur)
                     ((Mem.mem_access m) !! b ofs Cur).
Proof.
  induction ev; simpl; intros.
  + subst. apply perm_order_pp_refl.
  + destruct a.
  - destruct EV  as [m'' [ST EV]].
    apply Mem.storebytes_access in ST. rewrite <- ST. apply (IHev _ _ EV T).
  - destruct EV  as [LD EV].
    apply (IHev _ _ EV T).
  - destruct EV  as [m'' [ALLOC EV]].
    eapply po_trans. apply (IHev _ _ EV T). clear IHev.
    unfold Mem.perm_order''. remember ((Mem.mem_access m'') !! b ofs Cur) as q.
    symmetry in Heqq; destruct q.
    * exploit Mem.perm_alloc_inv. eassumption. unfold Mem.perm. rewrite Heqq. simpl. apply perm_refl.
      destruct (eq_block b b0); simpl; intros; subst.
      ++ rewrite Mem.nextblock_noaccess; trivial. intros N.
         eapply Mem.fresh_block_alloc; eassumption.
      ++ Transparent Mem.alloc. unfold Mem.alloc in ALLOC. inv ALLOC. simpl in *. clear EV.
         Opaque Mem.alloc.
         remember ((Mem.mem_access m) !! b ofs Cur) as r. destruct r; trivial. symmetry in Heqr.
         rewrite PMap.gso in Heqq; trivial. rewrite Heqq in Heqr. inv Heqr. apply perm_refl.
    * erewrite alloc_access_inv_None; eauto.
  - destruct EV  as [m'' [FR EV]]. specialize (IHev _ _ EV).
    destruct (in_free_list_dec b ofs l).
    * elim T. left; trivial.
    * destruct (in_free_list_trace_dec b ofs ev).
      elim T. right; trivial.
      eapply po_trans. apply IHev; trivial.
      erewrite freelist_access_1; eauto. apply perm_order_pp_refl.
Qed.

Lemma free_list_cases:
  forall l m m' b ofs
    (Hfree: Mem.free_list m l = Some m'),
    ((Mem.mem_access m) !! b ofs Cur = Some Freeable /\
     (Mem.mem_access m') !! b ofs Cur = None) \/
    ((Mem.mem_access m) !! b ofs Cur =
     (Mem.mem_access m') !! b ofs Cur).
Proof.
  induction l; simpl; intros. inv Hfree. right; trivial.
  destruct a as [[bb lo] hi].
  remember (Mem.free m bb lo hi) as q; symmetry in Heqq. destruct q; inv Hfree.
  specialize (IHl _ _ b ofs H0); clear H0.
  Transparent Mem.free. unfold Mem.free in Heqq. Opaque Mem.free.
  remember (Mem.range_perm_dec m bb lo hi Cur Freeable). destruct s; try discriminate. inv Heqq. clear Heqs.
  simpl in *.
  rewrite PMap.gsspec in *.
  destruct (peq b bb); subst; trivial.
  destruct IHl.
  + destruct H.
    rewrite H0; clear H0.
    destruct (zle lo ofs); try discriminate; simpl in *.
  - destruct (zlt ofs hi); try discriminate; simpl in *. rewrite H. left; split; trivial.
  - rewrite H. left; split; trivial.
    + destruct (zle lo ofs); simpl in *; try solve [right; trivial].
      destruct (zlt ofs hi); simpl in *; try solve [right; trivial].
      rewrite <- H; clear H.
      assert (A: lo <= ofs < hi) by omega.
      specialize (r _ A). unfold Mem.perm, Mem.perm_order' in r.
      remember ((Mem.mem_access m) !! bb ofs Cur) as q. destruct q; try contradiction.
      left; split; trivial. destruct p; simpl in *; trivial; inv r.
Qed.


Require Import Omega.
Require Import Bool.
Require Import RelationClasses.

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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import MemoryFacts.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.

Require Import Mapping.

Require Import PFStep.
Require Import OrdStep.

Set Implicit Arguments.

Module ReleaseWrites.
  Section ReleaseWrites.
    Variable L: Loc.t -> bool.

    Definition t: Type := list (Loc.t * Time.t).

    Definition append (e: ThreadEvent.t) (rels: t): t :=
      match ThreadEvent.is_writing e with
      | Some (loc, from, to, val, released, ord) =>
        if L loc
        then if Ordering.le Ordering.acqrel ord then (loc, to) :: rels else rels
        else rels
      | None => rels
      end.

    Definition wf (rels: t) (promises mem: Memory.t): Prop :=
      forall loc to (IN: List.In (loc, to) rels),
        Memory.get loc to promises = None /\
        exists from val released,
          Memory.get loc to mem = Some (from, Message.concrete val released).

    Lemma append_app e rels1 rels2:
      append e rels1 ++ rels2 = append e (rels1 ++ rels2).
    Proof.
      unfold append. des_ifs.
    Qed.
  End ReleaseWrites.
End ReleaseWrites.

Module RAThread.
  Section RAThread.
    Variable lang: language.
    Variable L: Loc.t -> bool.

    Inductive step rels1: forall (rels2: ReleaseWrites.t) (e: ThreadEvent.t) (e1 e2: Thread.t lang), Prop :=
    | step_intro
        pf e e1 e2
        (STEP: @OrdThread.step lang L Ordering.acqrel pf e e1 e2):
        step rels1 (ReleaseWrites.append L e rels1) e e1 e2
    .

    Inductive steps rels1: forall (rels2: ReleaseWrites.t) (e1 e2: Thread.t lang), Prop :=
    | steps_refl
        e:
        steps rels1 rels1 e e
    | steps_step
        rels2 rels3 e e1 e2 e3
        (STEP: step rels1 rels2 e e1 e2)
        (STEPS: steps rels2 rels3 e2 e3):
        steps rels1 rels3 e1 e3
    .
    Hint Constructors steps.

    Inductive tau_steps rels1: forall (rels2: ReleaseWrites.t) (e1 e2: Thread.t lang), Prop :=
    | tau_steps_refl
        e:
        tau_steps rels1 rels1 e e
    | tau_steps_step
        rels2 rels3 e e1 e2 e3
        (STEP: step rels1 rels2 e e1 e2)
        (SILENT: ThreadEvent.get_machine_event e = MachineEvent.silent)
        (STEPS: tau_steps rels2 rels3 e2 e3):
        tau_steps rels1 rels3 e1 e3
    .
    Hint Constructors tau_steps.

    Inductive opt_step rels1: forall (rels2: ReleaseWrites.t) (e: ThreadEvent.t) (e1 e2: Thread.t lang), Prop :=
    | step_none
        e:
        opt_step rels1 rels1 ThreadEvent.silent e e
    | step_some
        rels2 e e1 e2
        (STEP: step rels1 rels2 e e1 e2):
        opt_step rels1 rels2 e e1 e2
    .
    Hint Constructors opt_step.

    Lemma step_ord_step
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2):
      exists pf, OrdThread.step L Ordering.acqrel pf e e1 e2.
    Proof.
      inv STEP. eauto.
    Qed.

    Lemma steps_ord_steps
          rels1 rels2 e1 e2
          (STEPS: steps rels1 rels2 e1 e2):
      rtc (OrdThread.all_step L Ordering.acqrel) e1 e2.
    Proof.
      induction STEPS; eauto.
      exploit step_ord_step; eauto. i. des.
      econs 2; eauto. econs. econs. eauto.
    Qed.

    Lemma tau_steps_ord_tau_steps
          rels1 rels2 e1 e2
          (STEPS: tau_steps rels1 rels2 e1 e2):
      rtc (@OrdThread.tau_step lang L Ordering.acqrel) e1 e2.
    Proof.
      induction STEPS; eauto.
      inv STEP; ss.
      econs 2; eauto. econs; eauto. econs. eauto.
    Qed.

    Lemma ord_tau_steps_tau_steps
          e1 e2
          (STEPS: rtc (@OrdThread.tau_step lang L Ordering.acqrel) e1 e2):
      forall rels1, exists rels2,
          tau_steps rels1 rels2 e1 e2.
    Proof.
      induction STEPS; eauto. inv H. inv TSTEP. i.
      specialize (IHSTEPS (ReleaseWrites.append L e rels1)). des.
      esplits. econs 2; eauto. econs; eauto.
    Qed.

    Lemma tau_steps_steps
          rels1 rels2 e1 e2
          (STEPS: tau_steps rels1 rels2 e1 e2):
      steps rels1 rels2 e1 e2.
    Proof.
      induction STEPS; eauto.
    Qed.

    Lemma reserve_steps_tau_steps
          rels e1 e2
          (STEPS: rtc (@Thread.reserve_step _) e1 e2):
      tau_steps rels rels e1 e2.
    Proof.
      induction STEPS; eauto.
      inv H. inv STEP; [|inv STEP0; inv LOCAL].
      econs 2; eauto.
      - replace rels with
            (ReleaseWrites.append
               L (ThreadEvent.promise loc from to Message.reserve Memory.op_kind_add) rels)
            at 2 by ss.
        econs. econs 1; eauto.
        ii. inv PROMISE.
      - ss.
    Qed.

    Lemma cancel_steps_tau_steps
          rels e1 e2
          (STEPS: rtc (@Thread.cancel_step _) e1 e2):
      tau_steps rels rels e1 e2.
    Proof.
      induction STEPS; eauto.
      inv H. inv STEP; [|inv STEP0; inv LOCAL].
      econs 2; eauto.
      - replace rels with
            (ReleaseWrites.append
               L (ThreadEvent.promise loc from to Message.reserve Memory.op_kind_cancel) rels)
            at 2 by ss.
        econs. econs 1; eauto.
        ii. inv PROMISE; ss.
      - ss.
    Qed.

    Lemma tau_steps_rtc_tau_step
          rels1 rels2 e1 e2
          (STEPS: tau_steps rels1 rels2 e1 e2):
      rtc (@OrdThread.tau_step lang L Ordering.acqrel) e1 e2.
    Proof.
      induction STEPS; eauto.
      econs 2; eauto. inv STEP; ss.
      econs; eauto. econs. eauto.
    Qed.

    Lemma opt_step_steps
          rels1 rels2 e e1 e2
          (STEP: opt_step rels1 rels2 e e1 e2):
      steps rels1 rels2 e1 e2.
    Proof.
      inv STEP; eauto.
    Qed.

    Lemma steps_trans
          rels1 rels2 rels3 e1 e2 e3
          (STEPS1: steps rels1 rels2 e1 e2)
          (STEPS2: steps rels2 rels3 e2 e3):
      steps rels1 rels3 e1 e3.
    Proof.
      revert rels3 e3 STEPS2.
      induction STEPS1; i; eauto.
    Qed.

    Lemma tau_steps_trans
          rels1 rels2 rels3 e1 e2 e3
          (STEPS1: tau_steps rels1 rels2 e1 e2)
          (STEPS2: tau_steps rels2 rels3 e2 e3):
      tau_steps rels1 rels3 e1 e3.
    Proof.
      revert rels3 e3 STEPS2.
      induction STEPS1; i; eauto.
    Qed.

    Lemma step_future
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      inv STEP; eauto using OrdThread.step_future.
    Qed.

    Lemma opt_step_future
          rels1 rels2 e e1 e2
          (STEP: opt_step rels1 rels2 e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      inv STEP.
      - esplits; eauto; refl.
      - inv STEP0; eauto using OrdThread.step_future.
    Qed.

    Lemma steps_future
          rels1 rels2 e1 e2
          (STEPS: steps rels1 rels2 e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      revert WF1 SC1 CLOSED1. induction STEPS; i.
      - splits; ss; refl.
      - exploit step_future; eauto. i. des.
        exploit IHSTEPS; eauto. i. des.
        splits; ss; etrans; eauto.
    Qed.

    Lemma step_disjoint
          rels1 rels2 e e1 e2 lc
          (STEP: step rels1 rels2 e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      inv STEP; eauto using OrdThread.step_disjoint.
    Qed.

    Lemma opt_step_disjoint
          rels1 rels2 e e1 e2 lc
          (STEP: opt_step rels1 rels2 e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      inv STEP; eauto.
      inv STEP0; eauto using OrdThread.step_disjoint.
    Qed.

    (* ReleaseWrites.wf *)

    Lemma promise_rels_wf
          rels promises1 mem1 loc from to msg promises2 mem2 kind
          (RELS1: ReleaseWrites.wf rels promises1 mem1)
          (PROMISE: Memory.promise promises1 mem1 loc from to msg promises2 mem2 kind):
      ReleaseWrites.wf rels promises2 mem2.
    Proof.
      ii. exploit RELS1; eauto. i. des. inv PROMISE; ss.
      - exploit Memory.add_get1; try exact x0; eauto. i. esplits; eauto.
        erewrite Memory.add_o; eauto. condtac; ss. des. subst.
        exploit Memory.add_get0; try exact MEM. i. des. congr.
      - exploit Memory.split_get1; try exact x0; eauto. i. des. subst. esplits; eauto.
        erewrite Memory.split_o; eauto. repeat condtac; ss.
        + des. subst. exploit Memory.split_get0; try exact MEM. i. des. congr.
        + guardH o. des. subst.
          exploit Memory.split_get0; try exact PROMISES. i. des. congr.
      - exploit Memory.lower_get1; try exact x0; eauto. i. des. subst. inv MSG_LE.
        esplits; eauto.
        erewrite Memory.lower_o; eauto. condtac; ss. des. subst.
        exploit Memory.lower_get0; try exact PROMISES. i. des. congr.
      - erewrite (@Memory.remove_o promises2); eauto.
        erewrite (@Memory.remove_o mem2); eauto. condtac; ss; eauto.
        des. subst. exploit Memory.remove_get0; try exact PROMISES. i. des. congr.
    Qed.

    Lemma step_rels_wf
          rels1 rels2 e e1 e2
          (RELS1: ReleaseWrites.wf rels1 (Local.promises (Thread.local e1)) (Thread.memory e1))
          (STEP: step rels1 rels2 e e1 e2):
      ReleaseWrites.wf rels2 (Local.promises (Thread.local e2)) (Thread.memory e2).
    Proof.
      inv STEP. unfold ReleaseWrites.append.
      inv STEP0; inv STEP; inv LOCAL; ss.
      - eauto using promise_rels_wf.
      - inv LOCAL0. inv STEP. ss.
      - inv LOCAL0. inv STEP. inv WRITE. ss.
        hexploit promise_rels_wf; eauto. i.
        cut (ReleaseWrites.wf rels1 promises2 mem2).
        { i. repeat condtac; ss. ii. inv IN; eauto. inv H1.
          exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
          exploit Memory.remove_get0; eauto. i. des.
          esplits; eauto. }
        ii. exploit H; eauto. i. des. esplits; eauto.
        erewrite Memory.remove_o; eauto. condtac; ss.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. inv WRITE. ss.
        hexploit promise_rels_wf; eauto. i.
        cut (ReleaseWrites.wf rels1 promises2 mem2).
        { i. repeat condtac; ss. ii. inv IN; eauto. inv H1.
          exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
          exploit Memory.remove_get0; eauto. i. des.
          esplits; eauto. }
        ii. exploit H; eauto. i. des. esplits; eauto.
        erewrite Memory.remove_o; eauto. condtac; ss.
      - inv LOCAL0. ss.
      - inv LOCAL0. ss.
    Qed.

    Lemma steps_rels_wf
          rels1 rels2 e1 e2
          (RELS1: ReleaseWrites.wf rels1 (Local.promises (Thread.local e1)) (Thread.memory e1))
          (STEPS: steps rels1 rels2 e1 e2):
      ReleaseWrites.wf rels2 (Local.promises (Thread.local e2)) (Thread.memory e2).
    Proof.
      induction STEPS; eauto.
      apply IHSTEPS. eapply step_rels_wf; eauto.
    Qed.

    Lemma promise_rels_disjoint
          promises1 mem1 loc from to msg promises2 mem2 kind
          promises
          (PROMISE: Memory.promise promises1 mem1 loc from to msg promises2 mem2 kind)
          (DISJOINT: Memory.disjoint promises1 promises)
          (LE: Memory.le promises mem1):
      Memory.get loc to promises = None.
    Proof.
      destruct (Memory.get loc to promises) as [[]|] eqn:GETP; ss.
      exploit LE; eauto. i.
      inv PROMISE; ss.
      - exploit Memory.add_get0; try exact MEM. i. des. congr.
      - exploit Memory.split_get0; try exact MEM. i. des. congr.
      - exploit Memory.lower_get0; try exact PROMISES. i. des.
        inv DISJOINT. exploit DISJOINT0; eauto. i. des. exfalso.
        exploit Memory.get_ts; try exact GETP. i. des; try congr.
        exploit Memory.get_ts; try exact GET. i. des; try congr.
        apply (x0 to); econs; try refl; ss.
      - exploit Memory.remove_get0; try exact PROMISES. i. des.
        inv DISJOINT. exploit DISJOINT0; eauto. i. des. exfalso.
        exploit Memory.get_ts; try exact GETP. i. des; try congr.
        exploit Memory.get_ts; try exact GET. i. des; try congr.
        apply (x0 to); econs; try refl; ss.
    Qed.

    Lemma step_rels_disjoint
          rels1 rels2 e e1 e2 promises
          (RELS1: ReleaseWrites.wf rels1 (Local.promises (Thread.local e1)) (Thread.memory e1))
          (STEP: step rels1 rels2 e e1 e2)
          (DISJOINT: Memory.disjoint (Local.promises (Thread.local e1)) promises)
          (LE: Memory.le promises (Thread.memory e1))
          (RELS: ReleaseWrites.wf rels1 promises (Thread.memory e1)):
      ReleaseWrites.wf rels2 promises (Thread.memory e2).
    Proof.
      hexploit step_rels_wf; eauto. ii.
      exploit H; eauto. i. des. esplits; eauto.
      inv STEP. unfold ReleaseWrites.append in *.
      inv STEP0; inv STEP; inv LOCAL; ss.
      - exploit RELS; eauto. i. des. ss.
      - exploit RELS; eauto. i. des. ss.
      - exploit RELS; eauto. i. des. ss.
      - inv LOCAL0. inv STEP. inv WRITE. ss. revert IN.
        repeat condtac; ss; i; des; try by (exploit RELS; eauto; i; des; ss).
        inv IN. eapply promise_rels_disjoint; eauto.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. inv WRITE. ss. revert IN.
        repeat condtac; ss; i; des; try by (exploit RELS; eauto; i; des; ss).
        inv IN. eapply promise_rels_disjoint; eauto.
      - exploit RELS; eauto. i. des. ss.
      - exploit RELS; eauto. i. des. ss.
      - exploit RELS; eauto. i. des. ss.
    Qed.

    Lemma steps_rels_disjoint
          rels1 rels2 e1 e2 lc
          (RELS1: ReleaseWrites.wf rels1 (Local.promises (Thread.local e1)) (Thread.memory e1))
          (STEPS: steps rels1 rels2 e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1))
          (RELS: ReleaseWrites.wf rels1 (Local.promises lc) (Thread.memory e1)):
      ReleaseWrites.wf rels2 (Local.promises lc) (Thread.memory e2).
    Proof.
      induction STEPS; ss.
      hexploit step_rels_disjoint; eauto; try apply DISJOINT; try apply WF. i.
      hexploit step_rels_wf; eauto. i.
      inv STEP.
      exploit OrdThread.step_future; eauto. i. des.
      exploit OrdThread.step_disjoint; eauto. i. des.
      eapply IHSTEPS; eauto.
    Qed.

    Lemma cap_tau_steps_current_tau_steps
          rels0 rels1 e0 e1 fe0
          (THREAD: thread_map ident_map e0 fe0)
          (STEPS: tau_steps rels0 rels1 e0 e1)
          (LOCAL: Local.wf (Thread.local e0) (Thread.memory e0))
          (FLOCAL: Local.wf (Thread.local fe0) (Thread.memory fe0))
          (MEMORY: Memory.closed (Thread.memory e0))
          (FMEMORY: Memory.closed (Thread.memory fe0))
          (SC: Memory.closed_timemap (Thread.sc e0) (Thread.memory e0))
          (FSC: Memory.closed_timemap (Thread.sc fe0) (Thread.memory fe0)):
        exists fe1,
          (<<THREAD: thread_map ident_map e1 fe1>>) /\
          (<<STEPS: tau_steps rels0 rels1 fe0 fe1>>).
    Proof.
      ginduction STEPS; eauto. i.
      inv STEP; ss.
      exploit OrdThread.cap_step_current_step; eauto. i. des.
      exploit OrdThread.step_future; try apply STEP; eauto. i. des.
      exploit OrdThread.step_future; try apply STEP0; eauto. i. des.
      exploit IHSTEPS; eauto. i. des. exists fe2. splits; eauto.
      replace (ReleaseWrites.append L e rels1) with (ReleaseWrites.append L fe rels1) in STEPS0; cycle 1.
      { unfold ReleaseWrites.append. destruct e; inv EVENT; ss.
        - inv FROM. inv TO. refl.
        - inv FROM. inv TO. refl. }
      econs; [econs 1; eauto|..]; eauto.
      destruct e; inv EVENT; ss.
    Qed.

    Lemma cap_plus_step_current_plus_step
          rels1 rels2 rels3 e e1 e2 e3 sc1 mem1
          (LOCAL: Local.wf (Thread.local e1) (Thread.memory e1))
          (MEMORY: Memory.closed (Thread.memory e1))
          (SC: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CAP: Memory.cap (Thread.memory e1) mem1)
          (SC_MAX: Memory.max_concrete_timemap mem1 sc1)
          (STEPS: tau_steps rels1 rels2 (Thread.mk lang (Thread.state e1) (Thread.local e1) sc1 mem1) e2)
          (STEP: RAThread.step rels2 rels3 e e2 e3):
        exists rels3' e' e2' e3',
          (<<STEPS: tau_steps rels1 rels2 e1 e2'>>) /\
          (<<STEP: RAThread.step rels2 rels3' e' e2' e3'>>) /\
          (<<LOCAL: local_map ident_map (Thread.local e2) (Thread.local e2')>>) /\
          (<<EVENT: tevent_map ident_map e' e>>).
    Proof.
      exploit cap_tau_steps_current_tau_steps; try apply STEPS; eauto; ss.
      { destruct e1. ss. econs; eauto.
        { eapply ident_map_local. }
        { econs.
          { i. eapply Memory.cap_inv in GET; eauto. des; auto.
            right. exists to, from, msg, msg; splits; ss.
            { eapply ident_map_message. }
            { refl. }
          }
          { i. eapply CAP in GET. left. esplits; ss.
            { refl. }
            { refl. }
            { i. econs; eauto. }
          }
        }
        { eapply mapping_map_lt_collapsable_unwritable. eapply ident_map_lt. }
        { eapply ident_map_timemap. }
        { eapply Memory.max_concrete_timemap_spec; eauto.
          eapply Memory.cap_closed_timemap; eauto. }
      }
      { eapply Local.cap_wf; eauto. }
      { eapply Memory.cap_closed; eauto. }
      { eapply Memory.max_concrete_timemap_closed; eauto. }
      i. des.
      exploit steps_future; try eapply tau_steps_steps; try apply STEPS; ss.
      { eapply Local.cap_wf; eauto. }
      { eapply Memory.max_concrete_timemap_closed; eauto. }
      { eapply Memory.cap_closed; eauto. }
      i. des.
      exploit steps_future; try eapply tau_steps_steps; try apply STEPS0; ss. i. des.
      inv STEP.
      exploit OrdThread.cap_step_current_step; eauto. i. des.
      esplits; eauto.
      - econs; eauto.
      - inv THREAD. ss.
    Qed.

    (* promises get *)

    Lemma promise_get_None
          promises1 mem1 loc' from' to' msg' promises2 mem2 kind
          loc from to msg
          (PROMISE: Memory.promise promises1 mem1 loc' from' to' msg' promises2 mem2 kind)
          (PROMISES1: Memory.get loc to promises1 = None)
          (MEM1: Memory.get loc to mem1 = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to promises2 = None>>) /\
      (<<MEM2: Memory.get loc to mem2 = Some (from, msg)>>) /\
      (<<LOCTS: __guard__ (loc' <> loc \/ to' <> to)>>).
    Proof.
      unguard. inv PROMISE.
      - exploit Memory.add_get0; try exact PROMISES. i. des.
        exploit Memory.add_get0; try exact MEM. i. des.
        erewrite Memory.add_o; eauto.
        erewrite (@Memory.add_o mem2); eauto.
        condtac; ss.
        + des. subst. congr.
        + splits; ss. des; eauto.
      - exploit Memory.split_get0; try exact PROMISES. i. des.
        exploit Memory.split_get0; try exact MEM. i. des.
        erewrite Memory.split_o; eauto.
        erewrite (@Memory.split_o mem2); eauto.
        repeat condtac; ss.
        + des. subst. congr.
        + des; subst; congr.
        + splits; ss. des; eauto.
      - exploit Memory.lower_get0; try exact PROMISES. i. des.
        exploit Memory.lower_get0; try exact MEM. i. des.
        erewrite Memory.lower_o; eauto.
        erewrite (@Memory.lower_o mem2); eauto.
        condtac; ss.
        + des. subst. congr.
        + splits; ss. des; eauto.
      - exploit Memory.remove_get0; try exact PROMISES. i. des.
        exploit Memory.remove_get0; try exact MEM. i. des.
        erewrite Memory.remove_o; eauto.
        erewrite (@Memory.remove_o mem2); eauto.
        condtac; ss.
        + des. subst. congr.
        + splits; ss. des; eauto.
    Qed.

    Lemma write_get_None
          promises1 mem1 loc' from' to' val released promises2 mem2 kind
          loc from to msg
          (WRITE: Memory.write promises1 mem1 loc' from' to' val released promises2 mem2 kind)
          (PROMISES1: Memory.get loc to promises1 = None)
          (MEM1: Memory.get loc to mem1 = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to promises2 = None>>) /\
      (<<MEM2: Memory.get loc to mem2 = Some (from, msg)>>) /\
      (<<LOCTS: __guard__ (loc' <> loc \/ to' <> to)>>).
    Proof.
      inv WRITE.
      exploit promise_get_None; eauto. i. des. split; ss.
      erewrite Memory.remove_o; eauto. condtac; ss.
    Qed.

    Lemma step_get_None
          e rels1 rels2 e1 e2
          loc from to msg
          (STEP: step rels1 rels2 e e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>) /\
      (<<EVENT: forall from' val released ord, ThreadEvent.is_writing e <> Some (loc, from', to, val, released, ord)>>).
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
      - exploit promise_get_None; eauto. i. des. splits; ss.
      - inv LOCAL0. inv STEP. ss.
      - inv LOCAL0. inv STEP.
        exploit write_get_None; eauto. i. des. splits; ss.
        ii. inv H. unguard. des; ss.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP.
        exploit write_get_None; eauto. i. des. splits; ss.
        ii. inv H. unguard. des; ss.
      - inv LOCAL0. ss.
      - inv LOCAL0. ss.
    Qed.

    Lemma opt_step_get_None
          e rels1 rels2 e1 e2
          loc from to msg
          (STEP: opt_step rels1 rels2 e e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>) /\
      (<<EVENT: forall from' val released ord, ThreadEvent.is_writing e <> Some (loc, from', to, val, released, ord)>>).
    Proof.
      inv STEP.
      - splits; eauto. ss.
      - exploit step_get_None; eauto.
    Qed.

    Lemma reserve_step_get_None
          e1 e2
          loc from to msg
          (STEP: @Thread.reserve_step lang e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>).
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
      exploit promise_get_None; eauto. i. des. ss.
    Qed.

    Lemma cancel_step_get_None
          e1 e2
          loc from to msg
          (STEP: @Thread.cancel_step lang e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>).
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
      exploit promise_get_None; eauto. i. des. ss.
    Qed.

    Lemma reserve_steps_get_None
          e1 e2
          loc from to msg
          (STEP: rtc (@Thread.reserve_step lang) e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>).
    Proof.
      induction STEP; ss.
      exploit reserve_step_get_None; eauto. i. des. eauto.
    Qed.

    Lemma cancel_steps_get_None
          e1 e2
          loc from to msg
          (STEP: rtc (@Thread.cancel_step lang) e1 e2)
          (PROMISES1: Memory.get loc to (Local.promises (Thread.local e1)) = None)
          (MEM1: Memory.get loc to (Thread.memory e1) = Some (from, msg)):
      (<<PROMISES2: Memory.get loc to (Local.promises (Thread.local e2)) = None>>) /\
      (<<MEM2: Memory.get loc to (Thread.memory e2) = Some (from, msg)>>).
    Proof.
      induction STEP; ss.
      exploit cancel_step_get_None; eauto. i. des. eauto.
    Qed.

    (* reserve_only *)

    Definition reserve_only (promises: Memory.t): Prop :=
      forall loc from to msg
        (LOC: L loc)
        (GET: Memory.get loc to promises = Some (from, msg)),
        msg = Message.reserve.

    Lemma step_reserve_only
          rels1 rels2 e e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEP: step rels1 rels2 e e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; ss; try by (inv LOCAL0; ss).
      - destruct (L loc) eqn:LOC.
        + ii. destruct msg.
          { exploit PF; ss. }
          revert GET. inv PROMISE; ss.
          * erewrite Memory.add_o; eauto. condtac; ss; eauto.
            i. des. subst. inv GET. ss.
          * erewrite Memory.split_o; eauto. repeat (condtac; ss; eauto).
            { i. des. subst. inv GET. ss. }
            { guardH o. i. des. subst. inv GET. ss. }
          * erewrite Memory.lower_o; eauto. condtac; ss; eauto.
            i. des. subst. inv GET. ss.
          * erewrite Memory.remove_o; eauto. condtac; ss; eauto.
        + ii. revert GET. inv PROMISE; ss.
          * erewrite Memory.add_o; eauto. condtac; ss; eauto.
            i. des. subst. congr.
          * erewrite Memory.split_o; eauto. repeat (condtac; ss; eauto).
            { i. des. subst. congr. }
            { guardH o. i. des. subst. congr. }
          * erewrite Memory.lower_o; eauto. condtac; ss; eauto.
            i. des. subst. congr.
          * erewrite Memory.remove_o; eauto. condtac; ss; eauto.
      - inv LOCAL0. inv STEP. ss.
      - inv LOCAL0. inv STEP. inv WRITE. ss.
        ii. revert GET. erewrite Memory.remove_o; eauto. condtac; ss.
        guardH o. inv PROMISE; ss.
        + erewrite Memory.add_o; eauto. condtac; ss; eauto.
        + erewrite Memory.split_o; eauto. condtac; ss. condtac; ss; eauto.
          guardH o0. i. des. inv GET.
          exploit Memory.split_get0; try exact PROMISES. i. des.
          exploit PROMISES1; try exact GET0; eauto.
        + erewrite Memory.lower_o; eauto. condtac; ss; eauto.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. inv WRITE. ss.
        ii. revert GET0. erewrite Memory.remove_o; eauto. condtac; ss.
        guardH o. inv PROMISE; ss.
        + erewrite Memory.add_o; eauto. condtac; ss; eauto.
        + erewrite Memory.split_o; eauto. condtac; ss. condtac; ss; eauto.
          guardH o0. i. des. inv GET0.
          exploit Memory.split_get0; try exact PROMISES. i. des.
          exploit PROMISES1; try exact GET0; eauto.
        + erewrite Memory.lower_o; eauto. condtac; ss; eauto.
    Qed.

    Lemma opt_step_reserve_only
          rels1 rels2 e e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEP: opt_step rels1 rels2 e e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP; ss.
      eapply step_reserve_only; eauto.
    Qed.

    Lemma reserve_step_reserve_only
          e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEP: @Thread.reserve_step lang e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL. inv PROMISE. ss. ii.
      revert GET. erewrite Memory.add_o; eauto. condtac; ss; eauto.
      i. des. inv GET. ss.
    Qed.

    Lemma cancel_step_reserve_only
          e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEP: @Thread.cancel_step lang e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL. inv PROMISE. ss. ii.
      revert GET. erewrite Memory.remove_o; eauto. condtac; ss; eauto.
    Qed.

    Lemma reserve_steps_reserve_only
          e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEPS: rtc (@Thread.reserve_step lang) e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEPS; ss.
      hexploit reserve_step_reserve_only; eauto.
    Qed.

    Lemma cancel_steps_reserve_only
          e1 e2
          (PROMISES1: reserve_only (Local.promises (Thread.local e1)))
          (STEPS: rtc (@Thread.cancel_step lang) e1 e2):
      <<PROMISES2: reserve_only (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEPS; ss.
      hexploit cancel_step_reserve_only; eauto.
    Qed.

    Lemma step_rels_incl
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2):
      rels2 = rels1 \/ exists a, rels2 = a :: rels1.
    Proof.
      inv STEP. unfold ReleaseWrites.append. des_ifs; eauto.
    Qed.

    Lemma step_non_concrete
          rels1 rels2 e e1 e2 loc to
          (STEP: step rels1 rels2 e e1 e2)
          (LOC: L loc)
          (EVENT: forall from val released ord,
              ThreadEvent.is_writing e <> Some (loc, from, to, val, released, ord))
          (GET1: forall from val released,
              Memory.get loc to (Thread.memory e1) <> Some (from, Message.concrete val released)):
      <<GET2: forall from val released,
        Memory.get loc to (Thread.memory e2) <> Some (from, Message.concrete val released)>>.
    Proof.
      i. inv STEP. inv STEP0; inv STEP; inv LOCAL; ss; eauto.
      - inv PROMISE.
        + erewrite Memory.add_o; eauto. condtac; ss; eauto.
          des. subst. ii. clarify. exploit PF; ss.
        + erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
          * des. subst. exploit PF; eauto.
          * guardH o. des. subst. exploit PF; eauto.
        + erewrite Memory.lower_o; eauto. condtac; ss; eauto.
          des. subst. ii. clarify. exploit PF; ss.
        + erewrite Memory.remove_o; eauto. condtac; ss; eauto.
      - inv LOCAL0. inv STEP. inv WRITE. inv PROMISE; ss.
        + erewrite Memory.add_o; eauto. condtac; ss; eauto.
          des. subst. exploit EVENT; eauto.
        + erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
          * des. subst. exploit EVENT; eauto.
          * des. subst. exploit EVENT; eauto.
          * guardH o. des. subst.
            exploit Memory.split_get0; try exact MEM. i. des.
            exploit GET1; eauto.
        + erewrite Memory.lower_o; eauto. condtac; ss; eauto.
          des. subst. exploit EVENT; eauto.
      - inv LOCAL1. inv STEP.
        inv LOCAL2. inv STEP. inv WRITE. inv PROMISE; ss.
        + erewrite Memory.add_o; eauto. condtac; ss; eauto.
          des. subst. exploit EVENT; eauto.
        + erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
          * des. subst. exploit EVENT; eauto.
          * des. subst. exploit EVENT; eauto.
          * guardH o. des. subst.
            exploit Memory.split_get0; try exact MEM. i. des.
            exploit GET1; eauto.
        + erewrite Memory.lower_o; eauto. condtac; ss; eauto.
          des. subst. exploit EVENT; eauto.
    Qed.

    Lemma opt_step_non_concrete
          rels1 rels2 e e1 e2 loc to
          (STEP: opt_step rels1 rels2 e e1 e2)
          (LOC: L loc)
          (EVENT: forall from val released ord,
              ThreadEvent.is_writing e <> Some (loc, from, to, val, released, ord))
          (GET1: forall from val released,
              Memory.get loc to (Thread.memory e1) <> Some (from, Message.concrete val released)):
      <<GET2: forall from val released,
        Memory.get loc to (Thread.memory e2) <> Some (from, Message.concrete val released)>>.
    Proof.
      inv STEP; eauto.
      eapply step_non_concrete; eauto.
    Qed.

    Lemma reserve_steps_non_concrete
          e1 e2 loc to
          (STEPS: rtc (@Thread.reserve_step lang) e1 e2)
          (LOC: L loc)
          (GET1: forall from val released,
              Memory.get loc to (Thread.memory e1) <> Some (from, Message.concrete val released)):
      <<GET2: forall from val released,
        Memory.get loc to (Thread.memory e2) <> Some (from, Message.concrete val released)>>.
    Proof.
      induction STEPS; eauto. i.
      eapply IHSTEPS; eauto. i.
      inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE; ss.
      erewrite Memory.add_o; eauto. condtac; ss; eauto.
    Qed.

    Lemma cancel_steps_non_concrete
          e1 e2 loc to
          (STEPS: rtc (@Thread.cancel_step lang) e1 e2)
          (LOC: L loc)
          (GET1: forall from val released,
              Memory.get loc to (Thread.memory e1) <> Some (from, Message.concrete val released)):
      <<GET2: forall from val released,
        Memory.get loc to (Thread.memory e2) <> Some (from, Message.concrete val released)>>.
    Proof.
      induction STEPS; eauto. i.
      eapply IHSTEPS; eauto. i.
      inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE; ss.
      erewrite Memory.remove_o; eauto. condtac; ss; eauto.
    Qed.
  End RAThread.
End RAThread.

Module RAConfiguration.
  Section RAConfiguration.
    Variable L: Loc.t -> bool.

    Inductive step:
      forall (e: ThreadEvent.t) (tid: Ident.t) (rels1 rels2: ReleaseWrites.t) (c1 c2: Configuration.t), Prop :=
    | step_intro
        rels1 rels2
        e tid c1 lang st1 lc1 e2 e3 st4 lc4 sc4 memory4
        (TID: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st1, lc1))
        (CANCELS: rtc (@Thread.cancel_step _) (Thread.mk _ st1 lc1 (Configuration.sc c1) (Configuration.memory c1)) e2)
        (STEP: RAThread.opt_step L rels1 rels2 e e2 e3)
        (RESERVES: rtc (@Thread.reserve_step _) e3 (Thread.mk _ st4 lc4 sc4 memory4))
        (CONSISTENT: e <> ThreadEvent.failure ->
                     OrdThread.consistent L Ordering.acqrel (Thread.mk _ st4 lc4 sc4 memory4)):
        step e tid rels1 rels2
             c1 (Configuration.mk (IdentMap.add tid (existT _ _ st4, lc4) (Configuration.threads c1)) sc4 memory4)
    .

    Inductive steps rels1: forall (rels2: ReleaseWrites.t) (c1 c2: Configuration.t), Prop :=
    | steps_refl
        c:
        steps rels1 rels1 c c
    | steps_step
        rels2 rels3 e tid c1 c2 c3
        (STEP: step e tid rels1 rels2 c1 c2)
        (STEPS: steps rels2 rels3 c2 c3):
        steps rels1 rels3 c1 c3
    .
    Hint Constructors steps.

    Lemma steps_trans
          rels1 rels2 rels3 c1 c2 c3
          (STEPS1: steps rels1 rels2 c1 c2)
          (STEPS2: steps rels2 rels3 c2 c3):
      steps rels1 rels3 c1 c3.
    Proof.
      revert c3 STEPS2. induction STEPS1; i; eauto.
    Qed.

    Lemma step_ord_step
          e tid rels1 rels2 c1 c2
          (STEP: step e tid rels1 rels2 c1 c2):
      OrdConfiguration.step L Ordering.acqrel e tid c1 c2.
    Proof.
      inv STEP. econs; eauto. inv STEP0; [econs 1|].
      inv STEP. econs 2. eauto.
    Qed.

    Lemma steps_ord_steps
          rels1 rels2 c1 c2
          (STEPS: steps rels1 rels2 c1 c2):
      rtc (@OrdConfiguration.all_step L Ordering.acqrel) c1 c2.
    Proof.
      induction STEPS; eauto.
      exploit step_ord_step; eauto. i. econs 2; eauto.
      econs. eauto.
    Qed.

    Lemma step_future
          e tid rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEP: step e tid rels1 rels2 c1 c2):
      <<WF2: Configuration.wf c2>>.
    Proof.
      inv WF1. inv WF. inv STEP; s.
      exploit THREADS; eauto. i.
      exploit Thread.rtc_cancel_step_future; try exact CANCELS; eauto. s. i. des.
      exploit RAThread.opt_step_future; try exact STEP0; eauto. i. des.
      exploit Thread.rtc_reserve_step_future; try exact RESERVES; eauto. s. i. des.
      econs; ss. econs.
      - i. Configuration.simplify.
        + exploit THREADS; try apply TH1; eauto. i.
          exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
            try eapply Thread.cancel_step_tau_step; try exact CANCELS; eauto. i. des.
          exploit RAThread.opt_step_disjoint; try exact STEP0; eauto. i. des.
          exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
            try eapply Thread.reserve_step_tau_step; try exact RESERVES; eauto. s. i. des.
          symmetry. ss.
        + exploit THREADS; try apply TH1; eauto. i.
          exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
            try eapply Thread.cancel_step_tau_step; try exact CANCELS; eauto. i. des.
          exploit RAThread.opt_step_disjoint; try exact STEP0; eauto. i. des.
          exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
            try eapply Thread.reserve_step_tau_step; try exact RESERVES; eauto. s. i. des.
          ss.
        + eapply DISJOINT; cycle 1; eauto.
      - i. Configuration.simplify.
        exploit THREADS; try apply TH; eauto. i. exploit THREADS; try apply TH1; eauto. i.
        exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
          try eapply Thread.cancel_step_tau_step; try exact CANCELS; eauto. i. des.
        exploit RAThread.opt_step_disjoint; try exact STEP0; eauto. i. des.
        exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
          try eapply Thread.reserve_step_tau_step; try exact RESERVES; eauto. s. i. des.
        ss.
    Qed.

    Lemma step_future2
          e tid rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEP: step e tid rels1 rels2 c1 c2):
      (<<WF2: Configuration.wf c2>>) /\
      (<<SC_FUTURE: TimeMap.le (Configuration.sc c1) (Configuration.sc c2)>>) /\
      (<<MEM_FUTURE: Memory.future (Configuration.memory c1) (Configuration.memory c2)>>).
    Proof.
      exploit step_future; eauto. i. des. split; ss.
      inv STEP. s.
      inv WF1. inv WF. exploit THREADS; eauto. i. clear DISJOINT THREADS.
      exploit Thread.rtc_cancel_step_future; eauto. s. i. des.
      exploit RAThread.opt_step_future; eauto. i. des.
      exploit Thread.rtc_reserve_step_future; eauto. s. i. des.
      splits; (etrans; [etrans|]; eauto).
    Qed.

    Lemma steps_future
          rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEPS: steps rels1 rels2 c1 c2):
      <<WF2: Configuration.wf c2>>.
    Proof.
      induction STEPS; ss.
      exploit step_future; eauto.
    Qed.

    Lemma steps_future2
          rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEPS: steps rels1 rels2 c1 c2):
      (<<WF2: Configuration.wf c2>>) /\
      (<<SC_FUTURE: TimeMap.le (Configuration.sc c1) (Configuration.sc c2)>>) /\
      (<<MEM_FUTURE: Memory.future (Configuration.memory c1) (Configuration.memory c2)>>).
    Proof.
      induction STEPS.
      - splits; ss; try refl.
      - exploit step_future2; eauto. i. des.
        exploit IHSTEPS; eauto. i. des.
        splits; ss; etrans; eauto.
    Qed.

    Lemma write_get_None
          e tid rels1 rels2 c1 c2
          loc from to val released ord
          (WF1: Configuration.wf c1)
          (STEP: step e tid rels1 rels2 c1 c2)
          (WRITE: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
      (<<PROMISES: forall tid lang st lc
                     (FIND: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st, lc)),
          Memory.get loc to (Local.promises lc) = None>>) /\
      (<<MEM: Memory.get loc to (Configuration.memory c2) = Some (from, Message.concrete val released)>>).
    Proof.
      inv STEP. inv STEP0; ss.
      split; cycle 1.
      { inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
        - inv LOCAL0. inv STEP. exploit Memory.write_get2; eauto. i. des.
          exploit RAThread.reserve_steps_get_None; eauto. i. des. inv WRITE. ss.
        - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP.
          exploit Memory.write_get2; eauto. i. des.
          exploit RAThread.reserve_steps_get_None; eauto. i. des. inv WRITE. ss.
      }
      ii. revert FIND. rewrite IdentMap.gsspec. condtac; ss.
      { i. inv FIND.
        inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
        - inv LOCAL0. inv STEP. exploit Memory.write_get2; eauto. i. des.
          exploit RAThread.reserve_steps_get_None; eauto. i. des. inv WRITE. ss.
        - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP.
          exploit Memory.write_get2; eauto. i. des.
          exploit RAThread.reserve_steps_get_None; eauto. i. des. inv WRITE. ss.
      }

      i. inv WF1. inv WF. hexploit DISJOINT; eauto. i.
      exploit THREADS; try eapply TID. i.
      exploit THREADS; try eapply FIND. i.
      exploit Thread.rtc_tau_step_disjoint; try eapply rtc_implies;
        try eapply Thread.cancel_step_tau_step; try exact CANCELS; eauto. i. des.
      exploit Thread.rtc_tau_step_future; try eapply rtc_implies;
        try eapply Thread.cancel_step_tau_step; try exact CANCELS; eauto. s. i. des.
      exploit RAThread.step_future; try exact STEP; eauto. i. des.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; inv WRITE; ss.
      - inv LOCAL0. inv STEP. inv WRITE.
        exploit Memory.promise_disjoint; try eapply WF; try eapply DISJOINT2; eauto. i. des.
        exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
        destruct (Memory.get loc to (Local.promises lc)) as [[]|] eqn:GETP; ss.
        exfalso.
        exploit MemoryFacts.promise_time_lt; eauto; try by (inv PROMISE; ss). i.
        inv DISJOINT0. hexploit DISJOINT1; eauto. i. des.
        exploit Memory.get_ts; try exact GETP. i. des.
        { subst. ss. }
        apply (H0 to); econs; ss; refl.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. inv WRITE.
        exploit Memory.promise_disjoint; try eapply WF; try eapply DISJOINT2; eauto. i. des.
        exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
        destruct (Memory.get loc to (Local.promises lc)) as [[]|] eqn:GETP; ss.
        exfalso.
        exploit MemoryFacts.promise_time_lt; eauto; try by (inv PROMISE; ss). i.
        inv DISJOINT0. hexploit DISJOINT1; eauto. i. des.
        exploit Memory.get_ts; try exact GETP. i. des.
        { subst. ss. }
        apply (H0 to); econs; ss; refl.
    Qed.

    Lemma step_get_None
          e tid rels1 rels2 c1 c2
          loc from to msg
          (STEP: step e tid rels1 rels2 c1 c2)
          (PROMISES1: forall tid lang st lc
                       (FIND: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st, lc)),
              Memory.get loc to (Local.promises lc) = None)
          (MEM1: Memory.get loc to (Configuration.memory c1) = Some (from, msg)):
      (<<PROMISES2: forall tid lang st lc
                     (FIND: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st, lc)),
          Memory.get loc to (Local.promises lc) = None>>) /\
      (<<MEM2: Memory.get loc to (Configuration.memory c2) = Some (from, msg)>>) /\
      (<<EVENT: forall from' val released ord, ThreadEvent.is_writing e <> Some (loc, from', to, val, released, ord)>>).
    Proof.
      inv STEP. ss.
      exploit PROMISES1; eauto. i.
      exploit RAThread.cancel_steps_get_None; eauto. i. des.
      exploit RAThread.opt_step_get_None; eauto. i. des.
      exploit RAThread.reserve_steps_get_None; eauto. i. des.
      splits; eauto. i.
      revert FIND. rewrite IdentMap.gsspec. condtac; eauto. i. inv FIND. ss.
    Qed.

    Lemma steps_rels
          rels1 rels2 c1 c2
          loc from to msg
          (STEPS: steps rels1 rels2 c1 c2)
          (PROMISES1: forall tid lang st lc
                       (FIND: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st, lc)),
              Memory.get loc to (Local.promises lc) = None)
          (MEM1: Memory.get loc to (Configuration.memory c1) = Some (from, msg))
          (RELS1: ~ List.In (loc, to) rels1):
      ~ List.In (loc, to) rels2.
    Proof.
      induction STEPS; ss.
      exploit step_get_None; eauto. i. des.
      eapply IHSTEPS; eauto.
      ii. inv STEP. ss. inv STEP0; ss. inv STEP.
      unfold ReleaseWrites.append in H. des_ifs. inv H; ss. inv H0.
      eapply EVENT; eauto.
    Qed.

    Lemma write_rels
          e tid rels1 rels2 c1 c2
          loc from to val released ord
          (WF1: Configuration.wf c1)
          (RELS1: forall tid lang st lc
                    (TH: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st, lc)),
              ReleaseWrites.wf rels1 (Local.promises lc) (Configuration.memory c1))
          (STEP: step e tid rels1 rels2 c1 c2)
          (WRITE: ThreadEvent.is_writing e = Some (loc, from, to, val, released, ord)):
      ~ List.In (loc, to) rels1.
    Proof.
      ii. inv STEP. inv STEP0; ss.
      hexploit RELS1; eauto. i.
      hexploit (@RAThread.steps_rels_wf lang L); try eapply RAThread.tau_steps_steps;
        try eapply RAThread.cancel_steps_tau_steps; eauto; ss; eauto. i.
      inv STEP. inv STEP0; inv STEP; inv LOCAL; ss.
      - inv LOCAL0. inv STEP. inv WRITE0.
        exploit RAThread.promise_rels_wf; eauto. i. des.
        exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
        congr.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. inv WRITE0. ss.
        exploit RAThread.promise_rels_wf; eauto. i. des.
        exploit Memory.promise_get0; eauto; try by (inv PROMISE; ss). i. des.
        congr.
    Qed.

    (* reserve_only *)

    Definition reserve_only (c: Configuration.t): Prop :=
      forall tid lang st lc
        (FIND: IdentMap.find tid (Configuration.threads c) = Some (existT _ lang st, lc)),
        RAThread.reserve_only L (Local.promises lc).

    Lemma init_reserve_only s:
      reserve_only (Configuration.init s).
    Proof.
      ii. unfold Configuration.init, Threads.init in *. ss.
      rewrite IdentMap.Facts.map_o in *.
      destruct (@UsualFMapPositive.UsualPositiveMap'.find
                  (@sigT _ (@Language.syntax ProgramEvent.t)) tid s); inv FIND.
      ss. rewrite Memory.bot_get in *. ss.
    Qed.

    Lemma step_reserve_only
          tid e rels1 rels2 c1 c2
          (RESERVE: reserve_only c1)
          (STEP: step tid e rels1 rels2 c1 c2):
      reserve_only c2.
    Proof.
      inv STEP. ii. ss.
      revert FIND. rewrite IdentMap.gsspec. condtac; ss; i; cycle 1.
      { eapply RESERVE; eauto. }
      inv FIND. apply inj_pair2 in H1. subst.
      unfold reserve_only in RESERVE.
      hexploit RESERVE; eauto. i.
      hexploit RAThread.cancel_steps_reserve_only; try exact CANCELS; eauto. i. des.
      hexploit RAThread.opt_step_reserve_only; try exact STEP0; eauto. i.
      hexploit RAThread.reserve_steps_reserve_only; try exact RESERVES; eauto.
    Qed.

    Lemma steps_reserve_only
          rels1 rels2 c1 c2
          (RESERVE: reserve_only c1)
          (STEPS: steps rels1 rels2 c1 c2):
      reserve_only c2.
    Proof.
      induction STEPS; ss.
      hexploit step_reserve_only; eauto.
    Qed.

    Lemma step_rels_incl
          e tid rels1 rels2 c1 c2
          (STEP: step e tid rels1 rels2 c1 c2):
      rels2 = rels1 \/ exists a, rels2 = a :: rels1.
    Proof.
      inv STEP. inv STEP0; eauto. inv STEP.
      unfold ReleaseWrites.append. des_ifs; eauto.
    Qed.

    Lemma steps_rels_incl
          rels1 rels2 c1 c2
          (STEPS: steps rels1 rels2 c1 c2):
      exists rels, rels2 = rels ++ rels1.
    Proof.
      induction STEPS.
      - exists []. ss.
      - des. exploit step_rels_incl; eauto. i. des; subst.
        + exists rels. ss.
        + exists (rels ++ [a]). rewrite <- List.app_assoc. ss.
    Qed.

    Lemma step_non_concrete
          e tid rels1 rels2 c1 c2 loc to
          (STEP: step e tid rels1 rels2 c1 c2)
          (LOC: L loc)
          (EVENT: forall from val released ord,
              ThreadEvent.is_writing e <> Some (loc, from, to, val, released, ord))
          (GET1: forall from val released,
              Memory.get loc to (Configuration.memory c1) <> Some (from, Message.concrete val released)):
      <<GET2: forall from val released,
        Memory.get loc to (Configuration.memory c2) <> Some (from, Message.concrete val released)>>.
    Proof.
      inv STEP. ss.
      hexploit RAThread.cancel_steps_non_concrete; eauto. i. des.
      hexploit RAThread.opt_step_non_concrete; eauto. i. des.
      hexploit RAThread.reserve_steps_non_concrete; eauto.
    Qed.
  End RAConfiguration.
End RAConfiguration.

Module RARaceW.
  Section RARace.
    Variable L: Loc.t -> bool.

    Definition ra_race (rels: ReleaseWrites.t) (tview: TView.t) (loc: Loc.t) (to: Time.t) (ordr: Ordering.t): Prop :=
      (<<LOC: L loc>>) /\
      (<<HIGHER: Time.lt ((View.rlx (TView.cur tview)) loc) to>>) /\
      ((<<ORDW: ~ List.In (loc, to) rels>>) \/
       (<<ORDR: Ordering.le ordr Ordering.strong_relaxed>>)).

    Definition ra_race_steps (rels: ReleaseWrites.t) (c: Configuration.t): Prop :=
      exists tid rels2 rels3 rels4
        c2 lang st2 lc2 e loc to val released ord e3 e4,
        (<<STEPS: RAConfiguration.steps L rels rels2 c c2>>) /\
        (<<TID: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st2, lc2)>>) /\
        (<<THREAD_STEPS: RAThread.steps L rels2 rels3
                                        (Thread.mk _ st2 lc2 (Configuration.sc c2) (Configuration.memory c2)) e3>>) /\
        (<<CONS: Local.promise_consistent (Thread.local e3)>>) /\
        (<<THREAD_STEP: RAThread.step L rels3 rels4 e e3 e4>>) /\
        (<<READ: ThreadEvent.is_reading e = Some (loc, to, val, released, ord)>>) /\
        (<<RARACE: ra_race rels3 (Local.tview (Thread.local e3)) loc to ord>>).

    Definition racefree (rels: ReleaseWrites.t) (c: Configuration.t): Prop :=
      forall tid rels2 rels3 rels4
        c2 lang st2 lc2 e loc to val released ord e3 e4
        (STEPS: RAConfiguration.steps L rels rels2 c c2)
        (TID: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st2, lc2))
        (THREAD_STEPS: RAThread.steps L rels2 rels3
                                      (Thread.mk _ st2 lc2 (Configuration.sc c2) (Configuration.memory c2)) e3)
        (CONS: Local.promise_consistent (Thread.local e3))
        (THREAD_STEP: RAThread.step L rels3 rels4 e e3 e4)
        (READ: ThreadEvent.is_reading e = Some (loc, to, val, released, ord))
        (RARACE: ra_race rels3 (Local.tview (Thread.local e3)) loc to ord),
        False.

    Definition racefree_syn (syn: Threads.syntax): Prop :=
      racefree [] (Configuration.init syn).

    Lemma step_racefree
          e tid rels1 rels2 c1 c2
          (RACEFREE: racefree rels1 c1)
          (STEP: RAConfiguration.step L e tid rels1 rels2 c1 c2):
      racefree rels2 c2.
    Proof.
      ii. eapply RACEFREE; eauto. econs 2; eauto.
    Qed.

    Lemma step_ord_step
          e tid rels1 rels2 c1 c2
          (STEP: RAConfiguration.step L e tid rels1 rels2 c1 c2):
      OrdConfiguration.step L Ordering.acqrel e tid c1 c2.
    Proof.
      inv STEP. econs; eauto. inv STEP0.
      - econs 1.
      - inv STEP. econs 2. eauto.
    Qed.
  End RARace.
End RARaceW.


Require Import Coq.ZArith.ZArith.
Require Import riscv.Decode.
Require Import riscv.Encode.
Require Import riscv.Utility.
Require Import riscv.util.Tactics.
Require Import riscv.util.div_mod_to_quot_rem.
Require Import riscv.proofs.invert_encode_R.
Require Import riscv.proofs.invert_encode_R_atomic.
Require Import riscv.proofs.invert_encode_I.
Require Import riscv.proofs.invert_encode_I_shift_57.
Require Import riscv.proofs.invert_encode_I_shift_66.
Require Import riscv.proofs.invert_encode_I_system.
Require Import riscv.proofs.invert_encode_S.
Require Import riscv.proofs.invert_encode_SB.
Require Import riscv.proofs.invert_encode_U.
Require Import riscv.proofs.invert_encode_UJ.
Require Import riscv.proofs.invert_encode_Fence.

Local Open Scope bool_scope.
Local Open Scope Z_scope.

Ltac somega_pre :=
  rewrite? bitSlice_alt in * by omega; unfold bitSlice' in *;
  repeat (so fun hyporgoal => match hyporgoal with
  | context [signExtend ?l ?n] =>
      let E := fresh "E" in
      destruct (signExtend_alt' l n) as [[? [? E]] | [? [? E]]];
      [ omega | rewrite E in *; clear E .. ]
  end);
  rewrite? Z.shiftl_mul_pow2 in * by omega;
  repeat (so fun hyporgoal => match hyporgoal with
     | context [2 ^ ?x] => let r := eval cbv in (2 ^ x) in change (2 ^ x) with r in *
  end);
  div_mod_to_quot_rem;
  repeat match goal with
         | z: ?T |- _ => progress change T with Z in *
         end.

(* omega which understands bitSlice and shift *)
Ltac somega := somega_pre; omega.

Ltac write_as_pow2_opportunities f :=
    repeat (so fun hyporgoal => match hyporgoal with
               | context [ Z.pos ?p ] =>
                   match p with
                   | 1%positive => fail 1
                   | 2%positive => fail 1
                   | _ => idtac
                   end;
                   let e := eval cbv in (Z.log2 (Z.pos p)) in
                   f (Z.pos p) (2 ^ e)
               end);
    (* we might have been a bit too eager -- undo undesired chained powers: *)
    repeat (so fun hyporgoal => match hyporgoal with
               | context [2 ^ 2 ^ ?p] => let r := eval cbv in (2 ^ p) in
                                         change (2 ^ 2 ^ p) with (2 ^ r) in *
               end).

Tactic Notation "write_as_pow2" "in" "*|-" :=
  write_as_pow2_opportunities ltac:(fun old new => change old with new in *|-).

Tactic Notation "write_as_pow2" "in" "*" :=
  write_as_pow2_opportunities ltac:(fun old new => change old with new in *).

Lemma invert_encode_InvalidInstruction: forall i,
  verify_Invalid i ->
  forall inst,
  encode_Invalid i = inst ->
  False.
Proof. intros. assumption. Qed.

Ltac cbn_encode := repeat (
  cbn [
    Z.eqb
    Pos.eqb andb
    opcode_SYSTEM
    opcode_STORE_FP
    opcode_STORE
    opcode_OP_IMM_32
    opcode_OP_IMM
    opcode_OP_FP
    opcode_OP_32
    opcode_OP
    opcode_NMSUB
    opcode_NMADD
    opcode_MSUB
    opcode_MISC_MEM
    opcode_MADD
    opcode_LUI
    opcode_LOAD_FP
    opcode_LOAD
    opcode_JALR
    opcode_JAL
    opcode_BRANCH
    opcode_AUIPC
    opcode_AMO
    funct3_JALR
    funct7_XOR
    funct7_SUBW
    funct7_SRLIW
    funct7_SRL
    funct7_SUB
    funct7_SRLW
    funct7_SRA
    funct7_SLTU
    funct7_SLT
    funct7_SLLW
    funct7_SLLIW
    funct7_SLL
    funct7_SRAW
    funct7_SRAIW
    funct7_MUL
    funct7_DIVW
    funct7_DIVUW
    funct7_DIVU
    funct7_DIV
    funct7_AND
    funct7_SFENCE_VMA
    funct7_REMW
    funct7_REMUW
    funct7_REMU
    funct7_REM
    funct7_OR
    funct7_MULW
    funct7_MULHU
    funct7_MULHSU
    funct7_MULH
    funct3_SRAIW
    funct3_SRAI
    funct3_SRA
    funct3_SLTU
    funct3_SLTIU
    funct3_SLTI
    funct7_ADDW
    funct7_ADD
    funct6_SRLI
    funct6_SRAI
    funct6_SLLI
    funct5_SC
    funct5_LR
    funct5_AMOXOR
    funct5_AMOSWAP
    funct5_AMOOR
    funct5_AMOMINU
    funct5_AMOMIN
    funct5_AMOMAXU
    funct5_AMOMAX
    funct5_AMOAND
    funct5_AMOADD
    funct3_XORI
    funct3_XOR
    funct3_SW
    funct3_SUBW
    funct3_SUB
    funct3_SRLW
    funct3_SRLIW
    funct3_SRLI
    funct3_SRL
    funct3_SRAW
    funct12_EBREAK
    funct3_DIVUW
    funct3_SLT
    funct3_SLLW
    funct3_SLLIW
    funct3_SLLI
    funct3_SLL
    funct3_SH
    funct3_SD
    funct3_SB
    funct3_REMW
    funct3_REMUW
    funct3_REMU
    funct3_REM
    funct3_PRIV
    funct3_ORI
    funct3_OR
    funct3_MULW
    funct3_MULHU
    funct3_MULHSU
    funct3_MULH
    funct3_MUL
    funct3_LWU
    funct3_LW
    funct3_LHU
    funct3_LH
    funct3_LD
    funct3_LBU
    funct3_LB
    funct3_FENCE_I
    funct3_FENCE
    funct3_DIVW
    funct3_AND
    funct3_DIVU
    funct3_DIV
    funct3_CSRRWI
    funct3_CSRRW
    funct3_CSRRSI
    funct3_CSRRS
    funct3_CSRRCI
    funct3_CSRRC
    funct3_BNE
    funct3_BLTU
    funct3_BLT
    funct3_BGEU
    funct3_BGE
    funct3_BEQ
    funct3_ANDI
    funct12_URET
    funct3_AMOW
    funct3_AMOD
    funct3_ADDW
    funct3_ADDIW
    funct3_ADDI
    funct3_ADD
    funct12_WFI
    funct12_MRET
    funct12_SRET
    funct12_ECALL
    isValidM64
    isValidM
    isValidI64
    isValidI
    isValidCSR
    isValidA64
    isValidA
    supportsM
    supportsA
    bitwidth
    app
  ] in *;
  cbv [machineIntToShamt id] in *
).

Lemma decode_encode: forall (inst: Instruction) (iset: InstructionSet),
    verify inst iset ->
    decode iset (encode inst) = inst.
Proof.
  intros. unfold verify in H. destruct H as [H H0].
  unfold verify_iset in *.
  cbv beta delta [decode].
  repeat match goal with
  | |- (let x := ?a in ?b) = ?c => change (let x := a in b = c); intro
  | x := ?t : ?T |- _ => pose proof (eq_refl t : x = t); clearbody x
  end.
  remember (encode inst) as encoded eqn:Henc; symmetry in Henc.
  cbv [encode] in Henc.
  cbv [
      Encoder
        Verifier
        apply_InstructionMapper
        map_Fence
        map_I
        map_I_shift_57
        map_I_shift_66
        map_I_system
        map_Invalid
        map_R
        map_R_atomic
        map_S
        map_SB
        map_U
        map_UJ
    ] in Henc.

  destruct inst as [i|i|i|i|i|i|i|i].
  par: abstract (destruct i; try (
    (lazymatch type of Henc with
     | encode_I _ _ _ _ _ = _ =>
       apply invert_encode_I in Henc
     | encode_Fence _ _ _ _ _ _ _ = _ =>
       apply invert_encode_Fence in Henc
     | encode_I_shift_66 _ _ _ _ _ _ = _ =>
       apply (@invert_encode_I_shift_66 (bitwidth iset)) in Henc
     | encode_I_shift_57 _ _ _ _ _ _ = _ =>
       apply invert_encode_I_shift_57 in Henc
     | encode_R _ _ _ _ _ _ = _ =>
       apply invert_encode_R in Henc
     | encode_Invalid _ = _ =>
       apply invert_encode_InvalidInstruction in Henc
     | encode_R_atomic _ _ _ _ _ _ _ = _ =>
       apply invert_encode_R_atomic in Henc
     | encode_I_system _ _ _ _ _ = _ =>
       apply invert_encode_I_system in Henc
     | encode_U _ _ _ = _ =>
       apply invert_encode_U in Henc
     | encode_UJ _ _ _ = _ =>
       apply invert_encode_UJ in Henc
     | encode_S _ _ _ _ _ = _ =>
       apply invert_encode_S in Henc
     | encode_SB _ _ _ _ _ = _ =>
       apply invert_encode_SB in Henc
     end; [|trivial]);
      repeat match type of Henc with
               _ /\ _ => let H := fresh "H" in destruct Henc as [H Henc]; rewrite <-?H in *
             end; rewrite <-?Henc in *;
      subst results; subst resultI; subst decodeI; subst opcode; subst funct3;
      subst funct5; subst funct6; subst funct7; subst funct10; subst funct12;
      destruct iset;
      repeat match goal with
      | H: False |- _ => destruct H
      | |- ?x = ?x => exact_no_check (eq_refl x)
      | |- _ => progress cbn_encode
      | |- _ => rewrite !Bool.orb_true_r in *
      | |- _ => rewrite !Bool.andb_false_r in *
      | |- _ => progress subst
      end);
     (* cases where bitSlice in goal and hyps do not match *)
     cbv [funct7_SFENCE_VMA opcode_SYSTEM funct3_PRIV funct12_WFI funct12_MRET
          funct12_SRET funct12_URET funct12_EBREAK funct12_ECALL
          funct3_FENCE_I opcode_MISC_MEM isValidI] in *;
     repeat match goal with
            | |- ?x = ?x => exact_no_check (eq_refl x)
            | |- context [?x =? ?y] =>
              let H := fresh "H" in
              destruct (x =? y) eqn:H;
                apply Z.eqb_eq in H || apply Z.eqb_neq in H
            | _ => progress cbn in *
            end;
     try (intuition discriminate);
     try solve [ exfalso;
                 try (match goal with H: _ <> _ |- _ => apply H; clear H end);
                 somega ]).
Qed.

Print Assumptions decode_encode.