From Hammer Require Import Hammer.

From compcert Require Import Raux.
From compcert Require Import Defs.
From compcert Require Import Round_pred.
From compcert Require Import Generic_fmt.
From compcert Require Import Float_prop.
From compcert Require Import FIX.
From compcert Require Import Ulp.
From compcert Require Import Round_NE.
Require Import Psatz.

Section RND_FLX.

Variable beta : radix.

Notation bpow e := (bpow beta e).

Variable prec : Z.

Class Prec_gt_0 :=
prec_gt_0 : (0 < prec)%Z.

Context { prec_gt_0_ : Prec_gt_0 }.

Inductive FLX_format (x : R) : Prop :=
FLX_spec (f : float beta) :
x = F2R f -> (Z.abs (Fnum f) < Zpower beta prec)%Z -> FLX_format x.

Definition FLX_exp (e : Z) := (e - prec)%Z.

Global Instance FLX_exp_valid : Valid_exp FLX_exp.
Proof. hammer_hook "FLX" "FLX.FLX_exp_valid".
intros k.
unfold FLX_exp.
generalize prec_gt_0.
repeat split ; intros ; omega.
Qed.

Theorem FIX_format_FLX :
forall x e,
(bpow (e - 1) <= Rabs x <= bpow e)%R ->
FLX_format x ->
FIX_format beta (e - prec) x.
Proof. hammer_hook "FLX" "FLX.FIX_format_FLX".
clear prec_gt_0_.
intros x e Hx [[xm xe] H1 H2].
rewrite H1, (F2R_prec_normalize beta xm xe e prec).
now eexists.
exact H2.
now rewrite <- H1.
Qed.

Theorem FLX_format_generic :
forall x, generic_format beta FLX_exp x -> FLX_format x.
Proof. hammer_hook "FLX" "FLX.FLX_format_generic".
intros x H.
rewrite H.
eexists ; repeat split.
simpl.
apply lt_IZR.
rewrite abs_IZR.
rewrite <- scaled_mantissa_generic with (1 := H).
rewrite <- scaled_mantissa_abs.
apply Rmult_lt_reg_r with (bpow (cexp beta FLX_exp (Rabs x))).
apply bpow_gt_0.
rewrite scaled_mantissa_mult_bpow.
rewrite IZR_Zpower, <- bpow_plus.
2: now apply Zlt_le_weak.
unfold cexp, FLX_exp.
ring_simplify (prec + (mag beta (Rabs x) - prec))%Z.
rewrite mag_abs.
destruct (Req_dec x 0) as [Hx|Hx].
rewrite Hx, Rabs_R0.
apply bpow_gt_0.
destruct (mag beta x) as (ex, Ex).
now apply Ex.
Qed.

Theorem generic_format_FLX :
forall x, FLX_format x -> generic_format beta FLX_exp x.
Proof. hammer_hook "FLX" "FLX.generic_format_FLX".
clear prec_gt_0_.
intros x [[mx ex] H1 H2].
simpl in H2.
rewrite H1.
apply generic_format_F2R.
intros Zmx.
unfold cexp, FLX_exp.
rewrite mag_F2R with (1 := Zmx).
apply Zplus_le_reg_r with (prec - ex)%Z.
ring_simplify.
now apply mag_le_Zpower.
Qed.

Theorem FLX_format_satisfies_any :
satisfies_any FLX_format.
Proof. hammer_hook "FLX" "FLX.FLX_format_satisfies_any".
refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
intros x.
split.
apply FLX_format_generic.
apply generic_format_FLX.
Qed.

Theorem FLX_format_FIX :
forall x e,
(bpow (e - 1) <= Rabs x <= bpow e)%R ->
FIX_format beta (e - prec) x ->
FLX_format x.
Proof with auto with typeclass_instances. hammer_hook "FLX" "FLX.FLX_format_FIX".
intros x e Hx Fx.
apply FLX_format_generic.
apply generic_format_FIX in Fx.
revert Fx.
apply generic_inclusion with (e := e)...
apply Z.le_refl.
Qed.

Inductive FLXN_format (x : R) : Prop :=
FLXN_spec (f : float beta) :
x = F2R f ->
(x <> 0%R -> Zpower beta (prec - 1) <= Z.abs (Fnum f) < Zpower beta prec)%Z ->
FLXN_format x.

Theorem generic_format_FLXN :
forall x, FLXN_format x -> generic_format beta FLX_exp x.
Proof. hammer_hook "FLX" "FLX.generic_format_FLXN".
intros x [[xm ex] H1 H2].
destruct (Req_dec x 0) as [Zx|Zx].
rewrite Zx.
apply generic_format_0.
specialize (H2 Zx).
apply generic_format_FLX.
rewrite H1.
eexists ; repeat split.
apply H2.
Qed.

Theorem FLXN_format_generic :
forall x, generic_format beta FLX_exp x -> FLXN_format x.
Proof. hammer_hook "FLX" "FLX.FLXN_format_generic".
intros x Hx.
rewrite Hx.
simpl.
eexists. easy.
rewrite <- Hx.
intros Zx.
simpl.
split.

apply le_IZR.
rewrite IZR_Zpower.
2: now apply Zlt_0_le_0_pred.
rewrite abs_IZR, <- scaled_mantissa_generic with (1 := Hx).
apply Rmult_le_reg_r with (bpow (cexp beta FLX_exp x)).
apply bpow_gt_0.
rewrite <- bpow_plus.
rewrite <- scaled_mantissa_abs.
rewrite <- cexp_abs.
rewrite scaled_mantissa_mult_bpow.
unfold cexp, FLX_exp.
rewrite mag_abs.
ring_simplify (prec - 1 + (mag beta x - prec))%Z.
destruct (mag beta x) as (ex,Ex).
now apply Ex.

apply lt_IZR.
rewrite IZR_Zpower.
2: now apply Zlt_le_weak.
rewrite abs_IZR, <- scaled_mantissa_generic with (1 := Hx).
apply Rmult_lt_reg_r with (bpow (cexp beta FLX_exp x)).
apply bpow_gt_0.
rewrite <- bpow_plus.
rewrite <- scaled_mantissa_abs.
rewrite <- cexp_abs.
rewrite scaled_mantissa_mult_bpow.
unfold cexp, FLX_exp.
rewrite mag_abs.
ring_simplify (prec + (mag beta x - prec))%Z.
destruct (mag beta x) as (ex,Ex).
now apply Ex.
Qed.

Theorem FLXN_format_satisfies_any :
satisfies_any FLXN_format.
Proof. hammer_hook "FLX" "FLX.FLXN_format_satisfies_any".
refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
split ; intros H.
now apply FLXN_format_generic.
now apply generic_format_FLXN.
Qed.

Lemma negligible_exp_FLX :
negligible_exp FLX_exp = None.
Proof. hammer_hook "FLX" "FLX.negligible_exp_FLX".
case (negligible_exp_spec FLX_exp).
intros _; reflexivity.
intros n H2; contradict H2.
unfold FLX_exp; unfold Prec_gt_0 in prec_gt_0_; omega.
Qed.

Theorem generic_format_FLX_1 :
generic_format beta FLX_exp 1.
Proof. hammer_hook "FLX" "FLX.generic_format_FLX_1".
unfold generic_format, scaled_mantissa, cexp, F2R; simpl.
rewrite Rmult_1_l, (mag_unique beta 1 1).
{ unfold FLX_exp.
rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega].
rewrite Ztrunc_IZR, IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega].
rewrite <- bpow_plus.
now replace (_ + _)%Z with Z0 by ring. }
rewrite Rabs_R1; simpl; split; [now right|].
unfold Z.pow_pos; simpl; rewrite Zmult_1_r; apply IZR_lt.
assert (H := Zle_bool_imp_le _ _ (radix_prop beta)); omega.
Qed.

Theorem ulp_FLX_0: (ulp beta FLX_exp 0 = 0)%R.
Proof. hammer_hook "FLX" "FLX.ulp_FLX_0".
unfold ulp; rewrite Req_bool_true; trivial.
rewrite negligible_exp_FLX; easy.
Qed.

Lemma ulp_FLX_1 : ulp beta FLX_exp 1 = bpow (-prec + 1).
Proof. hammer_hook "FLX" "FLX.ulp_FLX_1".
unfold ulp, FLX_exp, cexp; rewrite Req_bool_false; [|apply R1_neq_R0].
rewrite mag_1; f_equal; ring.
Qed.

Lemma succ_FLX_1 : (succ beta FLX_exp 1 = 1 + bpow (-prec + 1))%R.
Proof. hammer_hook "FLX" "FLX.succ_FLX_1".
now unfold succ; rewrite Rle_bool_true; [|apply Rle_0_1]; rewrite ulp_FLX_1.
Qed.

Theorem eq_0_round_0_FLX :
forall rnd {Vr: Valid_rnd rnd} x,
round beta FLX_exp rnd x = 0%R -> x = 0%R.
Proof. hammer_hook "FLX" "FLX.eq_0_round_0_FLX".
intros rnd Hr x.
apply eq_0_round_0_negligible_exp; try assumption.
apply FLX_exp_valid.
apply negligible_exp_FLX.
Qed.

Theorem gt_0_round_gt_0_FLX :
forall rnd {Vr: Valid_rnd rnd} x,
(0 < x)%R -> (0 < round beta FLX_exp rnd x)%R.
Proof with auto with typeclass_instances. hammer_hook "FLX" "FLX.gt_0_round_gt_0_FLX".
intros rnd Hr x Hx.
assert (K: (0 <= round beta FLX_exp rnd x)%R).
rewrite <- (round_0 beta FLX_exp rnd).
apply round_le... now apply Rlt_le.
destruct K; try easy.
absurd (x = 0)%R.
now apply Rgt_not_eq.
apply eq_0_round_0_FLX with rnd...
Qed.

Theorem ulp_FLX_le :
forall x, (ulp beta FLX_exp x <= Rabs x * bpow (1-prec))%R.
Proof. hammer_hook "FLX" "FLX.ulp_FLX_le".
intros x; case (Req_dec x 0); intros Hx.
rewrite Hx, ulp_FLX_0, Rabs_R0.
right; ring.
rewrite ulp_neq_0; try exact Hx.
unfold cexp, FLX_exp.
replace (mag beta x - prec)%Z with ((mag beta x - 1) + (1-prec))%Z by ring.
rewrite bpow_plus.
apply Rmult_le_compat_r.
apply bpow_ge_0.
now apply bpow_mag_le.
Qed.

Theorem ulp_FLX_ge :
forall x, (Rabs x * bpow (-prec) <= ulp beta FLX_exp x)%R.
Proof. hammer_hook "FLX" "FLX.ulp_FLX_ge".
intros x; case (Req_dec x 0); intros Hx.
rewrite Hx, ulp_FLX_0, Rabs_R0.
right; ring.
rewrite ulp_neq_0; try exact Hx.
unfold cexp, FLX_exp.
unfold Zminus; rewrite bpow_plus.
apply Rmult_le_compat_r.
apply bpow_ge_0.
left; now apply bpow_mag_gt.
Qed.

Lemma ulp_FLX_exact_shift :
forall x e,
(ulp beta FLX_exp (x * bpow e) = ulp beta FLX_exp x * bpow e)%R.
Proof. hammer_hook "FLX" "FLX.ulp_FLX_exact_shift".
intros x e.
destruct (Req_dec x 0) as [Hx|Hx].
{ unfold ulp.
now rewrite !Req_bool_true, negligible_exp_FLX; rewrite ?Hx, ?Rmult_0_l. }
unfold ulp; rewrite Req_bool_false;
[|now intro H; apply Hx, (Rmult_eq_reg_r (bpow e));
[rewrite Rmult_0_l|apply Rgt_not_eq, Rlt_gt, bpow_gt_0]].
rewrite (Req_bool_false _ _ Hx), <- bpow_plus; f_equal; unfold cexp, FLX_exp.
now rewrite mag_mult_bpow; [ring|].
Qed.

Lemma succ_FLX_exact_shift :
forall x e,
(succ beta FLX_exp (x * bpow e) = succ beta FLX_exp x * bpow e)%R.
Proof. hammer_hook "FLX" "FLX.succ_FLX_exact_shift".
intros x e.
destruct (Rle_or_lt 0 x) as [Px|Nx].
{ rewrite succ_eq_pos; [|now apply Rmult_le_pos, bpow_ge_0].
rewrite (succ_eq_pos _ _ _ Px).
now rewrite Rmult_plus_distr_r; f_equal; apply ulp_FLX_exact_shift. }
unfold succ.
rewrite Rle_bool_false; [|assert (H := bpow_gt_0 beta e); nra].
rewrite Rle_bool_false; [|now simpl].
rewrite Ropp_mult_distr_l_reverse, <-Ropp_mult_distr_l_reverse; f_equal.
unfold pred_pos.
rewrite mag_mult_bpow; [|lra].
replace (_ - 1)%Z with (mag beta (- x) - 1 + e)%Z; [|ring]; rewrite bpow_plus.
unfold Req_bool; rewrite Rcompare_mult_r; [|now apply bpow_gt_0].
fold (Req_bool (-x) (bpow (mag beta (-x) - 1))); case Req_bool.
{ unfold FLX_exp.
replace (_ - _)%Z with (mag beta (- x) - 1 - prec + e)%Z; [|ring].
rewrite bpow_plus; ring. }
rewrite ulp_FLX_exact_shift; ring.
Qed.

Global Instance FLX_exp_monotone : Monotone_exp FLX_exp.
Proof. hammer_hook "FLX" "FLX.FLX_exp_monotone".
intros ex ey Hxy.
now apply Zplus_le_compat_r.
Qed.

Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z.

Global Instance exists_NE_FLX : Exists_NE beta FLX_exp.
Proof. hammer_hook "FLX" "FLX.exists_NE_FLX".
destruct NE_prop as [H|H].
now left.
right.
unfold FLX_exp.
split ; omega.
Qed.

End RND_FLX.


Require Import Lia.
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.

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

Require Import PromiseConsistent.
Require Import Mapping.

Require Import PFStep.

Set Implicit Arguments.

Module OrdLocal.
  Section OrdLocal.
    Variable L: Loc.t -> bool.
    Variable ordcr: Ordering.t.
    Variable ordcw: Ordering.t.

    Inductive read_step (lc1:Local.t) (mem1:Memory.t) (loc:Loc.t) (to:Time.t) (val:Const.t) (released:option View.t) (ord:Ordering.t) (lc2:Local.t): Prop :=
    | read_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordcr else ord)
        (STEP: Local.read_step lc1 mem1 loc to val released ord' lc2)
    .
    Hint Constructors read_step: core.

    Inductive write_step (lc1:Local.t) (sc1:TimeMap.t) (mem1:Memory.t)
              (loc:Loc.t) (from to:Time.t)
              (val:Const.t) (releasedm released:option View.t) (ord:Ordering.t)
              (lc2:Local.t) (sc2:TimeMap.t) (mem2:Memory.t) (kind:Memory.op_kind): Prop :=
    | write_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordcw else ord)
        (STEP: Local.write_step lc1 sc1 mem1 loc from to val releasedm released ord' lc2 sc2 mem2 kind)
    .
    Hint Constructors write_step: core.

    Inductive write_na_step (lc1:Local.t) (sc1:TimeMap.t) (mem1:Memory.t)
                            (loc:Loc.t) (from to:Time.t) (val:Const.t) (ord:Ordering.t)
                            (lc2:Local.t) (sc2:TimeMap.t) (mem2:Memory.t):
      forall (msgs: list (Time.t * Time.t * Message.t))
        (kinds: list Memory.op_kind) (kind:Memory.op_kind), Prop :=
    | write_na_step_na
        ord' msgs kinds kind
        (ORD: ord' = if L loc then Ordering.join ord ordcw else ord)
        (STEP: Local.write_na_step lc1 sc1 mem1 loc from to val ord' lc2 sc2 mem2 msgs kinds kind):
      write_na_step lc1 sc1 mem1 loc from to val ord lc2 sc2 mem2 msgs kinds kind
    | write_na_step_at
        released ord' kind
        (LOC: L loc)
        (NA: Ordering.le ord Ordering.na)
        (ORD: ord' = Ordering.join ord ordcw)
        (STEP: Local.write_step lc1 sc1 mem1 loc from to val None released ord' lc2 sc2 mem2 kind):
      write_na_step lc1 sc1 mem1 loc from to val ord lc2 sc2 mem2 [] [] kind
    .
    Hint Constructors write_na_step: core.

    Inductive racy_read_step (lc1:Local.t) (mem1:Memory.t) (loc:Loc.t) (to:Time.t) (val:Const.t) (ord:Ordering.t): Prop :=
    | racy_read_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordcr else ord)
        (STEP: Local.racy_read_step lc1 mem1 loc to val ord')
    .
    Hint Constructors racy_read_step: core.

    Inductive racy_write_step (lc1:Local.t) (mem1:Memory.t) (loc:Loc.t) (to:Time.t) (ord:Ordering.t): Prop :=
    | racy_write_step_intro
        ord'
        (ORD: ord' = if L loc then Ordering.join ord ordcw else ord)
        (STEP: Local.racy_write_step lc1 mem1 loc to ord')
    .
    Hint Constructors racy_write_step: core.

    Inductive program_step:
      forall (e:ThreadEvent.t) (lc1:Local.t) (sc1:TimeMap.t) (mem1:Memory.t) (lc2:Local.t) (sc2:TimeMap.t) (mem2:Memory.t), Prop :=
    | step_silent
        lc1 sc1 mem1:
        program_step ThreadEvent.silent lc1 sc1 mem1 lc1 sc1 mem1
    | step_read
        lc1 sc1 mem1
        loc ts val released ord lc2
        (LOCAL: read_step lc1 mem1 loc ts val released ord lc2):
        program_step (ThreadEvent.read loc ts val released ord) lc1 sc1 mem1 lc2 sc1 mem1
    | step_write
        lc1 sc1 mem1
        loc from to val released ord lc2 sc2 mem2 kind
        (LOCAL: write_step lc1 sc1 mem1 loc from to val None released ord lc2 sc2 mem2 kind):
        program_step (ThreadEvent.write loc from to val released ord) lc1 sc1 mem1 lc2 sc2 mem2
    | step_update
        lc1 sc1 mem1
        loc ordr ordw
        tsr valr releasedr releasedw lc2
        tsw valw lc3 sc3 mem3 kind
        (LOCAL1: read_step lc1 mem1 loc tsr valr releasedr ordr lc2)
        (LOCAL2: write_step lc2 sc1 mem1 loc tsr tsw valw releasedr releasedw ordw lc3 sc3 mem3 kind):
        program_step (ThreadEvent.update loc tsr tsw valr valw releasedr releasedw ordr ordw)
                     lc1 sc1 mem1 lc3 sc3 mem3
    | step_fence
        lc1 sc1 mem1
        ordr ordw lc2 sc2
        (LOCAL: Local.fence_step lc1 sc1 ordr ordw lc2 sc2):
        program_step (ThreadEvent.fence ordr ordw) lc1 sc1 mem1 lc2 sc2 mem1
    | step_syscall
        lc1 sc1 mem1
        e lc2 sc2
        (LOCAL: Local.fence_step lc1 sc1 Ordering.seqcst Ordering.seqcst lc2 sc2):
        program_step (ThreadEvent.syscall e) lc1 sc1 mem1 lc2 sc2 mem1
    | step_failure
        lc1 sc1 mem1
        (LOCAL: Local.failure_step lc1):
      program_step ThreadEvent.failure lc1 sc1 mem1 lc1 sc1 mem1
    | step_write_na
        lc1 sc1 mem1
        loc from to val ord lc2 sc2 mem2 msgs kinds kind
        (LOCAL: write_na_step lc1 sc1 mem1 loc from to val ord lc2 sc2 mem2 msgs kinds kind):
      program_step (ThreadEvent.write_na loc msgs from to val ord) lc1 sc1 mem1 lc2 sc2 mem2
    | step_racy_read
        lc1 sc1 mem1
        loc to val ord
        (LOCAL: racy_read_step lc1 mem1 loc to val ord):
      program_step (ThreadEvent.racy_read loc to val ord) lc1 sc1 mem1 lc1 sc1 mem1
    | step_racy_write
        lc1 sc1 mem1
        loc to val ord
        (LOCAL: racy_write_step lc1 mem1 loc to ord):
      program_step (ThreadEvent.racy_write loc to val ord) lc1 sc1 mem1 lc1 sc1 mem1
    | step_racy_update
        lc1 sc1 mem1
        loc to valr valw ordr ordw
        (LOCAL: Local.racy_update_step lc1 mem1 loc to ordr ordw):
      program_step (ThreadEvent.racy_update loc to valr valw ordr ordw) lc1 sc1 mem1 lc1 sc1 mem1
    .
    Hint Constructors program_step: core.

    (* step_future *)

    Lemma write_step_non_cancel
          lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
          (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind):
      negb (Memory.op_kind_is_cancel kind).
    Proof.
      inv STEP. eapply Local.write_step_non_cancel; eauto.
    Qed.

    Lemma write_step_strong_relaxed
          lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
          (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
          (ORD: Ordering.le Ordering.strong_relaxed ord):
      negb (Memory.op_kind_is_lower kind).
    Proof.
      inv STEP. eapply Local.write_step_strong_relaxed; eauto.
      etrans; eauto. des_ifs; try refl.
      eapply Ordering.join_l.
    Qed.

    Lemma program_step_future
          e lc1 sc1 mem1 lc2 sc2 mem2
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (WF1: Local.wf lc1 mem1)
          (SC1: Memory.closed_timemap sc1 mem1)
          (CLOSED1: Memory.closed mem1):
      <<WF2: Local.wf lc2 mem2>> /\
      <<SC2: Memory.closed_timemap sc2 mem2>> /\
      <<CLOSED2: Memory.closed mem2>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview lc1) (Local.tview lc2)>> /\
      <<SC_FUTURE: TimeMap.le sc1 sc2>> /\
      <<MEM_FUTURE: Memory.future mem1 mem2>>.
    Proof.
      inv STEP.
      - esplits; eauto; try refl.
      - inv LOCAL.
        exploit Local.read_step_future; eauto. i. des.
        esplits; eauto; try refl.
      - inv LOCAL.
        exploit Local.write_step_future; eauto; try by econs. i. des.
        esplits; eauto; try refl.
      - inv LOCAL1. inv LOCAL2.
        exploit Local.read_step_future; eauto. i. des.
        exploit Local.write_step_future; eauto; try by econs. i. des.
        esplits; eauto. etrans; eauto.
      - exploit Local.fence_step_future; eauto. i. des. esplits; eauto; try refl.
      - exploit Local.fence_step_future; eauto. i. des. esplits; eauto; try refl.
      - esplits; eauto; try refl.
      - inv LOCAL.
        + exploit Local.write_na_step_future; eauto.
        + exploit Local.write_step_future; eauto. i. des. splits; ss.
      - esplits; eauto; try refl.
      - esplits; eauto; try refl.
      - esplits; eauto; try refl.
    Qed.

    Lemma program_step_inhabited
          e lc1 sc1 mem1 lc2 sc2 mem2
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (INHABITED1: Memory.inhabited mem1):
      <<INHABITED2: Memory.inhabited mem2>>.
    Proof.
      inv STEP; eauto.
      - inv LOCAL. inv STEP. eapply Memory.write_inhabited; eauto.
      - inv LOCAL2. inv STEP. eapply Memory.write_inhabited; eauto.
      - inv LOCAL.
        + inv STEP. eapply Memory.write_na_inhabited; eauto.
        + inv STEP. eapply Memory.write_inhabited; eauto.
    Qed.

    (* step_disjoint *)

    Lemma program_step_disjoint
          e lc1 sc1 mem1 lc2 sc2 mem2 lc
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (WF1: Local.wf lc1 mem1)
          (SC1: Memory.closed_timemap sc1 mem1)
          (CLOSED1: Memory.closed mem1)
          (DISJOINT1: Local.disjoint lc1 lc)
          (WF: Local.wf lc mem1):
      <<DISJOINT2: Local.disjoint lc2 lc>> /\
      <<WF: Local.wf lc mem2>>.
    Proof.
      inv STEP.
      - esplits; eauto.
      - inv LOCAL. exploit Local.read_step_disjoint; eauto.
      - inv LOCAL. exploit Local.write_step_disjoint; eauto.
      - inv LOCAL1. inv LOCAL2.
        exploit Local.read_step_future; eauto. i. des.
        exploit Local.read_step_disjoint; eauto. i. des.
        exploit Local.write_step_disjoint; eauto.
      - exploit Local.fence_step_disjoint; eauto.
      - exploit Local.fence_step_disjoint; eauto.
      - esplits; eauto.
      - inv LOCAL.
        + exploit Local.write_na_step_disjoint; eauto.
        + exploit Local.write_step_disjoint; eauto.
      - esplits; eauto.
      - esplits; eauto.
      - esplits; eauto.
    Qed.

    Lemma program_step_promises_bot
          e lc1 sc1 mem1 lc2 sc2 mem2
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2)
          (PROMISES: (Local.promises lc1) = Memory.bot):
      (Local.promises lc2) = Memory.bot.
    Proof.
      inv STEP; try inv LOCAL; ss; try inv STEP; ss.
      - eapply Memory.write_promises_bot; eauto.
      - inv LOCAL1. inv LOCAL2. inv STEP. inv STEP0.
        eapply Memory.write_promises_bot; eauto.
      - eapply Memory.write_na_promises_bot; eauto.
      - eapply Memory.write_promises_bot; eauto.
    Qed.

    (* reserve only *)

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

    Lemma promise_reserve_only
          promises1 mem1 loc from to msg promises2 mem2 kind
          (PROMISES1: reserve_only promises1)
          (LOC: L loc -> msg = Message.reserve)
          (PROMISE: Memory.promise promises1 mem1 loc from to msg promises2 mem2 kind):
      reserve_only promises2.
    Proof.
      ii. revert GET. inv PROMISE; ss.
      - erewrite Memory.add_o; eauto. condtac; ss; eauto.
        i. des. clarify. eauto.
      - erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
        + i. des. clarify. eauto.
        + guardH o. i. des. clarify.
          exploit Memory.split_get0; try exact PROMISES. i. des.
          exploit PROMISES1; eauto.
      - erewrite Memory.lower_o; eauto. condtac; ss; eauto.
        i. des. clarify. eauto.
      - erewrite Memory.remove_o; eauto. condtac; ss; eauto.
    Qed.

    Lemma write_reserve_only
          promises1 mem1 loc from to msg promises2 mem2 kind
          (PROMISES1: reserve_only promises1)
          (WRITE: Memory.write promises1 mem1 loc from to msg promises2 mem2 kind):
      reserve_only promises2.
    Proof.
      ii. revert GET. inv WRITE.
      erewrite Memory.remove_o; eauto. condtac; ss. guardH o.
      inv PROMISE; ss.
      - erewrite Memory.add_o; eauto. condtac; ss; eauto.
      - erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
        guardH o0. i. des. inv GET.
        exploit Memory.split_get0; try exact PROMISES. i. des.
        exploit PROMISES1; try exact GET0; ss.
      - erewrite Memory.lower_o; eauto. condtac; ss; eauto.
      - erewrite Memory.remove_o; eauto. condtac; ss; eauto.
    Qed.

    Lemma write_na_reserve_only
          ts promises1 mem1 loc from to msg promises2 mem2 msgs kinds kind
          (PROMISES1: reserve_only promises1)
          (WRITE: Memory.write_na ts promises1 mem1 loc from to msg promises2 mem2 msgs kinds kind):
      reserve_only promises2.
    Proof.
      induction WRITE; eauto using write_reserve_only.
    Qed.

    Lemma program_step_reserve_only
          e lc1 sc1 mem1 lc2 sc2 mem2
          (PROMISES1: reserve_only (Local.promises lc1))
          (STEP: program_step e lc1 sc1 mem1 lc2 sc2 mem2):
      <<PROMISES2: reserve_only (Local.promises lc2)>>.
    Proof.
      inv STEP; try inv LOCAL; try inv STEP; ss.
      - eapply write_reserve_only; eauto.
      - inv LOCAL1. inv STEP. inv LOCAL2. inv STEP. ss.
        eapply write_reserve_only; eauto.
      - eapply write_na_reserve_only; eauto.
      - eapply write_reserve_only; eauto.
    Qed.

    Lemma reserve_only_write_add
          promises1 mem1 loc from to msg promises2 mem2 kind
          (RESERVE_ONLY: reserve_only promises1)
          (LOC: L loc)
          (WRITE: Memory.write promises1 mem1 loc from to msg promises2 mem2 kind):
      kind = Memory.op_kind_add.
    Proof.
      inv WRITE. inv PROMISE; ss; exfalso.
      - exploit Memory.split_get0; try exact PROMISES. i. des. eauto.
      - exploit Memory.lower_get0; try exact PROMISES. i. des.
        exploit RESERVE_ONLY; eauto. i. subst. inv MSG_LE. ss.
      - exploit Memory.remove_get0; try exact PROMISES. i. des.
        exploit Memory.remove_get0; try exact REMOVE. i. des. congr.
    Qed.

    Lemma ordc_na
          ordc ord loc
          (ORDC: Ordering.le ordc Ordering.na):
      (if L loc then Ordering.join ord ordc else ord) = ord.
    Proof.
      condtac; ss.
      destruct ordc, ord; ss.
    Qed.

    Lemma write_step_le
          lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
          ordc'
          (STEP: write_step lc1 sc1 mem1 loc from to val releasedm released
                            (if L loc then Ordering.join ord ordc' else ord) lc2 sc2 mem2 kind)
          (ORDC: Ordering.le ordc' ordcw):
      write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind.
    Proof.
      econs; eauto.
      inv STEP. condtac; ss.
      replace (Ordering.join ord ordcw) with
          (Ordering.join (Ordering.join ord ordc') ordcw); ss.
      destruct ord, ordcw, ordc'; ss.
    Qed.

    Lemma racy_write_step_le
          lc1 mem1 loc to ord
          ordc'
          (STEP: racy_write_step lc1 mem1 loc to (if L loc then Ordering.join ord ordc' else ord))
          (ORDC: Ordering.le ordc' ordcw):
      racy_write_step lc1 mem1 loc to ord.
    Proof.
      inv STEP. econs; eauto. condtac; ss.
      replace (Ordering.join ord ordcw) with
          (Ordering.join (Ordering.join ord ordc') ordcw); ss.
      destruct ord, ordcw, ordc'; ss.
    Qed.
  End OrdLocal.
End OrdLocal.

Module OrdThread.
  Section OrdThread.
    Variable lang: language.
    Variable L: Loc.t -> bool.
    Variable ordcr: Ordering.t.
    Variable ordcw: Ordering.t.

    Inductive program_step (e:ThreadEvent.t): forall (e1 e2:Thread.t lang), Prop :=
    | program_step_intro
        st1 lc1 sc1 mem1
        st2 lc2 sc2 mem2
        (STATE: (Language.step lang) (ThreadEvent.get_program_event e) st1 st2)
        (LOCAL: OrdLocal.program_step L ordcr ordcw e lc1 sc1 mem1 lc2 sc2 mem2):
        program_step e (Thread.mk lang st1 lc1 sc1 mem1) (Thread.mk lang st2 lc2 sc2 mem2)
    .
    Hint Constructors program_step: core.

    Inductive step: forall (pf:bool) (e:ThreadEvent.t) (e1 e2:Thread.t lang), Prop :=
    | step_promise
        pf e e1 e2
        (STEP: Thread.promise_step pf e e1 e2)
        (PF: PF.pf_event L e):
        step pf e e1 e2
    | step_program
        e e1 e2
        (STEP: program_step e e1 e2):
        step true e e1 e2
    .
    Hint Constructors step: core.

    Inductive step_allpf (e: ThreadEvent.t) (e1 e2: Thread.t lang): Prop :=
    | step_nopf_intro
        pf
        (STEP: step pf e e1 e2)
    .
    Hint Constructors step_allpf: core.

    Lemma allpf pf: step pf <3= step_allpf.
    Proof.
      i. econs. eauto.
    Qed.

    Definition pf_tau_step := tau (step true).
    Hint Unfold pf_tau_step: core.

    Definition tau_step := tau step_allpf.
    Hint Unfold tau_step: core.

    Definition all_step := union step_allpf.
    Hint Unfold all_step: core.

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

    Definition steps_failure (e1: Thread.t lang): Prop :=
      exists e e2 e3,
        <<STEPS: rtc tau_step e1 e2>> /\
        <<STEP_FAILURE: step true e e2 e3>> /\
        <<EVENT_FAILURE: ThreadEvent.get_machine_event e = MachineEvent.failure>>.
    Hint Unfold steps_failure: core.

    Definition consistent (e: Thread.t lang): Prop :=
      forall mem1
        (CAP: Memory.cap (Thread.memory e) mem1),
        <<FAILURE: steps_failure (Thread.mk lang (Thread.state e) (Thread.local e) (Thread.sc e) mem1)>> \/
        exists e2,
          <<STEPS: rtc tau_step (Thread.mk lang (Thread.state e) (Thread.local e) (Thread.sc e) mem1) e2>> /\
          <<PROMISES: (Local.promises (Thread.local e2)) = Memory.bot>>.

    (* future *)

    Lemma program_step_future
          e e1 e2
          (STEP: program_step e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      inv STEP. ss. eapply OrdLocal.program_step_future; eauto.
    Qed.

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

    Lemma rtc_all_step_future
          e1 e2
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      revert WF1 SC1 CLOSED1. induction STEPS; i.
      - esplits; eauto; refl.
      - inv H. inv USTEP. exploit step_future; eauto. i. des.
        exploit IHSTEPS; eauto. i. des.
        esplits; eauto; etrans; eauto.
    Qed.

    Lemma rtc_tau_step_future
          e1 e2
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1)):
      <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\
      <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\
      <<CLOSED2: Memory.closed (Thread.memory e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\
      <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>.
    Proof.
      eapply rtc_all_step_future; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    (* disjoint *)

    Lemma step_disjoint
          pf e e1 e2 lc
          (STEP: step pf e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      inv STEP.
      - eapply Thread.promise_step_disjoint; eauto.
      - inv STEP0. eapply OrdLocal.program_step_disjoint; eauto.
    Qed.

    Lemma rtc_all_step_disjoint
          e1 e2 lc
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      revert WF1 SC1 CLOSED1 DISJOINT1 WF.
      induction STEPS; i; eauto.
      inv H. inv USTEP.
      exploit step_future; eauto. i. des.
      exploit step_disjoint; eauto. i. des.
      eauto.
    Qed.

    Lemma rtc_tau_step_disjoint
          e1 e2 lc
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (WF: Local.wf lc (Thread.memory e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<WF: Local.wf lc (Thread.memory e2)>>.
    Proof.
      eapply rtc_all_step_disjoint; try exact DISJOINT1; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    (* promise_consistent *)

    Lemma step_promise_consistent
          pf e e1 e2
          (STEP: step pf e e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      inv STEP; ss.
      - inv STEP0. s.
        eapply promise_step_promise_consistent; eauto.
      - inv STEP0. inv LOCAL; ss.
        + inv LOCAL0. eapply read_step_promise_consistent; eauto.
        + inv LOCAL0. eapply write_step_promise_consistent; eauto.
        + inv LOCAL1. inv LOCAL2.
          exploit Local.read_step_future; eauto. i. des.
          eapply read_step_promise_consistent; eauto.
          eapply write_step_promise_consistent; eauto.
        + eapply fence_step_promise_consistent; eauto.
        + eapply fence_step_promise_consistent; eauto.
        + inv LOCAL0.
          * eapply write_na_step_promise_consistent; eauto.
          * eapply write_step_promise_consistent; eauto.
    Qed.

    Lemma rtc_all_step_promise_consistent
          e1 e2
          (STEPS: rtc all_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      revert WF1 SC1 CLOSED1 CONS. induction STEPS; ss. i.
      inv H. inv USTEP. exploit step_future; eauto. i. des.
      eapply step_promise_consistent; eauto.
    Qed.

    Lemma rtc_tau_step_promise_consistent
          e1 e2
          (STEPS: rtc tau_step e1 e2)
          (WF1: Local.wf (Thread.local e1) (Thread.memory e1))
          (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1))
          (CLOSED1: Memory.closed (Thread.memory e1))
          (CONS: Local.promise_consistent (Thread.local e2)):
      Local.promise_consistent (Thread.local e1).
    Proof.
      eapply rtc_all_step_promise_consistent; try exact CONS; eauto.
      eapply rtc_implies; try exact STEPS.
      apply tau_union.
    Qed.

    Lemma cap_step_current_step
          pf e e0 e1 fe0
          (THREAD: thread_map ident_map e0 fe0)
          (STEP: step 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: step pf fe fe0 fe1>>) /\
          (<<EVENT: tevent_map ident_map fe e>>).
    Proof.
      assert (MAPLT: mapping_map_lt_iff ident_map).
      { eapply ident_map_lt_iff. }
      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_iff_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_iff_collapsable_unwritable; eauto. }
        }
        { econs 1. econs.
          { econs; eauto. eapply closed_message_map; eauto.
            eapply ident_map_message. }
          { inv KIND; ss. }
          { unfold PF.pf_event in *. i. inv PROMISE1. 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_iff_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 2; eauto. econs; eauto. }
          { 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_iff_non_collapsable; eauto. }
          i. des.
          exists (ThreadEvent.write loc from to val freleasedw ord). esplits.
          { econs; eauto. eapply mapping_map_lt_iff_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 3; eauto. econs; 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_iff_collapsable_unwritable; eauto. }
          { refl. }
          { eapply mapping_map_lt_iff_non_collapsable; eauto. }
          i. des.
          exists (ThreadEvent.update loc fto tsw valr valw freleased freleasedw ordr ordw). esplits.
          { econs; eauto. eapply mapping_map_lt_iff_collapsable_unwritable; eauto. }
          { econs 2; eauto. econs; eauto. econs 4; eauto.
            { econs; eauto. }
            { econs; eauto. }
          }
          { 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. }
        }
        { inv LOCAL2.
          { hexploit write_na_step_map; try eassumption; eauto.
            { eapply ident_map_bot. }
            { eapply FLOCAL. }
            { eapply FLOCAL. }
            { refl. }
            { refl. }
            { eapply mapping_map_lt_iff_non_collapsable; eauto. }
            { instantiate (1 := List.map fst msgs). clear.
              induction msgs; ss.
              econs; eauto. destruct a as [[]]. ss.
            }
            { rewrite List.Forall_forall. i.
              eapply mapping_map_lt_iff_non_collapsable; eauto.
            }
            i. des.
            exists (ThreadEvent.write_na loc fmsgs from to val ord). esplits.
            { econs; eauto. eapply mapping_map_lt_iff_collapsable_unwritable; eauto. }
            { econs 2; eauto. econs; eauto. econs 8; eauto. econs; eauto. }
            { econs; eauto; ss. }
          }
          { hexploit write_step_map; try eassumption; eauto.
            { eapply ident_map_bot. }
            { eapply FLOCAL. }
            { eapply FLOCAL. }
            { econs 2. }
            { refl. }
            { refl. }
            { eapply mapping_map_lt_iff_non_collapsable; eauto. }
            i. des.
            exists (ThreadEvent.write_na loc [] from to val ord). esplits.
            { econs; eauto. eapply mapping_map_lt_iff_collapsable_unwritable; eauto. }
            { econs 2; eauto. econs; eauto. econs 8; eauto. econs 2; eauto. }
            { econs; eauto; ss. }
          }
        }
        { inv LOCAL2. exploit racy_read_step_map; eauto.
          { apply ident_map_lt. }
          i. des.
          exists (ThreadEvent.racy_read loc fto val ord). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 9; eauto. econs; eauto. }
          { econs; eauto; ss. }
        }
        { inv LOCAL2. exploit racy_write_step_map; eauto.
          { apply ident_map_lt. }
          i. des.
          exists (ThreadEvent.racy_write loc fto val ord). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 10; eauto. econs; eauto. }
          { econs; eauto; ss. }
        }
        { exploit racy_update_step_map; eauto.
          { apply ident_map_bot. }
          { apply ident_map_lt. }
          i. des.
          exists (ThreadEvent.racy_update loc fto valr valw ordr ordw). esplits.
          { econs; eauto. }
          { econs 2; eauto. econs; eauto. econs 11; eauto. }
          { econs; eauto; ss. }
        }
      }
    Qed.

    (* reserve only *)

    Lemma step_reserve_only
          pf e e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: step pf e e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP; inv STEP0; eauto using OrdLocal.program_step_reserve_only.
      ii. revert GET. inv LOCAL. inv PROMISE; ss.
      - erewrite Memory.add_o; eauto. condtac; ss; eauto.
        i. des. inv GET. exploit PF; eauto.
      - erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
        + i. des. inv GET. exploit PF; eauto.
        + guardH o. i. des. inv GET.
          exploit Memory.split_get0; try exact PROMISES. i. des.
          exploit PF; try exact GET0; eauto.
      - erewrite Memory.lower_o; eauto. condtac; ss; eauto.
        i. des. inv GET. exploit PF; eauto.
      - erewrite Memory.remove_o; eauto. condtac; ss; eauto.
    Qed.

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

    Lemma reserve_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: @Thread.reserve_step lang e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL. ss.
      eapply OrdLocal.promise_reserve_only; eauto.
    Qed.

    Lemma cancel_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: @Thread.cancel_step lang e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      inv STEP. inv STEP0; inv STEP; inv LOCAL. ss.
      eapply OrdLocal.promise_reserve_only; eauto.
    Qed.

    Lemma rtc_tau_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: rtc tau_step e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEP; eauto.
      apply IHSTEP. inv H. inv TSTEP.
      eapply step_reserve_only; eauto.
    Qed.

    Lemma rtc_all_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: rtc all_step e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEP; eauto.
      apply IHSTEP. inv H. inv USTEP.
      eapply step_reserve_only; eauto.
    Qed.

    Lemma rtc_reserve_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: rtc (@Thread.reserve_step lang) e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEP; eauto.
      apply IHSTEP.
      eapply reserve_step_reserve_only; eauto.
    Qed.

    Lemma rtc_cancel_step_reserve_only
          e1 e2
          (PROMISES1: OrdLocal.reserve_only L (Local.promises (Thread.local e1)))
          (STEP: rtc (@Thread.cancel_step lang) e1 e2):
      <<PROMISES2: OrdLocal.reserve_only L (Local.promises (Thread.local e2))>>.
    Proof.
      induction STEP; eauto.
      apply IHSTEP.
      eapply cancel_step_reserve_only; eauto.
    Qed.
  End OrdThread.
End OrdThread.

Module OrdConfiguration.
  Section OrdConfiguration.
    Variable L: Loc.t -> bool.
    Variable ordcr: Ordering.t.
    Variable ordcw: Ordering.t.

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

    Inductive all_step (c1 c2: Configuration.t): Prop :=
    | all_step_intro
        e tid
        (STEP: step e tid c1 c2)
    .
    Hint Constructors all_step: core.

    Inductive machine_step: forall (e: MachineEvent.t) (tid: Ident.t) (c1 c2: Configuration.t), Prop :=
    | machine_step_instro
        e tid c1 c2
        (STEP: step e tid c1 c2):
        machine_step (ThreadEvent.get_machine_event e) tid c1 c2
    .
    Hint Constructors machine_step: core.

    (* reserve_only *)

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

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

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

    Lemma rtc_all_step_reserve_only
          c1 c2
          (RESERVE: reserve_only c1)
          (STEPS: rtc all_step c1 c2):
      reserve_only c2.
    Proof.
      induction STEPS; ss. inv H.
      hexploit step_reserve_only; eauto.
    Qed.

    Lemma step_future
          e tid c1 c2
          (STEP: step e tid c1 c2)
          (WF1: Configuration.wf c1):
      (<<WF2: Configuration.wf c2>>) /\
      (<<SC_FUTURE: TimeMap.le (Configuration.sc c1) (Configuration.sc c2)>>) /\
      (<<MEM_FUTURE: Memory.future (Configuration.memory c1) (Configuration.memory c2)>>).
    Proof.
      inv WF1. inv WF. inv STEP; s. exploit THREADS; ss; eauto. i.
      assert (STEPS: rtc
                       (@OrdThread.all_step _ L ordcr ordcw)
                       (Thread.mk _ st1 lc1 (Configuration.sc c1) (Configuration.memory c1))
                       (Thread.mk _ st4 lc4 sc4 memory4)).
      { etrans.
        { eapply rtc_implies; try apply CANCELS. i. inv H.
          inv STEP.
          2:{ inv STEP1; inv LOCAL. }
          econs; eauto. econs; eauto. econs 1; eauto. ii. clarify.
        }
        etrans.
        { instantiate (1:=e3). inv STEP0.
          { refl. }
          { econs 2; [|refl]. econs; eauto. econs; eauto. }
        }
        { eapply rtc_implies; try apply RESERVES. i. inv H.
          inv STEP.
          2:{ inv STEP1; inv LOCAL. }
          econs; eauto. econs; eauto. econs 1; eauto. ii. clarify.
        }
      }
      exploit OrdThread.rtc_all_step_future; eauto. s. i. des.
      splits; eauto. econs; ss. econs.
      + i. Configuration.simplify.
        * exploit THREADS; try apply TH1; eauto. i. des.
          exploit OrdThread.rtc_all_step_disjoint; eauto. i. des.
          symmetry. auto.
        * exploit THREADS; try apply TH2; eauto. i. des.
          exploit OrdThread.rtc_all_step_disjoint; eauto. i. des.
          auto.
        * eapply DISJOINT; [|eauto|eauto]. auto.
      + i. Configuration.simplify.
        exploit THREADS; try apply TH; eauto. i.
        exploit OrdThread.rtc_all_step_disjoint; eauto. i. des.
        auto.
    Qed.

    Lemma rtc_all_step_future
          c1 c2
          (STEP: rtc all_step c1 c2)
          (WF1: Configuration.wf c1):
      (<<WF2: Configuration.wf c2>>) /\
      (<<SC_FUTURE: TimeMap.le (Configuration.sc c1) (Configuration.sc c2)>>) /\
      (<<MEM_FUTURE: Memory.future (Configuration.memory c1) (Configuration.memory c2)>>).
    Proof.
      induction STEP; i.
      { splits; auto; try refl. }
      { inv H. hexploit step_future; eauto. i. des.
        hexploit IHSTEP; eauto. i. des. splits; auto.
        { etrans; eauto. }
        { etrans; eauto. }
      }
    Qed.
  End OrdConfiguration.
End OrdConfiguration.


(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect ssrbool.

Lemma test : False -> (bool -> False -> True -> True) -> True.
move=> F; let w := 2 in apply; last w first.
- by apply: F.
- by apply: I.
by apply: true.
Qed.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition restore_hcr_el2_spec0 (rec: Pointer) (adt: RData) : option RData :=
    match rec with
    | (_rec_base, _rec_ofst) =>
      when' _t'1 == get_rec_common_sysregs_spec (_rec_base, _rec_ofst) 75 adt;
      rely is_int64 _t'1;
      when adt == sysreg_write_spec 75 (VZ64 _t'1) adt;
      Some adt
     end
    .

End SpecLow.


(*
 * Copyright (c) 2021 BedRock Systems, Inc.
 * This software is distributed under the terms of the BedRock Open-Source License.
 * See the LICENSE-BedRock file in the repository root for details.
 *)
Require Export iris.bi.embedding.
Require Import bedrock.lang.bi.prelude.

(** * Composing embeddings *)
(** Given embeddings [Embed PROP1 PROP2] and [Embed PROP2 PROP3],
[compose_embed PROP2] is the induced embedding [Embed PROP1 PROP3].
Its [BiEmbed], etc instances are available after [Import
compose_embed_instances]. *)

Definition compose_embed_def {A B C} `{!Embed B C, !Embed A B} : Embed A C :=
  λ P, embed (embed P).
Definition compose_embed_aux : seal (@compose_embed_def). Proof. by eexists. Qed.
Definition compose_embed := compose_embed_aux.(unseal).
Definition compose_embed_eq : @compose_embed = _ := compose_embed_aux.(seal_eq).
#[global] Arguments compose_embed
  {_}%type_scope _%type_scope {_}%type_scope {_ _} _%bi_scope : assert.

Section instances.
  Context {PROP1 PROP2 PROP3 : bi}.
  Context `{!BiEmbed PROP2 PROP3, !BiEmbed PROP1 PROP2}.

  #[local] Ltac unseal :=
    unfold embed, bi_embed_embed; cbn;
    rewrite !compose_embed_eq; unfold compose_embed_def; cbn.

  Lemma compose_embedding_mixin : BiEmbedMixin PROP1 PROP3 (compose_embed PROP2).
  Proof.
    split.
    - intros n P1 P2 ?. unseal. solve_proper.
    - intros P1 P2 ?. unseal. solve_proper.
    - intros P. unseal. by rewrite !embed_emp_valid.
    - intros. unseal. by rewrite !embed_interal_inj.
    - unseal. by rewrite !embed_emp_2.
    - intros. unseal. by rewrite !embed_impl_2.
    - intros. unseal. by rewrite !embed_forall_2.
    - intros. unseal. by rewrite !embed_exist_1.
    - intros. unseal. by rewrite !embed_sep.
    - intros. unseal. by rewrite !embed_wand_2.
    - intros. unseal. by rewrite !embed_persistently.
  Qed.
  #[local] Instance compose_embedding : BiEmbed PROP1 PROP3 :=
    {| bi_embed_mixin := compose_embedding_mixin |}.

  Lemma embed_embed P : embed P ⊣⊢@{PROP3} embed (embed P).
  Proof. rewrite {1}/embed/bi_embed_embed/=. by rewrite compose_embed_eq. Qed.

  #[local] Instance compose_embed_emp
      `{!BiEmbedEmp PROP2 PROP3, !BiEmbedEmp PROP1 PROP2} :
    BiEmbedEmp PROP1 PROP3.
  Proof. rewrite/BiEmbedEmp. by rewrite embed_embed !embed_emp_1. Qed.

  #[local] Instance compose_embed_later
      `{!BiEmbedLater PROP2 PROP3, !BiEmbedLater PROP1 PROP2} :
    BiEmbedLater PROP1 PROP3.
  Proof. intros P. by rewrite !embed_embed !embed_later. Qed.

  #[local] Instance compose_embed_internal_eq
      `{!BiInternalEq PROP1, !BiInternalEq PROP2, !BiInternalEq PROP3}
      `{!BiEmbedInternalEq PROP2 PROP3, !BiEmbedInternalEq PROP1 PROP2} :
    BiEmbedInternalEq PROP1 PROP3.
  Proof. intros A x y. by rewrite embed_embed !embed_internal_eq_1. Qed.

  #[local] Instance compose_embed_bupd
      `{!BiBUpd PROP1, !BiBUpd PROP2, !BiBUpd PROP3}
      `{!BiEmbedBUpd PROP2 PROP3, !BiEmbedBUpd PROP1 PROP2} :
    BiEmbedBUpd PROP1 PROP3.
  Proof. intros P. by rewrite !embed_embed !embed_bupd. Qed.

  #[local] Instance compose_embed_fupd
      `{!BiFUpd PROP1, !BiFUpd PROP2, !BiFUpd PROP3}
      `{!BiEmbedFUpd PROP2 PROP3, !BiEmbedFUpd PROP1 PROP2} :
    BiEmbedFUpd PROP1 PROP3.
  Proof. intros E1 E2 P. by rewrite !embed_embed !embed_fupd. Qed.

  #[local] Instance compose_embed_plainly
      `{!BiPlainly PROP1, !BiPlainly PROP2, !BiPlainly PROP3}
      `{!BiEmbedPlainly PROP2 PROP3, !BiEmbedPlainly PROP1 PROP2} :
    BiEmbedPlainly PROP1 PROP3.
  Proof. intros P. by rewrite !embed_embed !embed_plainly. Qed.
End instances.

Module compose_embed_instances.
  #[export] Hint Resolve
    compose_embedding
    compose_embed_emp
    compose_embed_later
    compose_embed_internal_eq
    compose_embed_bupd
    compose_embed_fupd
    compose_embed_plainly
  : typeclass_instances.
End compose_embed_instances.


(**************************  uc/OS-II  ******************************)
(*************************** OS_MUTEX.C *****************************)
(******Proof of API Fucntion:  int8u OSMutexPost(OS_EVENT* pevent) **)
(***************************** Code: ********************************)
(**
Int8u ·OSMutexPost·(⌞pevent @ OS_EVENT∗ ⌟)··{
        ⌞
         x @ Int8u;
         pip @ Int8u;
         prio  @ Int8u;
         legal @ Int8u
        ⌟;

1       If (pevent′ ==ₑ NULL)
        {
2          RETURN ′OS_ERR_PEVENT_NULL
        };ₛ
3       ENTER_CRITICAL;ₛ
4       legal′ =ᶠ OS_EventSearch(·pevent′·);ₛ
5       If (legal′ ==ₑ ′0)
        {
6           EXIT_CRITICAL;ₛ
7           RETURN ′OS_ERR_PEVENT_NO_EX
        };ₛ
8       If (pevent′→OSEventType !=ₑ ′OS_EVENT_TYPE_MUTEX)
        {
9           EXIT_CRITICAL;ₛ
10          RETURN ′OS_ERR_EVENT_TYPE
        };ₛ

11      pip′  =ₑ 〈Int8u〉(pevent′→OSEventCnt ≫ ′8);ₛ
12      prio′ =ₑ 〈Int8u〉(pevent′→OSEventCnt &ₑ ′OS_MUTEX_KEEP_LOWER_8);ₛ
13      If (OSTCBCur′ !=ₑ pevent′→OSEventPtr)
        {   (* See if posting task owns the MUTEX*)
14          EXIT_CRITICAL;ₛ
15          RETURN ′OS_ERR_NOT_MUTEX_OWNER
        };ₛ
16      If (OSTCBCur′→OSTCBPrio <ₑ pip′)
        {
17          EXIT_CRITICAL;ₛ
18          RETURN ′OS_ERR_MUTEX_PRIO
        };ₛ
19      If (OSTCBCur′→OSTCBPrio ==ₑ pip′)
        {
          (* Did we have to raise current task's priority? *)
          (* Yes, Return to original priority              *)
          (*      Remove owner from ready list at 'pip'    *)
20          If ( OSTCBPrioTbl′[prio′]  !=ₑ 〈OS_TCB ∗〉 PlaceHolder)
            {
21              EXIT_CRITICAL;ₛ
22              RETURN ′OS_ERR_ORIGINAL_NOT_HOLDER
            };ₛ
23          OSRdyTbl′[OSTCBCur′→OSTCBY] =ₑ OSRdyTbl′[OSTCBCur′→OSTCBY] &ₑ (∼OSTCBCur′→OSTCBBitX);ₛ
24          If ( OSRdyTbl′[OSTCBCur′→OSTCBY] ==ₑ ′0)
            {
25              OSRdyGrp′ =ₑ OSRdyGrp′ &ₑ ∼OSTCBCur′→OSTCBBitY
            };ₛ
26          OSTCBCur′→OSTCBPrio         =ₑ prio′;ₛ
27          OSTCBCur′→OSTCBY            =ₑ prio′ ≫  ′3;ₛ
28          OSTCBCur′→OSTCBBitY         =ₑ OSMapTbl′[OSTCBCur′→OSTCBY];ₛ
29          OSTCBCur′→OSTCBX            =ₑ prio′ &ₑ ′7;ₛ
30          OSTCBCur′→OSTCBBitX         =ₑ OSMapTbl′[OSTCBCur′→OSTCBX];ₛ
31          OSRdyGrp′                    =ₑ OSRdyGrp′ |ₑ OSTCBCur′→OSTCBBitY;ₛ
32          OSRdyTbl′[OSTCBCur′→OSTCBY] =ₑ OSRdyTbl′[OSTCBCur′→OSTCBY] |ₑ OSTCBCur′→OSTCBBitX;ₛ
33          OSTCBPrioTbl′[prio′]         =ₑ 〈OS_TCB ∗〉 OSTCBCur′;ₛ
34          OSTCBPrioTbl′[pip′]          =ₑ 〈OS_TCB ∗〉 PlaceHolder
        };ₛ
        (*OSTCBPrioTbl′[prio′] =ₑ 〈OS_TCB ∗〉 PlaceHolder;ₛ*)
35      If (pevent′→OSEventGrp !=ₑ ′0)
        {
36          x′ =ₑ ′OS_STAT_MUTEX;ₛ
37          prio′ =ᶠ OS_EventTaskRdy(·pevent′, pevent′, x′·);ₛ
38          pevent′→OSEventCnt =ₑ pevent′→OSEventCnt &ₑ ′OS_MUTEX_KEEP_UPPER_8;ₛ  (*Save priority of mutex's new owner *)
39          pevent′→OSEventCnt =ₑ pevent′→OSEventCnt |ₑ prio′;ₛ
40          pevent′→OSEventPtr =ₑ OSTCBPrioTbl′[prio′];ₛ     (*Link to mutex owner's OS_TCB*)
            (*(OSTCBPrioTbl′[prio′])→OSTCBMutexOwn =ₑ pevent′;ₛ *)
41          EXIT_CRITICAL;ₛ
42          OS_Sched();ₛ
43          RETURN ′OS_NO_ERR
        };ₛ
44      pevent′→OSEventCnt =ₑ pevent′→OSEventCnt |ₑ ′OS_MUTEX_AVAILABLE;ₛ (* No,  Mutex is now available   *)
45      pevent′→OSEventPtr =ₑ NULL;ₛ
        (*OSTCBCur′→OSTCBMutexOwn =ₑ NULL;ₛ*)
46      EXIT_CRITICAL;ₛ
47      RETURN ′OS_NO_ERR
*)
Require Import ucos_include.
Require Import OSMutex_common.
Require Import os_ucos_h.
Require Import mutex_absop_rules.
Require Import sep_lemmas_ext.
Local Open Scope code_scope.
Local Open Scope Z_scope.
Local Open Scope int_scope.

(* Goal forall
 *   (v' v'0 v'1 v'2 : val
 * )(
 *   v'3 v'4 v'5 : list vallist
 * )(
 *   v'6 : list EventData
 * )(
 *   v'7 : list os_inv.EventCtr
 * )(
 *   v'8 : vallist
 * )(
 *   v'9 v'10 : val
 * )(
 *   v'11 : list vallist
 * )(
 *   v'12 : vallist
 * )(
 *   v'13 : list vallist
 * )(
 *   v'14 : vallist
 * )(
 *   v'15 : val
 * )(
 *   v'16 : EcbMod.map
 * )(
 *   v'17 : TcbMod.map
 * )(
 *   v'18 : int32
 * )(
 *   v'19 : addrval
 * )(
 *   v'20 : True
 * )(
 *   v'21 : val
 * )(
 *   v'22 : list vallist
 * )(
 *   v'25 v'26 : list os_inv.EventCtr
 * )(
 *   v'27 v'28 : list EventData
 * )(
 *   v'30 : vallist
 * )(
 *   v'31 : val
 * )(
 *   v'33 v'35 : list vallist
 * )(
 *   v'36 : vallist
 * )(
 *   v'38 : EcbMod.map
 * )(
 *   v'39 : TcbMod.map
 * )(
 *   v'42 : val
 * )(
 *   v'44 : vallist
 * )(
 *   v'46 : val
 * )(
 *   v'47 v'48 v'49 : EcbMod.map
 * )(
 *   w : waitset
 * )(
 *   v'51 : addrval
 * )(
 *   H3 : ECBList_P v'46 Vnull v'26 v'28 v'48 v'39
 * )(
 *   H17 : EcbMod.join v'47 v'49 v'38
 * )(
 *   H12 : length v'25 = length v'27
 * )(
 *   H16 : isptr v'46
 * )(
 *   v'23 : addrval
 * )(
 *   v'29 : block
 * )(
 *   H11 : array_type_vallist_match Int8u v'44
 * )(
 *   H19 : length v'44 = ∘ OS_EVENT_TBL_SIZE
 * )(
 *   x3 : val
 * )(
 *   i : int32
 * )(
 *   H21 : Int.unsigned i <= 255
 * )(
 *   H18 : RL_Tbl_Grp_P v'44 (Vint32 i)
 * )(
 *   H24 : isptr v'46
 * )(
 *   H2 : ECBList_P v'42 (Vptr (v'29, Int.zero)) v'25 v'27 v'47 v'39
 * )(
 *   H14 : id_addrval' (Vptr (v'29, Int.zero)) OSEventTbl OS_EVENT = Some v'23
 * )(
 *   H20 : Int.unsigned ($ OS_EVENT_TYPE_MUTEX) <= 255
 * )(
 *   x : int32
 * )(
 *   H10 : Int.unsigned x <= 65535
 * )(
 *   H15 : Int.unsigned (x >>ᵢ $ 8) < 64
 * )(
 *   H22 : Int.unsigned x <= 65535
 * )(
 *   v'24 v'40 : val
 * )(
 *   v'43 v'45 : TcbMod.map
 * )(
 *   v'50 : val
 * )(
 *   v'52 : block
 * )(
 *   H31 : v'31 <> Vnull
 * )(
 *   H32 : join v'43 v'45 v'39
 * )(
 *   H33 : TCBList_P v'31 v'33 v'36 v'43
 * )(
 *   H30 : Vptr (v'52, Int.zero) <> Vnull
 * )(
 *   x8 x9 : val
 * )(
 *   H37 : isptr x9
 * )(
 *   H38 : isptr x8
 * )(
 *   i6 : int32
 * )(
 *   H39 : Int.unsigned i6 <= 65535
 * )(
 *   i5 : int32
 * )(
 *   H40 : Int.unsigned i5 <= 255
 * )(
 *   i4 : int32
 * )(
 *   H41 : Int.unsigned i4 <= 255
 * )(
 *   i3 : int32
 * )(
 *   H42 : Int.unsigned i3 <= 255
 * )(
 *   i2 : int32
 * )(
 *   H43 : Int.unsigned i2 <= 255
 * )(
 *   i1 : int32
 * )(
 *   H44 : Int.unsigned i1 <= 255
 * )(
 *   i0 : int32
 * )(
 *   H45 : Int.unsigned i0 <= 255
 * )(
 *   H36 : isptr v'24
 * )(
 *   H27 : isptr v'50
 * )(
 *   H34 : TCBList_P (Vptr (v'52, Int.zero))
 *           ((v'50
 *             :: v'24
 *                :: x9
 *                   :: x8
 *                      :: Vint32 i6
 *                         :: Vint32 i5
 *                            :: Vint32 i4
 *                               :: Vint32 i3
 *                                  :: Vint32 i2
 *                                     :: Vint32 i1 :: Vint32 i0 :: nil) :: v'35)
 *           v'36 v'45
 * )(
 *   H : RH_TCBList_ECBList_P v'16 v'17 (v'52, Int.zero)
 * )(
 *   H0 : RH_CurTCB (v'52, Int.zero) v'17
 * )(
 *   H7 : RH_TCBList_ECBList_P v'38 v'39 (v'52, Int.zero)
 * )(
 *   H8 : RH_CurTCB (v'52, Int.zero) v'39
 * )(
 *   H23 : isptr (Vptr (v'52, $ 0))
 * )(
 *   H5 : R_ECB_ETbl_P (v'29, Int.zero)
 *          (V$ OS_EVENT_TYPE_MUTEX
 *           :: Vint32 i :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil,
 *          v'44) v'39
 * )(
 *   H1 : ECBList_P v'42 Vnull
 *          (v'25 ++
 *           ((V$ OS_EVENT_TYPE_MUTEX
 *             :: Vint32 i :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil,
 *            v'44) :: nil) ++ v'26)
 *          (v'27 ++ (DMutex (Vint32 x) (Vptr (v'52, $ 0)) :: nil) ++ v'28) v'38
 *          v'39
 * )(
 *   H28 : Int.ltu i4 (x >>ᵢ $ 8) = false
 * )(
 *   H29 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE \/
 *         x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE
 * )(
 *   H35 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE
 * )(
 *   H47 : Int.ltu (x >>ᵢ $ 8) (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = true
 * )(
 *   H48 : Int.unsigned (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) < 64
 * )(
 *   H6 : EcbMod.joinsig (v'29, Int.zero)
 *          (absmutexsem (x >>ᵢ $ 8)
 *             (Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)), w) v'48 v'49
 * )(
 *   H4 : Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = None -> w = nil
 * )(
 *   H9 : forall (tid0 : tid) (opr : int32),
 *        Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = Some (tid0, opr) ->
 *        Int.ltu (x >>ᵢ $ 8) opr = true /\ Int.unsigned opr < 64
 * )(
 *   H13 : w <> nil -> Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) <> None
 * )(
 *   H25 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE ->
 *         Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) = None /\
 *         Vptr (v'52, $ 0) = Vnull
 * )(
 *   H26 : x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE ->
 *         exists tid,
 *         Vptr (v'52, $ 0) = Vptr tid /\
 *         Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) =
 *         Some (tid, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)
 * )(
 *   backup : RLH_ECBData_P (DMutex (Vint32 x) (Vptr (v'52, $ 0)))
 *              (absmutexsem (x >>ᵢ $ 8)
 *                 (Some (v'52, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)), w)
 * )(
 *   v'32 : val
 * )(
 *   H46 : array_type_vallist_match OS_TCB ∗ v'30
 * )(
 *   H51 : length v'30 = 64%nat
 * )(
 *   H49 : RL_RTbl_PrioTbl_P v'36 v'30 v'51
 * )(
 *   H50 : R_PrioTbl_P v'30 v'39 v'51
 * )(
 *   x1 : val
 * )(
 *   H52 : nth_val (Z.to_nat (Int.unsigned (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8))) v'30 =
 *         Some x1
 * )(
 *   x0 : val
 * )(
 *   H53 : nth_val (Z.to_nat (Int.unsigned (x >>ᵢ $ 8))) v'30 = Some x0
 * )(
 *   H54 : array_type_vallist_match Int8u v'36
 * )(
 *   H58 : length v'36 = ∘ OS_RDY_TBL_SIZE
 * )(
 *   i7 : int32
 * )(
 *   H55 : Int.unsigned i7 <= 255
 * )(
 *   H57 : prio_in_tbl ($ OS_IDLE_PRIO) v'36
 * )(
 *   H56 : RL_Tbl_Grp_P v'36 (Vint32 i7)
 * )(
 *   x2 : int32
 * )(
 *   fffa : length OSUnMapVallist = 256%nat ->
 *          (Z.to_nat (Int.unsigned i) < 256)%nat ->
 *          exists x,
 *          Vint32 x2 = Vint32 x /\ true = rule_type_val_match Int8u (Vint32 x)
 * )(
 *   H59 : length OSUnMapVallist = 256%nat
 * )(
 *   H60 : (Z.to_nat (Int.unsigned i) < 256)%nat
 * )(
 *   H61 : nth_val' (Z.to_nat (Int.unsigned i)) OSUnMapVallist = Vint32 x2
 * )(
 *   H62 : true = rule_type_val_match Int8u (Vint32 x2)
 * )(
 *   fffbb : Int.unsigned x2 < 8
 * )(
 *   fffbb2 : (Z.to_nat (Int.unsigned x2) < length v'44)%nat
 * )(
 *   H19'' : length v'44 = Z.to_nat 8
 * )(
 *   x4 : int32
 * )(
 *   H63 : nth_val' (Z.to_nat (Int.unsigned x2)) v'44 = Vint32 x4
 * )(
 *   H64 : Int.unsigned x4 <= 255
 * )(
 *   H65 : (Z.to_nat (Int.unsigned x4) < length OSUnMapVallist)%nat
 * )(
 *   x5 : int32
 * )(
 *   H66 : nth_val' (Z.to_nat (Int.unsigned x4)) OSUnMapVallist = Vint32 x5
 * )(
 *   H67 : Int.unsigned x5 <= 255
 * )(
 *   ttfasd : Int.unsigned x5 < 8
 * )(
 *   H68 : val_inj
 *           (bool_and
 *              (val_inj
 *                 (notint
 *                    (val_inj
 *                       (if Int.eq i ($ 0)
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))))
 *              (val_inj
 *                 (bool_or
 *                    (val_inj
 *                       (if
 *                         Int.ltu ((x2<<ᵢ$ 3) +ᵢ  x5)
 *                           (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus))
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))
 *                    (val_inj
 *                       (if
 *                         Int.eq ((x2<<ᵢ$ 3) +ᵢ  x5)
 *                           (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus))
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))))) =
 *         Vint32 Int.zero \/
 *         val_inj
 *           (bool_and
 *              (val_inj
 *                 (notint
 *                    (val_inj
 *                       (if Int.eq i ($ 0)
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))))
 *              (val_inj
 *                 (bool_or
 *                    (val_inj
 *                       (if
 *                         Int.ltu ((x2<<ᵢ$ 3) +ᵢ  x5)
 *                           (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus))
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))
 *                    (val_inj
 *                       (if
 *                         Int.eq ((x2<<ᵢ$ 3) +ᵢ  x5)
 *                           (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus))
 *                        then Some (Vint32 Int.one)
 *                        else Some (Vint32 Int.zero)))))) = Vnull
 * )(
 *   H69 : i5 = $ OS_STAT_RDY /\ i6 = $ 0
 *                                      ),
 *    {|OS_spec, GetHPrio, OSLInv, I,
 *    fun v : option val =>
 *    ( <|| END v ||>  **
 *     p_local OSLInv (v'52, Int.zero) init_lg **
 *     ((EX v0 : val, LV pevent @ OS_EVENT ∗ |-> v0) **
 *      (EX v0 : val, LV os_code_defs.x @ Int8u |-> v0) **
 *      (EX v0 : val, LV pip @ Int8u |-> v0) **
 *      (EX v0 : val, LV prio @ Int8u |-> v0) **
 *      (EX v0 : val, LV legal @ Int8u |-> v0) ** Aemp) **
 *     Aie true ** Ais nil ** Acs nil ** Aisr empisr) **
 *    A_dom_lenv
 *      ((pevent, OS_EVENT ∗)
 *       :: (os_code_defs.x, Int8u)
 *          :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil), Afalse|}
 *    |- (v'52, Int.zero)
 *    {{ <|| mutexpost (Vptr (v'29, Int.zero) :: nil) ||>  **
 *      LV os_code_defs.x @ Int8u |-> Vint32 ((x2<<ᵢ$ 3) +ᵢ  x5) **
 *      LV legal @ Int8u |-> Vint32 x2 **
 *      PV v'51 @ Int8u |-> v'32 **
 *      Astruct (v'52, Int.zero) OS_TCB_flag
 *        (v'50
 *         :: v'24
 *            :: x9
 *               :: x8
 *                  :: Vint32 i6
 *                     :: Vint32 i5
 *                        :: Vint32 i4
 *                           :: Vint32 i3
 *                              :: Vint32 i2 :: Vint32 i1 :: Vint32 i0 :: nil) **
 *      dllseg v'50 (Vptr (v'52, Int.zero)) v'40 Vnull v'35 OS_TCB_flag
 *        (fun vl : vallist => nth_val 1 vl) (fun vl : vallist => nth_val 0 vl) **
 *      GV OSTCBList @ OS_TCB ∗ |-> v'31 **
 *      dllseg v'31 Vnull v'24 (Vptr (v'52, Int.zero)) v'33 OS_TCB_flag
 *        (fun vl : vallist => nth_val 1 vl) (fun vl : vallist => nth_val 0 vl) **
 *      GV OSTCBCur @ OS_TCB ∗ |-r-> Vptr (v'52, Int.zero) **
 *      LV prio @ Int8u
 *      |-> Vint32 (Int.modu (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) ($ Byte.modulus)) **
 *      LV pip @ Int8u |-> Vint32 (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus)) **
 *      Astruct (v'29, Int.zero) OS_EVENT
 *        (V$ OS_EVENT_TYPE_MUTEX
 *         :: Vint32 i :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil) **
 *      Aarray v'23 (Tarray Int8u ∘ OS_EVENT_TBL_SIZE) v'44 **
 *      Aie false **
 *      Ais nil **
 *      Acs (true :: nil) **
 *      Aisr empisr **
 *      GV OSEventList @ OS_EVENT ∗ |-> v'42 **
 *      evsllseg v'42 (Vptr (v'29, Int.zero)) v'25 v'27 **
 *      evsllseg v'46 Vnull v'26 v'28 **
 *      A_isr_is_prop **
 *      tcbdllflag v'31
 *        (v'33 ++
 *         (v'50
 *          :: v'24
 *             :: x9
 *                :: x8
 *                   :: Vint32 i6
 *                      :: Vint32 i5
 *                         :: Vint32 i4
 *                            :: Vint32 i3
 *                               :: Vint32 i2 :: Vint32 i1 :: Vint32 i0 :: nil)
 *         :: v'35) **
 *      GAarray OSRdyTbl (Tarray Int8u ∘ OS_RDY_TBL_SIZE) v'36 **
 *      GV OSRdyGrp @ Int8u |-> Vint32 i7 **
 *      GAarray OSTCBPrioTbl (Tarray OS_TCB ∗ 64) v'30 **
 *      G& OSPlaceHolder @ Int8u == v'51 **
 *      HECBList v'38 **
 *      HTCBList v'39 **
 *      HCurTCB (v'52, Int.zero) **
 *      p_local OSLInv (v'52, Int.zero) init_lg **
 *      AOSEventFreeList v'3 **
 *      AOSQFreeList v'4 **
 *      AOSQFreeBlk v'5 **
 *      AOSMapTbl **
 *      GAarray OSUnMapTbl (Tarray Int8u 256) OSUnMapVallist **
 *      AOSIntNesting **
 *      AOSTCBFreeList v'21 v'22 **
 *      AOSTime (Vint32 v'18) **
 *      HTime v'18 **
 *      AGVars **
 *      atoy_inv' **
 *      LV pevent @ OS_EVENT ∗ |-> Vptr (v'29, Int.zero) **
 *      A_dom_lenv
 *        ((pevent, OS_EVENT ∗)
 *         :: (os_code_defs.x, Int8u)
 *            :: (pip, Int8u) :: (prio, Int8u) :: (legal, Int8u) :: nil)}}
 *    If(OSTCBCur ′ → OSTCBPrio ==ₑ pip ′)
 *         {If(OSTCBPrioTbl ′ [prio ′] !=ₑ 〈 OS_TCB ∗ 〉 os_mutex.PlaceHolder)
 *               {EXIT_CRITICAL;ₛ
 *               RETURN ′ OS_ERR_ORIGINAL_NOT_HOLDER}  ;ₛ
 *         OSRdyTbl ′ [OSTCBCur ′ → OSTCBY] &= ∼ OSTCBCur ′ → OSTCBBitX;ₛ
 *         If(OSRdyTbl ′ [OSTCBCur ′ → OSTCBY] ==ₑ ′ 0)
 *              {OSRdyGrp ′ &= ∼ OSTCBCur ′ → OSTCBBitY}  ;ₛ
 *         OSTCBCur ′ → OSTCBPrio =ₑ prio ′;ₛ
 *         OSTCBCur ′ → OSTCBY =ₑ prio ′ ≫ ′ 3;ₛ
 *         OSTCBCur ′ → OSTCBBitY =ₑ OSMapTbl ′ [OSTCBCur ′ → OSTCBY];ₛ
 *         OSTCBCur ′ → OSTCBX =ₑ prio ′ &ₑ ′ 7;ₛ
 *         OSTCBCur ′ → OSTCBBitX =ₑ OSMapTbl ′ [OSTCBCur ′ → OSTCBX];ₛ
 *         OSRdyGrp ′ =ₑ OSRdyGrp ′ |ₑ OSTCBCur ′ → OSTCBBitY;ₛ
 *         OSRdyTbl ′ [OSTCBCur ′ → OSTCBY] =ₑ
 *         OSRdyTbl ′ [OSTCBCur ′ → OSTCBY] |ₑ OSTCBCur ′ → OSTCBBitX;ₛ
 *         OSTCBPrioTbl ′ [prio ′] =ₑ 〈 OS_TCB ∗ 〉 OSTCBCur ′;ₛ
 *         OSTCBPrioTbl ′ [pip ′] =ₑ 〈 OS_TCB ∗ 〉 os_mutex.PlaceHolder}  ;ₛ
 *    If(pevent ′ → OSEventGrp !=ₑ ′ 0)
 *         {os_code_defs.x ′ =ₑ ′ OS_STAT_MUTEX;ₛ
 *         prio ′ =ᶠ OS_EventTaskRdy (·pevent ′, 〈 (Void) ∗ 〉 pevent ′,
 *         os_code_defs.x ′·);ₛ
 *         pevent ′ → OSEventCnt &= ′ OS_MUTEX_KEEP_UPPER_8;ₛ
 *         pevent ′ → OSEventCnt =ₑ pevent ′ → OSEventCnt |ₑ prio ′;ₛ
 *         pevent ′ → OSEventPtr =ₑ OSTCBPrioTbl ′ [prio ′];ₛ
 *         EXIT_CRITICAL;ₛ
 *         OS_Sched ();ₛ
 *         RETURN ′ OS_NO_ERR}  ;ₛ
 *    pevent ′ → OSEventCnt =ₑ pevent ′ → OSEventCnt |ₑ ′ OS_MUTEX_AVAILABLE;ₛ
 *    pevent ′ → OSEventPtr =ₑ NULL;ₛ
 *    EXIT_CRITICAL;ₛ
 *    RETURN ′ OS_NO_ERR {{Afalse}}
 *                  .
 * Admitted. *)

Theorem OSMutexPostRight:
  forall vl p r tid,
    Some p = BuildPreA' os_api OSMutexPost mutexpostapi vl OSLInv tid init_lg ->
    Some r = BuildRetA' os_api OSMutexPost mutexpostapi vl OSLInv tid init_lg ->
    exists t d1 d2 s ,
      os_api OSMutexPost = Some (t, d1, d2, s) /\ {| OS_spec, GetHPrio, OSLInv, I, r, Afalse |} |- tid {{ p }} s {{ Afalse }}.
Proof.
  init_spec.
  destruct x;
  try solve [unfolds in H1; destruct H1; intros; simpljoin; tryfalse].
  hoare forward.
  (* intro; tryfalse. *)
  hoare unfold.
  hoare abscsq.
  apply noabs_oslinv.

  eapply  absinfer_mutex_post_null_return .
  go.
  hoare forward.
  hoare forward.
  hoare unfold.
  false.
  elim H; intros; tryfalse.

  hoare unfold.
  hoare forward.
  destruct a.
  simpl.
  intro; tryfalse.
  hoare unfold.
  false.
  destruct a.
  simpl in H; apply H; auto.
  instantiate (1:=Afalse).
  hoare forward.
  hoare unfold.
  clear H.
  clear H1.
  hoare unfold.
  hoare forward prim.
  hoare unfold.
  hoare forward.
  sep cancel tcbdllflag.
  sep cancel Aie.
  sep cancel Ais.
  sep cancel Acs.
  sep cancel Aisr.
  sep cancel AECBList.
  sep cancel AOSTCBList.
  sep cancel AOSRdyTblGrp.
  sep cancel AOSTCBPrioTbl.
  sep cancel 1%nat 1%nat.
  eauto.
  simpl; eauto 1.
  go.
  exact retpost_osev.
  Require Import linv_solver.
  linv solver.
  linv solver.
  (* sep cancel p_local.
   * simpl; auto. *)
  hoare unfold.
  eapply backward_rule1.
  intros;eapply disj_star_elim.
  eauto.
  hoare forward.
  Focus 2.
  hoare unfold.
  hoare forward.
  change (Int.eq ($ 0) ($ 0)) with true.
  (* simpl; intro; tryfalse. *)
  hoare_split_pure_all.
  inverts H5.
  hoare abscsq.
  apply noabs_oslinv.
  eapply  absinfer_mutex_post_p_not_legal_return.
  go.
  go.
  hoare forward prim.
  go.
  go.
  hoare forward.
  hoare forward.
  hoare unfold.
  false.
  assert (Int.eq ($ 0) ($ 0) = true).
  int auto.
  rewrite H4 in H3.
  simpl in H3.
  elim H3; intros; tryfalse.

  (* legal =1 *)
  hoare unfold.
  inverts H15.
  hoare forward.
  change (Int.eq ($ 1) ($ 0)) with false.
  (* simpl; intro; tryfalse. *)
  hoare unfold.
  instantiate (1:=Afalse).
  false.
  clear -H9.
  (* assert (Int.eq ($ 1) ($ 0 ) = false). *)
  int auto.
  (* rewrite H in H9. *)
  (* simpl in H9; apply H9; auto. *)
  hoare forward.

  (* legal = 1 *)
  hoare unfold.

  hoare forward.
  (* intro; tryfalse. *)
  go.
  destruct ( Int.eq i0 ($ OS_EVENT_TYPE_MUTEX)); simpl; intro; tryfalse.
  destruct ( Int.eq i0 ($ OS_EVENT_TYPE_MUTEX)); simpl; intro; tryfalse.

  hoare unfold.
  assert (Int.eq i0 ($ OS_EVENT_TYPE_MUTEX) = false \/ Int.eq i0 ($ OS_EVENT_TYPE_MUTEX) = true).
  clear.
  destruct (   Int.eq i0 ($ OS_EVENT_TYPE_MUTEX)).
  right; auto.
  left; auto.
  elim H25; intros.

    eapply backward_rule1.
  intros.
  sep lift 8%nat in H27.
  eapply eventtype_neq_mutex;
  eauto.
  hoare unfold.

  hoare abscsq.
  apply noabs_oslinv.
  eapply absinfer_mutex_post_wrong_type_return.
  go.
  eexists.
  split.
  go.
  intro.
  apply H27.
  simpljoin.
  do 3 eexists.
  go.
  hoare forward prim.
  unfold AECBList.
  sep pauto.
  2:eauto.
  rewrite list_prop1.
  rewrite list_prop1.
  eapply evsllseg_merge; eauto.

  lets Heq : ecblistp_length_eq H1 H12.
  simpl; auto.

  sep cancel 4%nat 1%nat.
  unfold evsllseg; fold evsllseg.
  unfold AEventNode.
  unfold AOSEvent.
  unfold node.
  unfold AOSEventTbl.
  sep pauto.
  go.
  go.
  go.
  go.
  hoare forward.
  false.
  rewrite H26 in H10.
  simpl in H10.
  apply H10; auto.
  hoare forward.
  hoare unfold.
  apply  val_inj_eq in H10.
  subst i0.
  unfold AEventData.
  destruct v'43; hoare_split_pure_all.
  inverts H13.
  inverts H10.
  inverts H10.
  inverts H15.
  inverts H13.
  clear H10.
  clear H9.
  lets backup : H4.
  unfolds in H4.
  destruct v'48.
  destruct e; tryfalse.
  simpljoin.
  unfolds in H4.
  simpljoin.
  inverts H4.
  unfolds in H9.
  simpljoin.

  hoare unfold.
  hoare forward.
  (* intro; tryfalse. *)
  go.
  change (Int.ltu ($ 8) Int.iwordsize ) with true.
  simpl; eauto.
  (* intro; tryfalse. *)

  hoare unfold.
  hoare forward.
  (* intro; tryfalse. *)
  go.
  (* intro; tryfalse. *)

  hoare unfold.
  hoare forward.
  (* intro; tryfalse. *)
  go.
  clear -H23.
  destruct v0;
  unfolds in H23;
  elim H23; intros; simpljoin; tryfalse.
  simpl; intro; tryfalse.
  inverts H.
  destruct x.
  destruct ( peq v'50 b); destruct (Int.eq Int.zero i); simpl; intro; tryfalse.
clear -H23.
  destruct v0;
  unfolds in H23;
  elim H23; intros; simpljoin; tryfalse.
  simpl; intro; tryfalse.
  inverts H.
  destruct x.
  destruct ( peq v'50 b); destruct (Int.eq Int.zero i); simpl; intro; tryfalse.

    hoare unfold.

  apply  valinj_lemma1 in H28.
  hoare abscsq.
  apply noabs_oslinv.
  eapply  absinfer_mutex_post_no_owner_return.
  go.
  go.
  intro.
  simpljoin.
  lets fff: H9 (eq_refl ( Some (v'50, Int.zero, x0))).
  assert (  x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE \/  x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE) by tauto.
  elim H46; intros.
  lets ffff: H25 H47.
  simpljoin.
  tryfalse.
  lets ffff: H26 H47.
  simpljoin.
  elim H28; intros.
  tryfalse.
  simpljoin.
  inverts H48.
  inverts H49.
  elim H52.
  clear; intro; int auto.
  clear; intro; auto.
  hoare forward prim.
  unfold AECBList; unfold AOSTCBList.
  sep pauto.
  2:eauto.
  rewrite list_prop1.
  rewrite list_prop1.
  unfold tcbdllseg.
  sep pauto.
  sep cancel 3%nat 1%nat.
  unfold1 dllseg.
  unfold node.
  sep pauto.
  sep cancel 1%nat 1%nat.
  sep cancel 1%nat 1%nat.
  eapply evsllseg_merge; eauto.

  lets Heq : ecblistp_length_eq H1 H12.
  simpl; auto.

  sep cancel 5%nat 1%nat.
  unfold evsllseg; fold evsllseg.
  unfold AEventNode.
  unfold AOSEvent.
  unfold node.
  unfold AOSEventTbl.
  unfold AEventData.
  sep pauto.
  sep cancel Astruct.
  sep cancel Aarray.
  sep cancel evsllseg.
  eauto.

  go.
  go.
  go.
  go.
  go.
  go.
  go.
  go.
  go.
  go.
  go.
  go.
  hoare forward.
  auto.
  hoare forward.

  hoare unfold.
  apply valinj_lemma2 in H28.
  subst v0.

  (* assert tcbcur has mutex *)

  hoare forward.
  go.
  apply del_intlemma1.
  auto.
  destruct ( Int.ltu i4 (Int.modu (x >>ᵢ $ 8) ($ Byte.modulus))); simpl; intro; tryfalse.

  hoare unfold.
  apply post_intlemma1 in H28.

  lets backup2: H34.

  unfold1 TCBList_P in H34.
  simpljoin.
  inverts H46.
  inverts H34.
  unfolds in H48.
  simpljoin.
  destruct x4.
  destruct p.
  simpljoin.
  inverts H34.
  inverts H46.

  hoare abscsq.

  apply noabs_oslinv.
  eapply absinfer_mutex_post_prio_err_return.

  go.
  go.
  unfold TcbJoin in *.
  unfold join in *; simpl in *.
  unfold sig in *; simpl in *.
  go.
  go.

  hoare forward prim.
  unfold AECBList.
  unfold AOSTCBList.
  unfold tcbdllseg.
  sep pauto.
  sep cancel 3%nat 1%nat.
  3:eauto.
  unfold1 dllseg.
  sep pauto.
  unfold node.
  3:eauto.
  sep pauto.
  sep cancel 1%nat 1%nat.
  sep cancel 1%nat 1%nat.
  do 2 rewrite list_prop1.
  eapply evsllseg_merge; eauto.

  lets Heq : ecblistp_length_eq H1 H12.
  simpl; auto.
  sep cancel 5%nat 1%nat.
  unfold1 evsllseg.
  unfold AEventNode.
  unfold AOSEvent.
  unfold AEventData.
  unfold node.
  sep pauto.
  sep cancel Astruct.
  unfold AOSEventTbl.
  sep cancel Aarray.
  sep cancel evsllseg.
  sep pauto.
  go.
  go.
  go.
  go.
  go.  go.  go.  go.  go.  go.  go.
  hoare forward.
  go.
  hoare forward.
  hoare unfold.
  apply post_intlemma2 in H28.

  2:auto.

  assert ( x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 = $ OS_MUTEX_AVAILABLE \/  x&ᵢ$ OS_MUTEX_KEEP_LOWER_8 <> $ OS_MUTEX_AVAILABLE).
  tauto.
  elim H29; intros.
  false.

  lets fff: H25 H35.
  clear -fff.
  simpljoin; tryfalse.

  lets fff: H26 H35.
  simpljoin.

  lets fff: H9 (eq_refl (Some (x0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8))).
  simpljoin.

  hoare unfold.
  unfold AOSTCBPrioTbl.
  hoare_split_pure_all.

  destruct H46.

  assert ( exists t, nth_val (Z.to_nat (Int.unsigned (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8))) v'29 = Some t).

  apply ls_has_nth_val.
  rewrite H51.
  clear -H48.
  remember (x&ᵢ$ OS_MUTEX_KEEP_LOWER_8) .
  mauto.

  assert ( exists t, nth_val (Z.to_nat (Int.unsigned (Int.shru x ($ 8)))) v'29 = Some t).

  apply ls_has_nth_val.
  rewrite H51.
  clear -H15.
  remember (Int.shru x ($ 8)) .
  mauto.

  simpljoin.
  Open Scope code_scope.
  unfold AOSUnMapTbl.
  unfold AOSRdyTblGrp.
  unfold AOSRdyTbl, AOSRdyGrp.
  hoare_split_pure_all.
  hoare forward.
  (* intro; tryfalse. *)
  go.
  Require Import symbolic_lemmas.
  apply array_type_vallist_match_imp_rule_type_val_match.
  clear -H21.
  unfold OSUnMapVallist.
  simpl.
  mauto.

  exact unMapvallistint8u.

  hoare unfold.
  lets fffa: nthval'_has_value  OSUnMapVallist_type_vallist_match.
  assert (length OSUnMapVallist = 256)%nat by auto.
  assert (Z.to_nat (Int.unsigned i) < 256)%nat.
  clear -H21.
  mauto.
  lets fffaa :fffa H59 H60.
  simpljoin.
  rewrite H61 in *.
  lets fffbb: math_unmap_get_y H21 H61.
  Hint Resolve OS_EVENT_TBL_SIZE : tlib.
  Hint Resolve intlt2nat : tlib.
  Hint Resolve int8ule255 : tlib.
  Hint Resolve array_type_vallist_match_imp_rule_type_val_match : tlib.
  lets fffbb2 : intlt2nat fffbb.
  lets H19'' : H19.
  unfold OS_EVENT_TBL_SIZE in H19''.
  unfold nat_of_Z in H19''.
  rewrite <- H19'' in fffbb2.

  lets bbbff:array_int8u_nth_lt_len H11 fffbb2.
  simpljoin.
  assert (Z.to_nat (Int.unsigned x4) < length OSUnMapVallist)%nat.
  clear -H64.
  mauto.
  lets bbfa: array_int8u_nth_lt_len OSUnMapVallist_type_vallist_match H65.
  simpljoin.

  hoare forward.
  (* change ( Int.ltu ($ 3) Int.iwordsize ) with true; simpl; intro ; tryfalse. *)
  rewrite H19.
  auto with tlib.
  rewrite H63.
  unfolds; auto.

  Local Open Scope Z_scope.
  math simpls.
  Ltac mew2 := match goal with
                 | |- (if _ then true else false) = true => rewrite ifE
                 | |- (_ <=? _ = true) => apply Zle_imp_le_bool
                 | |- (_ <= _ ) => apply Zle_bool_imp_le
               end.
  Hint Resolve ifE : tlib.
  Hint Resolve Zle_imp_le_bool : tlib.
  eauto.
  clear -H64; omega.
  clear -H64; omega.

  apply array_type_vallist_match_imp_rule_type_val_match.
  unfold OSUnMapVallist.
  simpl.
  clear -H64; mauto.
  exact OSUnMapVallist_type_vallist_match.
  Hint Resolve OSUnMapVallist_type_vallist_match: tlib.
  rewrite postintlemma4.
  rewrite H66.
  simpl; intro; tryfalse.
  rewrite postintlemma4.
  rewrite H66.
  simpl add.
  simpl val_inj.

  lets ttfasd: math_unmap_get_y H64 H66.
  hoare forward.
  (* intro; tryfalse. *)
  go.
  destruct (Int.eq i ($ 0)); simpl;intro; tryfalse.
  destruct (Int.eq i ($ 0)); simpl; intro; tryfalse.

  math simpls.
  clear -fffbb ttfasd.
  mauto.

  apply postintlemma1.
  destruct ( Int.ltu ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus))).
  simpl; intro; tryfalse.
  simpl; intro; tryfalse.
  clear -fffbb ttfasd.
  mauto.
  apply postintlemma1.

  destruct ( Int.eq ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus))); simpl; intro; tryfalse.
  destruct (Int.eq i ($ 0));
    destruct ( Int.ltu ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus)));    destruct ( Int.eq ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus))); simpl; intro; tryfalse.
  destruct (Int.eq i ($ 0));
    destruct ( Int.ltu ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus)));    destruct ( Int.eq ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus))); simpl; intro; tryfalse.

  hoare unfold.

  instantiate (1:=Afalse).

  (* to zhang hui *)

  rename v'42 into evnt_tbl.
  Ltac copy H1 H2 :=
    match type of H1 with
      | ?T =>
        assert(T) as H2 by (apply H1)
    end.
  copy H5 Hx.
  unfolds in Hx.
  destruct Hx as (Hx & _ & _).
  unfolds in Hx.
  destruct Hx as (_&_&_&Hx).
  unfolds in Hx.
  unfold V_OSEventType in Hx.
  simpl nth_val in Hx.
  assert(PrioWaitInQ (Int.unsigned ((x2<<ᵢ$ 3)+ᵢx5)) evnt_tbl).

  pose proof prio_from_grp_tbl_PrioWaitInQ i evnt_tbl x2 x4 x5.
  eapply H71; eauto.
  clear - H68 H69 H70.
  destruct (Int.eq i ($ 0)) eqn : eq1.

  destruct (Int.ltu ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus)));
    destruct (Int.eq ((x2<<ᵢ$ 3)+ᵢx5) (Int.modu (Int.shru x ($ 8)) ($ Byte.modulus)));
    simpl in *; try (rewrite int_ltu_zero_one_true in *); try (rewrite int_ltu_zero_notbool_one_false in *); try (rewrite int_ltu_zero_zero_false in *); simpl in *; tryfalse.

  clear - eq1.
  intro; substs.
  rewrite Int.eq_true in eq1.
  inversion eq1.

  apply Hx in H71; auto.
  do 3 destruct H71.
  copy H7 Hx1.
  unfolds in Hx1.
  destruct Hx1 as (_&_&_&Hx1).
  unfolds in Hx1.
  destruct Hx1 as (_&Hx1).
  copy H71 Hx2.
  apply Hx1 in H71.
  clear Hx1.
  simpljoin.
  unfold get in H71, Hx2; simpl in H71, Hx2.
  assert(EcbMod.get v'37 (v'28, Int.zero) = Some (absmutexsem (Int.shru x ($ 8)) (Some (v'50, $ 0, x&ᵢ$ OS_MUTEX_KEEP_LOWER_8)), w)).
  clear - H17 H6.
  pose proof H6 (v'28, Int.zero).
  rewrite EcbMod.get_sig_some in H.
  destruct (EcbMod.get v'46 (v'28, Int.zero)); tryfalse.
  destruct (EcbMod.get v'47 (v'28, Int.zero)) eqn : eq1; tryfalse.
  pose proof H17 (v'28, Int.zero).
  rewrite eq1 in H0.
  destruct (EcbMod.get v'45 (v'28, Int.zero)); tryfalse.
  destruct (EcbMod.get v'37 (v'28, Int.zero)); tryfalse.
  substs; auto.

  rewrite H71 in H73; inverts H73.

  hoare abscsq.

  apply noabs_oslinv.
  eapply absinfer_mutex_post_wl_highest_prio_err_return; eauto.
  go.
  go.

  apply zlt_false.
  assert(Int.modu (Int.shru x ($ 8)) ($ Byte.modulus) = (Int.shru x ($ 8))).
  clear - H15.
  apply mutexdel_intlemma1; auto.
  clear - H68 H69 H70 H73.
  rewrite H73 in *.
  destruct (Int.ltu ((Int.shl x2 ($ 3))+ᵢx5) (Int.shru x ($ 8))) eqn : eq1.
  rewrite Int.repr_unsigned.
  apply Int.ltu_inv in eq1.
  clear - eq1.
  apply Znot_lt_ge.
  apply Zle_not_lt.
  destruct eq1.
  apply Z.lt_le_incl; auto.
  destruct(Int.eq ((Int.shl x2 ($ 3))+ᵢx5) (Int.shru x ($ 8))) eqn : eq2;
    destruct(Int.eq i ($ 0)); simpl in *; try (rewrite int_ltu_zero_notbool_one_false in *); try (rewrite int_ltu_zero_zero_false in *); try (rewrite int_ltu_zero_one_true in *); try (rewrite int_ltu_zero_notbool_zero_true in *); simpl in *; tryfalse.
  rewrite Int.repr_unsigned.
  unfold Int.eq in eq2.
  destruct (zeq (Int.unsigned ((Int.shl x2 ($ 3))+ᵢx5)) (Int.unsigned (Int.shru x ($ 8)))) eqn : eq3.
  rewrite e.
  omega.
  inversion eq2.
  rewrite int_ltu_zero_zero_false in H68.
  simpl in H68.
  tryfalse.

  hoare forward prim.
  unfold AOSUnMapTbl.
  unfold AOSTCBPrioTbl.
  unfold AOSRdyTblGrp.
  unfold AOSTCBList.
  unfold AOSRdyTbl.
  unfold AOSRdyGrp.
  unfold tcbdllseg.
  unfold dllseg; fold dllseg.
  unfold  V_OSTCBPrev; unfold V_OSTCBNext.

  sep pauto; eauto.
  sep cancel tcbdllflag.
  sep cancel 5%nat 2%nat.
  sep cancel 5%nat 2%nat.
  sep cancel 3%nat 2%nat.
  sep cancel 11%nat 3%nat.
  unfold node.
  sep pauto.
  sep cancel 3%nat 1%nat.
  Local Open Scope list_scope.
  instantiate (3:=(v'24 ++
                        ((V$OS_EVENT_TYPE_MUTEX
                           :: Vint32 i :: Vint32 x :: Vptr (v'50, $ 0) :: x3 :: v'44 :: nil,
                          evnt_tbl) :: nil) ++ v'25)).
  instantiate (2:=(v'26 ++ (DMutex (Vint32 x) (Vptr (v'50, $ 0)) :: nil) ++ v'27)).
  unfold AECBList.
  sep pauto.
  eapply evsllseg_compose; eauto.
  unfolds; simpl; eauto.
  unfold AEventNode.
  unfold AOSEvent.
  unfold AEventData.
  unfold node.
  unfold AOSEventTbl.
  sep pauto; eauto.
  do 3 (sep cancel 5%nat 1%nat).
  exact H73.
  split; auto.
  go.
  split; auto.
  go.
  unfolds.
  lets Hx1: leb_bytemax_true_intro H55.
  rewrite Hx1.
  auto.
  go.
  go.
  go.

  hoare forward.
  (*to zhanghui end*)

  hoare forward.
  hoare unfold.

  hoare forward.

  go.

  destruct (Int.eq i5 ($ OS_STAT_RDY)); simpl; intro; tryfalse.
  destruct (Int.eq i5 ($ OS_STAT_RDY)); simpl; intro; tryfalse.

  go.

  destruct (Int.eq i6 ($ 0)); simpl; intro; tryfalse.
  destruct (Int.eq i6 ($ 0)); simpl; intro; tryfalse.
  destruct (Int.eq i6 ($ 0));
    destruct (Int.eq i5 ($ OS_STAT_RDY)); simpl; intro; tryfalse.

  instantiate (1:=Afalse).

  hoare abscsq.
  apply noabs_oslinv.
  eapply absinfer_mutex_post_original_not_holder_err_return .
  go.
  hoare forward prim.
  unfold AOSUnMapTbl.
  unfold AOSTCBPrioTbl.
  unfold AOSRdyTblGrp.
  unfold AOSTCBList.
  unfold AOSRdyTbl.
  unfold AOSRdyGrp.
  unfold tcbdllseg.
  unfold dllseg; fold dllseg.
  unfold node.
  sep pauto.
  sep cancel tcbdllflag.

  sep cancel 4%nat 1%nat.
  sep cancel 4%nat 1%nat.
  sep cancel 4%nat 1%nat.
  sep cancel 3%nat 1%nat.
  sep cancel 10%nat 2%nat.
  instantiate (3:=(v'24 ++
                        ((V$OS_EVENT_TYPE_MUTEX
                           :: Vint32 i :: Vint32 x :: Vptr (v'50, $ 0) :: x3 :: v'44 :: nil,
                          v'42) :: nil) ++ v'25)).
  instantiate (2:=(v'26 ++ (DMutex (Vint32 x) (Vptr (v'50, $ 0)) :: nil) ++ v'27)).

  (* instantiate (3 := ((v'25 ++
   *                          ((V$OS_EVENT_TYPE_MUTEX
   *                             :: Vint32 i :: Vint32 x :: Vptr (v'52, $ 0) :: x3 :: v'46 :: nil,
   *                            v'44) :: nil) ++ v'26))).
   * instantiate (2 := (  (v'27 ++ (DMutex (Vint32 x) (Vptr (v'52, $ 0)) :: nil) ++ v'28))). *)
  unfold AECBList.
  sep pauto.
  eapply evsllseg_compose; eauto.
  go.
  unfold AEventNode.
  unfold AEventData; unfold AOSEvent.
  unfold node.
  unfold AOSEventTbl.
  sep pauto.
  sep cancel Astruct.
  sep cancel Aarray.
  sep cancel evsllseg.
  eauto.
  go.   go.   go.   go.   go.   go.
  mew2; mew2.
  exact H55.
  go.   go.   go.
  go.   go.   go.
  go.   go.
  go.
  hoare forward.

  hoare forward.
  hoare unfold.

  apply simpl_valinj in H69.

  Require Import OSMutexPostPart2.

  eapply MutexPostPart1; eauto.

Qed.


Set Implicit Arguments.
Require Import LibKeyType LibValueType LibGenEnv LibVarKey LibTauValue LibEValue.
Require Import LibKappaValue.

Module VarEEnv   := GenEnv VarKey EValue.
Definition Heap  := VarEEnv.env.
Module VarKappa  := GenEnv VarKey KappaValue.
Definition Delta := VarKappa.env.
Module VarTauEnv := GenEnv VarKey TauValue.
Definition Gamma := VarTauEnv.env.

Module VarPathTauEnv := GenEnv VarPathKey TauValue.