Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import all_ssreflect.
From mathcomp Require Import all_algebra.

Require Import ProofIrrelevance.
Require Import String.
Require Import QArith.
Require Import Coq.FSets.FMapFacts.
Require Import Structures.Orders NArith.

Require Import OUVerT.strings compile combinators ccombinators
        OUVerT.numerics OUVerT.dyadic OUVerT.orderedtypes.

Require Import OUVerT.listlemmas OUVerT.maplemmas.
(* Boolability is important to our construction of affine games,
      however, it is non-essential and problematic for more advanced
      games (e.g. the routing games shown in routing.v)

  It's not hard to preserve boolability with certain combinators,
  however, it is hard to regain it.

  To work around this we have two layers of modules here:
    1.) MyOrderedType, used to preserve Boolablity through particular combinators.
    2.) SimpleMyOrderedType, used to strip away Boolability
          and its associated requirements
*)

(* Define the basic extension of OrderedType: MyOrderedType *)
Module Type MyOrderedType.
  Include MyOrderedType.
  Parameter cost_instance : forall N, CCostClass N t.
  Parameter cost_max : forall N, CCostMaxClass N t.
End MyOrderedType.

(* We extend MyOrderedType with boolability
    which is preserved under some relation EQ
    for the construction of affine games *)
Module Type BoolableMyOrderedType.
  Include MyOrderedType.
  Declare Instance boolable : Boolable t.
  Declare Instance boolableUnit : BoolableUnit boolable.
  Declare Instance eq' : Eq t.
  Declare Instance eq_dec' : Eq_Dec eq'.
  Declare Instance eq_refl' : Eq_Refl eq'.
End BoolableMyOrderedType.

(* SimplifyBoolable strips boolability *)
Module SimplifyBoolable (A : BoolableMyOrderedType) <: MyOrderedType.
  Include A.
End SimplifyBoolable.

(* Module OrderedType_of_MyOrderedType (A : MyOrderedType) *)
(*   <: OrderedType.OrderedType. *)
(*       Definition t : Type := A.t. *)
(*       Definition eq := A.eq. *)
(*       Definition lt := A.lt. *)
(*       Lemma eq_refl : forall x : t, eq x x. *)
(*       Proof. by move => x; rewrite /eq -A.eqP. Qed. *)
(*       Lemma eq_sym : forall x y : t, eq x y -> eq y x. *)
(*       Proof. by move => x y; rewrite /eq -2!A.eqP. Qed. *)
(*       Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. *)
(*       Proof. by move => x y z; rewrite /eq -3!A.eqP => -> ->. Qed. *)
(*       Definition lt_trans := A.lt_trans. *)
(*       Definition lt_not_eq := A.lt_not_eq. *)
(*       Definition compare := A.compare. *)
(*       Definition eq_dec := A.eq_dec. *)
(* End OrderedType_of_MyOrderedType. *)

Module Type OrderedFinType.
  Include MyOrderedType.
  Parameter eq_mixin : Equality.mixin_of t.
  Parameter choice_mixin : Choice.mixin_of (EqType t eq_mixin).
  Parameter fin_mixin : Finite.mixin_of (ChoiceType (EqType t eq_mixin) choice_mixin).
End OrderedFinType.

Module MyOrderedType_of_OrderedFinType
       (A : OrderedFinType) <: MyOrderedType.
  Include A.
End MyOrderedType_of_OrderedFinType.

(**
  The following provides OrderedType instances for the basic types
    Unit and Resource
**)
Module OrderedUnit <: MyOrderedType.
  Definition t := Unit.
  Definition t0 := mkUnit.
  Definition enumerable  : Enumerable t := _.
  Definition cost_instance : forall N, CCostClass N t := _.
  Definition cost_max : forall N, CCostMaxClass N t := _.
  Definition showable := unitShowable.
  Definition eq u1 u2 := Unit_eq u1 u2 = true.
  Definition lt (u1 u2 : Unit) := False.
  Lemma eq_refl : forall x, eq x x. by []. Qed.
  Lemma eq_symm : forall x y, eq x y -> eq y x. by []. Qed.
  Lemma eq_trans : forall x y z, eq x y -> eq y z -> eq x z. by []. Qed.
  Lemma lt_trans : forall x y z, lt x y -> lt y z -> lt x z. by []. Qed.
  Lemma lt_not_eq : forall x y, lt x y -> ~ eq x y. by []. Qed.
  Lemma compare : forall x y, Compare lt eq x y.
    move => x y; by apply EQ => //. Qed.
  Definition eq_dec : forall x y, {eq x y} + {~ eq x y}. by left => //. Qed.
  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof.
    move => x y. split; first by [].
    case: x => H. case y => //.
  Qed.
End OrderedUnit.

Module BoolableOrderedUnit <: BoolableMyOrderedType.
  Include OrderedUnit.
    (* It looks like these aspects are missing from unit games
      in compile.v.
     (** ToDo: update unit games to match the construction
          of the other combinators/games **)
  *)
  Definition boolable : Boolable t := fun _ => false.
  Definition boolableUnit : BoolableUnit boolable := mkUnit.
  Definition eq' : Eq t := fun x y => True.
  Lemma eq_refl' : Eq_Refl eq'.
    Proof. rewrite /Eq_Refl => x //. Qed.
  Lemma eq_dec' : Eq_Dec eq'.
    Proof. rewrite /Eq_Dec /eq'=> x y. left. by []. Qed.
End BoolableOrderedUnit.

Module OrderedResource <: MyOrderedType.
  Definition t := resource.
  Definition t0 := RYes.
  Definition enumerable  : Enumerable t := _.
  Definition cost_instance : forall N, CCostClass N t := _.
  Definition cost_max : forall N, CCostMaxClass N t := _.
  Definition showable : Showable t := _.
  Definition eq r1 r2 := resource_eq r1 r2 = true.
  Definition lt r1 r2 :=
    match r1, r2 with
    | RNo, RNo => False
    | RNo, RYes => True
    | RYes, RNo => False
    | RYes, RYes => False
    end.

  Lemma eq_refl : forall x, eq x x.
  Proof. by move => x; rewrite /eq; case: (@resource_eqP x x). Qed.

  Lemma eq_sym : forall x y, eq x y -> eq y x.
  Proof.
    move => x y; rewrite /eq.
    case: (@resource_eqP x y) => // -> _; apply: eq_refl.
  Qed.

  Lemma eq_trans : forall x y z, eq x y -> eq y z -> eq x z.
  Proof. by move => x y z; rewrite /eq; case: (@resource_eqP x y) => // ->. Qed.

  Lemma lt_trans : forall x y z, lt x y -> lt y z -> lt x z.
  Proof. by move => x y z; case: x => //; case: y => //; case: z. Qed.

  Lemma lt_not_eq : forall x y, lt x y -> ~eq x y.
  Proof. by move => x y; case: x => //; case: y. Qed.

  Lemma compare : forall x y, Compare lt eq x y.
  Proof.
    case => //; case => //.
    { apply: EQ => //. }
    { apply: GT => //. }
    { apply: LT => //. }
    apply: EQ => //.
  Qed.

  Lemma eq_dec : forall x y, {eq x y} + {~eq x y}.
  Proof.
    move => x y; rewrite /eq; case: (@resource_eqP x y).
    { by move => _; left. }
      by move => _; right.
  Qed.

  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof. by move => x y; rewrite /eq; case: (@resource_eqP x y). Qed.
End OrderedResource.

Module BoolableOrderedResource <: BoolableMyOrderedType.
  Include OrderedResource.
  Definition boolable : Boolable t := _.
  Definition boolableUnit : BoolableUnit boolable := _.
  Definition eq' : Eq t.
  unfold Eq.
  apply eq.
  Defined.
  Definition eq_refl' : Eq_Refl eq'.
  Proof.
    red; intros; case: x => //.
  Defined.
  Definition eq_dec' : Eq_Dec eq'.
    red; intros; case: x; case y => //;
    intuition.
  Defined.
End BoolableOrderedResource.

Module OrderedFinResource <: OrderedFinType.
  Include OrderedResource.
  Definition eq_mixin := resource_eqMixin.
  Definition choice_mixin := resource_choiceMixin.
  Definition fin_mixin := resource_finMixin.
End OrderedFinResource.

(* We now begin defining functors for constructing
    OrderedTypes and BoolableOrderedTypes *)

(** First, we set up those functors which work without boolability **)

  (* Products and their extensions (boolable and fin) *)
Module OrderedProd (A B : MyOrderedType) <: MyOrderedType.
  Definition t := (A.t*B.t)%type.
  Definition t0 := (A.t0, B.t0).
  Existing Instance A.enumerable.
  Existing Instance B.enumerable.
  Existing Instance A.cost_instance.
  Existing Instance B.cost_instance.
  Definition enumerable  : Enumerable t := _.
  Existing Instance A.cost_max.
  Existing Instance B.cost_max.
  Existing Instance A.showable.
  Existing Instance B.showable.
  Definition cost_instance : forall N, CCostClass N t := _.
  Definition cost_max : forall N, CCostMaxClass N t := _.
  Definition show_prod (p : A.t*B.t) : string :=
    let s1 := to_string p.1 in
    let s2 := to_string p.2 in
    append s1 s2.
  Instance showable : Showable t := mkShowable show_prod.
  Definition eq p1 p2 : Prop :=
    (eqProd A.eq B.eq) p1 p2.
  Definition lt p1 p2 :=
    match p1, p2 with
    | (a1, b1), (a2, b2) =>
      A.lt a1 a2 \/
      (A.eq a1 a2 /\ B.lt b1 b2)
    end.

  Lemma lt_trans : forall x y z, lt x y -> lt y z -> lt x z.
  Proof.
    case => a b; case => c d; case => e f; rewrite /lt.
    case => H.
    { case => H1.
      { left; by apply: (A.lt_trans _ _ _ H H1). }
      case: H1 => H2 H3.
      by move: H2; rewrite -A.eqP => H4; subst e; left. }
    case: H; rewrite -A.eqP => H1 H2; subst c.
    case; first by move => H3; left.
    case => H3 H4; right; split => //.
    by apply: (B.lt_trans _ _ _ H2 H4).
  Qed.

  Lemma lt_not_eq : forall x y, lt x y -> ~eq x y.
  Proof.
    case => a b; case => c d; rewrite /lt /eq /=.
    case.
    { move => H []H2 H3.
        by apply: (A.lt_not_eq _ _ H). }
    case => H H1 []H2 H3.
    by apply: (B.lt_not_eq _ _ H1).
  Qed.

  Lemma compare : forall x y, Compare lt eq x y.
  Proof.
    move => x y.
    case H: (A.compare x.1 y.1) => [lt_pf|eq_pf|gt_pf].
    { have H2: lt x y.
      { clear - lt_pf.
        move: lt_pf; case: x => a b; case: y => c d /= H.
          by left. }
      apply: LT H2. }
    { case: (B.compare x.2 y.2) => [lt_pf'|eq_pf'|gt_pf'].
      { have H2: lt x y.
        { clear - eq_pf lt_pf'.
          move: eq_pf lt_pf'; case: x => a b; case: y => c d /= H H2.
          right; split => //. }
        apply: LT H2. }
      { have H2: eq x y.
        { rewrite /eq /eqProd. destruct x, y; split => //. }
        apply: EQ H2. }
      have H2: lt y x.
      { clear - eq_pf gt_pf'; move: eq_pf gt_pf'.
        case: x => a b; case: y => c d /= H H2.
        right; split => //.
        by move: H; rewrite -2!A.eqP => ->. }
      by apply: GT H2. }
    have H2: lt y x.
    { clear - gt_pf; move: gt_pf; case: x => a b; case: y => c d /= H.
      by left. }
    by apply: GT H2.
  Qed.

  Lemma eq_dec : forall x y, {eq x y} + {~eq x y}.
  Proof.
    case => a b; case => c d; rewrite /eq /=.
    case H2: (A.eq_dec a c) => [pf|pf].
    { case H3: (B.eq_dec b d) => [pf'|pf'].
      { left.
        split => //. }
      right.
      case => H4 H5.
      clear H2 H3.
        by apply: pf'. }
    right; case => H3 H4.
    by clear H2; apply: pf.
  Qed.

  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof.
    case => a b; case => c d; rewrite /eq /=; split.
    { case => -> ->; split.
        by rewrite -A.eqP.
        by rewrite -B.eqP. }
    by case; rewrite -A.eqP -B.eqP => -> ->.
  Qed.
End OrderedProd.

Module OrderedFinProd (X Y : OrderedFinType) <: OrderedFinType.
  Module A := OrderedProd X Y.
  Include A.

  Definition xE := EqType X.t X.eq_mixin.
  Definition xC := ChoiceType xE X.choice_mixin.
  Definition xF := FinType xC X.fin_mixin.

  Definition yE := EqType Y.t Y.eq_mixin.
  Definition yC := ChoiceType yE Y.choice_mixin.
  Definition yF := FinType yC Y.fin_mixin.

  Definition eq_mixin := prod_eqMixin xE yE.
  Definition choice_mixin := prod_choiceMixin xC yC.
  Definition fin_mixin := prod_finMixin xF yF.
End OrderedFinProd.

Module BoolableOrderedProd (X Y : BoolableMyOrderedType) <: BoolableMyOrderedType.
  Module SimpX := SimplifyBoolable X.
  Module SimpY := SimplifyBoolable Y.
  Module A := OrderedProd SimpX SimpY.
  Include A.

  Definition boolable : Boolable t := _.
  Definition boolableUnit : BoolableUnit boolable := _.
  Definition eq' : Eq t := _.
  Definition eq_refl' : Eq_Refl eq' := _.
  Definition eq_dec' : Eq_Dec eq' := _.
End BoolableOrderedProd.

  (* Sigma Games *)
Module Type OrderedPredType.
  Include MyOrderedType.
  Declare Instance pred : PredClass t.
  Parameter a0 : t.
  Parameter a0_pred : pred a0.
End OrderedPredType.

  (** We don't want/need boolability to be preserved for every predicate.
        For those where it's important to do so, we use the BoolableOrderedPredType **)
Module Type BoolableOrderedPredType.
  Include BoolableMyOrderedType.

  Declare Instance pred : PredClass t.
  Parameter a0 : t.
  Parameter a0_pred : pred a0.
  Declare Instance boolablePres :
    PredClassPreservesBoolableUnit pred boolableUnit.
End BoolableOrderedPredType.

Module SimplifyBoolablePredType (A : BoolableOrderedPredType) <: OrderedPredType.
  Include A.
End SimplifyBoolablePredType.

Module OrderedSigma (T : OrderedPredType) <: MyOrderedType.
  Definition pred_instance : PredClass T.t := T.pred.

  Definition t := {x : T.t | @the_pred _ pred_instance x}%type.
  Definition t0 := exist the_pred T.a0 T.a0_pred.
  Existing Instance T.enumerable.
  Existing Instance T.cost_instance.
  Existing Instance T.cost_max.
  Existing Instance T.showable.
  Definition enumerable  : Enumerable t := _.
  Definition cost_instance : forall N, CCostClass N t := _.
  Definition cost_max : forall N, CCostMaxClass N t := _.
  Definition show_sigma (x : t) : string :=
    to_string (projT1 x).
  Instance showable : Showable t := mkShowable show_sigma.
  Definition eq (x1 x2 : t) := T.eq (projT1 x1) (projT1 x2).
  Definition lt (x1 x2 : t) := T.lt (projT1 x1) (projT1 x2).

  Lemma lt_trans : forall x y z, lt x y -> lt y z -> lt x z.
  Proof.
    case => a H; case => b H2; case => c H3; rewrite /lt /=.
    apply: T.lt_trans.
  Qed.

  Lemma lt_not_eq : forall x y, lt x y -> ~eq x y.
  Proof.
    case => a H; case => b H2; rewrite /lt /eq /=.
    by move/T.lt_not_eq.
  Qed.

  Lemma compare : forall x y, Compare lt eq x y.
  Proof.
    case => a H; case => b H2; rewrite /lt /eq /=.
    case H3: (T.compare a b).
    { apply: LT => //. }
    { apply: EQ => //. }
    apply: GT => //.
  Qed.

  Lemma eq_dec : forall x y, {eq x y} + {~eq x y}.
  Proof.
    case => a H; case => b H2; rewrite /eq /=.
    case: (T.eq_dec a b); first by left.
    by right.
  Qed.

  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof.
    case => a H; case => b H2; rewrite /eq /=; move: (T.eqP a b) => <-.
    split; first by inversion 1.
    move => H3; move: H H2; subst a => H H2; f_equal.
    apply: proof_irrelevance.
  Qed.
End OrderedSigma.

Module BoolableOrderedSigma (T : BoolableOrderedPredType) <: BoolableMyOrderedType.
  Module SimplPred := SimplifyBoolablePredType T.
  Module SimplSigma := OrderedSigma SimplPred.
  Include SimplSigma.
  Definition boolable : Boolable t := _.
  Definition boolableUnit: BoolableUnit boolable := _.
  Definition eq' : Eq t := eqSigma (A:=SimplPred.t) SimplPred.eq' (P:=SimplPred.pred).
  Definition eq_refl' : Eq_Refl eq' :=
    eqSigmaRefl SimplPred.t SimplPred.eq' SimplPred.eq_refl' SimplPred.pred.
  Definition eq_dec' : Eq_Dec eq' :=
    eqSigmaDec SimplPred.t SimplPred.eq' SimplPred.eq_dec' SimplPred.pred.
End BoolableOrderedSigma.

Module Type OrderedPredFinType.
  Include OrderedFinType.
  Declare Instance pred : PredClass t.
  Parameter a0 : t.
  Parameter a0_pred : pred a0.
End OrderedPredFinType.

Module OrderedPredType_of_OrderedPredFinType
       (X : OrderedPredFinType) <: OrderedPredType.
  Include X.
End OrderedPredType_of_OrderedPredFinType.

Module OrderedFinSigma (X : OrderedPredFinType) <: OrderedFinType.
  Module Y := OrderedPredType_of_OrderedPredFinType X.
  Module A := OrderedSigma Y.

  Include A.

  Definition xE := EqType X.t X.eq_mixin.
  Definition xC := ChoiceType xE X.choice_mixin.
  Definition xF := FinType xC X.fin_mixin.

  Definition eq_mixin := @sig_eqMixin xE X.pred.
  Definition choice_mixin := @sig_choiceMixin xC X.pred.
  Definition fin_mixin := @sig_finMixin xF X.pred.
End OrderedFinSigma.

(* Scalar Games *)
Module Type OrderedScalarType.
  Include MyOrderedType.
  Parameter scal : dyadic_rat.
  Instance scal_DyadicScalarInstance : DyadicScalarClass := scal.
  Local Open Scope ring_scope.
  Parameter scal_pos : 0 <= projT1 scal.
End OrderedScalarType.

Module Type BoolableOrderedScalarType.
  Include OrderedScalarType.
  Declare Instance boolable : Boolable t.
  Declare Instance boolableUnit: BoolableUnit boolable.
  Declare Instance eq' : Eq t.
  Declare Instance eq_dec' : Eq_Dec eq'.
  Declare Instance eq_refl' : Eq_Refl eq'.
End BoolableOrderedScalarType.

Module SimplifyBoolableScalarType (A: BoolableOrderedScalarType) <: OrderedScalarType.
  Include A.
End SimplifyBoolableScalarType.

Module OrderedScalar (T : OrderedScalarType) <: MyOrderedType.
  Definition t := scalar scalar_val T.t.
  Definition t0 := Wrap (Scalar (rty:=rat_realFieldType) scalar_val) T.t0.
  Existing Instance T.showable.
  Definition enumerable : Enumerable t :=
    scalarEnumerableInstance _ T.enumerable scalar_val.
  Definition cost_instance (N : nat) :=
    scalarCCostInstance T.enumerable (T.cost_instance N) (H1:=T.scal_DyadicScalarInstance).
  Definition cost_max (N : nat) :=
    scalarCCostMaxInstance (T.cost_max N) dyadic_scalar_val.
  Definition show_scalar (x : t) : string :=
    append "Scalar" (to_string (unwrap x)).
  Instance showable : Showable t := mkShowable show_scalar.
  Definition eq (x1 x2 : t) := T.eq (unwrap x1) (unwrap x2).
  Definition lt (x1 x2 : t) := T.lt (unwrap x1) (unwrap x2).
  Lemma lt_trans : forall x y z, lt x y -> lt y z -> lt x z.
  Proof.
    case => a; case => b; case => e.
    apply: T.lt_trans.
  Qed.
  Lemma lt_not_eq : forall x y, lt x y -> ~eq x y.
  Proof. case => a; case => b; apply: T.lt_not_eq. Qed.
  Lemma compare : forall x y, Compare lt eq x y.
  Proof.
    case => a; case => b; rewrite /=.
    case: (T.compare a b) => H.
    { rewrite /lt; constructor => //. }
    { by rewrite /lt /eq; apply: EQ. }
    by rewrite /lt /eq; apply: GT.
  Qed.
  Lemma eq_dec : forall x y, {eq x y} + {~eq x y}.
  Proof. case => a; case => b; apply: T.eq_dec. Qed.
  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof.
    case => a; case => b; split => H; rewrite /eq.
    by rewrite -(T.eqP a b); inversion H.
    rewrite /eq /= in H; f_equal.
    by rewrite T.eqP.
  Qed.
End OrderedScalar.

Module BoolableOrderedScalar (A : BoolableOrderedScalarType) <: BoolableMyOrderedType.
  Module SimplScalarType := SimplifyBoolableScalarType A.
  Module SimplScalar := OrderedScalar SimplScalarType.
  Include SimplScalar.

  (* Need to remind the system of these for some reason... *)
  Existing Instances eqScalarRefl eqScalarDec.

  Definition boolable : Boolable t := _.
  Definition boolableUnit : BoolableUnit boolable := _.
  Definition eq' : Eq t := _.
  Definition eq_refl' : Eq_Refl eq' := _.
  Definition eq_dec' : Eq_Dec eq' := _.
End BoolableOrderedScalar.

(** The following combinators require notions of boolability **)
Module BoolableOrderedSingleton (A : BoolableMyOrderedType) <: BoolableMyOrderedType.
  Definition t := singleton (A.t).
  Definition t0 := Wrap Singleton A.t0.
  Existing Instance A.enumerable.
  Existing Instance A.showable.
  Definition enumerable  : Enumerable t := _.
  Definition cost_instance : forall N, CCostClass N t := _.
  Definition cost_max : forall N, CCostMaxClass N t := _.
  Definition show_sing (sA : singleton (A.t)) : string :=
      append "Singleton" (to_string (unwrap sA)).
  Instance showable : Showable t := mkShowable show_sing.
  Definition eq (p1 p2 : t) := A.eq (unwrap p1) (unwrap p2).
  Definition lt (p1 p2 : t) := A.lt (unwrap p1) (unwrap p2).
  Definition lt_trans : forall x y z, lt x y -> lt y z -> lt x z.
  Proof.
    rewrite /lt; move => x y z; apply A.lt_trans.
  Qed.
  Lemma lt_not_eq : forall x y, lt x y -> ~ eq x y.
  Proof.
    rewrite /eq /lt; move => x y; apply A.lt_not_eq.
  Qed.
  Lemma compare : forall x y, Compare lt eq x y.
  Proof.
    move => x y.
    case H: (A.compare (unwrap x) (unwrap y)) => [lt_pf|eq_pf|gt_pf];
    [apply LT | apply EQ | apply GT] => //.
  Qed.
  Lemma eq_dec : forall x y, {eq x y} + {~eq x y}.
  Proof.
    move => x y.
    case H : (A.eq_dec (unwrap x) (unwrap y)); [left | right] => //.
  Qed.
  Lemma eqP : forall x y, x = y <-> eq x y.
  Proof.
    rewrite /t.
    move => x y. destruct x. destruct y.
    split => H. rewrite H /eq. apply A.eqP. auto.
    rewrite /eq /= in H. apply A.eqP in H. rewrite H => //.
  Qed.
  Definition boolable : Boolable t := _.
  Definition boolableUnit : BoolableUnit boolable := _.
  Definition eq' : Eq t := _.
  Definition eq_refl' : Eq_Refl eq' := _.
  Definition eq_dec' : Eq_Dec eq' := _.
End BoolableOrderedSingleton.

(* This bundles the scalar and bias terms of an affine game together *)
Module Type BoolableOrderedAffineType.
  Include BoolableMyOrderedType.
  Parameter scalar : dyadic_rat.
  Local Open Scope ring_scope.
  Parameter scalar_pos : 0 <= projT1 scalar.
  Parameter bias : dyadic_rat.
  Parameter bias_pos : 0 <= projT1 bias. (*FIXME*)
End BoolableOrderedAffineType.

Module ScalarType_of_OrderedAffineType (A : BoolableOrderedAffineType)
  <: BoolableOrderedScalarType.
  Include A.
  Definition scal := A.scalar.
  Definition scal_pos := A.scalar_pos.
  Instance scal_DyadicScalarInstance : DyadicScalarClass := scal.
End ScalarType_of_OrderedAffineType.

Module OffsetType_of_OrderedAffineType (A : BoolableOrderedAffineType)
  <: BoolableOrderedScalarType.
    Include A.
    Definition scal := A.bias.
    Definition scal_pos := A.bias_pos.
    Instance scal_DyadicScalarInstance : DyadicScalarClass := scal.
    (*FIXME: incorporate into module signature:*)
    Instance scal_ScalarAxiomInstance :
      ScalarAxiomClass
        (DyadicScalarInstance scal_DyadicScalarInstance) := scal_pos.
End OffsetType_of_OrderedAffineType.

Module BiasType_of_OffsetType (A : BoolableOrderedScalarType)
  <: BoolableOrderedScalarType.
    Include BoolableOrderedSingleton A.
    Definition scal := A.scal.
    Definition scal_pos := A.scal_pos.
    Instance scal_DyadicScalarInstance : DyadicScalarClass := scal.
    (*FIXME: incorporate into module signature:*)
    Instance scal_ScalarAxiomInstance :
      ScalarAxiomClass
        (DyadicScalarInstance scal_DyadicScalarInstance) := scal_pos.
End BiasType_of_OffsetType.

(* Given a BoolableOrderedAffineType, toss everything together to build
    affine games *)

Module OrderedAffinePred (A : BoolableOrderedAffineType) <: OrderedPredType.
    Module S := ScalarType_of_OrderedAffineType A.
    Module Off := OffsetType_of_OrderedAffineType A.
    Module Bias := BiasType_of_OffsetType Off.
    Module Scaled := BoolableOrderedScalar S.
    Module Offset := BoolableOrderedScalar Bias.
    Module Prod := BoolableOrderedProd Scaled Offset.

    Include Prod.
    Instance pred : PredClass Prod.t :=
      affinePredInstance A.eq_dec'.
    Definition a0 : t := (Wrap _ A.t0, Wrap _ (Wrap _ A.t0)).
    Lemma a0_pred : pred a0.
    Proof.
      rewrite /a0 /pred /affinePredInstance => /=.
      case H: (A.eq_dec' A.t0 A.t0) => //=.
      assert (A.eq' A.t0 A.t0) as  H0 by apply A.eq_refl'.
      contradiction.
    Qed.

    Instance boolablePres : PredClassPreservesBoolableUnit pred _ :=
      affinePredPreservesBoolableUnit _ _ _ _ _.

End OrderedAffinePred.

Module OrderedAffine (A : BoolableOrderedAffineType) <: BoolableMyOrderedType.
  Module Pred := OrderedAffinePred A.
  Include BoolableOrderedSigma Pred.
End OrderedAffine.

(** MyOrdNatDep: a computational analogue of 'I_B.n *)

Module MyOrdNatDep (B : BOUND) <: MyOrderedType.
  Module N := OrdNatDep B. Include N.

  Program Definition t0 := @mk 0%N _.
  Next Obligation. by apply: B.n_gt0. Qed.

  (* FIXME: this definition should be fold_left, not fold_right *)
  Program Fixpoint enumerate_rec (m : nat) (pf : (m < n)%nat) : list t :=
    (match m as x return _ = x -> list t with
     | O => fun _ => t0 :: nil
     | S m' => fun pf => @mk (N.of_nat m) _ :: enumerate_rec m' _
     end) erefl.
  Next Obligation. by rewrite Nat2N.id. Qed.

  Lemma lt_dec x y : ({x<y} + {x>=y})%nat.
  Proof.
    case H: (leq (S x) y); first by left.
    case H2: (y <= x)%nat; first by right.
    move: (leq_total y x); rewrite H2 /= => H3.
    rewrite ltnNge in H.
    rewrite leqNgt in H2.
    rewrite leqNgt in H3.
    rewrite -ltnNge in H.
    by rewrite H in H2.
  Qed.

  Lemma gt0_pred_lt n : (0 < n -> n.-1 < n)%nat.
  Proof. elim: n => //. Qed.

  Definition enumerate_t : list t :=
    match lt_dec 0 n with
    | left pfn => enumerate_rec (Nat.pred n) (gt0_pred_lt _ pfn)
    | right _ => nil
    end.

  Instance enumerable : Enumerable t := enumerate_t.

  Instance showable : Showable t :=
    mkShowable (fun x => to_string x.(val)).

  Lemma eqP : forall x y : t, x = y <-> eq x y.
  Proof.
    move => x y; case: x => vx px; case y => vy py.
    rewrite /eq /=; split.
    { inversion 1; subst.
      apply: M.E.eq_refl. }
    rewrite /BinNat.N.eq => H; subst vy.
    f_equal.
    apply: proof_irrelevance.
  Qed.

  (* FIXME: Bogus cost_instance -- perhaps cost_instance and cost_max should
     be factored out of MyOrderedType. *)
  Instance cost_instance (n : nat) : CCostClass n t := fun _ _ => 0%D.
  Instance cost_max (n : nat) : CCostMaxClass n t := 0%D.
End MyOrdNatDep.

Module MyOrdNatDepProps (B : BOUND).
  Module M := MyOrdNatDep B. Include M.

  Fixpoint enumerate_rec_erased (m : nat) : list N :=
    match m with
    | O => N.of_nat O :: nil
    | S m' => N.of_nat m :: enumerate_rec_erased m'
    end.

  Lemma enumerate_rec_map_erased m (pf : (m < n)%nat) :
    map val (enumerate_rec m pf) = enumerate_rec_erased m.
  Proof. by elim: m pf => // n IH pf /=; f_equal; rewrite IH. Qed.

  Fixpoint enumerate_rec_erased_nat (m : nat) : list nat :=
    match m with
    | O => O :: nil
    | S m' => m :: enumerate_rec_erased_nat m'
    end.

  Lemma enumerate_rec_erased_nat_iota n :
    List.rev (enumerate_rec_erased_nat n) = iota 0 (n.+1).
  Proof.
    elim: n => // n /= ->.
    have ->: (0::iota 1 n = [::0]++iota 1 n)%nat by [].
    rewrite -app_assoc /=; f_equal.
    have ->: (n.+1 = n+1)%nat by rewrite addnC.
    move: 1%nat => nx; elim: n nx => //= n IH nx; f_equal.
    have ->: (n.+1 +nx = n + nx.+1)%nat by rewrite addSn.
    apply: IH.
  Qed.

  Lemma enumerate_rec_map_erased_nat m :
    map N.to_nat (enumerate_rec_erased m) = enumerate_rec_erased_nat m.
  Proof.
    elim: m => // m IH /=; f_equal => //.
    by rewrite SuccNat2Pos.id_succ.
  Qed.

  Lemma notin_gtn m n :
    (m > n)%nat ->
    ~InA (fun x : nat => [eta Logic.eq x]) m (enumerate_rec_erased_nat n).
  Proof.
    elim: n m.
    { move => m H H2; inversion H2; subst => //.
      inversion H1. }
    move => n IH m H H2; apply: IH.
    { apply: ltn_trans; last by apply: H.
      by []. }
    inversion H2; subst => //.
    move: (ltP H) => H3; omega.
  Qed.

  Lemma enumerate_rec_erased_nat_nodup m :
    NoDupA (fun x : nat => [eta Logic.eq x]) (enumerate_rec_erased_nat m).
  Proof.
    elim: m.
    { constructor; first by inversion 1.
      constructor. }
    move => n IH /=; constructor => //.
    by apply: notin_gtn.
  Qed.

  Lemma enumerate_rec_erased_nat_total n m :
    (n <= m)%nat ->
    In n (enumerate_rec_erased_nat m).
  Proof.
    elim: m n; first by case => //= _; left.
    move => m IH n H; case: (Nat.eq_dec n m.+1) => [pf|pf].
    { by left; subst n. }
    right; apply: IH.
    apply/leP; move: (leP H) => H2; omega.
  Qed.

  Lemma enumerate_rec_erased_total n m :
    (N.to_nat n <= N.to_nat m)%nat ->
    In n (enumerate_rec_erased (N.to_nat m)).
  Proof.
    move => H.
    suff: In (N.to_nat n) (map N.to_nat (enumerate_rec_erased (N.to_nat m))).
    { clear H; elim: m n.
      { move => n /=; case => // H; left.
        destruct n => //.
        simpl in H.
        move: (PosN0 p); rewrite -H //. }
      move => p n; rewrite in_map_iff; case => x []H H1.
      by move: (N2Nat.inj _ _ H) => H2; subst n. }
    rewrite enumerate_rec_map_erased_nat.
    apply: (enumerate_rec_erased_nat_total _ _ H).
  Qed.

  Lemma enumerate_rec_total m (pf : (m < n)%nat) (x : t) :
    (m.+1 = n)%nat ->
    In x (enumerate_rec _ pf).
  Proof.
    move => Hsucc.
    suff: In (val x) (map val (enumerate_rec m pf)).
    { clear Hsucc.
      elim: m pf x => /=.
      { move => H x; case => // H2; left.
        rewrite /t0; f_equal; destruct x as [vx pfx].
        simpl in H2; subst vx; f_equal.
        apply: proof_irrelevance. }
      move => n IH pf x; case.
      { destruct x as [vx pfx]; simpl => H; subst vx; left.
        f_equal.
        apply: proof_irrelevance. }
      rewrite in_map_iff; case => x0 [] H H2; right.
      clear - H H2.
      destruct x0 as [vx0 pfx0].
      destruct x as [vx pfx].
      simpl in H; subst vx0.
      have ->: pfx = pfx0 by apply: proof_irrelevance.
      by []. }
    rewrite enumerate_rec_map_erased.
    destruct x as [vx pfx].
    rewrite /val.
    have ->: m = N.to_nat (N.of_nat m) by rewrite Nat2N.id.
    apply: enumerate_rec_erased_total.
    rewrite Nat2N.id.
    apply/leP; move: (ltP pfx) (ltP pf); move: (N.to_nat vx) => n0.
    rewrite -Hsucc => X Y.
    omega.
  Qed.

  Lemma InA_map A B (f : A -> B) (l : list A) x :
    InA (fun x => [eta Logic.eq x]) x l ->
    InA (fun x => [eta Logic.eq x]) (f x) (map f l).
  Proof.
    elim: l; first by inversion 1.
    move => a l IH; inversion 1; subst; first by constructor.
    by apply: InA_cons_tl; apply: IH.
  Qed.

  Lemma enumerate_rec_erased_nodup m :
    NoDupA (fun x => [eta Logic.eq x]) (enumerate_rec_erased m).
  Proof.
    suff: (NoDupA (fun x => [eta Logic.eq x]) (map N.to_nat (enumerate_rec_erased m))).
    { elim: (enumerate_rec_erased m) => // a l IH; inversion 1; subst.
      constructor.
      { by move => H; apply: H1; apply: InA_map. }
      apply: (IH H2). }
    rewrite enumerate_rec_map_erased_nat.
    apply: enumerate_rec_erased_nat_nodup.
  Qed.

  Lemma enumerate_rec_nodup m pf :
    NoDupA (fun x : t => [eta Logic.eq x]) (enumerate_rec m pf).
  Proof.
    suff: NoDupA (fun x => [eta Logic.eq x]) (map val (enumerate_rec m pf)).
    { elim: (enumerate_rec m pf) => // a l IH; inversion 1; subst.
      constructor.
      { clear - H1 => H2; apply: H1.
        elim: l H2; first by inversion 1.
        move => b l H; inversion 1; subst; first by constructor.
        by apply: InA_cons_tl; apply: H. }
      by apply: IH. }
    rewrite enumerate_rec_map_erased.
    apply: enumerate_rec_erased_nodup.
  Qed.

  Lemma enumerate_t_nodup :
    NoDupA (fun x : t => [eta Logic.eq x]) enumerate_t.
  Proof.
    rewrite /enumerate_t.
    case H: (lt_dec 0 n) => [pf|pf]; last by constructor.
    by apply: enumerate_rec_nodup.
  Qed.

  Lemma enumerate_t_total x : In x enumerate_t.
  Proof.
    rewrite /enumerate_t.
    case: (lt_dec 0 n) => [pf|pf]; last first.
    { destruct x as [vx pfx].
      move: (ltP pfx) (leP pf) => X Y.
      omega. }
    have H: (n = n.-1.+1).
    { rewrite (ltn_predK (m:=0)) => //. }
    symmetry in H.
    by apply: (enumerate_rec_total _ (gt0_pred_lt n pf) x H).
  Qed.

  Program Instance enum_ok : @Enum_ok t enumerable.
  Next Obligation.
    rewrite /enumerable_fun /enumerable.
    apply: enumerate_t_nodup.
  Qed.
  Next Obligation.
    rewrite /enumerable_fun /enumerable.
    apply: enumerate_t_total.
  Qed.

  Definition Ordinal_of_t (x : t) :=
    @Ordinal n (N.to_nat (val x)) (M.pf x).

  Definition val_of_Ordinal (x : 'I_n) : N :=
    match x with
      Ordinal n _ => N.of_nat n
    end.

  Lemma rev_enumerate_enum :
    List.rev (List.map Ordinal_of_t enumerate_t) =
    enum 'I_n.
  Proof.
    rewrite /enumerate_t; case: (lt_dec 0 n); last first.
    { move => a; move: (leP a) => H; move: (ltP B.n_gt0) => Hx; omega. }
    move => pf.
    suff: (List.rev (map val (enumerate_rec n.-1 (gt0_pred_lt n pf))) =
           List.map val_of_Ordinal (enum 'I_n)).
    { move: (enumerate_rec _ _) => l1.
      move: (enum 'I_n) => l2; elim: l1 l2; first by case.
      move => a l1 /= IH l2 H2.
      have [l2' H]:
        exists l2',
          map val_of_Ordinal l2 = map val_of_Ordinal l2' ++ [:: val a].
      { clear - H2; move: H2; move: (rev _) => l1x.
        elim: l2 l1x => //.
        { move => l1x /=; case: l1x => //. }
        move => ax l2x IH l1x /= H2; case: l1x H2.
        { simpl; inversion 1; subst; exists nil => //. }
        move => ay l1y /=; inversion 1; subst.
        case: (IH _ H1) => ll H3; exists (ax :: ll); simpl.
        by rewrite -H1 in H3; rewrite H3. }
      rewrite H in H2; apply app_inj_tail in H2; case: H2 => H2 _.
      rewrite (IH _ H2); clear - H; symmetry in H.
      have H2:
        map val_of_Ordinal l2' ++ [:: val a] =
        map val_of_Ordinal (l2' ++ [:: Ordinal_of_t a]).
      { by rewrite map_app /= N2Nat.id. }
      rewrite H2 in H; clear H2.
      apply: map_inj; last by apply: H.
      move => x y; case: x => x pfx; case: y => y pfy; move/Nat2N.inj.
      move => H2; subst; f_equal; apply: proof_irrelevance. }
    rewrite enumerate_rec_map_erased.
    suff:
      rev (map N.to_nat (enumerate_rec_erased n.-1)) =
      map N.to_nat (map val_of_Ordinal (enum 'I_n)).
    { rewrite -map_rev; move/map_inj; apply; apply: N2Nat.inj. }
    rewrite enumerate_rec_map_erased_nat.
    rewrite enumerate_rec_erased_nat_iota.
    have ->: (map N.to_nat (map val_of_Ordinal (enum 'I_n)) = iota 0 n).
    { have ->:
        map N.to_nat (map val_of_Ordinal (enum 'I_n)) =
        map eqtype.val (enum 'I_n).
      { elim: (enum 'I_n) => // a l /= IH; f_equal => //.
        by case: a => // m i; rewrite /val_of_Ordinal Nat2N.id. }
      rewrite -val_enum_ord //. }
    have ->: (n.-1.+1 = n).
    { move: (ltP pf) => Hx; omega. }
    by [].
  Qed.
End MyOrdNatDepProps.


Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.Classical_Prop.
Require Import Coq.Logic.Classical_Pred_Type.
Require Import Logic.lib.Bijection.
Require Import Logic.lib.Countable.
Require Import Logic.lib.EnsemblesProperties.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.Complete.Lindenbaum.
Require Import Logic.GeneralLogic.Complete.Lindenbaum_Kripke.
Require Import Logic.GeneralLogic.Complete.ContextProperty.
Require Import Logic.GeneralLogic.Complete.ContextProperty_Kripke.
Require Import Logic.GeneralLogic.Complete.ContextProperty_Trivial.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.Complete.Lindenbaum_Kripke.
Require Import Logic.MinimumLogic.Complete.ContextProperty_Kripke.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.Classical.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.Complete.Lindenbaum_Kripke.
Require Import Logic.PropositionalLogic.Complete.ContextProperty_Kripke.
Require Import Logic.PropositionalLogic.Complete.ContextProperty_Trivial.

Local Open Scope logic_base.
Local Open Scope syntax.
Import PropositionalLanguageNotation.

Section Lindenbaum_Trivial.

Context {L: Language}
        {minL: MinimumLanguage L}
        {pL: PropositionalLanguage L}
        {GammaP: Provable L}
        {GammaD: Derivable L}
        {SC: NormalSequentCalculus L GammaP GammaD}
        {bSC: BasicSequentCalculus L GammaD}
        {fwSC: FiniteWitnessedSequentCalculus L GammaD}
        {minSC: MinimumSequentCalculus L GammaD}
        {ipSC: IntuitionisticPropositionalSequentCalculus L GammaD}
        {cpSC: ClassicalPropositionalSequentCalculus L GammaD}
        {minAX: MinimumAxiomatization L GammaP}
        {ipAX: IntuitionisticPropositionalLogic L GammaP}.

Lemma Lindenbaum_for_max_consistent: forall P,
  Lindenbaum_ensures P derivable_closed ->
  Lindenbaum_ensures P orp_witnessed ->
  Lindenbaum_ensures P consistent ->
  Lindenbaum_ensures P (maximal consistent).
Proof.
  intros.
  hnf; intros.
  apply DDCS_MCS; auto.
Qed.

Lemma Lindenbaum_cannot_derive_ensures_max_consistent
      {AX: NormalAxiomatization L GammaP GammaD}:
  forall x, Lindenbaum_ensures (cannot_derive x) (maximal consistent).
Proof.
  intros.
  apply Lindenbaum_for_max_consistent.
  - apply Lindenbaum_cannot_derive_ensures_derivable_closed.
  - apply Lindenbaum_cannot_derive_ensures_orp_witnessed.
  - apply Lindenbaum_cannot_derive_ensures_consistent.
Qed.

End Lindenbaum_Trivial.


Require Import MirrorCore.Lambda.ExprCore.
Require Import MirrorCore.Lambda.Red.
Require Import MirrorCore.Lambda.ExprLift.
Require Import MirrorCore.Lambda.Expr.
Require Import MirrorCore.TypesI.

Require Import ExtLib.Core.RelDec.

Require Import Charge.SetoidRewrite.Base.
Require Import Charge.SetoidRewrite.AutoSetoidRewrite.
Require Import Charge.ModularFunc.ILogicFunc.

Require Import Charge.Logics.ILogic.

Section ILPullConjunct.
  Context {typ func : Type} {HIL : ILogicFunc typ func}.
  Context {RType_typ : RType typ}.
   Context {RelDec_func : RelDec (@eq (expr typ func))}.

  Let Rbase := expr typ func.

  Variable target : expr typ func -> bool.
Print rewriter.
Check @rewriter.

  Definition rw_under_and (l : typ) (P : expr typ func) (rw : rewriter _) : rewriter _ :=
    fun e rvars rg => rg_fmap (typ := typ) (func := func) (mkAnd l P) (rw e rvars rg).

Definition il_pull_conjunct_l (rw : @rw_type typ func) (e : expr typ func) (rvars : list (RG (expr typ func))) (rg : RG Rbase) : m (expr typ func) :=
  match e with
    | App (App a P) (App (App b Q) R) =>
      match ilogicS (typ := typ) (func := expr typ func) a, ilogicS b with
      	| Some (ilf_and l), Some (ilf_and _) =>
      		match target Q with
      			| true => rg_plus
                   (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGflip (RGinj (fEntails l))))
                      (fun _ => rw_under_and l Q rw (mkAnd l P R) rvars rg))
				   (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGinj (fEntails l)))
				      (fun _ => rw_under_and l Q rw (mkAnd l P R) rvars rg))
      		    | _ => rg_fail
      		end
      	| _, _ => rg_fail
      end
    | _ => rg_fail
  end.

Definition il_pull_conjunct_r (rw : @rw_type typ func) (e : expr typ func) (rvars : list (RG (expr typ func))) (rg : RG Rbase) : m (expr typ func) :=
  match e with
    | App (App a (App (App b P) Q)) R =>
      match ilogicS (typ := typ) (func := expr typ func) a, ilogicS b with
      	| Some (ilf_and l), Some (ilf_and _) =>
      		match target P with
      			| true => rg_plus
	               (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGflip (RGinj (fEntails l))))
	                 (fun _ => rw_under_and l P rw (mkAnd l Q R) rvars rg))
				   (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGinj (fEntails l)))
	                 (fun _ => rw_under_and l P rw (mkAnd l Q R) rvars rg))
      		    | _ => rg_fail
      		end
      	| _, _ => rg_fail
      end
    | _ => rg_fail
  end.

Variable gs : logic_ops.

Definition il_pull_conjunct_sym (rw : @rw_type typ func) (e : expr typ func) (rvars : list (RG (expr typ func))) (rg : RG Rbase) : m (expr typ func) :=
  match e with
    | App (App a P) Q =>
      match ilogicS (typ := typ) (func := expr typ func) a with
      	| Some (ilf_and l) =>
      		match target Q with
      		  | true => rg_plus
		                  (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGflip (RGinj (fEntails l))))
		                     (fun _ => rw_under_and l Q rw P rvars rg))
				 		  (rg_bind (unifyRG (@rel_dec (expr typ func) _ _) rg (RGinj (fEntails l)))
		                     (fun _ => rw_under_and l Q rw P rvars rg))
      		  | _ => rg_fail
      		end
        | _ => rg_fail
      end
    | _ => rg_fail
  end.

Definition il_pull_conjunct := sr_combineK il_pull_conjunct_sym (sr_combineK il_pull_conjunct_l il_pull_conjunct_r).

End ILPullConjunct.

Implicit Arguments il_pull_conjunct [[typ] [func] [HIL] [RelDec_func]].


Require Import sflib.

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

Require Import Time.
Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import NPThread.
Require Import Configuration.
Require Import MsgMapping.
Require Import DelaySet.
Require Import NPConfiguration.

Require Import LocalSim.
Require Import GlobSim.
Require Import ww_RF.

Require Import LibTactics.
Require Import ConfigInitLemmas.
Require Import CompThreadSteps.
Require Import CompAuxDef.
Require Import WFConfig.

Require Import Reordering.
Require Import ps_to_np_thread.
Require Import np_to_ps_thread.

Require Import simPromiseCertified.
Require Import Mem_at_eq_lemmas.
Require Import ConsistentProp.

(** * Compositionality Proof *)

(** This file contains the proof of compositionality of our thread-local simulation.

    The theorem [compositionality] in this file shows the compositionality of our thread-local simulation.
    It says that,
    if each target thread has thread-local simulation with
    its corresponding source thread
    and the source program is safe and write-write race free,
    then the whole target program simulates the whole source program.

    The theorem [compositionality] is a part of proof in Lemma 6.2 in our paper and
    also shown as a part of proof of the step 3 in Figure 6 (Our proof path) in our paper.
 *)

Lemma compositionality_aux:
      forall (index: Type) (index_order: index -> index -> Prop)
        (I: Invariant) (lo: Ordering.LocOrdMap) (b b': bool) inj
        (ths_tgt ths_src: Threads.t) (ctid: IdentMap.key)
        (sc_tgt sc_src: TimeMap.t) (mem_tgt mem_src: Memory.t)
        (WELL_FOUNDED_ORDER: well_founded index_order)
        (WELL_FORMED_INV: wf_I I)
        (READY_THRDS:
           forall tid (READY_TID: tid <> ctid) lang st_tgt lc_tgt
             (READY_TGT_THD: IdentMap.find tid ths_tgt = Some (existT _ lang st_tgt, lc_tgt)),
           exists st_src lc_src,
             IdentMap.find tid ths_src = Some (existT _ lang st_src, lc_src) /\
             @rely_local_sim_state index index_order lang I lo inj
                                   (Thread.mk lang st_tgt lc_tgt sc_tgt mem_tgt)
                                   (Thread.mk lang st_src lc_src sc_src mem_src) /\
             Local.promise_consistent lc_tgt)
        (CUR_THRD:
           forall lang st_tgt lc_tgt
             (CUR_TGT_THRD: IdentMap.find ctid ths_tgt = Some (existT _ lang st_tgt, lc_tgt)),
           exists st_src lc_src dset,
             IdentMap.find ctid ths_src = Some (existT _ lang st_src, lc_src) /\
             @local_sim_state index index_order lang I lo inj dset b
                              (Thread.mk lang st_tgt lc_tgt sc_tgt mem_tgt)
                              (Thread.mk lang st_src lc_src sc_src mem_src) /\
             (b = true -> dset = dset_init) /\
             Local.promise_consistent lc_tgt)
        (COMPLETE_THRDS_MAP:
           forall tid
             (IN_SRC_THRDS: IdentMap.mem tid ths_src = true),
             IdentMap.mem tid ths_tgt = true)
        (SAFE: ~(exists npc,
                    rtc (NPConfiguration.all_step lo)
                        (NPConfiguration.mk (Configuration.mk ths_src ctid sc_src mem_src) b') npc /\
                    Configuration.is_abort (NPConfiguration.cfg npc) lo))
        (WWRF: ~(exists npc,
                    rtc (NPConfiguration.all_step lo)
                        (NPConfiguration.mk (Configuration.mk ths_src ctid sc_src mem_src) b') npc /\
                    aux_ww_race lo (NPConfiguration.cfg npc)))
        (WF_CONFIG_TGT: Configuration.wf (Configuration.mk ths_tgt ctid sc_tgt mem_tgt))
        (WF_CONFIG_SRC: Configuration.wf (Configuration.mk ths_src ctid sc_src mem_src))
        (WF_ATM_BIT: b = true -> b' = true)
        (*(CTID_IN: IdentMap.mem ctid ths_tgt = true)*)
        (INV_OUT_ATM: b = true ->
                      (Mem_at_eq lo mem_tgt mem_src /\ I lo inj (Build_Rss sc_tgt mem_tgt sc_src mem_src)))
        (MONOTONIC_INJ: monotonic_inj inj),
        glob_sim_state lo (NPConfiguration.mk (Configuration.mk ths_tgt ctid sc_tgt mem_tgt) b)
                       (NPConfiguration.mk (Configuration.mk ths_src ctid sc_src mem_src) b').
Proof.
  cofix Hcofix; ii.
  econs; ss; ii.
  + (* tau step *)
    inv TGT_TAU; ss.
    assert(T_STEPS: rtc (NPAuxThread.tau_step lang lo)
                        (NPAuxThread.mk lang (Thread.mk lang st1 lc1 sc_tgt mem_tgt) b)
                        (NPAuxThread.mk lang (Thread.mk lang st2 lc2 sc2 m2) b0)).
    {
      eapply rtc_n1; [eapply STEPS | eapply STEP].
    }
    exploit wf_config_rtc_NPThread_tau_steps_prsv; [ | | eapply T_STEPS | eauto..]; eauto.
    introv T_CONFIG_WF'.
    eapply rtc_rtcn in T_STEPS. des.
    exploit CUR_THRD; [eapply TID1 | eauto..]. ii; des.
    assert(TGT_PROM_CONS: Local.promise_consistent lc2).
    {
      eapply consistent_nprm_promise_consistent in CONSISTENT; eauto; ss.
      eapply wf_config_to_local_wf; eauto.
      instantiate (3 := ctid). rewrite IdentMap.gss; eauto.
      inv T_CONFIG_WF'; eauto. inv T_CONFIG_WF'; eauto.
    }
    exploit sim_tau_steps; [eapply T_STEPS | eauto..]; ss.
    eapply wf_config_to_local_wf; eauto.
    inv WF_CONFIG_TGT; eauto.
    inv WF_CONFIG_TGT; eauto.
    ii; des.
    {
      (* not abort *)
      destruct e_src'.
      exploit wf_config_rtc_NPThread_tau_steps_prsv; [ | | eapply S_STEPS | eauto..]; eauto.
      introv S_CONFIG_WF'.
      eapply rtc_rtcn in S_STEPS. destruct S_STEPS as (n0 & S_STEPS).
      destruct n0.
      {
        (* source takes zero step *)
        inv S_STEPS.
        eexists. split. eauto.
        eapply Hcofix with (b' := b_src') (inj := inj'); eauto.
        {
          ii.
          erewrite IdentMap.gso in READY_TGT_THD; eauto.
          lets READY_SRC_THD: READY_TGT_THD.
          eapply READY_THRDS in READY_SRC_THD; eauto. des.
          do 2 eexists.
          split; eauto.
          split; eauto.
          eapply local_sim_rely_condition with (n_tgt := n) (n_src := 0) (lang2 := lang0); eauto.
          eapply wf_config_to_local_wf; eauto.
          clear S_CONFIG_WF'. eapply wf_config_to_local_wf; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          clear S_CONFIG_WF'. eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). erewrite IdentMap.gso; eauto.
          clear S_CONFIG_WF'. eapply wf_config_to_local_wf; eauto.
          inv T_CONFIG_WF'; eauto.
          inv S_CONFIG_WF'; eauto.
          inv T_CONFIG_WF'; eauto.
          inv S_CONFIG_WF'; eauto.
        }
        {
          ii.
          rewrite IdentMap.gss in CUR_TGT_THRD. inv CUR_TGT_THRD.
          eapply inj_pair2 in H1. subst.
          do 3 eexists. split. eauto. split; eauto.
        }
        {
          ii. rewrite IdentMap.mem_find.
          destruct (Loc.eq_dec tid ctid); subst.
          rewrite IdentMap.gss; eauto.
          rewrite IdentMap.gso; eauto.
          eapply COMPLETE_THRDS_MAP in IN_SRC_THRDS.
          rewrite IdentMap.mem_find in IN_SRC_THRDS. eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE. eexists. split. eauto. ss.
          econs; ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          do 3 eexists. split. eauto.
          split.
          eapply NP_STEPS. eauto.
          clear - STEP_INV RELY_STEP.
          ii. exploit RELY_STEP; eauto. ii; des.
          inv STEP_INV. eauto.
        }
      }
      {
        (* source takes multiply steps *)
        exploit Behavior.rtcn_tail; [eapply S_STEPS | eauto..].
        introv S_STEPS_CONS.
        destruct S_STEPS_CONS as (npc & S_STEPS_CONS & S_STEP).
        destruct npc.
        assert(CONSISTENT_S:
                 NPAuxThread.consistent lang (Thread.mk lang state local sc memory) lo).
        {
          eapply promise_certified_prsv; [ | eapply CONSISTENT | eauto..]; eauto.
          {
            clear - SAFE S_STEPS x.
            eapply rtcn_rtc in S_STEPS.
            introv S_ABORT. destruct S_ABORT as (e_src' & S_STEPS_TO_ABORT & S_ABORT).
            contradiction SAFE.
            eexists. split; eauto; ss.
            eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
            econs; ss.
            do 3 eexists.
            split. eapply x.
            split. eapply rtc_compose; [eapply S_STEPS | eapply S_STEPS_TO_ABORT].
            eauto.
          }
          {
            eapply aux_ww_race_to_thrd_ww_race; eauto; ss.
            eapply rtcn_rtc in S_STEPS.
            eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
          }
          {
            eapply wf_config_to_local_wf; eauto.
            instantiate (3 := ctid). erewrite IdentMap.gss; eauto.
          }
          {
            eapply wf_config_to_local_wf; eauto.
            instantiate (3 := ctid). erewrite IdentMap.gss; eauto.
          }
          {
            inv T_CONFIG_WF'; eauto.
          }
          {
            inv S_CONFIG_WF'; eauto.
          }
          {
            inv T_CONFIG_WF'; eauto.
          }
          {
            inv S_CONFIG_WF'; eauto.
          }
        }
        eexists. split.
        {
          eapply rtcn_rtc in S_STEPS_CONS.
          eapply Operators_Properties.clos_rt1n_step.
          eapply NPConfiguration.step_tau; ss; [ | eapply S_STEPS_CONS | eapply S_STEP | eauto..]; eauto.
        }
        eapply Hcofix; eauto.
        {
          ii.
          rewrite IdentMap.gso in READY_TGT_THD; eauto.
          rewrite IdentMap.gso; eauto.
          lets READY_SRC_THD: READY_TGT_THD.
          eapply READY_THRDS in READY_SRC_THD; eauto. des.
          do 2 eexists.
          split; eauto.
          split; eauto.
          eapply local_sim_rely_condition with (n_tgt := n) (n_src := (S n0)) (lang2 := lang0); eauto.
          eapply wf_config_to_local_wf; eauto.
          eapply wf_config_to_local_wf; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). erewrite IdentMap.gso; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). erewrite IdentMap.gso; eauto.
          inv T_CONFIG_WF'; eauto.
          inv S_CONFIG_WF'; eauto.
          inv T_CONFIG_WF'; eauto.
          inv S_CONFIG_WF'; eauto.
        }
        {
          ii. rewrite IdentMap.gss in CUR_TGT_THRD.
          inv CUR_TGT_THRD.
          eapply inj_pair2 in H1. subst.
          do 3 eexists. split.
          rewrite IdentMap.gss; eauto.
          split; eauto.
        }
        {
          ii. rewrite IdentMap.mem_find.
          destruct (Loc.eq_dec tid ctid); subst.
          rewrite IdentMap.gss; eauto.
          rewrite IdentMap.gso; eauto.
          rewrite IdentMap.mem_find in IN_SRC_THRDS.
          rewrite IdentMap.gso in IN_SRC_THRDS; eauto.
          rewrite <- IdentMap.mem_find in IN_SRC_THRDS.
          eapply COMPLETE_THRDS_MAP in IN_SRC_THRDS.
          rewrite IdentMap.mem_find in IN_SRC_THRDS. eauto.
        }
        {
          clear - SAFE S_STEPS x CONSISTENT_S.
          eapply rtcn_rtc in S_STEPS. ii. des.
          contradiction SAFE.
          eapply rtc_rtcn in S_STEPS. des.
          destruct n.
          inv S_STEPS.
          erewrite IdentMap.gsident in H; eauto.
          eapply Behavior.rtcn_tail in S_STEPS. des. destruct a2. destruct state0.
          eapply rtcn_rtc in S_STEPS.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs; eauto.
          eapply NPConfiguration.step_tau; ss; eauto.
          eapply H. eauto.
        }
        {
          ii; des. contradiction WWRF.
          clear - S_STEPS H H0 CONSISTENT_S x.
          eapply Behavior.rtcn_tail in S_STEPS. des. destruct a2. destruct state0.
          eapply rtcn_rtc in S_STEPS.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs; eauto.
          eapply NPConfiguration.step_tau; ss; eauto.
          eapply H. eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE.
          eapply rtcn_rtc in S_STEPS.
          eexists. split. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          econs; ss. do 3 eexists.
          split. eauto. split.
          eapply rtc_compose. eapply S_STEPS. eapply NP_STEPS. eauto.
          clear - STEP_INV RELY_STEP.
          ii. exploit RELY_STEP; eauto. ii; des.
          inv STEP_INV. eauto.
        }
      }
    }
    {
      (* abort *)
      clear - x SAFE S_STEPS ABORT.
      contradiction SAFE.
      eexists. split; eauto. ss.
      econs; ss.
      eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
      do 3 eexists.
      split; eauto.
    }
  + (* output step *)
    inv TGT_OUT; ss.
    exploit CUR_THRD; [eapply TID1 | eauto..]. ii; des.
    exploit sim_output_steps; [eapply STEP | eauto..]. ii; des.
    {
      (* not abort *)
      assert(CONSISTENT_S': Local.promises (Thread.local e_src0) = Memory.bot /\
                            Local.promises (Thread.local e_src') = Memory.bot).
      {
        clear - S_OUT. inv S_OUT; ss. inv H. inv OUT; ss.
        inv LOCAL; ss. inv LOCAL0; ss. exploit PROMISES; eauto.
      }
      destruct CONSISTENT_S' as (CONSISTENT_S' & CONSISTENT_S'').
      exploit wf_config_NPThread_out_step_prsv; [ | | eapply STEP | eauto..]; eauto.
      introv WF_CONFIG_TGT'.
      destruct e_src0, e_src'.
      exploit wf_config_rtc_NPThread_tau_steps_prsv; [ | | eapply S_STEPS | eauto..]; eauto.
      introv WF_CONFIG_SRC'.
      exploit wf_config_NPThread_out_step_prsv; [ | | eapply S_OUT | eauto..]; eauto.
      instantiate (1 := ctid). rewrite IdentMap.gss; eauto.
      introv WF_CONFIG_SRC''.
      erewrite IdentMap.add_add_eq in WF_CONFIG_SRC''; eauto.
      assert (T_PROM_CONS: Local.promise_consistent lc2).
      {
        inv STEP; ss. inv H; ss. inv OUT; ss.
        inv LOCAL; ss. inv LOCAL0; ss.
        exploit PROMISES; eauto. introv T_BOT.
        unfold Local.promise_consistent; ss.
        rewrite T_BOT; ss. ii. rewrite Memory.bot_get in PROMISE; ss.
      }
      eapply rtc_rtcn in S_STEPS. des. destruct n.
      {
        inv S_STEPS; ss.
        do 2 eexists. split. eauto.
        split.
        econs; ss. eapply x. eapply S_OUT.
        ss. econs. split. eauto. ss.
        eapply Hcofix with (inj := inj'); eauto.
        {
          ii.
          rewrite IdentMap.gso in READY_TGT_THD; eauto.
          rewrite IdentMap.gso; eauto. ss.
          exploit READY_THRDS; [eapply READY_TID | eapply READY_TGT_THD | eauto..]. ii; des.
          do 2 eexists. split. eauto.
          split; eauto.
          eapply local_sim_out_rely_condition in x4; eauto.
          eapply wf_config_to_local_wf; eauto.
          eapply wf_config_to_local_wf; eauto. instantiate (3 := ctid). erewrite IdentMap.gss; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_TGT; eauto.
          ss. inv WF_CONFIG_SRC'.
          ss. inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC'; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). erewrite IdentMap.gso; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). erewrite IdentMap.gso; eauto.
          inv WF_CONFIG_TGT'; eauto.
          inv WF_CONFIG_SRC'; eauto.
          inv WF_CONFIG_TGT'; eauto.
          inv WF_CONFIG_SRC''; eauto.
          inv WF_CONFIG_SRC''; eauto.
        }
        {
          ii. rewrite IdentMap.gss in CUR_TGT_THRD; eauto.
          inv CUR_TGT_THRD. eapply inj_pair2 in H1. subst.
          do 3 eexists. split. rewrite IdentMap.gss; eauto.
          split; eauto.
        }
        {
          ii. rewrite IdentMap.mem_find.
          destruct (Loc.eq_dec tid ctid); subst.
          rewrite IdentMap.gss; eauto.
          rewrite IdentMap.gso; eauto.
          rewrite IdentMap.mem_find in IN_SRC_THRDS.
          rewrite IdentMap.gso in IN_SRC_THRDS; eauto.
          rewrite <- IdentMap.mem_find in IN_SRC_THRDS.
          eapply COMPLETE_THRDS_MAP in IN_SRC_THRDS.
          rewrite IdentMap.mem_find in IN_SRC_THRDS. eauto.
        }
        {
          introv ABORT. destruct ABORT as (npc & TO_ABORT & ABORT).
          contradiction SAFE. exists npc.
          split. eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; ss; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; ss.
          eexists. split; eauto.
          eauto. eauto.
        }
        {
          introv WW_RACE. destruct WW_RACE as (npc & TO_WW_RACE & WW_RACE).
          contradiction WWRF. exists npc.
          split. eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; ss; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; ss.
          eexists. split; eauto.
          eauto. eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
          eexists. split. eauto. ss.
          ss. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          econs; ss. do 3 eexists.
          erewrite IdentMap.gss; eauto.
          clear - STEP_INV RELY_STEP.
          ii. exploit RELY_STEP; eauto. ii; des.
          inv STEP_INV. eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
          eexists. split. eauto. ss.
          ss. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          econs; ss. do 3 eexists.
          erewrite IdentMap.gss; eauto.
          clear - WELL_FORMED_INV RELY_STEP.
          exploit RELY_STEP; eauto. intros. des. clear x0 RELY_STEP.
          unfold wf_I in WELL_FORMED_INV. eapply WELL_FORMED_INV in x; eauto; ss.
          inv x; eauto.
        }
      }
      {
        ss.
        exploit Behavior.rtcn_tail; [eapply S_STEPS | eauto..].
        introv S_STEPS_CONS.
        destruct S_STEPS_CONS as (npc & S_STEPS_CONS & S_STEP).
        eapply rtcn_rtc in S_STEPS_CONS.
        do 2 eexists. split.
        eapply Relation_Operators.rt1n_trans. 2: eauto.
        eapply NPConfiguration.step_tau; ss.
        2: eapply S_STEPS_CONS. 2: eapply S_STEP. eauto.
        unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; ss.
        eexists. split; eauto; ss.
        split.
        econs; ss; eauto. rewrite IdentMap.gss; eauto.
        ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; ss; eauto.
        eapply Hcofix with (inj := inj'); eauto.
        {
          ii. rewrite IdentMap.gso in READY_TGT_THD; eauto.
          rewrite IdentMap.add_add_eq; eauto.
          rewrite IdentMap.gso; eauto.
          exploit READY_THRDS; eauto. ii; des.
          do 2 eexists. split; eauto.
          split; eauto.
          eapply local_sim_out_rely_condition with (n_src := S n) in x4; eauto.
          eapply wf_config_to_local_wf; eauto.
          eapply wf_config_to_local_wf; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). rewrite IdentMap.gso; eauto.
          eapply wf_config_to_local_wf; eauto.
          instantiate (3 := tid). rewrite IdentMap.gso; eauto.
          inv WF_CONFIG_TGT'; eauto.
          inv WF_CONFIG_TGT'; eauto.
          inv WF_CONFIG_SRC''; eauto.
          inv WF_CONFIG_SRC''; eauto.
        }
        {
          ii. rewrite IdentMap.add_add_eq; eauto.
          try rewrite IdentMap.gss in *; eauto.
          inv CUR_TGT_THRD. eapply inj_pair2 in H1. subst.
          do 3 eexists. split; eauto.
        }
        {
          rewrite IdentMap.add_add_eq; eauto.
          ii. rewrite IdentMap.mem_find.
          destruct (Loc.eq_dec tid ctid); subst.
          rewrite IdentMap.gss; eauto.
          rewrite IdentMap.gso; eauto.
          rewrite IdentMap.mem_find in IN_SRC_THRDS.
          rewrite IdentMap.gso in IN_SRC_THRDS; eauto.
          rewrite <- IdentMap.mem_find in IN_SRC_THRDS.
          eapply COMPLETE_THRDS_MAP in IN_SRC_THRDS.
          rewrite IdentMap.mem_find in IN_SRC_THRDS. eauto.
        }
        {
          introv ABORT. destruct ABORT as (npc' & TO_ABORT & ABORT).
          contradiction SAFE.
          exists npc'.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_tau; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; eauto.
          ss. eapply Relation_Operators.rt1n_trans. 2: eauto.
          econs. eapply NPConfiguration.step_out; ss; eauto; ss.
          rewrite IdentMap.gss; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; eauto.
          eauto.
        }
        {
          introv WW_RACE. destruct WW_RACE as (npc' & TO_WW_RACE & WW_RACE).
          contradiction WWRF.
          exists npc'.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_tau; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; eauto.
          ss. eapply Relation_Operators.rt1n_trans. 2: eauto.
          econs. eapply NPConfiguration.step_out; ss; eauto; ss.
          rewrite IdentMap.gss; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ii; eauto.
          eauto.
        }
        {
          rewrite IdentMap.add_add_eq; eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_tau; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss.
          ii. eexists. split. eauto. ss.
          ss.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; eauto.
          ss. rewrite IdentMap.gss; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
          eexists. split. eauto. ss.
          ss. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          econs; ss. do 3 eexists.
          split.
          erewrite IdentMap.gss; eauto.
          split; eauto.
          clear - STEP_INV RELY_STEP.
          ii. exploit RELY_STEP; eauto. ii; des.
          inv STEP_INV. eauto.
        }
        {
          inv LOCAL_SIM_PSV; ss.
          contradiction SAFE.
          eexists. split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_tau; eauto.
          unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss.
          ii. eexists. split. eauto. ss.
          ss.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_out; eauto.
          ss. rewrite IdentMap.gss; eauto.
          ss. unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
          eexists. split. eauto. ss.
          ss. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
          econs; ss. do 3 eexists.
          split.
          erewrite IdentMap.gss; eauto.
          split; eauto.
          clear - WELL_FORMED_INV RELY_STEP.
          exploit RELY_STEP; eauto. intros; des. clear RELY_STEP x0.
          unfold wf_I in WELL_FORMED_INV.
          eapply WELL_FORMED_INV in x; ss. inv x; eauto.
        }
      }
    }
    {
      (* abort *)
      clear - x SAFE S_STEPS ABORT.
      contradiction SAFE.
      eexists. split; eauto. ss.
      econs; ss.
      eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
      do 3 eexists.
      split; eauto.
    }
  + (* switch *)
    destruct npc_tgt'. destruct cfg.
    destruct (Loc.eq_dec tid ctid).
    {
      (* switch to the same thread *)
      subst.
      inv TGT_SW; ss.
      {
        (* thread not term *)
        inv NPC2; ss.
        exploit CUR_THRD; eauto. ii; des.
        do 2 eexists.
        split. eauto.
        split.
        econs; ss; eauto.
        eapply Hcofix; eauto.
        {
          introv ABORT.
          destruct ABORT as (npc & TO_ABORT & ABORT).
          contradiction SAFE.
          eexists.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_sw; ss; eauto.
          eauto. eauto.
        }
        {
          introv WW_RACE.
          destruct WW_RACE as (npc' & TO_WW_RACE & WW_RACE).
          contradiction WWRF.
          exists npc'.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs. eapply NPConfiguration.step_sw; ss; eauto.
          eauto. eauto.
        }
      }
      {
        (* thread term: contradiction *)
        inv NPC2.
        rewrite IdentMap.grs in NEW_TID_OK. ss.
      }
    }
    {
      (* switch to another thread *)
      inv TGT_SW; ss; subst.
      {
        (* thread not term *)
        inv NPC2; ss.
        exploit READY_THRDS; eauto. ii; des.
        assert(I_INV: I lo inj (Build_Rss sc_tgt mem_tgt sc_src mem_src) /\
                      Mem_at_eq lo mem_tgt mem_src).
        {
          exploit INV_OUT_ATM; eauto. ii. des. split; eauto.
        }
        destruct I_INV as (I_INV & MEM_AT_EQ).
        exploit rely_local_sim_state_to_local_sim_state; eauto.
        eapply wf_config_to_local_wf; eauto.
        eapply wf_config_to_local_wf; eauto.
        inv WF_CONFIG_TGT; eauto.
        inv WF_CONFIG_SRC; eauto.
        inv WF_CONFIG_TGT; eauto.
        inv WF_CONFIG_SRC; eauto.
        introv NEW_TH_LOCAL_SIM.
        do 2 eexists.
        split. eauto.
        split.
        econs; eauto; ss.
        ss.
        eapply Hcofix; eauto.
        {
          ii.
          destruct (Loc.eq_dec tid ctid); subst.
          {
            exploit CUR_THRD; [eapply READY_TGT_THD | eauto..].
            ii; des.
            do 2 eexists. split; eauto.
            exploit x4; eauto. ii; subst.
            split; eauto.
            eapply local_sim_state_to_rely_local_sim_state; eauto.
            instantiate (1 := ctid).
            introv ABORT. destruct ABORT as (npc' & TO_ABORT & ABORT).
            contradiction SAFE. clear SAFE.
            exploit WF_ATM_BIT; eauto. ii; subst.
            exists npc'.
            split. eauto.
            eapply NPConfig_abort_to_Config_abort; eauto.
          }
          {
            exploit READY_THRDS; eauto.
          }
        }
        {
          ii.
          exploit READY_THRDS; eauto. ii; des.
          exploit rely_local_sim_state_to_local_sim_state; eauto.
          eapply wf_config_to_local_wf; eauto.
          eapply wf_config_to_local_wf; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          inv WF_CONFIG_TGT; eauto.
          inv WF_CONFIG_SRC; eauto.
          ii; des.
          do 3 eexists.
          split. eauto.
          split. eauto.
          eauto.
        }
        {
          introv ABORT. destruct ABORT as (npc & TO_ABORT & ABORT).
          contradiction SAFE.
          exists npc.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs.
          eapply NPConfiguration.step_sw; eauto.
          ss. eauto.
        }
        {
          introv WW_RACE. destruct WW_RACE as (npc & TO_WW_RACE & WW_RACE).
          contradiction WWRF.
          exists npc.
          split.
          eapply Relation_Operators.rt1n_trans.
          econs.
          eapply NPConfiguration.step_sw; eauto.
          ss. eauto.
        }
        {
          eapply wf_config_sw_prsv; eauto.
        }
        {
          eapply wf_config_sw_prsv; eauto.
        }
      }
      {
        (* thread term *)
        inv NPC2; ss.
        exploit CUR_THRD; eauto. ii. des.
        inv x0; ss.
        {
          (* source will abort *)
          contradiction SAFE.
          eexists. split. eauto. ss.
          eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS. ss.
          econs; ss.
          do 3 eexists.
          split. eauto.
          split. eapply NP_STEPS. eauto.
        }
        {
          (* source not abort *)
          clear THRD_STEP RELY_STEP THRD_ABORT.
          exploit THRD_DONE0; eauto. ii; des.
          rewrite IdentMap.gro in NEW_TID_OK; eauto.
          exploit READY_THRDS; eauto. ii; des.
          exploit na_steps_dset_to_NPThread_tau_steps; eauto.
          instantiate (1 := b'). introv Hprefix_tau_steps. des.
          eapply rtc_rtcn in Hprefix_tau_steps.
          destruct Hprefix_tau_steps as (n0 & Hprefix_tau_steps).
          destruct n0.
          {
            inv Hprefix_tau_steps; ss.
            do 2 eexists.
            split. eauto.
            split.
            eapply NPConfiguration.step_thread_term; eauto; ss.
            instantiate (3 := tid2). rewrite IdentMap.gro; eauto.
            ss.
            eapply Hcofix with (inj := inj'); eauto.
            {
              ii.
              destruct (Loc.eq_dec tid ctid); subst.
              rewrite IdentMap.grs in READY_TGT_THD; ss.
              rewrite IdentMap.gro in READY_TGT_THD; eauto.
              rewrite IdentMap.gro; eauto.
              exploit READY_THRDS; eauto. ii; des.
              eapply local_sim_rely_condition with (n_tgt := 0) (n_src := 0) in x10; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
            }
            {
              ii.
              try rewrite IdentMap.gro in *; eauto.
              exploit READY_THRDS; eauto. ii; des.
              eapply local_sim_rely_condition with
                  (n_tgt := 0) (n_src := 0) (lc_tgt1 := lc1) (lc_src1 := lc_src) in x10; eauto.
              rewrite NEW_TID_OK in CUR_TGT_THRD.
              inv CUR_TGT_THRD. eapply inj_pair2 in H1. subst.
              eapply rely_local_sim_state_to_local_sim_state in x10; eauto.
              do 3 eexists.
              split. eauto.
              split. eauto.
              eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv STEP_INV; ss.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
            }
            {
              ii. rewrite IdentMap.mem_find in IN_SRC_THRDS.
              destruct (Loc.eq_dec tid ctid); subst.
              rewrite IdentMap.grs in IN_SRC_THRDS; ss.
              rewrite IdentMap.mem_find.
              try rewrite IdentMap.gro in *; eauto.
              try rewrite <- IdentMap.mem_find in *.
              eauto.
            }
            {
              introv ABORT. destruct ABORT as (npc & TO_ABORT & ABORT).
              contradiction SAFE.
              exists npc.
              split.
              eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_thread_term; eauto.
              ss. instantiate (3 := tid2). rewrite IdentMap.gro; eauto.
              ss. eauto.
            }
            {
              introv WW_RACE. destruct WW_RACE as (npc & TO_WW_RACE & WW_RACE).
              contradiction WWRF.
              exists npc.
              split.
              eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_thread_term; eauto.
              ss. instantiate (3 := tid2). rewrite IdentMap.gro; eauto.
              ss. eauto.
            }
            {
              eapply wf_config_rm_prsv; eauto.
            }
            {
              eapply wf_config_rm_prsv; eauto.
            }
            {
              ii. split; eauto.
              inv STEP_INV; eauto.
            }
            {
              clear - WELL_FORMED_INV x5.
              unfold wf_I in WELL_FORMED_INV.
              eapply WELL_FORMED_INV in x5; ss. inv x5; eauto.
            }
          }
          {
            exploit Behavior.rtcn_tail; [eapply Hprefix_tau_steps | eauto..].
            introv Hprefix_tau_steps'.
            destruct Hprefix_tau_steps' as (npc' & PREFIX_STEPS & PREFIX_STEP).
            destruct npc'. destruct state.
            eapply rtcn_rtc in PREFIX_STEPS.
            assert(CONSISTENT_T: Local.promises (Thread.local e_src) = Memory.bot).
            {
              clear - x3. inv x3. eauto.
            }
            exploit rtcn_rtc; [eapply Hprefix_tau_steps | eauto..]. introv PROFIX_STEPS_TEMP.
            destruct e_src.
            exploit wf_config_rtc_NPThread_tau_steps_prsv; [ | | eapply PROFIX_STEPS_TEMP | eauto..]; eauto.
            introv WF_CONFIG_SRC'.
            do 2 eexists.
            split. clear PROFIX_STEPS_TEMP.
            eapply Relation_Operators.rt1n_trans.
            eapply NPConfiguration.step_tau; eauto.
            unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
            eexists. split; eauto.
            ss. eauto.
            split.
            eapply NPConfiguration.step_thread_term; ss; eauto.
            rewrite IdentMap.gss; eauto.
            ss. instantiate (3 := tid2).
            rewrite IdentMap.gro; eauto.
            rewrite IdentMap.gso; eauto.
            eapply Hcofix with (inj := inj'); eauto.
            {
              ii.
              destruct (Loc.eq_dec tid ctid); subst.
              rewrite IdentMap.grs in READY_TGT_THD; ss.
              try rewrite IdentMap.gro in *; eauto.
              rewrite IdentMap.gso; eauto.
              exploit READY_THRDS; eauto. ii; des.
              clear PREFIX_STEPS PREFIX_STEP.
              eapply local_sim_rely_condition with (n_tgt := 0) (n_src := (S n0)) in x10; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              instantiate (3 := tid). rewrite IdentMap.gso; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
            }
            {
              ss. clear PREFIX_STEPS PREFIX_STEP. ii.
              destruct (Loc.eq_dec tid2 ctid); subst.
              rewrite IdentMap.grs in CUR_TGT_THRD. ss.
              try rewrite IdentMap.gro in *; eauto.
              rewrite IdentMap.gso; eauto.
              exploit READY_THRDS; eauto. ii; des.
              eapply local_sim_rely_condition with (n_tgt := 0) (n_src := (S n0)) in x10; eauto.
              eapply rely_local_sim_state_to_local_sim_state in x10; eauto.
              do 3 eexists.
              split. eauto.
              split. eauto.
              eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              instantiate (3 := tid2). rewrite IdentMap.gso; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
              inv STEP_INV; ss; eauto.
              clear - x0 ATOMIC_COVER.
              eapply na_steps_dset_to_Thread_na_steps in x0.
              eapply Mem_at_eq_na_steps_prsv with (m := mem_tgt) in x0; ss; eauto.
              eapply Mem_at_eq_reflexive; eauto.
              eapply Mem_at_eq_reflexive; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC; eauto.
              eapply wf_config_to_local_wf; eauto.
              eapply wf_config_to_local_wf; eauto.
              instantiate (3 := tid2). rewrite IdentMap.gso; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
              inv WF_CONFIG_TGT; eauto.
              inv WF_CONFIG_SRC'; eauto.
            }
            {
              ii. try rewrite IdentMap.mem_find in *.
              destruct (Loc.eq_dec tid ctid); subst.
              rewrite IdentMap.grs in IN_SRC_THRDS; eauto.
              try rewrite IdentMap.gro in *; eauto.
              rewrite IdentMap.gso in IN_SRC_THRDS; eauto.
              try rewrite <- IdentMap.mem_find in *.
              eauto.
            }
            {
              introv ABORT. destruct ABORT as (npc' & TO_ABORT & ABORT).
              contradiction SAFE. clear PROFIX_STEPS_TEMP.
              eexists npc'. split; eauto.
              eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_tau; eauto.
              unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
              eexists. split; eauto.
              ss. eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_thread_term; ss; eauto.
              rewrite IdentMap.gss; eauto.
              ss. instantiate (3 := tid2).
              rewrite IdentMap.gro; eauto.
              rewrite IdentMap.gso; eauto.
              eauto.
            }
            {
              introv WW_RACE. destruct WW_RACE as (npc' & TO_WW_RACE & WW_RACE).
              contradiction WWRF. clear PROFIX_STEPS_TEMP.
              exists npc'. split; eauto.
              eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_tau; eauto.
              unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
              eexists. split; eauto.
              ss. eapply Relation_Operators.rt1n_trans.
              econs. eapply NPConfiguration.step_thread_term; ss; eauto.
              rewrite IdentMap.gss; eauto.
              ss. instantiate (3 := tid2).
              rewrite IdentMap.gro; eauto.
              rewrite IdentMap.gso; eauto.
              eauto.
            }
            {
              eapply wf_config_rm_prsv; eauto.
            }
            {
              eapply wf_config_rm_prsv; eauto.
            }
            {
              ss. ii.
              split; eauto.
              inv STEP_INV.
              eapply na_steps_dset_to_Thread_na_steps in x0.
              eapply Mem_at_eq_na_steps_prsv with (m := mem_tgt) in x0; eauto; ss.
              eapply Mem_at_eq_reflexive; eauto.
              eapply Mem_at_eq_reflexive; eauto.
            }
            {
              clear - WELL_FORMED_INV x5; ss.
              unfold wf_I in WELL_FORMED_INV.
              eapply WELL_FORMED_INV in x5; ss. inv x5; eauto.
            }
          }
        }
      }
    }
  + (* program done *)
    inv TGT_DONE; ss. des.
    exploit CUR_THRD; eauto. ii. des.
    inv x1; ss.
    {
      (* source will abort *)
      contradiction SAFE.
      eexists. split. eauto. ss.
      eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS. ss.
      econs; ss.
      do 3 eexists.
      split. eauto.
      split. eapply NP_STEPS. eauto.
    }
    {
      (* source not abort *)
      clear THRD_STEP RELY_STEP THRD_ABORT.
      exploit THRD_DONE; eauto. ii; des. clear THRD_DONE.
      exploit na_steps_dset_to_NPThread_tau_steps; eauto.
      instantiate (1 := b'). introv Hprefix_tau_steps. des. renames x to lang.
      eapply rtc_rtcn in Hprefix_tau_steps.
      destruct Hprefix_tau_steps as (n0 & Hprefix_tau_steps).
      assert(TO_DONE_S: IdentMap.is_empty (IdentMap.remove ctid ths_src) = true).
      {
        eapply IdentMap.is_empty_1.
        eapply IdentMap.is_empty_2 in H1.
        unfold IdentMap.Empty in *. ii.
        eapply IdentMap.find_1 in H2.
        destruct (Loc.eq_dec a ctid); subst.
        rewrite IdentMap.grs in H2; ss.
        rewrite IdentMap.gro in H2; eauto.
        assert(CONRT_SRC: IdentMap.mem a ths_src = true).
        {
          rewrite IdentMap.mem_find. rewrite H2; eauto.
        }
        exploit COMPLETE_THRDS_MAP; eauto. introv CONTR_TGT.
        rewrite IdentMap.mem_find in CONTR_TGT.
        destruct (IdentMap.find a ths_tgt) eqn: CONTR_TGT_TID; ss.
        specialize (H1 a p).
        contradiction H1.
        eapply IdentMap.find_2. rewrite IdentMap.gro; eauto.
      }
      assert(CONSISTENT_S: Local.promises (Thread.local e_src) = Memory.bot).
      {
        clear - x4. inv x4. eauto.
      }
      destruct n0.
      {
        inv Hprefix_tau_steps; ss.
        eexists. split. eauto.
        econs; eauto.
      }
      {
        exploit Behavior.rtcn_tail; eauto. ii; des.
        destruct e_src.
        eexists.
        split.
        eapply Relation_Operators.rt1n_trans.
        eapply rtcn_rtc in x7.
        eapply NPConfiguration.step_tau; eauto.
        unfold NPAuxThread.consistent. unfold Thread.consistent_nprm; ss. ii.
        eexists. split. eauto. ss.
        ss. eauto.
        econs; eauto.
        ss.
        rewrite IdentMap.gss.
        do 2 eexists. split. eauto.
        split; eauto.
        eapply IdentMap.is_empty_2 in TO_DONE_S.
        eapply IdentMap.is_empty_1; eauto.
        unfold IdentMap.Empty in *. ii.
        specialize (TO_DONE_S a e). contradiction TO_DONE_S.
        eapply IdentMap.find_1 in H2.
        eapply IdentMap.find_2.
        destruct (Loc.eq_dec a ctid); subst.
        rewrite IdentMap.grs in H2; ss.
        rewrite IdentMap.gro in H2; eauto.
        rewrite IdentMap.gso in H2; eauto.
        rewrite IdentMap.gro; eauto.
      }
    }
  + (* abort *)
    inv TGT_ABORT; ss. des; subst; ss.
    exploit CUR_THRD; eauto. ii; des.
    eapply rtc_rtcn in H2; des.
    exploit sim_tau_steps; eauto; ss.
    eapply wf_config_to_local_wf; eauto.
    inv WF_CONFIG_TGT; eauto. inv WF_CONFIG_TGT; eauto.
    inv H3. des; eauto.
    ii; des.
    {
      inv LOCAL_SIM_PSV; ss.
      {
        (* source thread abort *)
        contradiction SAFE.
        eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS; ss.
        eapply NPAuxThread_tau_steps_2_Thread_tau_steps in NP_STEPS; ss.
        eexists.
        split. eauto. ss.
        econs; ss.
        do 3 eexists.
        split. eapply x0.
        split. eapply rtc_compose. eapply S_STEPS. eapply NP_STEPS.
        eauto.
      }
      {
        (* target not promise consistent *)
        inv H3; ss.
      }
      {
        (* source thread not abort *)
        clear THRD_STEP RELY_STEP THRD_DONE.
        exploit THRD_ABORT; eauto. ii; des.
        eapply rtc_rtcn in x4. des.
        eapply rtc_na_p_to_np with (b := b_src') in x4; eauto. des.
        eapply np_na_steps_is_tau_steps in x4.
        eexists. split. eauto.
        econs; ss.
        do 6 eexists.
        split. eauto. ss.
        split. eapply x0.
        split. eauto.
        split.
        eapply rtc_compose. eapply S_STEPS. eapply x4.
        eauto.
      }
    }
    {
      contradiction SAFE.
      eexists. split. eauto. ss.
      eapply NPAuxThread_tau_steps_2_Thread_tau_steps in S_STEPS. ss.
      econs; ss.
      do 3 eexists.
      split. eauto.
      split. eapply S_STEPS. eauto.
    }
    Unshelve.
    exact state.
    exact true.
    exact lang.
    exact st_src0.
    exact true.
    exact st_src0.
    exact true.
    exact lang.
    exact st_src.
    exact true.
    exact st_src.
    exact true.
    exact st_src.
    exact true.
    exact st_src.
    exact true.
Qed.

(** ** Compositionality *)
(** It depicts the following conclusion, if
    - [LOCAL_SIM]: local simulation holds;
    - [SAFE_NP_SRC]: source program is safe under the non-preemptive semantics;
    - [WW_RF_NP_SRC]: source progra is write-write race freedom;
    then the global simulation holds. *)
Theorem compositionality
        (lang: language) (index: Type) (index_order: index -> index -> Prop)
        (I: Invariant) (lo: Ordering.LocOrdMap)
        (code_t code_s: Language.syntax lang) (fs: list IdentMap.key) (ctid: IdentMap.key)
        (LOCAL_SIM: @local_sim index index_order lang I lo code_t code_s)
        (SAFE_NP_SRC: NPConfiguration.safe lo fs code_s ctid)
        (WW_RF_NP_SRC: ww_rf_np lo fs code_s ctid):
  glob_sim lang lo fs ctid code_t code_s.
Proof.
  intros.
  inv LOCAL_SIM.
  unfold glob_sim.
  introv TGT_INIT.

  (* destruct the target initial state *)
  unfolds NPConfiguration.init.
  destruct (Configuration.init fs code_t ctid) eqn:H_tgt_init; tryfalse.
  inv TGT_INIT.
  renames t to c_tgt.

  (* construct the source initial state *)
  lets H_src_init : H_tgt_init.
  eapply cons_source_init_from_target_init_program in H_src_init; eauto.
  destruct H_src_init as (c_src & H_src_init & Htgt_2_src & Hsrc_2_tgt).
  rewrite H_src_init.
  eexists. split; eauto.

  (* construct global simulation *)
  destruct c_tgt, c_src; simpls.
  renames threads to ths_tgt, sc to sc_tgt, memory to mem_tgt.
  renames threads0 to ths_src, sc0 to sc_src, memory0 to mem_src.
  assert (Hctid: tid = ctid /\ tid0 = ctid).
  {
    clear - H_tgt_init H_src_init.
    unfolds Configuration.init.
    destruct (Threads.init fs code_t); tryfalse.
    inv H_tgt_init.
    destruct (Threads.init fs code_s); tryfalse.
    inv H_src_init; eauto.
  }
  destruct Hctid; subst.
  eapply config_init_ths_sc_mem in H_tgt_init; simpl in H_tgt_init.
  destruct H_tgt_init as (Hths_tgt_init & Hsc_tgt_init & Hmem_tgt_init); subst.
  eapply config_init_ths_sc_mem in H_src_init; simpl in H_src_init.
  destruct H_src_init as (Hths_src_init & Hsc_src_init & Hmem_src_init); subst.
  assert (NP_CONFIG_INIT: NPConfiguration.init fs code_s ctid =
                          Some (NPConfiguration.mk (Configuration.mk ths_src ctid TimeMap.bot Memory.init) true)).
  {
    clear - Hths_src_init.
    unfold NPConfiguration.init, Configuration.init; simpl.
    rewrite Hths_src_init; eauto.
  }
  eapply compositionality_aux with (I := I) (inj := inj_init); eauto.
  {
    (* ready threads *)
    introv Hready_tid Hready_th.
    assert (lang0 = lang).
    {
      clear - Hths_tgt_init Hready_th.
      eapply thread_init_same_lang in Hths_tgt_init; eauto.
    }
    subst.
    eapply Htgt_2_src in Hready_th.
    destruct Hready_th as (st_src & lc_src & Hlc_tgt_init & Hlc_src_init & Hsrc_ready_th & Hlocal_sim_state); subst.
    do 2 eexists.
    split. eapply Hsrc_ready_th.
    split; eauto.
    eapply local_sim_state_to_rely_local_sim_state; eauto.
    instantiate (1 := ctid).
    clear - SAFE_NP_SRC NP_CONFIG_INIT.
    inv SAFE_NP_SRC.
    eapply SAFE_EXEC in NP_CONFIG_INIT. ii. des.
    contradiction NP_CONFIG_INIT. econs; eauto.
    unfold Local.promise_consistent, Local.init; ii; ss.
    rewrite Memory.bot_get in PROMISE; eauto. ss.
    unfold Local.promise_consistent, Local.init; ii; ss.
    rewrite Memory.bot_get in PROMISE; eauto. ss.
  }
  {
    (* current thread *)
    introv Hcur_th.
    assert (lang0 = lang).
    {
      clear - Hths_tgt_init Hcur_th.
      eapply thread_init_same_lang in Hths_tgt_init; eauto.
    }
    subst.
    eapply Htgt_2_src in Hcur_th.
    destruct Hcur_th as(st_src & lc_src & Hlc_tgt_init & Hlc_src_init & Hsrc_cur_th & Hlocal_sim_state); subst.
    do 3 eexists.
    split; eauto. split; eauto.
    split; eauto.
    unfold Local.promise_consistent, Local.init; ii; ss.
    rewrite Memory.bot_get in PROMISE; eauto. ss.
  }
  {
    (* safe *)
    eapply sound_np_abort; eauto.
    clear - SAFE_NP_SRC NP_CONFIG_INIT.
    inv SAFE_NP_SRC.
    eapply SAFE_EXEC in NP_CONFIG_INIT; eauto.
    clear - NP_CONFIG_INIT.
    introv Hnp_abort.
    contradict NP_CONFIG_INIT.
    destruct Hnp_abort as (npc' & Hrtc_steps & Habort).
    econstructor; eauto.
  }
  {
    (* write-write race free *)
    eapply sound_np_aux_wwrf; eauto.
    eapply wf_config_init with (fs := fs) (code := code_s) (ctid := ctid); eauto.
    clear - NP_CONFIG_INIT.
    unfolds NPConfiguration.init; eauto.
    destruct (Configuration.init fs code_s ctid); tryfalse.
    inv NP_CONFIG_INIT; eauto.
    clear - WW_RF_NP_SRC NP_CONFIG_INIT.
    unfolds ww_rf_np.
    introv Haux_ww_race.
    contradict WW_RF_NP_SRC.
    destruct Haux_ww_race as (npc' & Hrtc & Haux_ww_race).
    econstructor.
    Focus 2. eapply Hrtc.
    eauto.
    eauto.
  }
  {
    (* well-formed target configuraiton in initialization *)
    eapply wf_config_init with (fs := fs) (code := code_t) (ctid := ctid); eauto.
    unfold Configuration.init.
    rewrite Hths_tgt_init; eauto.
  }
  {
    (* well-formed source configuration in initialization *)
    eapply wf_config_init with (fs := fs) (code := code_s) (ctid := ctid); eauto.
    unfold Configuration.init.
    rewrite Hths_src_init; eauto.
  }
  {
    (* init Mem_at_eq I *)
    ii. split; eauto.
    eapply Mem_at_eq_init.
  }
  {
    (* monotonic inj *)
    unfold monotonic_inj. unfold inj_init; ss. ii.
    des_ifH INJ1; ss; subst. inv INJ1.
    des_ifH INJ2; ss; subst. inv INJ2.
    auto_solve_time_rel.
  }
Qed.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^256 - 4294968273
Base: 25.6
***)

Definition curve : CurveParameters :=
  {|
    sz := 10%nat;
    base := 25 + 3/5;
    bitwidth := 64;
    s := 2^256;
    c := [(1, 4294968273)];
    carry_chains := Some [seq 0 (pred 10); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.