Require Import CertiGraph.CertiGC.gc_spec.
Require Import CertiGraph.msl_ext.ramification_lemmas.

Local Open Scope logic.

Lemma root_valid_int_or_ptr: forall g (roots: roots_t) root outlier,
    In root roots ->
    roots_compatible g outlier roots ->
    graph_rep g * outlier_rep outlier |-- !! (valid_int_or_ptr (root2val g root)).
Proof.
  intros. destruct H0. destruct root as [[? | ?] | ?].
  - simpl root2val. unfold odd_Z2val. replace (2 * z + 1) with (z + z + 1) by lia.
    apply prop_right, valid_int_or_ptr_ii1.
  - sep_apply (roots_outlier_rep_single_rep _ _ _ H H0).
    sep_apply (single_outlier_rep_valid_int_or_ptr g0). entailer!.
  - red in H1. rewrite Forall_forall in H1.
    rewrite (filter_sum_right_In_iff v roots) in H.
    apply H1 in H. simpl. sep_apply (graph_rep_valid_int_or_ptr _ _ H). entailer!.
Qed.

Lemma weak_derives_strong: forall (P Q: mpred),
    P |-- Q -> P |-- (weak_derives P Q && emp) * P.
Proof.
  intros. cancel. apply andp_right. 2: cancel.
  assert (HS: emp |-- TT) by entailer; sep_apply HS; clear HS.
  apply derives_weak. assumption.
Qed.

Lemma sapi_ptr_val: forall p m n,
    isptr p -> Int.min_signed <= n <= Int.max_signed ->
    (force_val
       (sem_add_ptr_int int_or_ptr_type Signed (offset_val (WORD_SIZE * m) p)
                        (vint n))) = offset_val (WORD_SIZE * (m + n)) p.
Proof.
  intros. rewrite sem_add_pi_ptr_special; [| easy | | easy].
  - simpl. rewrite offset_offset_val. f_equal. fold WORD_SIZE; rep_lia.
  - rewrite isptr_offset_val. assumption.
Qed.

Lemma sapil_ptr_val: forall p m n,
    isptr p ->
    if Archi.ptr64 then
      force_val
        (sem_add_ptr_long int_or_ptr_type (offset_val (WORD_SIZE * m) p)
                          (Vlong (Int64.repr n))) = offset_val (WORD_SIZE * (m + n)) p
    else
      force_val
        (sem_add_ptr_int int_or_ptr_type Signed (offset_val (WORD_SIZE * m) p)
                         (vint n)) = offset_val (WORD_SIZE * (m + n)) p.
Proof.
  intros. simpl.
  first [rewrite sem_add_pi_ptr_special' | rewrite sem_add_pl_ptr_special']; auto.
  simpl. fold WORD_SIZE. rewrite offset_offset_val. f_equal. lia.
Qed.

Lemma data_at_mfs_eq: forall g v i sh nv,
    field_compatible int_or_ptr_type [] (offset_val (WORD_SIZE * i) nv) ->
    0 <= i < Zlength (raw_fields (vlabel g v)) ->
    data_at sh (tarray int_or_ptr_type i) (sublist 0 i (make_fields_vals g v)) nv *
    field_at sh int_or_ptr_type [] (Znth i (make_fields_vals g v))
             (offset_val (WORD_SIZE * i) nv) =
    data_at sh (tarray int_or_ptr_type (i + 1))
            (sublist 0 (i + 1) (make_fields_vals g v)) nv.
Proof.
  intros. rewrite field_at_data_at. unfold field_address.
  rewrite if_true by assumption. simpl nested_field_type.
  simpl nested_field_offset. rewrite offset_offset_val.
  replace (WORD_SIZE * i + 0) with (WORD_SIZE * i)%Z by lia.
  rewrite <- (data_at_singleton_array_eq
                sh int_or_ptr_type _ [Znth i (make_fields_vals g v)]) by reflexivity.
  rewrite <- fields_eq_length in H0.
  rewrite (data_at_tarray_value
             sh (i + 1) i nv (sublist 0 (i + 1) (make_fields_vals g v))
             (make_fields_vals g v) (sublist 0 i (make_fields_vals g v))
             [Znth i (make_fields_vals g v)]).
  - replace (i + 1 - i) with 1 by lia. reflexivity.
  - lia.
  - lia.
  - autorewrite with sublist. reflexivity.
  - reflexivity.
  - rewrite sublist_one; [reflexivity | lia..].
Qed.

Lemma data_at__value_0_size: forall sh p,
    data_at_ sh (tarray int_or_ptr_type 0) p |-- emp.
Proof. intros. rewrite data_at__eq. apply data_at_zero_array_inv; reflexivity. Qed.

Lemma data_at_minus1_address: forall sh v p,
    data_at sh (if Archi.ptr64 then tulong else tuint)
            v (offset_val (- WORD_SIZE) p) |--
            !! (force_val (sem_add_ptr_int (if Archi.ptr64 then tulong else tuint)
                                           Signed p (eval_unop Oneg tint (vint 1))) =
                field_address (if Archi.ptr64 then tulong else tuint) []
                              (offset_val (- WORD_SIZE) p)).
Proof.
  intros. unfold eval_unop. simpl. entailer!.
  unfold field_address. rewrite if_true by assumption. rewrite offset_offset_val.
  simpl. reflexivity.
Qed.


Require Import Crypto.
Require Import ProtoRep.
Require Import CpdtTactics.
Require Import Eqdep_dec.
Require Import Program.
Require Import SfLib.
Require Import Coq.Program.Equality.
Require Import LibTactics.

Definition ob (t:type) := list ((message t) * (list (message Key))).

Record State : Type := mkState
        {keys : list (message Key);
         basics : list (message Basic);
         kOb : ob Key;
         bOb : ob Basic
        }.

Definition emptyState := mkState nil nil nil nil.

Definition Assertion := State -> Prop.

Definition addKey : forall mt (m:message mt) (pf: mt = Key),
    (list (message Key)) -> (list (message Key)).
Proof.
  intros. subst. exact (m :: X).
Defined.

Definition addMKey t (m:message t) : (list (message Key)) -> (list (message Key)) := fun l => (
  match t as t' return (t = t') -> (list (message Key)) with
  | Key => fun pf => (addKey t m pf l)
  | _ => fun _ => l
  end (eq_refl t)).

Definition addBasic : forall mt (m:message mt) (pf: mt = Basic),
    (list (message Basic)) -> (list (message Basic)).
Proof.
  intros. subst. exact (m :: X).
Defined.

Definition addMBasic t (m:message t) : (list (message Basic)) -> (list (message Basic)) := fun l => (
  match t as t' return (t = t') -> (list (message Basic)) with
  | Basic => fun pf => (addBasic t m pf l)
  | _ => fun _ => l
  end (eq_refl t)).

Definition addP (t:type) : forall mt (pf:mt = t),  ((message mt) * (list (message Key))) -> (ob t) -> (ob t).
Proof.
  intros. subst. exact (X :: X0 ).
Defined.

Definition addMp mt (p:((message mt)*(list (message Key)))) : (ob Basic) -> (ob Basic) := fun l => (
  match mt as t' return (mt = t') -> (ob Basic) with
  | Basic => fun pf => (addP _ _ pf p l)
  | _ => fun _ => l
  end (eq_refl mt)).

Definition addMpK mt (p:((message mt)*(list (message Key)))) : (ob Key) -> (ob Key) := fun l => (
  match mt as t' return (mt = t') -> (ob Key) with
  | Key => fun pf => (addP _ _ pf p l)
  | _ => fun _ => l
  end (eq_refl mt)).

Fixpoint obligations'{mt:type} (m:message mt) (kl: list (message Key))
                               (l:ob Basic) : ob Basic :=
  match m with
  | encrypt mt' m' k => match mt' with
                       | Basic => let new := (m', (kl ++ [(key k)])) in
                                 addMp mt' new l
                       | _ => obligations' m' (kl ++ [(key k)]) l
                       end
  | pair _ _ m1 m2 => (obligations' m1 kl l) ++ (obligations' m2 kl l)
  | basic n => addMp _ ((basic n), kl) l
  | _ => addMp _ (m, nil) l
  end.

Definition obligations{mt:type} (m:message mt) : ob Basic :=
  obligations' m nil nil.

Fixpoint obligationsK'{mt:type} (m:message mt) (kl: list (message Key))
                               (l:ob Key) : ob Key :=
  match m with
  | encrypt mt' m' k => match mt' with
                       | Key => let new := (m', (kl ++ [(key k)])) in
                                 addMpK _ new l
                       | _ => obligationsK' m' (kl ++ [(key k)]) l
                       end
  | pair _ _ m1 m2 => (obligationsK' m1 kl l) ++ (obligationsK' m2 kl l)
  | key k => addMpK _ ((key k), kl) l
  | _ => addMpK _ (m, nil) l
  end.

Definition obligationsK{mt:type} (m:message mt) : ob Key :=
  obligationsK' m nil nil.

Definition updateState{t:type} (m:message t) (sIn: State) : State :=
  match t with
  | Basic => mkState  sIn.(keys) (addMBasic t m sIn.(basics)) sIn.(kOb) sIn.(bOb)
  | Key => mkState (addMKey t m sIn.(keys)) sIn.(basics) sIn.(kOb) sIn.(bOb)
  | Encrypt _ => mkState sIn.(keys) sIn.(basics)
                                       ((obligationsK m) ++ sIn.(kOb))
                                       ((obligations m) ++ sIn.(bOb))
  | _ =>  sIn
  end.

Inductive step : forall (s:State) (t r t':protoType),
    (protoExp t) -> (protoExp r) -> (protoExp t') -> State -> Prop :=
| ST_Send_Rec : forall x y  mt
                  (m:message mt) (p1':protoExp x)
                  (f:(message mt) -> protoExp y) (s:State),
    step s _ _ _ (SendC m p1') (ReceiveC f) p1' s
| ST_Rec_Send : forall x y mt (m:message mt) (p1':protoExp x)
                       (f:(message mt) -> protoExp y) s,
    step s _ _ _ (ReceiveC f) (SendC m p1') (f m) (updateState m s)
| ST_Choice_true : forall rt rt' st st'
                     (r:protoExp rt) (r0:protoExp rt')
                     (s:protoExp st) (s0:protoExp st') stt,
    step stt _ _ _ (ChoiceC true r s) (OfferC r0 s0) r stt
| ST_Choice_false : forall rt rt' st st'
                     (r:protoExp rt) (r0:protoExp rt')
                     (s:protoExp st) (s0:protoExp st') stt,
    step stt _ _ _ (ChoiceC false r s) (OfferC r0 s0) s stt
| ST_Offer_true : forall rt rt' st st'
                     (r:protoExp rt) (r0:protoExp rt')
                     (s:protoExp st) (s0:protoExp st') stt,
    step stt _ _ _ (OfferC r0 s0) (ChoiceC true r s) r0 stt
| ST_Offer_false : forall rt rt' st st'
                     (r:protoExp rt) (r0:protoExp rt')                     (s:protoExp st) (s0:protoExp st') stt,
    step stt _ _ _ (OfferC r0 s0) (ChoiceC false r s) s0 stt.

(*Notation "'stepe' st st'" := (step st _ _ _ st') (at level 50).*)

Inductive multi : forall s (t r t':protoType),
    (protoExp t) -> (protoExp r)  -> (protoExp t') -> State -> Prop :=
| multi_refl : forall (t r :protoType) (x:protoExp t) (y:protoExp r) st,
    multi st _ _ _ x y x st
| multi_step : forall (t t' r r2 s:protoType),
    forall (x:protoExp t) (x':protoExp t')
      (y:protoExp r) (y2:protoExp r2)
      (z1:protoExp s) st st' st'' st2 st2',
                    step st _ _ _ x x' y st' ->
                    step st2 _ _ _ x' x y2 st2' ->
                    multi st' _ _ _ y y2 z1 st'' ->
                    multi st _ _ _ x x' z1 st''.

(*Notation "'multie' st st'" := (multi st _ _ _ st')
                                (at level 50).*)

Definition normal_form {p1t p2t:protoType}
           (p1:protoExp p1t)(p2:protoExp p2t) : Prop :=
  forall st st',  ~ exists  t' (x:protoExp t'),  step st _ _ _ p1 p2 x st'.

Theorem nf_ex : normal_form (ReturnC (basic 0)) (ReturnC (basic 1)).
Proof.
 unfold normal_form. unfold not. intros. destruct H. destruct H. inversion H.
Qed.

Axiom updateBoth :  forall t (m:message t) x6 x7 p1t p2t p3t (p1:protoExp p1t) (p2:protoExp p2t) (p3: protoExp p3t),
    multi x6 _ _ _ p1 p2 p3 x7 ->
    multi (updateState m x6) _ _ _ p1 p2 p3 (updateState m x7).

Ltac bool_destruct :=
  match goal with H: bool |- _ =>
                  destruct H
  end.

Ltac steps_destruct :=
  match goal with H: step _ _ _ _ _ _ _ _ /\ _ |- _ =>
                  destruct H
  end.

Ltac step_destruct :=
  match goal with H: step _ _ _ _ _ _ _ _ |- _ =>
                  dep_destruct H; clear H
  end.

Parameter A B C : Type.
Parameter P : A -> B -> C -> Prop.
Parameter Q : Prop.

(* This will try to match an hypothesis named h with 'exists u: T, P'
   and return the name of 'u' *)
Ltac extract_name h :=
  match goal with
    | [h : ?A |- _ ] =>
      match A with
        | @ex ?T ?P => match P with
                          | fun u => _ => u
                   end
   end
end.

(* 'smart' destruct using the name we just computed *)
Ltac one_destruct h :=
   let a := extract_name h in
   destruct h as [a h].

Goal (exists (a:A) (b:B) (c:C), P a b c) -> Q.
  intros H.
  one_destruct H. one_destruct H. one_destruct H.
repeat (one_destruct H).
Abort.
(* the goal is now
1 subgoals
a : A
b : B
c : C
H : P a b c
______________________________________(1/1)
Q
*)

Ltac ih_dep_destruct :=
  match goal with
    | [ IHp1 : forall (p2t:protoType) (p2: protoExp p2t),
         Dual _ _ -> exists _ _ _ _ _ _ _ _, _,
          H : protoType,
          H2 : message ?t0 -> (protoExp _),
          H3 : message ?t0
        |- _
        ] => dep_destruct (IHp1 H (H2 H3))
  end.

Hint Constructors multi.
Hint Resolve updateBoth.

Theorem normalization {p1t p2t :protoType} :
    forall (p1:protoExp p1t) (p2:protoExp p2t),
      (Dual p1 p2) ->
    exists p3t p4t (p3:protoExp p3t) (p4:protoExp p4t) st st' st2 st2',
      (multi st _ _ _ p1 p2 p3 st') /\ (multi st2 _ _ _ p2 p1 p4 st2')
      /\ normal_form p3 p4.
Proof.
  intros.
  generalize dependent p2. generalize dependent p2t.
  induction p1; destruct p2;
  try (intros H; inversion H; subst).
  ih_dep_destruct. assumption.

  Ltac ih_destruct :=
  match goal with
    | [ H: exists _, _
        |- _
        ] => destruct H
  end.

  repeat ih_destruct.

  Ltac multi_destruct :=
  match goal with
    | [ H: multi _ _ _ _ _ _ _ _  /\ _
        |- _
        ] => destruct H
  end.
  repeat multi_destruct.

  eexists. eexists. eexists. eexists.
  eexists. eexists. eexists. eexists.
  split. eapply multi_step. constructor. constructor. eassumption.
  split. apply multi_step with (y:=(p m)) (y2:=p1) (st':=(updateState m x6)) (st2:=x4) (st2':=x4). constructor. constructor. apply updateBoth. eassumption. assumption.

  intros. inversion H0; subst.

  Ltac ih_dep_destruct' :=
  match goal with
    | [ IHp1 : forall m (p2t:protoType) (p2: protoExp p2t),
         Dual _ _ -> exists _ _ _ _ _ _ _ _, _,
          H : protoType,
          H2 : (protoExp _),
          H3: message _
        |- _
        ] => dep_destruct (IHp1 H3 H H2)
                end.
  ih_dep_destruct'. assumption.

  repeat ih_destruct.
  repeat multi_destruct.

  eexists. eexists. eexists. eexists.
  eexists. eexists. eexists. eexists.

  split. apply multi_step with (y:=(p m)) (y2:=p2) (st':=(updateState m x4)) (st2:=x4) (st2':=x4). constructor. constructor. apply updateBoth. eassumption.
  split. apply multi_step with (y:=(p2)) (y2:=(p m)) (st':=x6) (st2:=x4) (st2':=(updateState m x4)). constructor. constructor. eassumption. assumption.

  intros. inversion H0.
  intros. inversion H0.
  intros. inversion H0.
  intros. inversion H0.

Abort.

(*

  eapply multi_step; constructor. eassumption.

  apply multi_step with (y:=p2) (st':=(updateState m x6)) (st2:=x4) (st2':=x4).
  apply multi_step with (y:=p2) (y2:=(p m)) (st':=x4) (st2:=x6) (st2':=(updateState m x6)).

  eapply multi_step. constructor. constructor. eassumption.
  split. apply multi_step with (y:=(p m)) (st':=(updateState m x6)) (st2:=x4) (st2':=x4). constructor. constructor. apply updateBoth. eassumption. assumption.

  constructor.
  split. constructor
  constructor
  exists x2. exists x3.
  exists x4. exists x5. exists x6. exists (updateState m x7).

  try (ih_dep_destruct; inversion H; assumption).
  dep_destruct (IHp1 p'0 (p m)).
               inversion H. assumption.

  dep_destruct
           (p3t p4t : protoType) (p3 : protoExp p3t)
         (p4 : protoExp p4t) (st st' st2 st2' : State),
           (multie st p1) p2 p3 st' /\
           (multie st2 p2) p1 p4 st2' /\ normal_form p3 p4

  destruct H0. destruct H0. destruct H0. destruct H0. destruct H0. destruct H0. destruct H0. destruct H0. destruct H4. eexists. eexists. exists x2. exists x3.
  exists x4. exists x5. exists x6. exists (updateState m x7).

  split. apply multi_step with (y:=p1) (y2:=(p m)) (st':=x4) (st2:=x6) (st2':=(updateState m x6)). constructor. constructor. assumption.
  split. apply multi_step with (y:=(p m)) (y2:=p1) (st':=(updateState m x6)) (st2:=x4) (st2':=x4). constructor. constructor.
  apply updateBoth. assumption. assumption.

  intros. inversion H0. subst.
  dep_destruct (H m _ p2).
  inversion H0. assumption.
  destruct H0.  destruct H1. destruct H1. destruct H1. destruct H1. destruct H1. destruct H1. destruct H1. destruct H1. destruct H4.

  eexists. eexists. exists x2. exists x3. exists x4. exists (updateState m x5). exists x6. exists x7.

  split. apply multi_step with (y:=(p m)) (y2:=p2) (st':=(updateState m x4)) (st2:=x6) (st2':=x6). constructor. constructor.
  apply updateBoth. assumption.
  split. apply multi_step with (y:=p2) (y2:=(p m)) (st':=x6) (st2:=x4) (st2':=(updateState m x4)). constructor. constructor. assumption. assumption.
  intros. inversion H0.
  intros. inversion H0.
  intros. inversion H0.
  intros. inversion H0.

  destruct b. dep_destruct (IHp1_1 r0 p2_1). assumption. destruct x. assumption. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H4.

    destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H6.

  eexists. eexists. eexists. eexists.

  exists x11. exists x12. exists x13. exists x14.
  split. apply multi_step with (y:=p1_1) (y2:=p2_1) (st':=x11) (st2:=x13) (st2':=x13). constructor. constructor. apply H3.
  split. apply multi_step with (y:=p2_1) (y2:=p1_1) (st':=x13) (st2:=x11) (st2':=x11). constructor. constructor. apply H6. assumption.

  dep_destruct (IHp1_2 s0 p2_2). assumption. destruct x. assumption.
  destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H4.

  destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H6.

  eexists. eexists. eexists. eexists.

  exists x11. exists x12. exists x13. exists x14.
  split. apply multi_step with (y:=p1_2) (y2:=p2_2) (st':=x11) (st2:=x13) (st2':=x13). constructor. constructor. apply H3.
  split. apply multi_step with (y:=p2_2) (y2:=p1_2) (st':=x13) (st2:=x11) (st2':=x11). constructor. constructor. apply H6. assumption.

  destruct b. dep_destruct (IHp1_1 r0 p2_1). assumption. destruct x. assumption. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H4.

    destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H6.

  eexists. eexists. eexists. eexists.

  exists x11. exists x12. exists x13. exists x14.
  split. apply multi_step with (y:=p1_1) (y2:=p2_1) (st':=x11) (st2:=x13) (st2':=x13). constructor. constructor. apply H3.
  split. apply multi_step with (y:=p2_1) (y2:=p1_1) (st':=x13) (st2:=x11) (st2':=x11). constructor. constructor. apply H6. assumption.

  dep_destruct (IHp1_2 s0 p2_2). assumption. destruct x. assumption.
  destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H2. destruct H4.

  destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H3. destruct H6.

  eexists. eexists. eexists. eexists.

  exists x11. exists x12. exists x13. exists x14.
  split. apply multi_step with (y:=p1_2) (y2:=p2_2) (st':=x11) (st2:=x13) (st2':=x13). constructor. constructor. apply H3.
  split. apply multi_step with (y:=p2_2) (y2:=p1_2) (st':=x13) (st2:=x11) (st2':=x11). constructor. constructor. apply H6. assumption.

  eexists. eexists. eexists. eexists. exists emptyState. exists emptyState. exists emptyState. exists emptyState.
  split. constructor. split. constructor.
  unfold normal_form. intros. unfold not. intros. destruct H0. destruct H0. inversion H0.
Qed.

*)

Definition isValue {t:protoType} (p:protoExp t) : Prop :=
  match p with
  | ReturnC _ => True
  | _ => False
  end.

Theorem ex_isValue : isValue (ReturnC (basic 1)).
Proof.
  simpl. trivial.
Qed.

Theorem progress {t t':protoType} :
    forall (p1:protoExp t) (p2:protoExp t') st,
    (Dual p1 p2) ->
    isValue p1 \/ (exists t''(p3:protoExp t'') st', step st _ _ _ p1 p2 p3 st').
Proof.
  intros p1 p2 st dualProof. destruct p1; destruct p2; inversion dualProof;
  (* Case:  p1 = SendC, p2 = ReceiveC *)
  (* Case:  p1 = ReceiveC, p2 = SendC *)
  (* Case:  p1 = ChoiceC, p2 = OfferC *)
  (* Case:  p1 = OfferC, p2 = ChoiceC *)
  try (right;
       try (bool_destruct);
       subst; repeat (eexists); constructor).
  (* Case:  p1 = ReturnC, p2 = ReturnC *)
  left. simpl. trivial.
Qed.

Theorem preservation {t t' p3t p4t : protoType} :
    forall (p1:protoExp t) (p2:protoExp t'),
    (Dual p1 p2) ->
    forall (p3:protoExp p3t) (p4:protoExp p4t) st st' st2 st2',
      step st _ _ _ p1 p2 p3 st' /\
      step st _ _ _ p1 p2 p3 st' /\
       step st2 _ _ _ p2 p1 p4 st2'
      -> (Dual p3 p4).
Proof.
  intros p1 p2 dualProof. destruct p1; destruct p2; inversion dualProof;
  intros; try (repeat steps_destruct); (repeat step_destruct); assumption.
Qed.

Lemma value_is_nf {t t':protoType} (p1:protoExp t) (p2:protoExp t') :
  (isValue p1) /\ (isValue p2) -> normal_form p1 p2.
Proof.
  intros.
  destruct p1; destruct p2;
  (cbv; intros; solve by inversion 3).
Qed.

Lemma nf_is_value {t t':protoType} (p1:protoExp t) (p2:protoExp t') : (Dual p1 p2) ->
  normal_form p1 p2 -> (isValue p1) /\ (isValue p2).
Proof.
  unfold normal_form.
  intros D H.
  destruct p1; destruct p2; try (inversion D);
  try (try bool_destruct; destruct H with (st:=emptyState) (st':=emptyState);
       repeat eexists; subst; constructor).

  destruct H with (st:=emptyState) (st':=updateState m emptyState);
    eexists; subst; eexists; constructor.
  jauto.
Qed.

Corollary nf_same_as_value {t t':protoType} (p1:protoExp t) (p2:protoExp t')
  : (Dual p1 p2) -> normal_form p1 p2 <-> (isValue p1) /\ (isValue p2).
Proof.
  intros. split.
  intros. apply nf_is_value in H0. assumption. assumption.
  intros. apply value_is_nf in H0. assumption.
Qed.


Require Import Arith.
Require Import Bool.
Require Import List.
Require Import FMapInterface.
Require Import FMapFacts.
Require Import Structures.OrderedType.
Require Import Structures.OrderedTypeEx.
Require Import Log.
Require Import Pred.
Require Import Prog.
Require Import Hoare.
Require Import SepAuto.
Require Import FunctionalExtensionality.
Require Import Omega.
Require Import Word.
Require Import WordAuto.
Require Import Rec.
Require Import Array.
Require Import Eqdep_dec.
Require Import GenSep.

Set Implicit Arguments.
Import List.ListNotations.

(* XXX parameterize by length and stick in Word.v *)
Module addr_as_OT <: UsualOrderedType.
  Definition WIDTH:=addrlen.
  Definition t := word WIDTH.
  Definition eq := @eq t.
  Definition eq_refl := @eq_refl t.
  Definition eq_sym := @eq_sym t.
  Definition eq_trans := @eq_trans t.
  Definition lt := @wlt WIDTH.

  Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z.
  Proof.
    unfold lt; intros.
    apply wlt_lt in H; apply wlt_lt in H0.
    apply lt_wlt.
    omega.
  Qed.

  Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y.
  Proof.
    unfold lt, eq; intros.
    apply wlt_lt in H.
    intro He; subst; omega.
  Qed.

  Definition compare x y : Compare lt eq x y.
  Proof.
    unfold lt, eq.
    destruct (wlt_dec x y); [ apply LT; auto | ].
    destruct (weq x y); [ apply EQ; auto | ].
    apply GT. apply le_neq_lt; auto.
  Defined.

  Definition eq_dec := @weq WIDTH.
End addr_as_OT.

Module LOG (Map:FMapInterface.WSfun addr_as_OT).
  Definition memstate := Map.t valu.
  Definition ms_empty := Map.empty valu : memstate.
  Definition diskstate := list valu.
  Module MapFacts := WFacts_fun addr_as_OT Map.
  Module MapProperties := WProperties_fun addr_as_OT Map.

  Inductive logstate :=
  | NoTransaction (cur : diskstate)
  (* Don't touch the disk directly in this state. *)
  | ActiveTxn (old : diskstate) (cur : diskstate)
  (* A transaction is in progress.
   * It started from the first memory and has evolved into the second.
   * It has not committed yet. *)
  | FlushedTxn (old : diskstate) (cur : diskstate)
  (* A transaction has been flushed to the log, but not committed yet. *)
  | CommittedTxn (cur : diskstate)
  (* A transaction has committed but the log has not been applied yet. *).

  Record xparams := {
    (* The actual data region is everything that's not described here *)
    LogHeader : word addrlen; (* Store the header here *)
    LogCommit : word addrlen; (* Store true to apply after crash. *)

    LogStart : word addrlen; (* Start of log region on disk *)
    LogLen : word addrlen  (* Maximum number of entries in log; length but still use addr type *)
  }.

  Definition header_type := Rec.RecF ([("length", Rec.WordF addrlen)]).
  Definition header := Rec.data header_type.
  Definition mk_header (len : nat) : header := ($ len, tt).

(*
  Theorem header_sz_ok : Rec.len header_type <= valulen.
  Proof.
    rewrite valulen_is. simpl. firstorder. (* this could be much faster, say with reflection *)
  Qed.

  Theorem plus_minus_header : Rec.len header_type + (valulen - Rec.len header_type) = valulen.
  Proof.
    apply le_plus_minus_r; apply header_sz_ok.
  Qed.

  Definition header_to_valu (h : header) : valu.
    set (zext (Rec.to_word h) (valulen - Rec.len header_type)) as r.
    rewrite plus_minus_header in r.
    refine r.
  Defined.
  Arguments header_to_valu : simpl never.

  Definition valu_to_header (v : valu) : header.
    apply Rec.of_word.
    rewrite <- plus_minus_header in v.
    refine (split1 _ _ v).
  Defined.

  Definition header_valu_id : forall h,
    valu_to_header (header_to_valu h) = h.
  Proof.
    unfold valu_to_header, header_to_valu.
    unfold eq_rec_r, eq_rec.
    intros.
    rewrite <- plus_minus_header.
    do 2 rewrite <- eq_rect_eq_dec by (apply eq_nat_dec).
    unfold zext.
    rewrite split1_combine.
    apply Rec.of_to_id.
    simpl; destruct h; tauto.
  Qed.

  Definition addr_per_block := valulen / addrlen.
  Definition descriptor_type := Rec.ArrayF (Rec.WordF addrlen) addr_per_block.
  Definition descriptor := Rec.data descriptor_type.
  Theorem descriptor_sz_ok : valulen = Rec.len descriptor_type.
    simpl. unfold addr_per_block. rewrite valulen_is. reflexivity.
  Qed.

  Definition descriptor_to_valu (d : descriptor) : valu.
    rewrite descriptor_sz_ok.
    apply Rec.to_word; auto.
  Defined.
  Arguments descriptor_to_valu : simpl never.

  Definition valu_to_descriptor (v : valu) : descriptor.
    rewrite descriptor_sz_ok in v.
    apply Rec.of_word; auto.
  Defined.

  Theorem valu_descriptor_id : forall v,
    descriptor_to_valu (valu_to_descriptor v) = v.
  Proof.
    unfold descriptor_to_valu, valu_to_descriptor.
    unfold eq_rec_r, eq_rec.
    intros.
    rewrite Rec.to_of_id.
    rewrite <- descriptor_sz_ok.
    do 2 rewrite <- eq_rect_eq_dec by (apply eq_nat_dec).
    trivial.
  Defined.
*)

  Definition indomain' (a : addr) (m : diskstate) := wordToNat a < length m.

  (* Check that the state is well-formed *)
  Definition valid_entries m (ms : memstate) :=
    forall a v, Map.MapsTo a v ms -> indomain' a m.

  Definition valid_size xp (ms : memstate) :=
    Map.cardinal ms <= wordToNat (LogLen xp).

  (* Replay the state in memory *)
  Definition replay' V (l : list (addr * V)) (m : list V) : list V :=
    fold_right (fun p m' => upd m' (fst p) (snd p)) m l.

  Definition replay (ms : memstate) (m : diskstate) : diskstate :=
    replay' (Map.elements ms) m.

  Definition data_rep (old : diskstate) : pred :=
    diskIs (list2mem old).

  Definition cur_rep (old : diskstate) (ms : memstate) (cur : diskstate) : @pred valu :=
    [[ cur = replay ms old ]]%pred.

  Theorem firstn_map : forall A B n l (f: A -> B),
    firstn n (map f l) = map f (firstn n l).
  Proof.
    induction n; intros; simpl; auto.
    destruct l.
    reflexivity.
    simpl. rewrite IHn. reflexivity.
  Qed.

  Definition KIn V := InA (@Map.eq_key V).
  Definition KNoDup V := NoDupA (@Map.eq_key V).

  Lemma replay_sel_other : forall a ms m def,
    ~ Map.In a ms -> selN (replay ms m) (wordToNat a) def = selN m (wordToNat a) def.
  Proof.
    (* intros; rename a into a'; remember (wordToNat a') as a. *)
    intros a ms m def HnotIn.
    destruct (MapFacts.elements_in_iff ms a) as [_ Hr].
    assert (not (exists e : valu, InA (Map.eq_key_elt (elt:=valu))
      (a, e) (Map.elements ms))) as HnotElem by auto; clear Hr HnotIn.
    remember (Map.eq_key_elt (elt:=valu)) as eq in *.
    unfold replay, replay'.
    remember (Map.elements ms) as elems in *.
    assert (forall x y, InA eq (x,y) elems -> x <> a) as Hneq. {
      intros x y Hin.
      destruct (addr_as_OT.eq_dec a x); [|intuition].
      destruct HnotElem; exists y; subst; auto.
    }
    clear Heqelems HnotElem.
    induction elems as [|p]; [reflexivity|].
    rewrite <- IHelems; clear IHelems; [|intros; eapply Hneq; right; eauto].
    destruct p as [x y]; simpl.
    assert (x <> a) as Hsep. {
      apply (Hneq x y); left; subst eq.
      apply Equivalence.equiv_reflexive_obligation_1.
      apply MapProperties.eqke_equiv.
    }
    eapply (selN_updN_ne _ y);
      unfold not; intros; destruct Hsep; apply wordToNat_inj; trivial.
  Qed.

  Lemma replay'_length : forall V (l:list (addr * V)) (m:list V),
      length m = length (replay' l m).
    induction l; [trivial|]; intro.
    unfold replay'; simpl.
    rewrite length_upd.
    eapply IHl.
  Qed.

  Lemma InA_NotInA_neq : forall T eq, Equivalence eq -> forall l (x y:T),
      InA eq x l -> ~ (InA eq y l) -> ~ eq x y.
    intros until 0; intros Eqeq; intros until 0; intros HIn HnotIn.
    rewrite InA_altdef, Exists_exists in *.
    intro Hcontra; apply HnotIn; clear HnotIn.
    elim HIn; clear HIn; intros until 0; intros HIn.
    destruct HIn as [HIn Heq_x_x0].
    exists x0. split; [apply HIn|].
    etransitivity; eauto; symmetry; auto.
  Qed.

  Lemma replay'_sel : forall V a (v: V) l m def,
    KNoDup l -> In (a, v) l -> wordToNat a < length m -> sel (replay' l m) a def = v.
  Proof.
    intros until 0; intros HNoDup HIn Hbounds.

    induction l as [|p]; [inversion HIn|]; destruct p as [x y]; simpl.
    destruct HIn. {
      clear IHl.
      injection H; clear H;
        intro H; rewrite H in *; clear H;
        intro H; rewrite H in *; clear H.
      apply selN_updN_eq. rewrite <- replay'_length; assumption.
    } {
      assert (x <> a) as Hneq. {
        inversion HNoDup.
        assert (InA eq (a,v) l). {
          apply In_InA; subst; eauto using MapProperties.eqk_equiv.
        }
      remember (Map.eq_key (elt:=V)) as eq_key in *.
      assert (forall a b, eq a b -> eq_key a b) as Heq_eqk by (
        intros; subst; apply MapProperties.eqk_equiv).
      assert (forall a l, InA eq a l -> InA eq_key a l) as HIn_eq_eqk by (
        intros until 0; intro HInAeq; induction HInAeq; [subst|right]; auto).
      assert (@Equivalence (Map.key*V) eq_key) as Eqeq by (
        subst eq_key; apply MapProperties.eqk_equiv).
      intro Hcontra; destruct
        (@InA_NotInA_neq (Map.key*V) eq_key Eqeq l (a,v) (x,y) (HIn_eq_eqk _ _ H4) H2).
      subst; unfold Map.eq_key; reflexivity.
      }
      unfold sel, upd in *.
      rewrite selN_updN_ne, IHl;
        try trivial;
        match goal with
          | [ H: KNoDup (?a::?l) |- KNoDup ?l ] => inversion H; assumption
          | [ Hneq: ?a<>?b |- wordToNat ?a <> wordToNat ?b] =>
            unfold not; intro Hcontra; destruct (Hneq (wordToNat_inj _  _ Hcontra))
        end.
    }
  Qed.

  Lemma InA_eqke_In : forall V a v l,
    InA (Map.eq_key_elt (elt:=V)) (a, v) l -> In (a, v) l.
  Proof.
    intros.
    induction l.
    inversion H.
    inversion H.
    inversion H1.
    destruct a0; simpl in *; subst.
    left; trivial.
    simpl.
    right.
    apply IHl; auto.
  Qed.

  Lemma mapsto_In : forall V a (v: V) ms,
    Map.MapsTo a v ms -> In (a, v) (Map.elements ms).
  Proof.
    intros.
    apply Map.elements_1 in H.
    apply InA_eqke_In; auto.
  Qed.

  Lemma replay_sel_in : forall a v ms m def,
    Map.MapsTo a v ms -> selN (replay ms m) (wordToNat a) def = v.
  Proof.
    intros.
    apply mapsto_In in H.
    unfold replay.
    apply replay'_sel.
    apply Map.elements_3w.
    auto.
  Qed.

  Lemma replay_sel_invalid : forall a ms m def,
    ~ goodSize addrlen a -> selN (replay ms m) a def = selN m a def.
  Proof.
    intros; unfold goodSize in *.
    destruct (lt_dec a (length m)); [|
      repeat (rewrite selN_oob); unfold replay;
        try match goal with [H: _ |- length (replay' _ _) <= a]
            => rewrite <- replay'_length end;
        auto; omega].
    unfold replay, replay'.
    induction (Map.elements ms); [reflexivity|].
    rewrite <- IHl0; clear IHl0; simpl.
    unfold upd.
    rewrite selN_updN_ne.
  Qed.

  Lemma replay'_len : forall V l m,
    length (@replay' V l m) = length m.
  Proof.
    induction l.
    auto.
    intros.
    simpl.
    rewrite length_upd, IHl.
  Qed.

  Lemma replay_len : forall ms m,
    length (replay ms m) = length m.
  Proof.
    intros.
    unfold replay.
    apply replay'_len.
  Qed.

  Lemma replay_add : forall a v ms m,
    replay (Map.add a v ms) m = upd (replay ms m) a v.
  Proof.
    intros.
    (* Let's show that the lists are equal because [sel] at any index [pos] gives the same valu *)
    eapply list_selN_ext.
    rewrite length_upd.
    repeat rewrite replay_len.
    trivial.

    intros.
    destruct (lt_dec pos (pow2 addrlen)).
    - (* [pos] is a valid address *)
      replace pos with (wordToNat (natToWord addrlen (pos))) by word2nat_auto.
      destruct (weq ($ pos) a).
      + (* [pos] is [a], the address we're updating *)
        erewrite replay_sel_in.
        reflexivity.
        instantiate (default := $0).
        subst.
        unfold upd.
        rewrite selN_updN_eq.
        apply Map.add_1.
        trivial.
        rewrite replay_len in *.
        word2nat_auto.

      + (* [pos] is another address *)
        unfold upd.
        rewrite selN_updN_ne by word2nat_auto.

        case_eq (Map.find $ pos ms).

        (* [pos] is in the transaction *)
        intros w Hf.
        erewrite replay_sel_in.
        reflexivity.
        apply Map.find_2 in Hf.

        erewrite replay_sel_in.
        apply Map.add_2.
        unfold not in *; intros; solve [auto].
        eauto.
        eauto.

        (* [pos] is not in the transaction *)
        Ltac wneq H := intro HeqContra; symmetry in HeqContra; apply H; auto.
        intro Hf;
          repeat (erewrite replay_sel_other);
          try trivial;
          intro HIn; destruct HIn as [x HIn];
          try apply Map.add_3 in HIn;
          try apply Map.find_1 in HIn;
          try wneq n;
          replace (Map.find $ (pos) ms) with (Some x) in Hf; inversion Hf.
    - (* [pos] is an invalid address *)
      rewrite replay_sel_invalid by auto.
      unfold upd.
      rewrite selN_updN_ne by (
        generalize (wordToNat_bound a); intro Hb;
        unfold addr_as_OT.WIDTH in *; omega).
      rewrite replay_sel_invalid by auto; trivial.
  Qed.

  Lemma valid_entries_add : forall a v ms m,
    valid_entries m ms -> indomain' a m -> valid_entries m (Map.add a v ms).
  Proof.
    unfold valid_entries in *.
    intros.
    destruct (weq a a0).
    subst; auto.
    eapply H.
    eapply Map.add_3; eauto.
  Qed.

(* Testing.. *)

Definition do_two_writes a1 a2 v1 v2 rx :=
  Write a1 v1 ;; Write a2 v2 ;; rx tt.

Example two_writes: forall a1 a2 v1 v2 rx rec,
  {{ exists v1' v2' F,
     a1 |-> v1' * a2 |-> v2' * F
   * [[{{ a1 |-> v1 * a2 |-> v2 * F }} rx tt >> rec]]
   * [[{{ (a1 |-> v1' * a2 |-> v2' * F) \/
          (a1 |-> v1 * a2 |-> v2' * F) \/
          (a1 |-> v1 * a2 |-> v2 * F) }} rec >> rec]]
  }} do_two_writes a1 a2 v1 v2 rx >> rec.
Proof.
  unfold do_two_writes.
  hoare.
Qed.

Hint Extern 1 ({{_}} progseq (do_two_writes _ _ _ _) _ >> _) => apply two_writes : prog.

Example read_write: forall a v rx rec,
  {{ exists v' F,
     a |-> v' * F
   * [[{{ a |-> v * F }} (rx v) >> rec]]
   * [[{{ (a |-> v' * F)
       \/ (a |-> v * F) }} rec >> rec]]
  }} Write a v ;; x <- Read a ; rx x >> rec.
Proof.
  hoare.
Qed.

Example four_writes: forall a1 a2 v1 v2 rx rec,
  {{ exists v1' v2' F,
     a1 |-> v1' * a2 |-> v2' * F
   * [[{{ a1 |-> v1 * a2 |-> v2 * F }} rx >> rec]]
   * [[{{ (a1 |-> v1' * a2 |-> v2' * F)
       \/ (a1 |-> v1 * a2 |-> v2' * F)
       \/ (a1 |-> v1 * a2 |-> v2 * F) }} rec >> rec]]
  }} do_two_writes a1 a2 v1 v2 ;; do_two_writes a1 a2 v1 v2 ;; rx >> rec.
Proof.
  hoare.
Qed.

Example inc_up_to_5: forall a rx rec,
  {{ exists v F,
     a |-> v * F
   * [[{{ [[v < 5]] * a |-> (S v) * F
       \/ [[v >= 5]] * a |-> v * F }} rx >> rec]]
   * [[{{ a |-> v * F
       \/ a |-> S v * F }} rec >> rec]]
  }} x <- !a;
  If (lt_dec x 5) {
    a <-- (S x) ;; rx
  } else {
    rx
  } >> rec.
Proof.
  hoare.
Qed.

Example count_up: forall (n:nat) rx rec F,
  {{ F
   * [[ {{ F }} (rx n) >> rec ]]
   * [[ {{ F }} rec >> rec ]]
  }} r <- For i < n
     Loopvar l <- 0
     Continuation lrx
     Invariant
       F * [[ l=i ]]
         * [[ {{ F }} rx n >> rec ]]
         * [[ {{ F }} rec >> rec ]]
     OnCrash
       any
     Begin
       lrx (S l)
     Rof; rx r
  >> rec.
Proof.
  hoare.
Qed.

Require Import Log.

Inductive onestate :=
| One (a: nat).

Module Type ONEINT.
  (* Methods *)
  Parameter read : xparams -> prog nat.
  Parameter write : xparams -> nat -> prog unit.

  Parameter rep : xparams -> onestate -> pred.

  Axiom read_ok : forall xp v,
    {{rep xp (One v) /\
      [DataStart xp <= 3 < DataStart xp + DataLen xp]}}
    (read xp)
    {{r, rep xp (One v)
      /\ [r = Crashed \/ r = Halted v]}}.

  Axiom write_ok : forall xp v0 v,
    {{rep xp (One v0) /\
      [DataStart xp <= 3 < DataStart xp + DataLen xp]}}
    (write xp v)
    {{r, rep xp (One v)
      \/ ([r = Crashed] /\ rep xp (One v0))}}.
End ONEINT.

Module Oneint : ONEINT.
  Definition read xp := $(mem:
    (Call (fun m : mem => Log.begin_ok xp m));;
    x <- (Call (fun m : mem => Log.read_ok xp 3 (m, m)));
    (Call (fun m : mem => Log.commit_ok xp m m));;
    (Halt x)
  ).

  Definition write xp v := $(mem:
    (Call (fun m : mem => Log.begin_ok xp m));;
    (Call (fun m : mem => Log.write_ok xp 3 v (m, upd m 3 v)));;
    (Call (fun m : mem => Log.commit_ok xp m (upd m 3 v)))
  ).

  Definition rep xp (os: onestate) :=
    match os with
    | One a => exists lm,
      Log.rep xp (NoTransaction lm) /\
      [lm (DataStart xp + 3) = a]
    end%pred.

  Theorem read_ok : forall xp a (m:mem),
    {{rep xp (One a) /\
      [DataStart xp <= 3 < DataStart xp + DataLen xp]}}
    (read xp)
    {{r, rep xp (One a)
      /\ [r = Crashed \/ r = Halted a]}}.
  Proof.
    hoare.


Require Import Bool.
Require Import List.

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

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.

Require Import Event.
From PromisingLib Require Import Language.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Thread.
Require Import Configuration.

Require Import Simulation.

Set Implicit Arguments.

Section Compose.
  Variable (ths1 ths2:Threads.t).
  Hypothesis (DISJOINT: Threads.disjoint ths1 ths2).

  Lemma compose_comm:
    Threads.compose ths1 ths2 = Threads.compose ths2 ths1.
  Proof.
    apply IdentMap.eq_leibniz. ii.
    rewrite ? Threads.compose_spec.
    unfold Threads.compose_option.
    destruct (IdentMap.find y ths1) eqn:SRC,
             (IdentMap.find y ths2) eqn:TGT; auto.
    exfalso. inv DISJOINT. eapply THREAD; eauto.
  Qed.

  Lemma compose_forall P:
    (forall tid lang st th (TH: IdentMap.find tid (Threads.compose ths1 ths2) = Some (existT _ lang st, th)),
        (P tid lang st th):Prop) <->
    (forall tid lang st th (TH: IdentMap.find tid ths1 = Some (existT _ lang st, th)),
        (P tid lang st th):Prop) /\
    (forall tid lang st th (TH: IdentMap.find tid ths2 = Some (existT _ lang st, th)),
        (P tid lang st th):Prop).
  Proof.
    econs; i.
    - i. splits.
      + i. eapply H; eauto.
        rewrite Threads.compose_spec. rewrite TH. ss.
      + i. eapply H; eauto.
        rewrite compose_comm.
        rewrite Threads.compose_spec. rewrite TH. ss.
    - des.
      rewrite Threads.compose_spec in TH.
      unfold Threads.compose_option in TH.
      destruct (IdentMap.find tid ths1) eqn:SRC; inv TH.
      + eapply H; eauto.
      + eapply H0; eauto.
  Qed.

  Lemma compose_forall_rev P:
    (forall tid lang st th (TH: IdentMap.find tid ths1 = Some (existT _ lang st, th)),
        (P tid lang st th):Prop) ->
    (forall tid lang st th (TH: IdentMap.find tid ths2 = Some (existT _ lang st, th)),
        (P tid lang st th):Prop) ->
    (forall tid lang st th (TH: IdentMap.find tid (Threads.compose ths1 ths2) = Some (existT _ lang st, th)),
        (P tid lang st th):Prop).
  Proof.
    i. apply compose_forall; auto.
  Qed.

  Lemma compose_is_terminal:
    Threads.is_terminal (Threads.compose ths1 ths2) <->
    Threads.is_terminal ths1 /\ Threads.is_terminal ths2.
  Proof.
    apply compose_forall.
  Qed.

  Lemma compose_threads_wf mem:
    Threads.wf (Threads.compose ths1 ths2) mem <->
    <<CONSISTENT1: Threads.wf ths1 mem>> /\
    <<CONSISTENT2: Threads.wf ths2 mem>>.
  Proof.
    econs; intro X; des; splits; ii.
    - econs; ss.
      + i. eapply X; eauto.
        * rewrite Threads.compose_spec.
          unfold Threads.compose_option.
          rewrite TH1. auto.
        * rewrite Threads.compose_spec.
          unfold Threads.compose_option.
          rewrite TH2. auto.
      + i. eapply X.
        rewrite Threads.compose_spec.
        unfold Threads.compose_option.
        rewrite TH. auto.
    - econs; ss.
      + i. eapply X; eauto.
        * rewrite compose_comm.
          rewrite Threads.compose_spec.
          unfold Threads.compose_option.
          rewrite TH1. auto.
        * rewrite compose_comm.
          rewrite Threads.compose_spec.
          unfold Threads.compose_option.
          rewrite TH2. auto.
      + i. eapply X.
        rewrite compose_comm.
        rewrite Threads.compose_spec.
        unfold Threads.compose_option.
        rewrite TH. auto.
    - inv CONSISTENT1. inv CONSISTENT2. econs; ss.
      + i. rewrite ? Threads.compose_spec in *.
        destruct (IdentMap.find tid1 ths1) eqn:TH11,
                 (IdentMap.find tid1 ths2) eqn:TH12,
                 (IdentMap.find tid2 ths1) eqn:TH21,
                 (IdentMap.find tid2 ths2) eqn:TH22;
          Configuration.simplify;
          try (by eapply DISJOINT; eauto);
          try (by eapply DISJOINT0; eauto);
          try (by eapply DISJOINT1; eauto).
        * symmetry. eapply DISJOINT; eauto.
        * symmetry. eapply DISJOINT; eauto.
      + i. rewrite ? Threads.compose_spec in *.
        unfold Threads.compose_option in *.
        destruct (IdentMap.find tid ths1) eqn:TH1.
        * inv TH. eapply THREADS. eauto.
        * eapply THREADS0. eauto.
  Qed.

  Lemma compose_threads_consistent sc mem:
    Threads.consistent (Threads.compose ths1 ths2) sc mem <->
    <<CONSISTENT1: Threads.consistent ths1 sc mem>> /\
    <<CONSISTENT2: Threads.consistent ths2 sc mem>>.
  Proof.
    econs; intro X; des; splits; ii.
    - eapply X; eauto.
      rewrite Threads.compose_spec.
      unfold Threads.compose_option.
      rewrite TH. auto.
    - eapply X; eauto.
      rewrite compose_comm.
      rewrite Threads.compose_spec.
      unfold Threads.compose_option.
      rewrite TH. auto.
    - rewrite ? Threads.compose_spec in *.
      destruct (IdentMap.find tid ths1) eqn:TH11,
               (IdentMap.find tid ths2) eqn:TH12,
               (IdentMap.find tid ths1) eqn:TH21,
               (IdentMap.find tid ths2) eqn:TH22;
        Configuration.simplify.
      + exfalso. inv DISJOINT. eapply THREAD; eauto.
      + eapply CONSISTENT1; eauto.
      + eapply CONSISTENT2; eauto.
  Qed.

  Lemma compose_wf sc mem:
    Configuration.wf (Configuration.mk (Threads.compose ths1 ths2) sc mem) <->
    <<WF1: Configuration.wf (Configuration.mk ths1 sc mem)>> /\
    <<WF2: Configuration.wf (Configuration.mk ths2 sc mem)>>.
  Proof.
    econs; intro X.
    - inv X. splits; econs; ss.
      + apply compose_threads_wf; auto.
      + apply compose_threads_wf; auto.
    - des. inv WF1. inv WF2. econs; ss.
      apply compose_threads_wf. auto.
  Qed.

  Lemma compose_consistent sc mem:
    Configuration.consistent (Configuration.mk (Threads.compose ths1 ths2) sc mem) <->
    <<CONSISTENT1: Configuration.consistent (Configuration.mk ths1 sc mem)>> /\
    <<CONSISTENT2: Configuration.consistent (Configuration.mk ths2 sc mem)>>.
  Proof.
    econs; intro X.
    - splits; apply compose_threads_consistent; auto.
    - apply compose_threads_consistent. auto.
  Qed.
End Compose.

Lemma compose_step
      ths1 ths2
      e tid sc mem ths' sc' mem'
      (DISJOINT: Threads.disjoint ths1 ths2)
      (STEP: Configuration.step
               e tid
               (Configuration.mk (Threads.compose ths1 ths2) sc mem)
               (Configuration.mk ths' sc' mem')):
  (exists ths1',
      <<NEXT: ths' = Threads.compose ths1' ths2>> /\
      <<STEP: Configuration.step
                e tid
                (Configuration.mk ths1 sc mem)
                (Configuration.mk ths1' sc' mem')>>) \/
  (exists ths2',
      <<NEXT: ths' = Threads.compose ths1 ths2'>> /\
      <<STEP: Configuration.step
                e tid
                (Configuration.mk ths2 sc mem)
                (Configuration.mk ths2' sc' mem')>>).
Proof.
  inv STEP. ss.
  rewrite Threads.compose_spec in TID.
  unfold Threads.compose_option in TID.
  destruct (IdentMap.find tid ths1) eqn:TH1,
           (IdentMap.find tid ths2) eqn:TH2; inv TID.
  - exfalso. inv DISJOINT. eapply THREAD; eauto.
  - left. exists (IdentMap.add tid (existT _ lang st3, lc3) ths1). splits; [|econs; eauto].
    apply IdentMap.eq_leibniz. ii.
    rewrite ? IdentMap.Facts.add_o.
    rewrite ? Threads.compose_spec.
    rewrite ? IdentMap.Facts.add_o.
    condtac; auto.
  - right. exists (IdentMap.add tid (existT _ lang st3, lc3) ths2). splits; [|econs; eauto].
    apply IdentMap.eq_leibniz. ii.
    rewrite ? IdentMap.Facts.add_o.
    rewrite ? Threads.compose_spec.
    rewrite ? IdentMap.Facts.add_o.
    condtac; auto.
    subst. unfold Threads.compose_option. rewrite TH1. auto.
Qed.

Lemma compose_step1
      ths1 ths2
      e tid sc mem ths1' sc' mem'
      (STEP: Configuration.step
               e tid
               (Configuration.mk ths1 sc mem)
               (Configuration.mk ths1' sc' mem'))
      (DISJOINT: Threads.disjoint ths1 ths2)
      (WF1: Configuration.wf (Configuration.mk ths1 sc mem))
      (WF2: Configuration.wf (Configuration.mk ths2 sc mem))
      (CONSISTENT1: Configuration.consistent (Configuration.mk ths1 sc mem))
      (CONSISTENT2: Configuration.consistent (Configuration.mk ths2 sc mem)):
  <<STEP: Configuration.step
            e tid
            (Configuration.mk (Threads.compose ths1 ths2) sc mem)
            (Configuration.mk (Threads.compose ths1' ths2) sc' mem')>> /\
  <<DISJOINT': Threads.disjoint ths1' ths2>> /\
  <<WF2': Configuration.wf (Configuration.mk ths2 sc' mem')>> /\
  <<CONSISTENT2': Configuration.consistent (Configuration.mk ths2 sc' mem')>>.
Proof.
  exploit Configuration.step_disjoint; eauto. s. i. des.
  splits; eauto. inv STEP. ss.
  replace (Threads.compose (IdentMap.add tid (existT _ lang st3, lc3) ths1) ths2)
  with (IdentMap.add tid (existT _ lang st3, lc3) (Threads.compose ths1 ths2)).
  - econs; eauto.
    s. rewrite Threads.compose_spec. unfold Threads.compose_option.
    rewrite TID. auto.
  - apply IdentMap.eq_leibniz. ii.
    rewrite ? IdentMap.Facts.add_o.
    rewrite ? Threads.compose_spec.
    rewrite ? IdentMap.Facts.add_o.
    condtac; auto.
Qed.

Lemma compose_step2
      ths1 ths2
      e tid sc mem ths2' sc' mem'
      (STEP: Configuration.step
               e tid
               (Configuration.mk ths2 sc mem)
               (Configuration.mk ths2' sc' mem'))
      (DISJOINT: Threads.disjoint ths1 ths2)
      (WF1: Configuration.wf (Configuration.mk ths1 sc mem))
      (WF2: Configuration.wf (Configuration.mk ths2 sc mem))
      (CONSISTENT1: Configuration.consistent (Configuration.mk ths1 sc mem))
      (CONSISTENT2: Configuration.consistent (Configuration.mk ths2 sc mem)):
  <<STEP: Configuration.step
            e tid
            (Configuration.mk (Threads.compose ths1 ths2) sc mem)
            (Configuration.mk (Threads.compose ths1 ths2') sc' mem')>> /\
  <<DISJOINT': Threads.disjoint ths1 ths2'>> /\
  <<WF1': Configuration.wf (Configuration.mk ths1 sc' mem')>> /\
  <<CONSISTENT1': Configuration.consistent (Configuration.mk ths1 sc' mem')>>.
Proof.
  exploit Configuration.step_disjoint; try symmetry; eauto. s. i. des.
  exploit compose_step1; try apply STEP; try apply CONSISTENT1; eauto.
  { symmetry. auto. }
  i. des. splits; eauto.
  - rewrite (@compose_comm ths1 ths2); auto.
    rewrite (@compose_comm ths1 ths2'); auto.
    symmetry. auto.
  - symmetry. auto.
Qed.

Lemma compose_opt_step1
      ths1 ths2
      e tid sc mem ths1' sc' mem'
      (STEP: Configuration.opt_step
               e tid
               (Configuration.mk ths1 sc mem)
               (Configuration.mk ths1' sc' mem'))
      (DISJOINT: Threads.disjoint ths1 ths2)
      (WF1: Configuration.wf (Configuration.mk ths1 sc mem))
      (WF2: Configuration.wf (Configuration.mk ths2 sc mem))
      (CONSISTENT1: Configuration.consistent (Configuration.mk ths1 sc mem))
      (CONSISTENT2: Configuration.consistent (Configuration.mk ths2 sc mem)):
  <<STEP: Configuration.opt_step
            e tid
            (Configuration.mk (Threads.compose ths1 ths2) sc mem)
            (Configuration.mk (Threads.compose ths1' ths2) sc' mem')>> /\
  <<DISJOINT': Threads.disjoint ths1' ths2>> /\
  <<WF2': Configuration.wf (Configuration.mk ths2 sc' mem')>> /\
  <<CONSISTENT2': Configuration.consistent (Configuration.mk ths2 sc' mem')>>.
Proof.
  inv STEP.
  - splits; eauto. econs 1.
  - exploit compose_step1; eauto. i. des. splits; eauto. econs 2. auto.
Qed.

Lemma compose_opt_step2
      ths1 ths2
      e tid sc mem ths2' sc' mem'
      (STEP: Configuration.opt_step
               e tid
               (Configuration.mk ths2 sc mem)
               (Configuration.mk ths2' sc' mem'))
      (DISJOINT: Threads.disjoint ths1 ths2)
      (WF1: Configuration.wf (Configuration.mk ths1 sc mem))
      (WF2: Configuration.wf (Configuration.mk ths2 sc mem))
      (CONSISTENT1: Configuration.consistent (Configuration.mk ths1 sc mem))
      (CONSISTENT2: Configuration.consistent (Configuration.mk ths2 sc mem)):
  <<STEP: Configuration.opt_step
            e tid
            (Configuration.mk (Threads.compose ths1 ths2) sc mem)
            (Configuration.mk (Threads.compose ths1 ths2') sc' mem')>> /\
  <<DISJOINT': Threads.disjoint ths1 ths2'>> /\
  <<WF1': Configuration.wf (Configuration.mk ths1 sc' mem')>> /\
  <<CONSISTENT1': Configuration.consistent (Configuration.mk ths1 sc' mem')>>.
Proof.
  inv STEP.
  - splits; eauto. econs 1.
  - exploit compose_step2; eauto. i. des. splits; eauto. econs 2. auto.
Qed.

Lemma compose_rtc_step1
      c1 c2 ths
      (STEPS: rtc Configuration.tau_step c1 c2)
      (DISJOINT: Threads.disjoint c1.(Configuration.threads) ths)
      (WF1: Configuration.wf c1)
      (WF: Configuration.wf (Configuration.mk ths c1.(Configuration.sc) c1.(Configuration.memory)))
      (CONSISTENT1: Configuration.consistent c1)
      (CONSISTENT: Configuration.consistent (Configuration.mk ths c1.(Configuration.sc) c1.(Configuration.memory))):
  <<STEPS: rtc Configuration.tau_step
               (Configuration.mk (Threads.compose c1.(Configuration.threads) ths) c1.(Configuration.sc) c1.(Configuration.memory))
               (Configuration.mk (Threads.compose c2.(Configuration.threads) ths) c2.(Configuration.sc) c2.(Configuration.memory))>> /\
  <<DISJOINT': Threads.disjoint c2.(Configuration.threads) ths>> /\
  <<WF': Configuration.wf (Configuration.mk ths c2.(Configuration.sc) c2.(Configuration.memory))>> /\
  <<CONSISTENT': Configuration.consistent (Configuration.mk ths c2.(Configuration.sc) c2.(Configuration.memory))>>.
Proof.
  revert CONSISTENT1 CONSISTENT. induction STEPS; auto. i. inv H.
  exploit Configuration.step_future; eauto. i. des.
  exploit Configuration.step_disjoint; eauto. i. des.
  destruct x, y. exploit compose_step1; eauto. s. i. des.
  exploit IHSTEPS; eauto. s. i. des.
  splits; eauto.
  econs; eauto. econs. eauto.
Qed.

Lemma compose_rtc_step2
      c1 c2 ths
      (STEPS: rtc Configuration.tau_step c1 c2)
      (DISJOINT: Threads.disjoint ths c1.(Configuration.threads))
      (WF1: Configuration.wf c1)
      (WF: Configuration.wf (Configuration.mk ths c1.(Configuration.sc) c1.(Configuration.memory)))
      (CONSISTENT1: Configuration.consistent c1)
      (CONSISTENT: Configuration.consistent (Configuration.mk ths c1.(Configuration.sc) c1.(Configuration.memory))):
  <<STEPS: rtc Configuration.tau_step
               (Configuration.mk (Threads.compose ths c1.(Configuration.threads)) c1.(Configuration.sc) c1.(Configuration.memory))
               (Configuration.mk (Threads.compose ths c2.(Configuration.threads)) c2.(Configuration.sc) c2.(Configuration.memory))>> /\
  <<DISJOINT': Threads.disjoint ths c2.(Configuration.threads)>> /\
  <<WF': Configuration.wf (Configuration.mk ths c2.(Configuration.sc) c2.(Configuration.memory))>> /\
  <<CONSISTENT': Configuration.consistent (Configuration.mk ths c2.(Configuration.sc) c2.(Configuration.memory))>>.
Proof.
  revert CONSISTENT1 CONSISTENT. induction STEPS; auto. i. inv H.
  exploit Configuration.step_future; eauto. i. des.
  exploit Configuration.step_disjoint; try symmetry; eauto. i. des.
  destruct x, y. exploit compose_step2; eauto. s. i. des.
  exploit IHSTEPS; try symmetry; eauto. s. i. des.
  splits; eauto.
  econs; eauto. econs. eauto.
Qed.

Lemma sim_compose
      ths1_src ths2_src sc0_src mem0_src
      ths1_tgt ths2_tgt sc0_tgt mem0_tgt
      (DISJOINT_SRC: Threads.disjoint ths1_src ths2_src)
      (DISJOINT_TGT: Threads.disjoint ths1_tgt ths2_tgt)
      (SIM1: sim ths1_src sc0_src mem0_src ths1_tgt sc0_tgt mem0_tgt)
      (SIM2: sim ths2_src sc0_src mem0_src ths2_tgt sc0_tgt mem0_tgt):
  sim (Threads.compose ths1_src ths2_src) sc0_src mem0_src
      (Threads.compose ths1_tgt ths2_tgt) sc0_tgt mem0_tgt.
Proof.
  revert
    ths1_src ths2_src sc0_src mem0_src
    ths1_tgt ths2_tgt sc0_tgt mem0_tgt
    DISJOINT_SRC DISJOINT_TGT
    SIM1 SIM2.
  pcofix CIH. i. pfold. ii.
  apply compose_wf in WF_SRC; auto.
  apply compose_wf in WF_TGT; auto.
  apply compose_consistent in CONSISTENT_SRC; auto.
  apply compose_consistent in CONSISTENT_TGT; auto.
  des. splits; i.
  - punfold SIM1. exploit SIM1; try apply SC1; eauto. i. des.
    apply compose_is_terminal in TERMINAL_TGT; auto. des.
    exploit TERMINAL; eauto. i. des.
    exploit Configuration.rtc_step_future; eauto. s. i. des.
    exploit Configuration.rtc_step_disjoint; eauto. s. i. des.
    exploit compose_rtc_step1; eauto. s. i. des.
    punfold SIM2. exploit SIM2; try apply SC; eauto.
    { etrans; eauto. }
    { etrans; eauto. }
    i. des.
    exploit TERMINAL0; eauto. i. des.
    exploit Configuration.rtc_step_future; eauto. s. i. des.
    exploit Configuration.rtc_step_disjoint; try symmetry; eauto. s. i. des.
    exploit compose_rtc_step2; eauto. s. i. des.
    esplits.
    + etrans; eauto.
    + eauto.
    + eauto.
    + apply compose_is_terminal; auto.
  - apply compose_step in STEP_TGT; auto. des; subst.
    + exploit Configuration.step_future; eauto. s. i. des.
      exploit Configuration.step_disjoint; eauto. s. i. des.
      punfold SIM1. exploit SIM1; try apply SC1; eauto. i. des.
      exploit STEP0; eauto. i. des. inv SIM; [|done].
      exploit Configuration.rtc_step_future; eauto. s. i. des.
      exploit Configuration.rtc_step_disjoint; eauto. s. i. des.
      exploit compose_rtc_step1; eauto. s. i. des.
      exploit Configuration.opt_step_future; eauto. s. i. des.
      exploit Configuration.opt_step_disjoint; eauto. s. i. des.
      exploit compose_opt_step1; eauto. i. des.
      esplits; eauto.
      right. apply CIH; auto.
      eapply sim_future; eauto.
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
    + exploit Configuration.step_future; eauto. s. i. des.
      exploit Configuration.step_disjoint; try symmetry; eauto. s. i. des.
      punfold SIM2. exploit SIM2; try apply SC1; eauto. i. des.
      exploit STEP0; eauto. i. des. inv SIM; [|done].
      exploit Configuration.rtc_step_future; eauto. s. i. des.
      exploit Configuration.rtc_step_disjoint; try symmetry; eauto. s. i. des.
      exploit compose_rtc_step2; eauto. s. i. des.
      exploit Configuration.opt_step_future; eauto. s. i. des.
      exploit Configuration.opt_step_disjoint; eauto. s. i. des.
      exploit compose_opt_step2; eauto. i. des.
      esplits; eauto.
      right. apply CIH; auto.
      { symmetry. auto. }
      eapply sim_future; eauto.
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
      * repeat (etrans; eauto).
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 Behavior.
Require Import Single.

Require Import OrdStep.
Require Import RARace.
Require Import SCStep.
Require Import Stable.

Require Import MemoryProps.
Require Import Mapping.
Require Import SplitCertification.

Require Import LocalDRFRA.

Section SIM.

  Variable L: Loc.t -> bool.

  Lemma ra_program_step_sc_program_step_or_race lang
        (th0 th1: Thread.t lang) e
        (STEP: OrdThread.program_step L Ordering.acqrel e th0 th1)
    :
      (<<STEP: SCThread.program_step L e th0 th1>>) \/
      (<<RACE: SCRace.race L th0>>).
  Proof.
    destruct (classic (SCRace.race L th0)) as [RACE|RACE]; auto.
    left. inv STEP. econs; eauto. inv LOCAL; ss.
    - econs; eauto.
    - inv LOCAL0. econs; eauto. econs; eauto.
      i. destruct (Time.le_lt_dec to' ts); auto. exfalso. eapply RACE.
      unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
      inv STEP. inv READABLE. eapply TimeFacts.le_lt_lt; eauto.
      eapply RLX. des_ifs. etrans; [|eapply Ordering.join_r]. auto.
    - inv LOCAL0. econs; eauto. econs; eauto.
      i. destruct (Time.le_lt_dec to to'); auto. exfalso. eapply RACE.
      unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
      inv STEP. inv WRITABLE. eapply TimeFacts.lt_le_lt; eauto.
    - inv LOCAL1. inv LOCAL2. econs; eauto.
      + econs; eauto.
        i. destruct (Time.le_lt_dec to' tsr); auto. exfalso. eapply RACE.
        unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
        inv STEP. inv READABLE. eapply TimeFacts.le_lt_lt; eauto.
        eapply RLX. des_ifs. etrans; [|eapply Ordering.join_r]. auto.
      + econs; eauto.
        i. destruct (Time.le_lt_dec tsw to'); auto. exfalso. eapply RACE.
        unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
        inv STEP0. inv WRITABLE. eapply TimeFacts.lt_le_lt; eauto.
        eapply TimeFacts.le_lt_lt; eauto. inv STEP. ss.
        etrans; [|eapply Time.join_l]. eapply Time.join_l.
    - econs; eauto.
    - econs; eauto.
    - econs; eauto.
  Qed.

  Lemma ra_thread_step_sc_thread_step_or_race lang
        (th0 th1: Thread.t lang) pf e
        (STEP: OrdThread.step L Ordering.acqrel pf e th0 th1)
    :
      (<<STEP: SCThread.step L pf e th0 th1>>) \/
      (<<RACE: SCRace.race L th0>>).
  Proof.
    inv STEP.
    - left. econs; eauto.
    - eapply ra_program_step_sc_program_step_or_race in STEP0.
      des; auto. left. econs 2; eauto.
  Qed.

  Lemma ra_thread_opt_step_sc_thread_opt_step_or_race lang
        (th0 th1: Thread.t lang) e
        (STEP: OrdThread.opt_step L Ordering.acqrel e th0 th1)
    :
      (<<STEP: SCThread.opt_step L e th0 th1>>) \/
      (<<RACE: SCRace.race L th0>>).
  Proof.
    inv STEP.
    - left. econs; eauto.
    - eapply ra_thread_step_sc_thread_step_or_race in STEP0.
      des; auto. left. econs 2; eauto.
  Qed.

  Lemma ra_thread_tau_steps_sc_thread_tau_steps_or_race lang
        (th0 th1: Thread.t lang)
        (STEPS: rtc (OrdThread.tau_step L Ordering.acqrel) th0 th1)
    :
      (<<STEPS: rtc (SCThread.tau_step L) th0 th1>>) \/
      (exists th',
          (<<STEPS0: rtc (SCThread.tau_step L) th0 th'>>) /\
          (<<STEPS1: rtc (OrdThread.tau_step L Ordering.acqrel) th' th1>>) /\
          (<<RACE: SCRace.race L th'>>)).
  Proof.
    induction STEPS; eauto. dup H. inv H. inv TSTEP.
    eapply ra_thread_step_sc_thread_step_or_race in STEP; eauto. des.
    - left. econs; eauto. econs; eauto. econs; eauto.
    - right. exists th'. esplits; eauto. econs; eauto. econs; eauto. econs; eauto.
    - right. exists x. esplits; eauto.
    - right. exists x. esplits; eauto.
  Qed.

  Lemma ra_thread_all_steps_sc_thread_all_steps_or_race lang
        (th0 th1: Thread.t lang)
        (STEPS: rtc (OrdThread.all_step L Ordering.acqrel) th0 th1)
    :
      (<<STEPS: rtc (SCThread.all_step L) th0 th1>>) \/
      (exists th',
          (<<STEPS0: rtc (SCThread.all_step L) th0 th'>>) /\
          (<<STEPS1: rtc (OrdThread.all_step L Ordering.acqrel) th' th1>>) /\
          (<<RACE: SCRace.race L th'>>)).
  Proof.
    induction STEPS; eauto. dup H. inv H. inv USTEP.
    eapply ra_thread_step_sc_thread_step_or_race in STEP; eauto. des.
    - left. econs; eauto. econs; eauto. econs; eauto.
    - right. exists th'. esplits; eauto. econs; eauto. econs; eauto. econs; eauto.
    - right. exists x. esplits; eauto.
    - right. exists x. esplits; eauto.
  Qed.

  Lemma cap_step_current_step
        pf e lang (e0 e1: Thread.t lang) fe0
        (THREAD: thread_map ident_map e0 fe0)
        (STEP: SCThread.step L pf e 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 fe fe1,
          (<<THREAD: thread_map ident_map e1 fe1>>) /\
          (<<STEP: SCThread.step L pf fe fe0 fe1>>) /\
          (<<EVENT: tevent_map ident_map fe e>>)) \/
      (<<RACE: SCRace.race L fe0>>)
  .
  Proof.
    destruct (classic (SCRace.race L fe0)) as [RACE|RACE]; auto. left.
    assert (MAPLT: mapping_map_lt ident_map).
    { eapply ident_map_lt. }
    assert (MAPLE: mapping_map_le ident_map).
    { eapply ident_map_le. }
    assert (MAPEQ: mapping_map_eq ident_map).
    { eapply ident_map_eq. }

    inv THREAD. ss. inv STEP.
    { inv STEP0. inv LOCAL1.
      exploit promise_map; try apply PROMISE; eauto; ss.
      { eapply FLOCAL. }
      { eapply LOCAL0. }
      { eapply mapping_map_lt_non_collapsable; eauto. }
      { eapply ident_map_message. }
      i. des. inv LOCAL0.
      eexists _, (Thread.mk _ st (Local.mk (Local.tview flc) fprom1) fsc fmem1).
      esplits; eauto.
      { econs; eauto.
        { econs; eauto. }
        { eapply mapping_map_lt_collapsable_unwritable; eauto. }
      }
      { econs 1. econs.
        { econs; eauto. eapply closed_message_map; eauto.
          eapply ident_map_message. }
        { inv KIND; ss. inv MSG; ss. }
        { ii. clarify. exploit PF; eauto. }
      }
      { econs; eauto; ss. eapply ident_map_message. }
    }
    { inv STEP0. inv LOCAL1.
      { esplits; eauto.
        { econs; eauto. }
        { econs 2; eauto. econs; eauto. econs 1; eauto. }
        { econs; eauto. }
      }
      { inv LOCAL2. exploit read_step_map; eauto.
        { eapply ident_map_bot. }
        { eapply FLOCAL. } i. des.
        exists (ThreadEvent.read loc fto val freleased ord). esplits.
        { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
        { econs 2; eauto. econs; eauto. econs 2; eauto. econs; eauto.
          ii. destruct (Time.le_lt_dec to' fto); auto. exfalso. eapply RACE.
          unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
          inv READ. inv READABLE. eapply TimeFacts.le_lt_lt; eauto.
          eapply RLX; eauto. des_ifs. etrans; [|eapply Ordering.join_r]. auto.
        }
        { econs; eauto. }
      }
      { inv LOCAL2. hexploit write_step_map; try eassumption; eauto.
        { eapply ident_map_bot. }
        { eapply FLOCAL. }
        { eapply FLOCAL. }
        { econs 2. }
        { refl. }
        { refl. }
        { eapply mapping_map_lt_non_collapsable; eauto. }
        i. des.
        exists (ThreadEvent.write loc from to val freleasedw ord). esplits.
        { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
        { econs 2; eauto. econs; eauto. econs 3; eauto. econs; eauto.
          ii. destruct (Time.le_lt_dec to to'); auto. exfalso. eapply RACE.
          unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
          inv WRITE. inv WRITABLE. eapply TimeFacts.lt_le_lt; eauto.
        }
        { econs; eauto; ss. }
      }
      { inv LOCAL2. inv LOCAL3. exploit read_step_map; eauto.
        { eapply ident_map_bot. }
        { eapply FLOCAL. } i. des.
        hexploit Local.read_step_future; try apply STEP; eauto. i. des.
        hexploit Local.read_step_future; try apply READ; eauto. i. des.
        hexploit write_step_map; try eapply STEP0; try eassumption; eauto.
        { eapply ident_map_bot. }
        { eapply WF0. }
        { eapply WF0. }
        { eapply mapping_map_lt_collapsable_unwritable; eauto. }
        { refl. }
        { eapply mapping_map_lt_non_collapsable; eauto. }
        i. des.
        exists (ThreadEvent.update loc fto tsw valr valw freleased freleasedw ordr ordw). esplits.
        { econs; eauto. eapply mapping_map_lt_collapsable_unwritable; eauto. }
        { econs 2; eauto. econs; eauto. econs 4; eauto.
          { econs; eauto.
            ii. destruct (Time.le_lt_dec to' fto); auto. exfalso. eapply RACE.
            unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
            inv READ. inv READABLE. eapply TimeFacts.le_lt_lt; eauto.
            eapply RLX; eauto. des_ifs. etrans; [|eapply Ordering.join_r]. auto.
          }
          { econs; eauto.
            ii. destruct (Time.le_lt_dec tsw to'); auto. exfalso. eapply RACE.
            unfold SCRace.race, SCLocal.non_maximal. esplits; eauto; ss.
            inv WRITE. inv WRITABLE. eapply TimeFacts.lt_le_lt; eauto.
            eapply TimeFacts.le_lt_lt; eauto. eapply TVIEW_FUTURE0.
          }
        }
        { econs; eauto; ss. }
      }
      { inv LOCAL2. exploit fence_step_map; try apply FENCE; eauto.
        { eapply ident_map_bot. }
        { eapply FLOCAL. } i. des.
        exists (ThreadEvent.fence ordr ordw). esplits.
        { econs; eauto. }
        { econs 2; eauto. econs; eauto. econs 5; eauto. }
        { econs; eauto; ss. }
      }
      { inv LOCAL2. exploit fence_step_map; eauto.
        { eapply ident_map_bot. }
        { eapply FLOCAL. } i. des.
        exists (ThreadEvent.syscall e0). esplits.
        { econs; eauto. }
        { econs 2; eauto. econs; eauto. econs 6; eauto. }
        { econs; eauto; ss. }
      }
      { inv LOCAL2. exploit failure_step_map; eauto. i.
        exists (ThreadEvent.failure). esplits.
        { econs; eauto. }
        { econs 2; eauto. econs; eauto. econs 7; eauto. }
        { econs; eauto; ss. }
      }
    }
  Qed.

  Lemma sc_race_map f lang (th0 fth0: Thread.t lang)
        (RACE: SCRace.race L th0)
        (THREAD: thread_map f th0 fth0)
        (MAPLT: mapping_map_lt f)
    :
      SCRace.race L fth0.
  Proof.
    unfold SCRace.race, SCLocal.non_maximal in *. des. inv THREAD. ss.
    eapply MEM in GET. des; ss. inv MSG. inv MSGLE.
    esplits; eauto. inv LOCAL. inv TVIEWLE. inv CUR. specialize (RLX loc).
    eapply TimeFacts.le_lt_lt; eauto.
    eapply (@MAPLT loc (View.rlx (TView.cur (Local.tview lc)) loc) to (View.rlx (TView.cur ftv') loc) fto); eauto.
    eapply TVIEW.
  Qed.

  Lemma cap_tau_steps_current_tau_steps
        lang (e0 e1: Thread.t lang) fe0
        (THREAD: thread_map ident_map e0 fe0)
        (STEPS: rtc (SCThread.tau_step L) 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>>) /\
          (<<STEP: rtc (SCThread.tau_step L) fe0 fe1>>)) \/
      (exists e' fe',
          (<<FSTEPS: rtc (SCThread.tau_step L) fe0 fe'>>) /\
          (<<STEPS0: rtc (SCThread.tau_step L) e0 e'>>) /\
          (<<STEPS1: rtc (SCThread.tau_step L) e' e1>>) /\
          (<<THREAD: thread_map ident_map e' fe'>>) /\
          (<<RACE: SCRace.race L fe'>>)).
  Proof.
    ginduction STEPS; i.
    { left. esplits; eauto. }
    dup H. inv H. inv TSTEP. exploit cap_step_current_step; eauto.
    i. des.
    - exploit SCThread.step_future; try apply STEP; eauto. i. des.
      exploit SCThread.step_future; try apply STEP0; eauto. i. des.
      exploit IHSTEPS; eauto. i. des.
      + left. esplits; eauto. econs; eauto. econs.
        * econs; eauto.
        * erewrite <- EVENT. inv EVENT0; eauto.
      + right. exists e', fe'. esplits; eauto. econs; eauto. econs.
        * econs; eauto.
        * erewrite <- EVENT. inv EVENT0; eauto.
    - right. esplits; eauto.
  Qed.

  Lemma cap_race_current_race
        lang (e0 e1: Thread.t lang) cap max
        (CAP: Memory.cap (Thread.memory e0) cap)
        (MAX: Memory.max_concrete_timemap cap max)
        (STEPS: rtc (SCThread.tau_step L) (Thread.mk _ (Thread.state e0) (Thread.local e0) max cap) e1)
        (LOCAL: Local.wf (Thread.local e0) (Thread.memory e0))
        (MEMORY: Memory.closed (Thread.memory e0))
        (SC: Memory.closed_timemap (Thread.sc e0) (Thread.memory e0))
        (CONSISTENT: Local.promise_consistent (Thread.local e1))
        (RACE: SCRace.race L e1)
    :
      exists e2,
        (<<STEPS: rtc (SCThread.tau_step L) e0 e2>>) /\
        (<<CONSISTENT: Local.promise_consistent (Thread.local e2)>>) /\
        (<<RACE: SCRace.race L e2>>).
  Proof.
    exploit cap_tau_steps_current_tau_steps.
    { econs.
      { eapply ident_map_local. }
      { instantiate (1:=(Thread.memory e0)). instantiate (1:=cap). econs.
        - i. eapply Memory.cap_inv in GET; eauto. des; clarify; auto.
          right. exists to, from, msg, msg.
          esplits; eauto; try refl. eapply ident_map_message.
        - i. left.
          exists fto, ffrom, fto, ffrom. esplits; eauto; try refl.
          i. econs; eauto. eapply Memory.cap_le; eauto. refl.
      }
      { eapply mapping_map_lt_collapsable_unwritable. eapply ident_map_lt. }
      { eapply ident_map_timemap. }
      { instantiate (1:=max). instantiate (1:=(Thread.sc e0)).
        eapply Memory.max_concrete_timemap_spec; eauto.
        eapply Memory.cap_closed_timemap; eauto. }
    }
    { eauto. }
    { eapply Local.cap_wf; eauto. }
    { eauto. }
    { eapply Memory.cap_closed; eauto. }
    { eauto. }
    { eapply Memory.max_concrete_timemap_closed; eauto. }
    { eauto. }
    i. des.
    - exists fe1. esplits.
      + destruct e0. ss.
      + destruct e1, fe1. destruct local, local0. ss. inv THREAD.
        inv LOCAL0. ss.
        eapply promise_consistent_mon.
        { eapply promise_consistent_map; eauto.
          { eapply ident_map_le. }
          { eapply ident_map_eq. }
        }
        { eauto. }
        { refl. }
      + eapply sc_race_map; eauto. eapply ident_map_lt.
    - assert (CONSISTENT0: Local.promise_consistent (Thread.local e')).
      { exploit SCThread.rtc_tau_step_future; try apply STEPS0; eauto.
        { eapply Local.cap_wf; eauto. }
        { eapply Memory.max_concrete_timemap_closed; eauto. }
        { eapply Memory.cap_closed; eauto. }
        i. des. ss. eapply SCThread.rtc_tau_step_promise_consistent; eauto.
      }
      exists fe'. esplits.
      + destruct e0. ss.
      + destruct e', fe'. destruct local, local0. ss. inv THREAD.
        inv LOCAL0. ss.
        eapply promise_consistent_mon.
        { eapply promise_consistent_map; eauto.
          { eapply ident_map_le. }
          { eapply ident_map_eq. }
        }
        { eauto. }
        { refl. }
      + auto.
  Qed.

  Lemma ord_thread_consistent_promise_consistent lang
        (th0: Thread.t lang)
        (CONSISTENT: OrdThread.consistent L Ordering.acqrel th0)
        (LOCAL: Local.wf (Thread.local th0) (Thread.memory th0))
        (MEMORY: Memory.closed (Thread.memory th0))
        (SC: Memory.closed_timemap (Thread.sc th0) (Thread.memory th0))
    :
      Local.promise_consistent (Thread.local th0).
  Proof.
    hexploit (@Memory.cap_exists (Thread.memory th0)); eauto. intros [cap CAP].
    hexploit (@Memory.max_concrete_timemap_exists cap); eauto.
    { eapply Memory.cap_closed; eauto. } intros [max MAX].
    exploit CONSISTENT; eauto. i. des.
    { unfold OrdThread.steps_failure in FAILURE. des.
      eapply OrdThread.rtc_tau_step_promise_consistent in STEPS; eauto.
      { eapply Local.cap_wf; eauto. }
      { eapply Memory.max_concrete_timemap_closed; eauto. }
      { eapply Memory.cap_closed; eauto. }
      { inv FAILURE0; inv STEP. inv LOCAL0. inv LOCAL1. ss. }
    }
    { eapply OrdThread.rtc_tau_step_promise_consistent in STEPS; eauto.
      { eapply Local.cap_wf; eauto. }
      { eapply Memory.max_concrete_timemap_closed; eauto. }
      { eapply Memory.cap_closed; eauto. }
      { eapply Local.bot_promise_consistent; eauto. }
    }
  Qed.

  Lemma ra_thread_consistent_sc_thread_consistent_or_race lang
        (th0: Thread.t lang)
        (CONSISTENT: OrdThread.consistent L Ordering.acqrel th0)
        (LOCAL: Local.wf (Thread.local th0) (Thread.memory th0))
        (MEMORY: Memory.closed (Thread.memory th0))
        (SC: Memory.closed_timemap (Thread.sc th0) (Thread.memory th0))
    :
      (<<CONSISTENT: SCThread.consistent L th0>>) \/
      (exists th1,
          (<<STEPS: rtc (SCThread.tau_step L) th0 th1>>) /\
          (<<CONSISTENT: Local.promise_consistent (Thread.local th1)>>) /\
          (<<RACE: SCRace.race L th1>>)).
  Proof.
    destruct (classic (exists th1,
                          (<<STEPS: rtc (SCThread.tau_step L) th0 th1>>) /\
                          (<<CONSISTENT: Local.promise_consistent (Thread.local th1)>>) /\
                          (<<RACE: SCRace.race L th1>>))) as [RACE|RACE]; auto.
    left. ii. exploit CONSISTENT; eauto. i. des.
    - unfold OrdThread.steps_failure in *. des.
      left. unfold SCThread.steps_failure.
      eapply ra_thread_tau_steps_sc_thread_tau_steps_or_race in STEPS. des.
      + inv FAILURE0; inv STEP. inv LOCAL0. inv LOCAL1.
        esplits; eauto. econs 2; eauto; ss. econs; eauto. econs; eauto.
      + exfalso. eapply RACE.
        eapply cap_race_current_race; eauto.
        exploit SCThread.rtc_tau_step_future; try apply STEPS0; eauto.
        { eapply Local.cap_wf; eauto. }
        { eapply Memory.max_concrete_timemap_closed; eauto. }
        { eapply Memory.cap_closed; eauto. }
        i. des. ss. eapply OrdThread.rtc_tau_step_promise_consistent; eauto.
        inv FAILURE0; inv STEP. inv LOCAL0. inv LOCAL1. ss.
    - right. eapply ra_thread_tau_steps_sc_thread_tau_steps_or_race in STEPS. des.
      + esplits; eauto.
      + exfalso. eapply RACE.
        eapply cap_race_current_race; eauto.
        exploit SCThread.rtc_tau_step_future; try apply STEPS0; eauto.
        { eapply Local.cap_wf; eauto. }
        { eapply Memory.max_concrete_timemap_closed; eauto. }
        { eapply Memory.cap_closed; eauto. }
        i. des. ss. eapply OrdThread.rtc_tau_step_promise_consistent; eauto.
        eapply Local.bot_promise_consistent; eauto.
  Qed.

  Lemma ra_configuration_step_sc_configuration_step_or_race e tid c0 c1
        (STEP: OrdConfiguration.step L Ordering.acqrel e tid c0 c1)
        (WF: Configuration.wf c0)
    :
      (<<STEP: SCConfiguration.step L e tid c0 c1>>) \/
      (<<RACE: SCRace.race_steps L c0 tid>>).
  Proof.
    destruct (classic (SCRace.race_steps L c0 tid)) as [RACE|RACE]; auto. left.
    inv STEP.
    exploit Thread.rtc_cancel_step_future; eauto; try eapply WF; eauto. i. des. ss.
    assert ((<<LOCAL: Local.wf lc4 memory4>>) /\
            (<<MEMORY: Memory.closed memory4>>) /\
            (<<CLOSED: Memory.closed_timemap sc4 memory4>>)).
    { inv STEP0.
      - exploit Thread.rtc_reserve_step_future; eauto. i. des. ss.
      - exploit OrdThread.step_future; eauto. i. des. ss.
        exploit Thread.rtc_reserve_step_future; eauto. i. des. ss.
    } des.

    assert ((<<CONSISTENT: Local.promise_consistent (Thread.local e2)>>) /\
            (<<CONSISTENT: Local.promise_consistent lc4>>)).
    { destruct (classic (e = ThreadEvent.failure)).
      - clarify. inv STEP0. inv STEP; inv STEP0. inv LOCAL0. inv LOCAL1. splits; auto.
        eapply PromiseConsistent.rtc_reserve_step_promise_consistent2 in RESERVES; eauto.
      - hexploit ord_thread_consistent_promise_consistent; eauto. i. ss. splits; eauto.
        eapply PromiseConsistent.rtc_reserve_step_promise_consistent in RESERVES; eauto.
        inv STEP0; auto. eapply OrdThread.step_promise_consistent in STEP; eauto.
    }

    exploit ra_thread_opt_step_sc_thread_opt_step_or_race; try apply STEP0.
    i. des; cycle 1.
    { exfalso. eapply RACE. unfold SCRace.race_steps. esplits.
      + eauto.
      + eapply rtc_implies; try apply CANCELS. i.
        inv H. inv STEP; [|inv STEP1; inv LOCAL0]. econs; eauto.
        * econs; eauto. econs 1; eauto. ii. clarify.
        (* * ss. *)
      + eauto.
      + eauto.
    }

    econs; eauto. i.
    hexploit ra_thread_consistent_sc_thread_consistent_or_race; eauto; ss. i. des; ss.
    destruct (ThreadEvent.get_machine_event e) eqn:EVENT.
    { exfalso. eapply RACE. unfold SCRace.race_steps. esplits.
      + eauto.
      + etrans.
        { eapply rtc_implies; try apply CANCELS. i.
          inv H0. inv STEP1; [|inv STEP2; inv LOCAL0]. econs.
          * econs; eauto. econs 1; eauto. ii. clarify.
          (* * ss. *)
        } etrans.
        { instantiate (1:=e3). inv STEP; eauto. econs; eauto.
          econs; eauto. econs; eauto. } etrans.
        { eapply rtc_implies; try apply RESERVES. i.
          inv H0. inv STEP1; [|inv STEP2; inv LOCAL0]. econs.
          * econs; eauto. econs 1; eauto. ii. clarify.
          (* * ss. *)
        }
        { eapply rtc_implies; try apply STEPS. i. inv H0. econs; eauto. }
      + eauto.
      + eauto.
    }
    { destruct e; clarify. inv STEP. inv STEP1; inv STEP.
      inv LOCAL0. inv LOCAL1. hexploit PROMISES; eauto. ii. right. ss.
      hexploit reserve_steps_le_cancel_steps.
      { eapply RESERVES. }
      { eapply Memory.cap_le; eauto. refl. }
      i. des. esplits.
      { eapply rtc_implies; try apply STEPS0; eauto. i.
        inv H1. inv STEP; [|inv STEP1; inv LOCAL1]. econs.
        * econs; eauto. econs 1; eauto. ii. clarify.
        * ss.
      }
      erewrite LOCAL0. eauto.
    }
    { destruct e; ss. }
  Qed.

  Lemma ra_configuration_steps_sc_configuration_steps_or_race c0 c1
        (STEPS: rtc (OrdConfiguration.all_step L Ordering.acqrel) c0 c1)
        (WF: Configuration.wf c0)
    :
      (<<STEPS: rtc (SCConfiguration.all_step L) c0 c1>>) \/
      (exists c' tid,
          (<<STEPS: rtc (SCConfiguration.all_step L) c0 c'>>) /\
          (<<RACE: SCRace.race_steps L c' tid>>)).
  Proof.
    ginduction STEPS; eauto. i. inv H.
    eapply ra_configuration_step_sc_configuration_step_or_race in STEP; eauto. des.
    { exploit SCConfiguration.step_future; eauto. i. des.
      exploit IHSTEPS; eauto. i. des.
      { left. econs; eauto. econs; eauto. }
      { right. esplits; [|eapply RACE]. econs; eauto. econs; eauto. }
    }
    { right. esplits; eauto. }
  Qed.

  Lemma ra_behavior_sc_behavior_or_race c
        (RACEFREE: SCRace.racefree L c)
        (WF: Configuration.wf c)
    :
      behaviors (@OrdConfiguration.machine_step L Ordering.acqrel) c <1=
      behaviors (@SCConfiguration.machine_step L) c.
  Proof.
    i. ginduction PR; eauto; i.
    - econs 1; eauto.
    - inv STEP.
      eapply ra_configuration_step_sc_configuration_step_or_race in STEP0; eauto. des.
      + econs 2; eauto.
        * rewrite <- H0. econs; eauto.
        * eapply IHPR; eauto.
          { eapply SCRace.step_racefree; eauto. }
          { eapply SCConfiguration.step_future; eauto. }
      + exfalso. eapply RACEFREE; eauto.
    - inv STEP.
      eapply ra_configuration_step_sc_configuration_step_or_race in STEP0; eauto. des.
      + econs 3; eauto.
        * rewrite <- H0. econs; eauto.
      + exfalso. eapply RACEFREE; eauto.
    - inv STEP.
      eapply ra_configuration_step_sc_configuration_step_or_race in STEP0; eauto. des.
      + econs 4; eauto.
        * rewrite <- H0. econs; eauto.
        * eapply IHPR; eauto.
          { eapply SCRace.step_racefree; eauto. }
          { eapply SCConfiguration.step_future; eauto. }
      + exfalso. eapply RACEFREE; eauto.
  Qed.

  Lemma sc_racefree_ra_racefree c
        (RACEFREE: SCRace.racefree L c)
        (WF: Configuration.wf c)
    :
      RARace.racefree L c.
  Proof.
    ii. unfold RARace.race in *. des. guardH ORDERING.
    exploit ra_configuration_steps_sc_configuration_steps_or_race.
    { etrans.
      { eapply STEPS1. } econs 2.
      { econs; eauto. }
      { eapply STEPS2. }
    }
    { eauto. }
    i. des.
    { exploit ra_thread_all_steps_sc_thread_all_steps_or_race; eauto. i. des.
      { eapply RACEFREE; eauto. econs. esplits; eauto.
        unfold ThreadEvent.is_reading in *. des_ifs.
        - inv READ_STEP; inv STEP. econs; eauto. esplits; eauto; ss.
          inv LOCAL. inv LOCAL0. inv STEP.
          unfold SCLocal.non_maximal. esplits; eauto.
        - inv READ_STEP; inv STEP. econs; eauto. esplits; eauto; ss.
          inv LOCAL. inv LOCAL1. inv LOCAL2. inv STEP.
          unfold SCLocal.non_maximal. esplits; eauto.
      }
      { eapply RACEFREE; eauto. econs. esplits; eauto.
        exploit SCConfiguration.all_steps_future; eauto. i. des.
        exploit SCThread.rtc_all_step_future; eauto; try eapply WF2; eauto.
        i. des. ss.
        eapply OrdThread.rtc_all_step_promise_consistent in STEPS3; eauto.
      }
    }
    { eapply RACEFREE; eauto. }
  Qed.

End SIM.

(* LDRF-SC theorem *)
Theorem local_drf_sc L
        s
        (RACEFREE: SCRace.racefree_syn L s):
  behaviors SConfiguration.machine_step (Configuration.init s) <1=
  behaviors (@SCConfiguration.machine_step L) (Configuration.init s).
Proof.
  i. eapply local_drf_ra in PR; eauto.
  - eapply ra_behavior_sc_behavior_or_race; eauto.
    eapply Configuration.init_wf; eauto.
  - eapply sc_racefree_ra_racefree; eauto.
    eapply Configuration.init_wf; eauto.
Qed.