From compcert Require Export Clightdefs.
Require Export VST.veric.base.
Require Export VST.veric.SeparationLogic.
Require Export VST.msl.Extensionality.
Require Export compcert.lib.Coqlib.
Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
Require Export VST.floyd.functional_base.

Lemma is_int_dec i s v: {is_int i s v} + {~ is_int i s v}.
Proof. destruct v; simpl; try solve [right; intros N; trivial].
destruct i.
+ destruct s.
    * destruct (zle Byte.min_signed (Int.signed i0)); [| right; omega].
      destruct (zle (Int.signed i0) Byte.max_signed). left; omega. right; omega.
    * destruct (zle (Int.unsigned i0) Byte.max_unsigned). left; omega. right; omega.
+ destruct s.
    * destruct (zle (-32768) (Int.signed i0)); [| right; omega].
      destruct (zle (Int.signed i0) 32767). left; omega. right; omega.
    * destruct (zle (Int.unsigned i0) 65535). left; omega. right; omega.
+ left; trivial.
+ destruct (Int.eq_dec i0 Int.zero); subst. left; left; trivial.
    destruct (Int.eq_dec i0 Int.one); subst. left; right; trivial.
    right. intros N; destruct N; contradiction.
Defined.

Lemma tc_val_dec t v: {tc_val t v} + {~ tc_val t v}.
Proof. destruct t; simpl.
+ right; intros N; trivial.
+ apply is_int_dec.
+ apply is_long_dec.
+ destruct f. apply is_single_dec. apply is_float_dec.
+ destruct ((eqb_type t Tvoid &&
    eqb_attr a
      {| attr_volatile := false; attr_alignas := Some log2_sizeof_pointer |})%bool).
  apply is_pointer_or_integer_dec.
  apply is_pointer_or_null_dec.
+ apply is_pointer_or_null_dec.
+ apply is_pointer_or_null_dec.
+ apply isptr_dec.
+ apply isptr_dec.
Defined.

Lemma sem_add_pi_ptr:
   forall {cs: compspecs}  t p i si,
    isptr p ->
    match si with
    | Signed => Int.min_signed <= i <= Int.max_signed
    | Unsigned => 0 <= i <= Int.max_unsigned
    end ->
    Cop.sem_add_ptr_int cenv_cs t si p (Vint (Int.repr i)) = Some (offset_val (sizeof t * i) p).
Proof.
  intros. destruct p; try contradiction.
  unfold offset_val, Cop.sem_add_ptr_int.
  unfold Cop.ptrofs_of_int, Ptrofs.of_ints, Ptrofs.of_intu, Ptrofs.of_int.
  f_equal. f_equal. f_equal.
  destruct si; rewrite <- ptrofs_mul_repr;  f_equal.
  rewrite Int.signed_repr by omega; auto.
  rewrite Int.unsigned_repr by omega; auto.
Qed.
Hint Rewrite @sem_add_pi_ptr using (solve [auto with norm]) : norm.

Lemma sem_cast_i2i_correct_range: forall sz s v,
  is_int sz s v -> sem_cast_i2i sz s v = Some v.
Proof.
  intros.
  destruct sz, s, v; try solve [inversion H]; simpl;
  f_equal; f_equal; try apply sign_ext_inrange; try apply zero_ext_inrange; eauto.
  + simpl in H; destruct H; subst; reflexivity.
  + simpl in H; destruct H; subst; reflexivity.
Qed.
Hint Rewrite sem_cast_i2i_correct_range using (solve [auto with norm]) : norm.

Lemma sem_cast_neutral_ptr:
  forall p, isptr p -> sem_cast_pointer p = Some p.
Proof. intros. destruct p; try contradiction; reflexivity. Qed.
Hint Rewrite sem_cast_neutral_ptr using (solve [auto with norm]): norm.

Lemma sem_cast_neutral_Vint: forall v,
  sem_cast_pointer (Vint v) = Some (Vint v).
Proof.
  intros. reflexivity.
Qed.
Hint Rewrite sem_cast_neutral_Vint : norm.

Definition isVint v := match v with Vint _ => True | _ => False end.

Lemma is_int_is_Vint: forall i s v, is_int i s v -> isVint v.
Proof. intros.
 destruct i,s,v; simpl; intros; auto.
Qed.

Lemma is_int_I32_Vint: forall s v, is_int I32 s (Vint v).
Proof.
intros.
hnf. auto.
Qed.
Hint Resolve is_int_I32_Vint.

Lemma sem_cast_neutral_int: forall v,
  isVint v ->
  sem_cast_pointer v = Some v.
Proof.
destruct v; simpl; intros; try contradiction; auto.
Qed.

Hint Rewrite sem_cast_neutral_int using
  (auto;
   match goal with H: is_int ?i ?s ?v |- isVint ?v => apply (is_int_is_Vint i s v H) end) : norm.

Lemma sizeof_tuchar: forall {cs: compspecs}, sizeof tuchar = 1%Z.
Proof. reflexivity. Qed.
Hint Rewrite @sizeof_tuchar: norm.

Hint Rewrite Z.mul_1_l Z.mul_1_r Z.add_0_l Z.add_0_r Z.sub_0_r : norm.

Hint Rewrite eval_id_same : norm.
Hint Rewrite eval_id_other using solve [clear; intro Hx; inversion Hx] : norm.
Hint Rewrite Int.sub_idem Int.sub_zero_l  Int.add_neg_zero : norm.
Hint Rewrite Ptrofs.sub_idem Ptrofs.sub_zero_l  Ptrofs.add_neg_zero : norm.

Lemma eval_expr_Etempvar:
  forall {cs: compspecs}  i t, eval_expr (Etempvar i t) = eval_id i.
Proof. reflexivity.
Qed.
Hint Rewrite @eval_expr_Etempvar : eval.

Lemma eval_expr_binop: forall {cs: compspecs}  op a1 a2 t, eval_expr (Ebinop op a1 a2 t) =
          `(eval_binop op (typeof a1) (typeof a2)) (eval_expr a1) (eval_expr a2).
Proof. reflexivity. Qed.
Hint Rewrite @eval_expr_binop : eval.

Lemma eval_expr_unop: forall {cs: compspecs} op a1 t, eval_expr (Eunop op a1 t) =
          lift1 (eval_unop op (typeof a1)) (eval_expr a1).
Proof. reflexivity. Qed.
Hint Rewrite @eval_expr_unop : eval.

Hint Resolve  eval_expr_Etempvar.

Lemma eval_expr_Etempvar' : forall {cs: compspecs}  i t, eval_id i = eval_expr (Etempvar i t).
Proof. intros. symmetry; auto.
Qed.
Hint Resolve  @eval_expr_Etempvar'.

Hint Rewrite Int.add_zero  Int.add_zero_l Int.sub_zero_l : norm.
Hint Rewrite Ptrofs.add_zero  Ptrofs.add_zero_l Ptrofs.sub_zero_l : norm.

Lemma eval_var_env_set:
  forall i t j v (rho: environ), eval_var i t (env_set rho j v) = eval_var i t rho.
Proof. reflexivity. Qed.
Hint Rewrite eval_var_env_set : norm.

Lemma eval_expropt_Some: forall {cs: compspecs}  e, eval_expropt (Some e) = `Some (eval_expr e).
Proof. reflexivity. Qed.
Lemma eval_expropt_None: forall  {cs: compspecs} , eval_expropt None = `None.
Proof. reflexivity. Qed.
Hint Rewrite @eval_expropt_Some @eval_expropt_None : eval.

Lemma deref_noload_tarray:
  forall ty n, deref_noload (tarray ty n) = (fun v => v).
Proof.
 intros. extensionality v. reflexivity.
Qed.
Hint Rewrite deref_noload_tarray : norm.

Lemma deref_noload_Tarray:
  forall ty n a, deref_noload (Tarray ty n a) = (fun v => v).
Proof.
 intros. extensionality v. reflexivity.
Qed.
Hint Rewrite deref_noload_Tarray : norm.

Lemma flip_lifted_eq:
  forall (v1: environ -> val) (v2: val),
    `eq v1 `(v2) = `(eq v2) v1.
Proof.
intros. unfold_lift. extensionality rho. apply prop_ext; split; intro; auto.
Qed.
Hint Rewrite flip_lifted_eq : norm.

Lemma isptr_is_pointer_or_null:
  forall v, isptr v -> is_pointer_or_null v.
Proof. intros. destruct v; inv H; simpl; auto.
Qed.
Hint Resolve isptr_is_pointer_or_null.

Definition add_ptr_int  {cs: compspecs}  (ty: type) (v: val) (i: Z) : val :=
           eval_binop Cop.Oadd (tptr ty) tint v (Vint (Int.repr i)).

Lemma add_ptr_int_offset:
  forall  {cs: compspecs}  t v n,
  repable_signed (sizeof t) ->
  repable_signed n ->
  add_ptr_int t v n = offset_val (sizeof t * n) v.
Abort. (* broken in CompCert 2.7 *)

Lemma typed_false_cmp:
  forall op i j ,
   typed_false tint (force_val (sem_cmp op tint tint (Vint i) (Vint j))) ->
   Int.cmp (negate_comparison op) i j = true.
Proof.
intros.
unfold sem_cmp in H.
unfold Cop.classify_cmp in H. simpl in H.
rewrite Int.negate_cmp.
unfold both_int, force_val, typed_false, strict_bool_val, sem_cast, classify_cast, tint in H.
destruct Archi.ptr64 eqn:Hp; simpl in H.
destruct (Int.cmp op i j); inv H; auto.
destruct (Int.cmp op i j); inv H; auto.
Qed.

Lemma typed_true_cmp:
  forall op i j,
   typed_true tint (force_val (sem_cmp op tint tint (Vint i) (Vint j))) ->
   Int.cmp op i j = true.
Proof.
intros.
unfold sem_cmp in H.
unfold Cop.classify_cmp in H. simpl in H.
unfold both_int, force_val, typed_false, strict_bool_val, sem_cast, classify_cast, tint in H.
destruct Archi.ptr64 eqn:Hp; simpl in H.
destruct (Int.cmp op i j); inv H; auto.
destruct (Int.cmp op i j); inv H; auto.
Qed.

Definition Zcmp (op: comparison) : Z -> Z -> Prop :=
 match op with
 | Ceq => eq
 | Cne => (fun i j => i<>j)
 | Clt => Z.lt
 | Cle => Z.le
 | Cgt => Z.gt
 | Cge => Z.ge
 end.

Lemma int_cmp_repr:
 forall op i j, repable_signed i -> repable_signed j ->
   Int.cmp op (Int.repr i) (Int.repr j) = true ->
   Zcmp op i j.
Proof.
intros.
unfold Int.cmp, Int.eq, Int.lt in H1.
replace (if zeq (Int.unsigned (Int.repr i)) (Int.unsigned (Int.repr j))
             then true else false)
 with (if zeq i j then true else false) in H1.
2:{
destruct (zeq i j); destruct (zeq (Int.unsigned (Int.repr i)) (Int.unsigned (Int.repr j)));
 auto.
subst. contradiction n; auto.
clear - H H0 e n.
apply Int.signed_repr in H. rewrite Int.signed_repr_eq in H.
apply Int.signed_repr in H0; rewrite Int.signed_repr_eq in H0.
contradiction n; clear n.
repeat rewrite Int.unsigned_repr_eq in e.
 match type of H with
           | context [if ?a then _ else _] => destruct a
           end;
 match type of H0 with
           | context [if ?a then _ else _] => destruct a
           end; omega.
}
unfold Zcmp.
rewrite (Int.signed_repr _ H) in H1; rewrite (Int.signed_repr _ H0) in H1.
repeat match type of H1 with
           | context [if ?a then _ else _] => destruct a
           end; try omegaContradiction;
 destruct op; auto; simpl in *; try discriminate; omega.
Qed.

Lemma typed_false_cmp_repr:
  forall op i j,
   repable_signed i -> repable_signed j ->
   typed_false tint (force_val (sem_cmp op tint tint
                              (Vint (Int.repr i))
                              (Vint (Int.repr j)) )) ->
   Zcmp (negate_comparison op) i j.
Proof.
 intros.
 apply typed_false_cmp in H1.
 apply int_cmp_repr; auto.
Qed.

Lemma typed_true_cmp_repr:
  forall op i j,
   repable_signed i -> repable_signed j ->
   typed_true tint (force_val (sem_cmp op tint tint
                              (Vint (Int.repr i))
                              (Vint (Int.repr j)) )) ->
   Zcmp op i j.
Proof.
 intros.
 apply typed_true_cmp in H1.
 apply int_cmp_repr; auto.
Qed.

Ltac intcompare H :=
 (apply typed_false_cmp_repr in H || apply typed_true_cmp_repr in H);
   [ simpl in H | auto; unfold repable_signed, Int.min_signed, Int.max_signed in *; omega .. ].

Lemma isptr_deref_noload:
 forall t p, access_mode t = By_reference -> isptr (deref_noload t p) = isptr p.
Proof.
intros.
unfold deref_noload. rewrite H. reflexivity.
Qed.
Hint Rewrite isptr_deref_noload using reflexivity : norm.

Definition headptr (v: val): Prop :=
  exists b,  v = Vptr b Ptrofs.zero.

Lemma headptr_isptr: forall v,
  headptr v -> isptr v.
Proof.
  intros.
  destruct H as [b ?].
  subst.
  hnf; auto.
Qed.
Hint Resolve headptr_isptr.

Lemma headptr_offset_zero: forall v,
  headptr (offset_val 0 v) <->
  headptr v.
Proof.
  split; intros.
  + destruct H as [b ?]; subst.
    destruct v; try solve [inv H].
    simpl in H.
    remember (Ptrofs.add i (Ptrofs.repr 0)).
    inversion H; subst.
    rewrite Ptrofs.add_zero in H2; subst.
    hnf; eauto.
  + destruct H as [b ?]; subst.
    exists b.
    reflexivity.
Qed.

(* Equality proofs for all constants from the Compcert Int, Int64, Ptrofs modules: *)

Lemma typed_false_ptr:
  forall {t a v},  typed_false (Tpointer t a) v -> v=nullval.
Proof.
unfold typed_false, strict_bool_val, nullval; simpl; intros.
destruct Archi.ptr64 eqn:Hp;
destruct v; try discriminate; f_equal.
first [pose proof (Int64.eq_spec i Int64.zero);
          destruct (Int64.eq i Int64.zero)
       | pose proof (Int.eq_spec i Int.zero);
         destruct (Int.eq i Int.zero)];
      subst; auto; discriminate.
Qed.

Lemma typed_true_ptr:
  forall {t a v},  typed_true (Tpointer t a) v -> isptr v.
Proof.
unfold typed_true, strict_bool_val; simpl; intros.
destruct v; try discriminate; simpl; auto;
destruct Archi.ptr64; try discriminate;
 revert H; simple_if_tac; intros; discriminate.
Qed.

Lemma int_cmp_repr':
 forall op i j, repable_signed i -> repable_signed j ->
   Int.cmp op (Int.repr i) (Int.repr j) = false ->
   Zcmp (negate_comparison op) i j.
Proof.
intros.
apply int_cmp_repr; auto.
rewrite Int.negate_cmp.
rewrite H1; reflexivity.
Qed.

Lemma typed_false_of_bool:
 forall x, typed_false tint (Val.of_bool x) -> (x=false).
Proof.
unfold typed_false; simpl.
unfold strict_bool_val, Val.of_bool; simpl.
destruct x; simpl; intros; [inversion H | auto].
Qed.

Lemma typed_true_of_bool:
 forall x, typed_true tint (Val.of_bool x) -> (x=true).
Proof.
unfold typed_true; simpl.
unfold strict_bool_val, Val.of_bool; simpl.
destruct x; simpl; intros; [auto | inversion H].
Qed.

Lemma typed_false_tint:
 Archi.ptr64=false ->
 forall v, typed_false tint v -> v=nullval.
Proof.
intros.
 hnf in H0. destruct v; inv H0.
 destruct (Int.eq i Int.zero) eqn:?; inv H2.
 apply int_eq_e in Heqb. subst.
 inv H; reflexivity.
Qed.

Lemma typed_false_tlong:
 Archi.ptr64=true ->
 forall v, typed_false tlong v -> v=nullval.
Proof.
intros. unfold nullval. rewrite H.
 hnf in H0. destruct v; inv H0.
pose proof (Int64.eq_spec i Int64.zero).
 destruct (Int64.eq i Int64.zero); inv H2.
reflexivity.
Qed.

Lemma typed_true_e:
 forall t v, typed_true t v -> v<>nullval.
Proof.
intros.
 intro Hx. subst.
 hnf in H. unfold nullval, strict_bool_val in H.
 destruct Archi.ptr64, t; discriminate.
Qed.

Lemma typed_false_tint_Vint:
  forall v, typed_false tint (Vint v) -> v = Int.zero.
Proof.
intros.
unfold typed_false, strict_bool_val in H. simpl in H.
pose proof (Int.eq_spec v Int.zero).
destruct (Int.eq v Int.zero); auto. inv H.
Qed.

Lemma typed_true_tint_Vint:
  forall v, typed_true tint (Vint v) -> v <> Int.zero.
Proof.
intros.
unfold typed_true, strict_bool_val in H. simpl in H.
pose proof (Int.eq_spec v Int.zero).
destruct (Int.eq v Int.zero); auto. inv H.
Qed.

Lemma typed_true_tlong_Vlong:
  forall v, typed_true tlong (Vlong v) -> v <> Int64.zero.
Proof.
intros.
unfold typed_true, strict_bool_val in H. simpl in H.
pose proof (Int64.eq_spec v Int64.zero).
destruct (Int64.eq v Int64.zero); auto. inv H.
Qed.

Ltac intro_redundant_prop :=
  (* do it in this complicated way because the proof will come out smaller *)
match goal with |- ?P -> _ =>
  ((assert P by immediate; fail 1) || fail 1) || intros _
end.

Ltac fancy_intro aggressive :=
 match goal with
 | |- ?P -> _ => match type of P with Prop => idtac end
 | |- ~ _ => idtac
 end;
 let H := fresh in
 intro H;
 try simple apply ptr_eq_e in H;
 try simple apply Vint_inj in H;
 try match type of H with
 | tc_val _ _ => unfold tc_val in H; try change (eqb_type _ _) with false in H; cbv iota in H
 end;
 match type of H with
 | ?P => clear H;
              match goal with H': P |- _ => idtac end (* work around bug number 6998 in Coq *)
             + (((assert (H:P) by (clear; immediate); fail 1) || fail 1) || idtac)
                (* do it in this complicated way because the proof will come out smaller *)
 | ?x = ?y => constr_eq aggressive true;
                     first [subst x | subst y
                             | is_var x; rewrite H
                             | is_var y; rewrite <- H
                             | idtac]
 | headptr (_ ?x) => let Hx1 := fresh "HP" x in
                     let Hx2 := fresh "P" x in
                       rename H into Hx1;
                       pose proof headptr_isptr _ Hx1 as Hx2
 | headptr ?x => let Hx1 := fresh "HP" x in
                 let Hx2 := fresh "P" x in
                   rename H into Hx1;
                   pose proof headptr_isptr _ Hx1 as Hx2
 | isptr ?x => let Hx := fresh "P" x in rename H into Hx
 | is_pointer_or_null ?x => let Hx := fresh "PN" x in rename H into Hx
 | typed_false _ _ =>
        first [simple apply typed_false_of_bool in H
               | apply typed_false_tint_Vint in H
               | apply (typed_false_tint (eq_refl _)) in H
               | apply (typed_false_tlong (eq_refl _)) in H
               | apply typed_false_ptr in H
               | idtac ]
 | typed_true _ _ =>
        first [simple apply typed_true_of_bool in H
               | apply typed_true_tint_Vint in H
               | apply typed_true_tlong_Vlong in H
(*  This one is not portable 32/64 bits
                | apply (typed_true_e tint) in H
*)
               | apply typed_true_ptr in H
               | idtac ]
 (* | locald_denote _ _ => hnf in H *)
 | _ => try solve [discriminate H]
 end.

Ltac fancy_intros aggressive :=
 repeat match goal with
  | |- (_ <= _ < _) -> _ => fancy_intro aggressive
  | |- (_ < _ <= _) -> _ => fancy_intro aggressive
  | |- (_ <= _ <= _) -> _ => fancy_intro aggressive
  | |- (_ < _ < _) -> _ => fancy_intro aggressive
  | |- (?A /\ ?B) -> ?C => apply (@and_ind A B C) (* For some reason "apply and_ind" doesn't work the same *)
  | |- _ -> _ => fancy_intro aggressive
  end.

Ltac fold_types :=
 fold noattr tuint tint tschar tuchar;
 repeat match goal with
 | |- context [Tpointer ?t noattr] =>
      change (Tpointer t noattr) with (tptr t)
 | |- context [Tarray ?t ?n noattr] =>
      change (Tarray t n noattr) with (tarray t n)
 end.

Ltac fold_types1 :=
  match goal with |- _ -> ?A =>
  let a := fresh "H" in set (a:=A); fold_types; subst a
  end.

Lemma is_int_Vbyte: forall c, is_int I8 Signed (Vbyte c).
Proof.
intros. simpl. normalize. rewrite Int.signed_repr by rep_omega. rep_omega.
Qed.
Hint Resolve is_int_Vbyte.


(************************************************************************)
(* Copyright (c) 2022, Gergei Bana, Rohit Chadha, Ajay Kumar Eeralla,   *)
(* Qianli Zhang                                                         *)
(*                                                                      *)
(* This work is licensed under the MIT license. The license is          *)
(* described in the file "LICENSE" available at the root of the source  *)
(* or at https://opensource.org/licenses/MIT                            *)
(************************************************************************)

Require Import Coq.micromega.Lia.
Require Export contexts.
(* Require Export prop11. *)
Import ListNotations.

(********************************************************************)

(* Proposition 15.8 *)
Proposition DoNegElim: forall b, bppt b -> (! ! b) = b.
  intros.
  rewrite (@If_morph (fun x => If x Then FAlse Else TRue)).
  rewrite If_true.
  rewrite If_false.
  rewrite <- If_tf.
  reflexivity.
  all : ProveboolandContext.
Qed.

(* Prop21 is similar to the Blindness property of a blind-signature scheme,
   but states that even if the attacker has access to the acceptance checks, the blind-signature game will still keep indistinguishable. *)

Proposition prop21: forall n0 n1 z, forall m0 m1 t :ppt, forall t0 t1,
      n0 <> n1 ->
  Fresh (nonce n0) (m0 :: m1 :: t :: z) -> FreshTermc (nonce n0) t0 -> FreshTermc (nonce n0) t1 ->
  Fresh (nonce n1) (m0 :: m1 :: t :: z) -> FreshTermc (nonce n1) t0 -> FreshTermc (nonce n1) t1 ->
  let bn0 := Brand (nonce n0) in
  let bn1 := Brand (nonce n1) in
  let ti0 := t0 [b m0 t bn0; b m1 t bn1] in
  let ti1 := t1 [b m1 t bn0; b m0 t bn1] in
  z ++ [b m0 t bn0; b m1 t bn1; acc m0 t bn0 ti0 & acc m1 t bn1 ti0 ; If acc m0 t bn0 ti0 & acc m1 t bn1 ti0 Then ＜ ub m0 t bn0 ti0, ub m1 t bn1 ti0 ＞ Else (＜ ⫠, ⫠ ＞)]
  ~
  z ++ [b m1 t bn0; b m0 t bn1; acc m1 t bn0 ti1 & acc m0 t bn1 ti1 ; If acc m1 t bn0 ti1 & acc m0 t bn1 ti1 Then ＜ ub m0 t bn1 ti1, ub m1 t bn0 ti1 ＞ Else (＜ ⫠, ⫠ ＞)].
Proof.
  intros n0 n1 z m0 m1 t t0 t1 noteq. intros.
  pose (Blindness z m0 m1 t (nonce n0) (nonce n1) t0 t1 H H0 H1 H2 H3 H4) as c. simpl in c.
  apply (@cind_funcapp (fun lc =>  (firstn (length z) lc) ++ [(Nth (length z + 0) lc); (Nth (length z + 1) lc); (Nth (length z + 2) lc); ((π1 (Nth (length z + 2) lc)) ≟ ⫠) ])) in c;
    unfold Nth in c;
    repeat rewrite app_nth2_plus in c;
    repeat rewrite firstn_app_exact in c;
    unfold nth in c; simpl in c; fold ti0 ti1 in c.
  rewrite (@If_morph (fun x => (π1 x) ≟ ⫠)) in c.
  rewrite (@If_morph (fun x => (π1 x) ≟ ⫠)) in c.
  repeat rewrite proj1pair in c.
  rewrite ceqeq in c. (*  *)
  fold bn0 bn1 in c. fold ti0 ti1 in c.
  rewrite (AndComm (acc m1 t bn0 ti1) (acc m0 t bn1 ti1)) in c.
  rewrite (@AndGuard2 (acc m0 t bn0 ti0) (acc m1 t bn1 ti0) (ub m0 t bn0 ti0 ≟ ⫠) FAlse TRue) in c.
  rewrite (@AndGuard2 (acc m0 t bn1 ti1) (acc m1 t bn0 ti1) (ub m0 t bn1 ti1 ≟ ⫠) FAlse TRue) in c.
  rewrite (AndComm (acc m0 t bn1 ti1) (acc m1 t bn0 ti1)) in c.
  unfold bn0 , bn1 in c.
  rewrite (UbNotUndefined m0 t (nonce n0) ti0) in c.
  rewrite (UbNotUndefined m0 t (nonce n1) ti1) in c.
  fold bn0 bn1 in c.
  apply (@cind_funcapp (fun lc =>  (firstn (length z) lc) ++ [(Nth (length z + 0) lc); (Nth (length z + 1) lc); ! (Nth (length z + 3) lc); (Nth (length z + 2) lc) ])) in c;
    unfold Nth in c; repeat rewrite app_nth2_plus in c; repeat rewrite firstn_app_exact in c; unfold nth in c; simpl in c.
  rewrite DoNegElim in c. rewrite DoNegElim in c.
  auto.
  all : Provebool.
  all : ProveboolandContext.
  { apply frConc.
  assert (t = Nth 2 (m0 :: m1 :: t :: z)).
  auto.
  rewrite H5.
  ProveFresh.
  assert (m0 = Nth 0 (m0 :: m1 :: t :: z)).
  auto. rewrite H5.
  ProveFresh. }
  2: { apply frConc.
  assert (t = Nth 2 (m0 :: m1 :: t :: z)).
  auto.
  rewrite H5.
  ProveFresh.
  assert (m0 = Nth 0 (m0 :: m1 :: t :: z)).
  auto. rewrite H5.
  ProveFresh. }
  unfold ti1. apply FreshTermcfromNonceList in H4.
  destruct H4. destruct H4. destruct H4. destruct H5.
  destruct H6. rewrite H7.
  apply  UbNUDAttContListTerm. assumption.
  apply  UbNUDContextApp. apply UbNUDFresh. assumption.
  apply  UbNUDContextConc.
  apply UbNUDFreshTerm.
  inversion H2. inversion H12. inversion H17. unfold bn0.
  ProveFresh. unfold bn1. apply UbNUDContextConc. apply UbNUDBlindSign.
  inversion H2; assumption. inversion H2. inversion H12. inversion H17; assumption.
  apply UbNUDFresh. ProveFresh.
   unfold ti0. apply FreshTermcfromNonceList in H0.
  destruct H0. destruct H0. destruct H0. destruct H5.
  destruct H6. rewrite H7.
  apply  UbNUDAttContListTerm. assumption.
  apply  UbNUDContextApp. apply UbNUDFresh. assumption.
  apply  UbNUDContextConc.
  apply UbNUDBlindSign.
  inversion H; assumption. inversion H. inversion H12. inversion H17; assumption.
  apply UbNUDFresh. unfold bn1.
  inversion H. inversion H12. inversion H17.
  ProveFresh.
Qed.


(* -------------------------------------------------------------------------- *
 *                     Vellvm - the Verified LLVM project                     *
 *                                                                            *
 *     Copyright (c) 2017 Steve Zdancewic <stevez@cis.upenn.edu>              *
 *                                                                            *
 *   This file is distributed under the terms of the GNU General Public       *
 *   License as published by the Free Software Foundation, either version     *
 *   3 of the License, or (at your option) any later version.                 *
 ---------------------------------------------------------------------------- *)

Require Import ZArith List String Omega.
Require Import ExtLib.Structures.Monads.

Require Import Vellvm.Util.
Require Import Vellvm.LLVMAst Vellvm.AstLib Vellvm.CFG Vellvm.CFGProp.
Require Import Vellvm.LLVMEvents Vellvm.Denotation.

Import MonadNotation.
Import ListNotations.

Set Implicit Arguments.
Set Contextual Implicit.

Module DenotationProp(A:MemoryAddress.ADDRESS)(LLVMIO:LLVM_INTERACTIONS(A)).
  Module SS := Denotation(A)(LLVMIO).
  Import SS.
  Import LLVMIO.DV.

  Section Properties.

  (* CB: THESE GO AWAY *)
  (*
  (** *Theorems about the environment *)
  Section ENVFACTS.

    (** Lookup on an aliasing add, aka gss *)
    Lemma lookup_env_hd : forall {X: Type} (id: ENV.key) (dv: X) (e: ENV.t X),
      lookup_env (add_env id dv e) id = ret dv.
    Proof.
      intros.
      unfold lookup_env.
      unfold add_env.
      erewrite ENV.find_1; auto.
      apply ENV.add_1; auto.
    Qed.

    (** Lookup on a non-aliasing add, aka gso *)
    Lemma lookup_env_tl : forall {X: Type} (id1 id2: ENV.key) (v1: X) (e: ENV.t X),
        id1 <> id2 -> lookup_env (add_env id1 v1 e) id2 = lookup_env e id2.
    Proof.
      intros.
      unfold lookup_env.
      unfold add_env.

      destruct (ENV.find id2 e) eqn: FINDID2.
      - (** Some x **)
        assert (ID2_MAPSTO: ENV.MapsTo id2 x e).
        apply ENV.find_2; auto.

        assert (ID2_MAPSTO_ADDED_E': ENV.MapsTo id2 x (ENV.add id1 v1 e)).
        apply ENV.add_2; auto.
        erewrite ENV.find_1; eauto.

      - assert (ID2_NOT_IN: ~ ENV.In  id2 e).
        rewrite ENVFacts.not_find_in_iff; auto.

        assert (ID2_NOT_IN_E': ~ ENV.In id2 (ENV.add id1 v1 e)).
        intros CONTRA.
        rewrite ENVFacts.add_in_iff in CONTRA.
        destruct CONTRA; try contradiction.

        rewrite ENVFacts.not_find_in_iff in ID2_NOT_IN_E'.
        rewrite ID2_NOT_IN_E'.
        auto.
    Qed.

    (** Extract information from a lookup-of-add *)
    Lemma lookup_add_env_inv :
      forall {X: Type} (id1 id2: ENV.key) (u v: X) (e: ENV.t X)
             {ID_EQ_DEC: forall id1 id2: ENV.key, {id1 = id2} + {id1 <> id2}}
             (Hl: lookup_env (add_env id1 v e) id2 = ret u),
        (id1 = id2 /\ v = u) \/ (id1 <> id2 /\ lookup_env e id2 = ret u).
    Proof.
      intros.

      assert (ID12_EQ_DEC: {id1 = id2}+ {id1 <> id2}).
      auto.

      destruct (ID12_EQ_DEC); subst.
      - (* id1 = id2 *)
        left.
        split; auto.

        rewrite lookup_env_hd in Hl.
        inversion Hl; auto.

      - (* id1 <> id2 *)
        right.
        split; auto.
        erewrite <- lookup_env_tl; eauto.
    Qed.
  End ENVFACTS.
   *)
  (*
  Definition pc_satisfies {T} (CFG:mcfg T) (p:pc) (P:cmd T -> Prop) : Prop :=
    forall cmd, fetch T CFG p = Some cmd -> P cmd.
*)

  (* Move to AstLib.v ? *)
  Definition is_Op {T} (i:instr T) : Prop :=
    match i with
    | INSTR_Op _ => True
    | _ => False
    end.

  Definition is_Eff {T} (i:instr T) : Prop :=
    match i with
    | INSTR_Alloca t nb a => True
    | INSTR_Load v t p a => True
    | INSTR_Store v val p a => True
    | _ => False    (* TODO: Think about call *)
    end.

  Definition is_Call {T} (i:instr T) : Prop :=
    match i with
    | INSTR_Call _ _ => True
    | _ => False
    end.

  (*
  Definition pc_non_call {T} (CFG:mcfg T) (p:pc) : Prop :=
    pc_satisfies CFG p (fun c => exists i, not (is_Call i) /\ c = Inst i).
   *)
  (*
  Ltac step_destruct :=
    repeat (match goal with
            | [ H : context[do _ <- trywith _ ?E; _] |- _ ] => destruct E; [simpl in H | solve [inversion H]]
            | [ H : context[do _ <- ?E; _] |- _ ] => destruct E; [solve [inversion H] | simpl in H]
            | [ H : context[match ?E with _ => _ end] |- _ ] => destruct E; try solve [inversion H]; simpl in H
            | [ H : Step (?p, _ , _) = Step (?q, _, _) |- Some ?p = Some ?q ] => inversion H; auto
            | [ H : ~ (is_Call (INSTR_Call _ _)) |- _ ] => simpl in H; contradiction
            end).
    *)

  (* Not true for Call *)
  (*
  Lemma step_pc_incr_inversion:
    forall CFG pc1 e1 k1 pc2 e2 k2
      (Hpc: pc_non_call CFG pc1)
      (Hstep: step CFG (pc1, e1, k1) = Step (pc2, e2, k2)),
      incr_pc CFG pc1 = Some pc2.
  Proof.
    (*
    intros CFG pc1 e1 k1 pc2 e2 k2 Hpc Hstep.
    simpl in Hstep.
    unfold pc_non_call in Hpc. unfold pc_satisfies in Hpc.
    destruct (fetch CFG pc1); try solve [inversion Hstep]; simpl in Hstep.
    specialize Hpc with (cmd0 := c). destruct Hpc as [i [Hi Hc]]; auto.
    subst.
    destruct (incr_pc CFG pc1); [simpl in Hstep | solve [inversion Hstep]].
    step_destruct.*)
    admit. (* TODO: fix up once the effects interface is stabilized *)
  Admitted.
*)
End Properties.

  (*
  Lemma stepD_Op_inversion :
    forall CFG fn bid phis term,
      let slc := slc_pc fn bid phis term in
      forall cd1 e1 k1 id i pc2 e2 k2
        (Hi: is_Op i)
        (HS1 : stepD CFG (slc ((id,i)::cd1), e1, k1) = Step (pc2, e2, k2)),
        pc2 = slc cd1.
  Proof.
    intros CFG fn0 bid phis term slc cd1 e1 k1 id i pc2 e2 k2 Hi HS1.
    inversion Hi.
    subst.
    simpl in HS1.
    destruct id; simpl in *.
    destruct (eval_op e1 None v); inversion HS1; auto.
    inversion HS1.
  Qed.

(* DenotationProp.v *)
Lemma stepD_Eff_weakening :
  forall CFG fn bid phis term,
    let slc := slc_pc fn bid phis term in
    forall cd1 e1 k1 id i eff
      (Hi: is_Eff i)
      (HS1 : stepD CFG (slc ((id,i)::cd1), e1, k1) = Obs (Eff eff))
      cd2,
      stepD CFG (pc_app (slc ((id,i)::cd1)) cd2, e1, k1) = Obs (Eff (fmap (fun st => (pc_app (pc_of st) cd2, env_of st, stack_of st)) eff)).
Proof.
  intros CFG fn0 bid phis term slc cd1 e1 k1 id i eff Hi HS1 cd2.
  inversion Hi; subst; simpl in HS1; destruct id; simpl in *; inversion HS1; simpl.
  - reflexivity.
  - destruct p as [u ptr]; destruct (eval_op e1 (Some u) ptr).  simpl in HS1. inversion HS1. simpl in HS1.
    destruct v0; try solve [inversion HS1].
    simpl in *. inversion HS1.
    reflexivity.
  - destruct val as [t val]; destruct p as [u p].
    destruct (eval_op e1 (Some t) val); try solve [inversion HS1].
    destruct (eval_op e1 (Some u) p); try solve [inversion HS1].
    simpl in *.
    destruct v1; try solve [inversion HS1].
    inversion HS1.
    reflexivity.
Qed.

(* DenotationProp.v *)
Lemma stepD_Eff_Alloca_inversion :
  forall CFG fn bid phis term,
    let slc := slc_pc fn bid phis term in
    forall cd e k id t nb al eff
      (HS1 : stepD CFG (slc ((id,INSTR_Alloca t nb al)::cd), e, k) = Obs (Eff eff)),
    exists lid,
      id = IId lid /\
      eff = Alloca t (fun (a:value) => (slc cd, add_env lid a e, k)).
Proof.
  intros CFG fn0 bid phis term slc cd e k id t nb al eff HS1.
  simpl in HS1.
  inversion HS1.
  destruct id as [lid | lv].
  exists lid. split; auto. inversion H0.
  reflexivity.
  inversion H0.
Qed.

(* DenotationProp.v *)
Lemma stepD_Eff_Load_inversion :
  forall CFG fn bid phis term,
    let slc := slc_pc fn bid phis term in
    forall cd e k id v t p al eff
      (HS1 : stepD CFG (slc ((id,INSTR_Load v t p al)::cd), e, k) = Obs (Eff eff)),
    exists lid a,
      id = IId lid /\
      eff = (Load a (fun dv => (slc cd, add_env lid dv e, k))).
Proof.
  intros CFG fn0 bid phis term slc cd e k id v t p al eff HS1.
  simpl in HS1.
  inversion HS1.
  destruct id as [lid | lv].
  exists lid.
  destruct p as [u p].
  destruct (eval_op e (Some u) p); try solve [inversion H0].
  destruct v0; try solve [inversion H0].
  simpl in H0.
  exists a. split; auto. inversion H0. reflexivity.
  inversion HS1.
Qed.

(* DenotationProp.v *)
Lemma stepD_Eff_Store_inversion :
  forall CFG fn bid phis term,
    let slc := slc_pc fn bid phis term in
    forall cd e k id v val p al eff
      (HS1 : stepD CFG (slc ((id,INSTR_Store v val p al)::cd), e, k) = Obs (Eff eff)),
    exists vid a dv,
      id = IVoid vid /\
      eff = (Store a dv (fun _ => (slc cd, e, k))).
Proof.
  intros CFG fn0 bid phis term slc cd e k id v val p al eff HS1.
  simpl in HS1.
  destruct id as [lid | lvid].
  - inversion HS1.
  - exists lvid.
    destruct val as [u val].
    destruct p as [w p].
    destruct (eval_op e (Some u) val); try solve [inversion HS1].
    destruct (eval_op e (Some w) p); try solve [inversion HS1].
    simpl in HS1.
    destruct v1; try solve [inversion HS1].
    exists a. exists v0. inversion HS1.
     subst. split; auto.
Qed.

(* DenotationProp.v *)
Lemma stepD_Op_weakening :
  forall CFG fn bid phis term,
    let slc := slc_pc fn bid phis term in
    forall id i cd1 e1 k1 pc2 e2 k2
    (Hi : is_Op i)
    (HS : stepD CFG (slc ((id,i)::cd1), e1, k1) = Step (pc2, e2, k2))
    cd2,
    stepD CFG (pc_app (slc ((id,i)::cd1)) cd2, e1, k1) = Step (pc_app pc2 cd2, e2, k2).
Proof.
  intros CFG fn0 bid phis term slc id i cd1 e1 k1 pc2 e2 k2 Hi HS cd2.
  inversion Hi.
  subst.
  simpl in HS.
  destruct id; simpl in *.
  destruct (eval_op e1 None v); inversion HS; auto.
  inversion HS.
Qed.
*)

End DenotationProp.


Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import TableDataOpsRef2.Spec.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsRef3.Specs.data_create3.
Require Import TableDataOpsRef3.LowSpecs.data_create3.
Require Import TableDataOpsRef3.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       data_create2_spec
       data_create_spec
    .

  Lemma data_create3_spec_exists:
    forall habd habd'  labd g_rd data_addr map_addr g_data g_src res
      (Hspec: data_create3_spec g_rd data_addr map_addr g_data g_src habd = Some (habd', res))
      (Hrel: relate_RData habd labd),
    exists labd', data_create3_spec0 g_rd data_addr map_addr g_data g_src labd = Some (labd', res) /\ relate_RData habd' labd'.
  Proof.
    Local Opaque peq ptr_eq.
    intros. duplicate Hrel. destruct D. clear hrepl lrepl. destruct g_data, g_src, g_rd.
    unfold data_create3_spec, data_create3_spec0 in *.
    unfold Assertion in *. rm_bind Hspec; rm_bind'. simpl in *.
    unfold Assertion; rm_bind'; grewrite.
    repeat simpl_hyp Hspec; extract_prop_dec; simpl_query_oracle; rm_bind'; grewrite.
    - rewrite_oracle_rel rel_oracle C6.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec. eexists; split. reflexivity.
      constructor; destruct Hrel; simpl; try assumption; try reflexivity.
    - rewrite_oracle_rel rel_oracle C6.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec. eexists; split. reflexivity.
      constructor; destruct Hrel; simpl; try assumption; try reflexivity.
    - rewrite_oracle_rel rel_oracle C6.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec. eexists; split. reflexivity.
      constructor; destruct Hrel; simpl; try assumption; try reflexivity.
    - rewrite_oracle_rel rel_oracle C6.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec. eexists; split. reflexivity.
      constructor; destruct Hrel; simpl; try assumption; try reflexivity.
    - rewrite_oracle_rel rel_oracle C6.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec. eexists; split. reflexivity.
      constructor; destruct Hrel; simpl; try assumption; try reflexivity.
  Qed.

End Refine.


Require Import Lia.
Require Import Classical Peano_dec.
From hahn Require Import Hahn.
Require Import AuxDef.
Require Import AuxRel2.
Require Import Events.
Require Import Execution.
Import ListNotations.
Require Import FinExecution.

Definition mem_fair (G: execution) := fsupp (co G) /\ fsupp (fr G).

Section FairExecution.
  Variable G: execution.
  Hypothesis FAIR: mem_fair G.
  Hypothesis WF: Wf G.

  Lemma co_imm:
    co G ≡ (immediate (co G))⁺.
  Proof using WF FAIR. apply fsupp_imm_t; apply WF || apply FAIR. Qed.

  Lemma nS_imm_co_in_sb
        (S : actid -> Prop) w wnext
        (WW : is_w (lab G) w)
        (NSW : ~ S w)
        (NCOIMM : immediate ((co G) ⨾ ⦗S⦘) w wnext)
        (FOR_SPLIT : ⦗set_compl S⦘ ⨾ immediate (co G) ⊆ sb G) :
    sb G w wnext.
  Proof using WF FAIR.
    assert (transitive (co G)) as COTRANS.
    { apply (co_trans WF). }

    assert (S wnext /\ co G w wnext) as [ISSNEXT CONEXT].
    { generalize NCOIMM. basic_solver. }
    apply clos_trans_of_transitiveD; [apply sb_trans|].
    apply (inclusion_t_t FOR_SPLIT).
    eapply fsupp_imm_t in CONEXT; cycle 1.
    { apply FAIR. }
    { apply (co_irr WF). }
    { apply (co_trans WF). }
    apply t_rt_step in CONEXT. destruct CONEXT as [z [IMMS IMM]].
    apply t_rt_step. exists z; split; [|apply seq_eqv_l; split; [|done]].
    { apply rtE in IMMS. destruct IMMS as [IMMS|IMMS].
      { red in IMMS; desf. apply rt_refl. }
      assert (immediate ((co G) ⨾ ⦗S⦘) z wnext) as IMM'.
      { red; split; [apply seq_eqv_r; split; auto|].
        { (* TODO: is the last tactic needed? *)
          apply clos_trans_immediate1; auto; try by apply ct_step. }
        ins. eapply NCOIMM; [|by apply R2].
        apply seq_eqv_r in R1; destruct R1 as [R1 R3].
        apply seq_eqv_r; split; auto.
        eapply (co_trans WF); [|by apply R1].
        apply clos_trans_immediate1; auto. }
      clear IMM.
      induction IMMS.
      { apply rt_step. apply seq_eqv_l; split; auto. }
      assert (co G y wnext) as YNEXT.
      { apply clos_trans_immediate1; auto.
        eapply transitive_ct; [by apply IMMS2|].
        eapply same_relation_exp.
        { symmetry. apply fsupp_imm_t; apply FAIR || apply WF. }
        unfolder in IMM'. basic_solver. }
      assert (immediate ((co G) ⨾ ⦗S⦘) y wnext) as YNEXTIMM.
      { red; split; [by apply seq_eqv_r; split|].
        ins. eapply NCOIMM; [|by apply R2].
        apply seq_eqv_r in R1; destruct R1 as [R1 R3].
        apply seq_eqv_r; split; auto.
        eapply (co_trans WF); [|by apply R1].
        apply clos_trans_immediate1; auto. }
      eapply rt_trans.
      { by apply IHIMMS1. }
      apply IHIMMS2; auto.
      { apply (wf_coD WF) in YNEXT.
        apply seq_eqv_l in YNEXT; desf. }
      intros NISS. eapply NCOIMM; apply seq_eqv_r; split; auto.
      2: by apply NISS.
      2: done.
      apply clos_trans_immediate1; auto. }
    intros HH. apply rtE in IMMS; destruct IMMS as [IMSS|IMMS].
    { red in IMSS; desf. }
    eapply NCOIMM; apply seq_eqv_r; split; auto.
    2: by apply HH.
    all: apply clos_trans_immediate1; auto.
    all: by apply ct_step.
  Qed.

  Lemma fsupp_rf: fsupp (rf G).
  Proof using WF.
    apply functional_inv_fsupp. by inversion WF.
  Qed.

  Lemma fsupp_sb:
    fsupp (⦗set_compl is_init⦘ ⨾ sb G).
  Proof using WF.
    unfold sb, ext_sb; unfolder; ins.
    destruct y; [exists nil; ins; desf|].
    exists (map (fun i => ThreadEvent thread i) (List.seq 0 index)).
    intros e ((NIe & E0) & (SB & E)).
    destruct e; [done| ]. destruct SB as [-> LT].
    apply in_map_iff. eexists. split; eauto. by apply in_seq0_iff.
  Qed.

  Lemma fsupp_sb_loc:
    fsupp (sb G ∩ same_loc (lab G)).
  Proof using WF.
    rewrite <- seq_id_l.
    rewrite set_full_split with (S := is_init), id_union, seq_union_l.
    apply fsupp_union.
    2: { eapply fsupp_mori; [| by apply fsupp_sb; eauto].
         red. basic_solver. }

    red. ins.
    remember (loc (lab G) y) as ly. destruct ly.
    { exists [InitEvent l].
      intros x REL%seq_eqv_l. desc. destruct x; [| done].
      simpl. left. f_equal. apply proj2 in REL0.
      red in REL0.
      unfold Events.loc in REL0 at 1. rewrite wf_init_lab in REL0; auto.
      congruence. }
    exists []. red. intros x REL%seq_eqv_l. desc.
    apply proj2 in REL0. red in REL0.
    destruct x; [| done].
    unfold Events.loc in REL0 at 1. rewrite wf_init_lab in REL0; auto.
    congruence.
  Qed.

End FairExecution.

Lemma fin_exec_fair G (WF: Wf G) (FIN: fin_exec G):
  mem_fair G.
Proof using.
  red. apply fsupp_union_iff.
  arewrite (co G ∪ fr G ≡ ⦗acts_set G⦘ ⨾ (co G ∪ fr G) ⨾ ⦗is_w (lab G)⦘).
  { rewrite wf_coE, wf_frE, wf_coD, wf_frD; eauto. basic_solver 10. }
  red. intros w.
  destruct (classic (is_w (lab G) w)) as [W | NW].
  2: { exists []. intros. apply seq_eqv_lr in REL. by desc. }
  forward eapply is_w_loc as [l Lw]; eauto.
  destruct FIN as [findom FIN].
  exists (InitEvent l :: findom).
  intros r REL%seq_eqv_lr. desc.
  destruct r eqn:RR.
  { simpl. left. f_equal. eapply hahn_inclusion_exp in REL0.
    2: { rewrite wf_col, wf_frl, unionK; eauto. reflexivity. }
    red in REL0. unfold loc in REL0 at 1. rewrite wf_init_lab in REL0; auto.
    congruence. }
  right. apply FIN. split; auto.
Qed.

Lemma fin_exec_full_fair G (WF: Wf G) (FIN: fin_exec_full G):
  mem_fair G.
Proof using.
  apply fin_exec_fair; auto. apply fin_exec_full_equiv in FIN. by desc.
Qed.


Require Import VST.floyd.base2.
Require Import VST.floyd.client_lemmas.

Local Open Scope logic.

(*
Lemma gvar_globals_only:
  forall i v rho, gvar i v rho -> gvar i v (globals_only rho).
Proof.
unfold gvar; intros.
unfold Map.get in *.
destruct (ve_of rho i) as [[? ?]|] eqn:?; try contradiction.
unfold globals_only.
simpl. auto.
Qed.
Hint Resolve gvar_globals_only.
*)

Ltac safe_auto_with_closed :=
   (* won't instantiate evars by accident *)
 match goal with |- ?A =>
          solve [first [has_evar A | auto 50 with closed]]
 end.

Lemma closed_env_set:
 forall {B} i v (P: environ -> B) rho,
     closed_wrt_vars (eq i) P ->
     P (env_set rho i v) = P rho.
Proof.
 intros. hnf in H.
 symmetry; destruct rho; apply H.
 intros; simpl; destruct (ident_eq i i0). left; auto.
 right; rewrite Map.gso; auto.
Qed.
Hint Rewrite @closed_env_set using safe_auto_with_closed : norm2.

Lemma subst_eval_id_eq:
 forall id v, subst id v (eval_id id) = v.
Proof. unfold subst, eval_id; intros. extensionality rho.
    unfold force_val, env_set; simpl. rewrite Map.gss; auto.
Qed.

Lemma subst_eval_id_neq:
  forall id v j, id<>j -> subst id v (eval_id j) = eval_id j.
Proof.
    unfold subst, eval_id; intros. extensionality rho.
    unfold force_val, env_set; simpl. rewrite Map.gso; auto.
Qed.

Hint Rewrite subst_eval_id_eq : subst.
Hint Rewrite subst_eval_id_neq using safe_auto_with_closed : subst.

(*
Lemma subst_temp_eq:
  forall i v w, subst i `v (temp i w) = `(eq w v).
Proof.
unfold temp; intros; autorewrite with subst.
extensionality rho; unfold_lift. reflexivity.
Qed.

Lemma subst_temp_neq:
  forall i j v w, i<>j -> subst i v (temp j w) = temp j w.
Proof.
unfold temp; intros. autorewrite with subst.
f_equal. apply subst_eval_id_neq; auto.
Qed.

Lemma subst_var:
   forall i j v t w,  subst i v (var j t w) = var j t w.
Proof.
unfold var; intros; autorewrite with subst; auto.
Qed.

Hint Rewrite subst_var : subst.
Hint Rewrite subst_temp_eq : subst.
Hint Rewrite subst_temp_neq using safe_auto_with_closed : subst.
*)

Fixpoint subst_eval_expr  {cs: compspecs}  (j: ident) (v: environ -> val) (e: expr) : environ -> val :=
 match e with
 | Econst_int i ty => `(Vint i)
 | Econst_long i ty => `(Vlong i)
 | Econst_float f ty => `(Vfloat f)
 | Econst_single f ty => `(Vsingle f)
 | Etempvar id ty => if eqb_ident j id then v else eval_id id
 | Eaddrof a ty => subst_eval_lvalue j v a
 | Eunop op a ty =>  `(eval_unop op (typeof a)) (subst_eval_expr j v a)
 | Ebinop op a1 a2 ty =>
                  `(eval_binop op (typeof a1) (typeof a2)) (subst_eval_expr j v a1) (subst_eval_expr j v a2)
 | Ecast a ty => `(eval_cast (typeof a) ty) (subst_eval_expr j v a)
 | Evar id ty => eval_var id ty
 | Ederef a ty => subst_eval_expr j v a
 | Efield a i ty => `(eval_field (typeof a) i) (subst_eval_lvalue j v a)
 | Esizeof t ty => `(Vptrofs (Ptrofs.repr (sizeof t)))
 | Ealignof t ty => `(Vptrofs (Ptrofs.repr (alignof t)))
 end

 with subst_eval_lvalue {cs: compspecs} (j: ident) (v: environ -> val) (e: expr) : environ -> val :=
 match e with
 | Evar id ty => eval_var id ty
 | Ederef a ty => subst_eval_expr j v a
 | Efield a i ty => `(eval_field (typeof a) i) (subst_eval_lvalue j v a)
 | _  => `Vundef
 end.

Lemma subst_eval_expr_eq:
    forall {cs: compspecs} j v e, subst j v (eval_expr e) = subst_eval_expr j v e
with subst_eval_lvalue_eq:
    forall {cs: compspecs} j v e, subst j v (eval_lvalue e) = subst_eval_lvalue j v e.
Proof.
intros cs j v; clear subst_eval_expr_eq; induction e; intros; simpl; try auto.
unfold eqb_ident.
unfold subst, eval_id, env_set, te_of. extensionality rho.
pose proof (Pos.eqb_spec j i).
destruct H. subst. rewrite Map.gss. reflexivity.
rewrite Map.gso; auto.
rewrite <- IHe; clear IHe.
unfold_lift.
extensionality rho; unfold subst.
reflexivity.
unfold_lift.
extensionality rho; unfold subst.
rewrite <- IHe1, <- IHe2; reflexivity.
unfold_lift.
extensionality rho; unfold subst.
rewrite <- IHe; reflexivity.
unfold_lift.
rewrite <- subst_eval_lvalue_eq.
extensionality rho; unfold subst.
f_equal. f_equal.

intros Delta j v; clear subst_eval_lvalue_eq; induction e; intros; simpl; try auto.
unfold_lift.
extensionality rho; unfold subst.
rewrite <- IHe.
f_equal.
Qed.

Hint Rewrite @subst_eval_expr_eq @subst_eval_lvalue_eq : subst.

Lemma closed_wrt_subst:
  forall {A} id e (P: environ -> A), closed_wrt_vars (eq id) P -> subst id e P = P.
Proof.
intros.
unfold subst, closed_wrt_vars in *.
extensionality rho.
symmetry.
apply H.
intros.
destruct (eq_dec id i); auto.
right.
rewrite Map.gso; auto.
Qed.

Lemma closed_wrt_map_subst:
   forall {A: Type} id e (Q: list (environ -> A)),
         Forall (closed_wrt_vars (eq id)) Q ->
         map (subst id e) Q = Q.
Proof.
induction Q; intros.
simpl; auto.
inv H.
simpl; f_equal; auto.
apply closed_wrt_subst; auto.
Qed.
Hint Rewrite @closed_wrt_map_subst using safe_auto_with_closed : subst.
Hint Rewrite @closed_wrt_subst using safe_auto_with_closed : subst.

Lemma closed_wrt_map_subst':
   forall {A: Type} id e (Q: list (environ -> A)),
         Forall (closed_wrt_vars (eq id)) Q ->
         @map (LiftEnviron A) _ (subst id e) Q = Q.
Proof.
apply @closed_wrt_map_subst.
Qed.

(*Hint Rewrite @closed_wrt_map_subst' using safe_auto_with_closed : norm.*)
Hint Rewrite @closed_wrt_map_subst' using safe_auto_with_closed : subst.
Lemma closed_wrt_subst_eval_expr:
  forall {cs: compspecs} j v e,
   closed_wrt_vars (eq j) (eval_expr e) ->
   subst_eval_expr j v e = eval_expr e.
Proof.
intros; rewrite <- subst_eval_expr_eq.
apply closed_wrt_subst; auto.
Qed.
Lemma closed_wrt_subst_eval_lvalue:
  forall {cs: compspecs} j v e,
   closed_wrt_vars (eq j) (eval_lvalue e) ->
   subst_eval_lvalue j v e = eval_lvalue e.
Proof.
intros; rewrite <- subst_eval_lvalue_eq.
apply closed_wrt_subst; auto.
Qed.
Hint Rewrite @closed_wrt_subst_eval_expr using solve [auto 50 with closed] : subst.
Hint Rewrite @closed_wrt_subst_eval_lvalue using solve [auto 50 with closed] : subst.

Hint Unfold closed_wrt_modvars : closed.

Lemma closed_wrt_local: forall S P, closed_wrt_vars S P -> closed_wrt_vars S (local P).
Proof.
intros.
hnf in H|-*; intros.
specialize (H _ _ H0).
unfold local, lift1.
f_equal; auto.
Qed.

Lemma closed_wrtl_local: forall S P, closed_wrt_lvars S P -> closed_wrt_lvars S (local P).
Proof.
intros.
hnf in H|-*; intros.
specialize (H _ _ H0).
unfold local, lift1.
f_equal; auto.
Qed.
Hint Resolve closed_wrt_local closed_wrtl_local : closed.

Lemma closed_wrt_lift0: forall {A} S (Q: A), closed_wrt_vars S (lift0 Q).
Proof.
intros.
intros ? ? ?.
unfold lift0; auto.
Qed.
Lemma closed_wrtl_lift0: forall {A} S (Q: A), closed_wrt_lvars S (lift0 Q).
Proof.
intros.
intros ? ? ?.
unfold lift0; auto.
Qed.
Hint Resolve closed_wrt_lift0 closed_wrtl_lift0 : closed.

Lemma closed_wrt_lift0C: forall {B} S (Q: B),
   closed_wrt_vars S (@liftx (LiftEnviron B) Q).
Proof.
intros.
intros ? ? ?.
unfold_lift; auto.
Qed.
Lemma closed_wrtl_lift0C: forall {B} S (Q: B),
   closed_wrt_lvars S (@liftx (LiftEnviron B) Q).
Proof.
intros.
intros ? ? ?.
unfold_lift; auto.
Qed.
Hint Resolve @closed_wrt_lift0C @closed_wrtl_lift0C: closed.

Lemma closed_wrt_lift1: forall {A}{B} S (f: A -> B) P,
        closed_wrt_vars S P ->
        closed_wrt_vars S (lift1 f P).
Proof.
intros.
intros ? ? ?. specialize (H _ _ H0).
unfold lift1; f_equal; auto.
Qed.
Lemma closed_wrtl_lift1: forall {A}{B} S (f: A -> B) P,
        closed_wrt_lvars S P ->
        closed_wrt_lvars S (lift1 f P).
Proof.
intros.
intros ? ? ?. specialize (H _ _ H0).
unfold lift1; f_equal; auto.
Qed.
Hint Resolve closed_wrt_lift1 closed_wrtl_lift1 : closed.

Lemma closed_wrt_lift1C: forall {A}{B} S (f: A -> B) P,
        closed_wrt_vars S P ->
        closed_wrt_vars S (@liftx (Tarrow A (LiftEnviron B)) f P).
Proof.
intros.
intros ? ? ?. specialize (H _ _ H0).
unfold_lift; f_equal; auto.
Qed.
Lemma closed_wrtl_lift1C: forall {A}{B} S (f: A -> B) P,
        closed_wrt_lvars S P ->
        closed_wrt_lvars S (@liftx (Tarrow A (LiftEnviron B)) f P).
Proof.
intros.
intros ? ? ?. specialize (H _ _ H0).
unfold_lift; f_equal; auto.
Qed.
Hint Resolve @closed_wrt_lift1C @closed_wrtl_lift1C : closed.

Lemma closed_wrt_lift2: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S (lift2 f P1 P2).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H1).
specialize (H0 _ _ H1).
unfold lift2; f_equal; auto.
Qed.
Lemma closed_wrtl_lift2: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S (lift2 f P1 P2).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H1).
specialize (H0 _ _ H1).
unfold lift2; f_equal; auto.
Qed.
Hint Resolve closed_wrt_lift2 closed_wrtl_lift2 : closed.

Lemma closed_wrt_lift2C: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S (@liftx (Tarrow A1 (Tarrow A2 (LiftEnviron B))) f P1 P2).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H1).
specialize (H0 _ _ H1).
unfold_lift; f_equal; auto.
Qed.
Lemma closed_wrtl_lift2C: forall {A1 A2}{B} S (f: A1 -> A2 -> B) P1 P2,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S (@liftx (Tarrow A1 (Tarrow A2 (LiftEnviron B))) f P1 P2).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H1).
specialize (H0 _ _ H1).
unfold_lift; f_equal; auto.
Qed.
Hint Resolve @closed_wrt_lift2C @closed_wrtl_lift2C : closed.

Lemma closed_wrt_lift3: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S P3 ->
        closed_wrt_vars S (lift3 f P1 P2 P3).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H2).
specialize (H0 _ _ H2).
specialize (H1 _ _ H2).
unfold lift3; f_equal; auto.
Qed.
Lemma closed_wrtl_lift3: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S P3 ->
        closed_wrt_lvars S (lift3 f P1 P2 P3).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H2).
specialize (H0 _ _ H2).
specialize (H1 _ _ H2).
unfold lift3; f_equal; auto.
Qed.
Hint Resolve closed_wrt_lift3 closed_wrtl_lift3 : closed.

Lemma closed_wrt_lift3C: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S P3 ->
        closed_wrt_vars S (@liftx (Tarrow A1 (Tarrow A2 (Tarrow A3 (LiftEnviron B)))) f P1 P2 P3).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H2).
specialize (H0 _ _ H2).
specialize (H1 _ _ H2).
unfold_lift. f_equal; auto.
Qed.

Lemma closed_wrtl_lift3C: forall {A1 A2 A3}{B} S (f: A1 -> A2 -> A3 -> B) P1 P2 P3,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S P3 ->
        closed_wrt_lvars S (@liftx (Tarrow A1 (Tarrow A2 (Tarrow A3 (LiftEnviron B)))) f P1 P2 P3).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H2).
specialize (H0 _ _ H2).
specialize (H1 _ _ H2).
unfold_lift. f_equal; auto.
Qed.
Hint Resolve @closed_wrt_lift3C @closed_wrtl_lift3C : closed.

Lemma closed_wrt_lift4: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B)
       P1 P2 P3 P4,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S P3 ->
        closed_wrt_vars S P4 ->
        closed_wrt_vars S (lift4 f P1 P2 P3 P4).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H3).
specialize (H0 _ _ H3).
specialize (H1 _ _ H3).
specialize (H2 _ _ H3).
unfold lift4; f_equal; auto.
Qed.
Lemma closed_wrtl_lift4: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B)
       P1 P2 P3 P4,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S P3 ->
        closed_wrt_lvars S P4 ->
        closed_wrt_lvars S (lift4 f P1 P2 P3 P4).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H3).
specialize (H0 _ _ H3).
specialize (H1 _ _ H3).
specialize (H2 _ _ H3).
unfold lift4; f_equal; auto.
Qed.
Hint Resolve closed_wrt_lift4  closed_wrtl_lift4 : closed.

Lemma closed_wrt_lift4C: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B) P1 P2 P3 P4,
        closed_wrt_vars S P1 ->
        closed_wrt_vars S P2 ->
        closed_wrt_vars S P3 ->
        closed_wrt_vars S P4 ->
        closed_wrt_vars S (@liftx (Tarrow A1 (Tarrow A2 (Tarrow A3 (Tarrow A4 (LiftEnviron B))))) f P1 P2 P3 P4).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H3).
specialize (H0 _ _ H3).
specialize (H1 _ _ H3).
specialize (H2 _ _ H3).
unfold liftx; simpl.
unfold lift. f_equal; auto.
Qed.
Lemma closed_wrtl_lift4C: forall {A1 A2 A3 A4}{B} S (f: A1 -> A2 -> A3 -> A4 -> B) P1 P2 P3 P4,
        closed_wrt_lvars S P1 ->
        closed_wrt_lvars S P2 ->
        closed_wrt_lvars S P3 ->
        closed_wrt_lvars S P4 ->
        closed_wrt_lvars S (@liftx (Tarrow A1 (Tarrow A2 (Tarrow A3 (Tarrow A4 (LiftEnviron B))))) f P1 P2 P3 P4).
Proof.
intros.
intros ? ? ?.
specialize (H _ _ H3).
specialize (H0 _ _ H3).
specialize (H1 _ _ H3).
specialize (H2 _ _ H3).
unfold liftx; simpl.
unfold lift. f_equal; auto.
Qed.
Hint Resolve @closed_wrt_lift4C @closed_wrtl_lift4C : closed.

Lemma closed_wrt_const:
 forall A (P: A) S, closed_wrt_vars S (fun rho: environ => P).
Proof.
intros. hnf; intros.
simpl. auto.
Qed.
Lemma closed_wrtl_const:
 forall A (P: A) S, closed_wrt_lvars S (fun rho: environ => P).
Proof.
intros. hnf; intros.
simpl. auto.
Qed.
Hint Resolve @closed_wrt_const @closed_wrtl_const : closed.

Lemma closed_wrt_eval_var:
  forall S id t, closed_wrt_vars S (eval_var id t).
Proof.
unfold closed_wrt_vars, eval_var; intros.
simpl.
auto.
Qed.
Hint Resolve closed_wrt_eval_var : closed.
Lemma closed_wrtl_eval_var:
  forall S id t, ~ S id -> closed_wrt_lvars S (eval_var id t).
Proof.
unfold closed_wrt_lvars, eval_var; intros.
simpl.
destruct (H0 id); [contradiction | ].
rewrite <- H1; auto.
Qed.
Hint Resolve closed_wrtl_eval_var : closed.

(*
Lemma closed_wrt_var:
  forall S id t v, closed_wrt_vars S (var id t v).
Proof.
unfold var; intros.
auto with closed.
Qed.
Hint Resolve closed_wrt_var : closed.

Lemma closed_wrtl_var:
 forall S id t v, ~ S id -> closed_wrt_lvars S (var id t v).
Proof.
unfold var; intros; auto with closed.
Qed.
Hint Resolve closed_wrtl_var : closed.
*)

Lemma closed_wrt_lvar:
  forall S id t v, closed_wrt_vars S (locald_denote (lvar id t v)).
Proof.
intros.
hnf; intros; simpl.
destruct (Map.get (ve_of rho) id); auto.
Qed.
Hint Resolve closed_wrt_lvar : closed.

Lemma closed_wrt_gvars:
  forall S gv, closed_wrt_vars S (locald_denote (gvars gv)).
Proof.
intros.
hnf; intros; simpl. reflexivity.
Qed.
Hint Resolve closed_wrt_gvars : closed.

Lemma closed_wrtl_gvars:
  forall S gv, closed_wrt_lvars S (locald_denote (gvars gv)).
Proof.
intros.
hnf; intros; simpl. reflexivity.
Qed.
Hint Resolve closed_wrtl_gvars : closed.

Lemma closed_wrtl_lvar:
 forall  {cs: compspecs} S id t v,
    ~ S id -> closed_wrt_lvars S (locald_denote (lvar id t v)).
Proof.
intros.
hnf; intros; simpl.
unfold lvar_denote.
destruct (H0 id); try contradiction.
rewrite H1; auto.
Qed.
Hint Resolve closed_wrtl_lvar : closed.

Definition expr_closed_wrt_lvars (S: ident -> Prop) (e: expr) : Prop :=
  forall (cs: compspecs) rho ve',
     (forall i, S i \/ Map.get (ve_of rho) i = Map.get ve' i) ->
     eval_expr e rho = eval_expr e (mkEnviron (ge_of rho) ve' (te_of rho)).

Definition lvalue_closed_wrt_lvars (S: ident -> Prop) (e: expr) : Prop :=
  forall (cs: compspecs) rho ve',
     (forall i, S i \/ Map.get (ve_of rho) i = Map.get ve' i) ->
     eval_lvalue e rho = eval_lvalue e (mkEnviron (ge_of rho) ve'  (te_of rho)).

Lemma closed_wrt_cmp_ptr : forall {cs: compspecs} S e1 e2 c,
  expr_closed_wrt_vars S e1 ->
  expr_closed_wrt_vars S e2 ->
  closed_wrt_vars S (`(cmp_ptr_no_mem c) (eval_expr e1) (eval_expr e2)).
Proof.
intros.
unfold closed_wrt_vars. intros.
super_unfold_lift.
unfold expr_closed_wrt_vars in *.
specialize (H rho te' H1).
specialize (H0 rho te' H1).
unfold cmp_ptr_no_mem. rewrite H0. rewrite H.
reflexivity.
Qed.
Lemma closed_wrtl_cmp_ptr : forall {cs: compspecs} S e1 e2 c,
  expr_closed_wrt_lvars S e1 ->
  expr_closed_wrt_lvars S e2 ->
  closed_wrt_lvars S (`(cmp_ptr_no_mem c) (eval_expr e1) (eval_expr e2)).
Proof.
intros.
unfold closed_wrt_lvars. intros.
super_unfold_lift.
unfold expr_closed_wrt_lvars in *.
specialize (H cs rho ve' H1).
specialize (H0 cs rho ve' H1).
unfold cmp_ptr_no_mem. rewrite H0. rewrite H.
reflexivity.
Qed.
Hint Resolve closed_wrt_cmp_ptr closed_wrtl_cmp_ptr: closed.

Lemma closed_wrt_eval_id: forall S i,
    ~ S i -> closed_wrt_vars S (eval_id i).
Proof.
intros.
intros ? ? ?.
unfold eval_id, force_val.
simpl.
destruct (H0 i).
contradiction.
rewrite H1; auto.
Qed.
Lemma closed_wrtl_eval_id: forall S i,
    closed_wrt_lvars S (eval_id i).
Proof.
intros.
intros ? ? ?.
unfold eval_id, force_val.
simpl. auto.
Qed.
Hint Resolve closed_wrt_eval_id closed_wrtl_eval_id : closed.

Lemma closed_wrt_temp: forall S i v,
    ~ S i -> closed_wrt_vars S (locald_denote (temp i v)).
Proof.
intros.
hnf; simpl; intros.
unfold_lift.
unfold eval_id; simpl.
destruct (H0 i).
contradiction.
rewrite H1; auto.
Qed.

Lemma closed_wrtl_temp: forall S i v,
    closed_wrt_lvars S (locald_denote (temp i v)).
Proof.
intros.
unfold locald_denote.
hnf; intros. simpl.
unfold eval_id; simpl. auto.
Qed.
Hint Resolve closed_wrt_temp closed_wrtl_temp : closed.

Lemma closed_wrt_get_result1 :
  forall (S: ident -> Prop) i , ~ S i -> closed_wrt_vars S (get_result1 i).
Proof.
intros. unfold get_result1. simpl.
 hnf; intros.
 simpl. f_equal.
apply (closed_wrt_eval_id _ _ H); auto.
Qed.
Lemma closed_wrtl_get_result1 :
  forall (S: ident -> Prop) i , closed_wrt_lvars S (get_result1 i).
Proof.
intros. unfold get_result1. simpl.
 hnf; intros.
 simpl. f_equal.
Qed.
Hint Resolve closed_wrt_get_result1 closed_wrtl_get_result1 : closed.

Lemma closed_wrt_tc_FF:
 forall {cs: compspecs} S e, closed_wrt_vars S (denote_tc_assert (tc_FF e)).
Proof.
 intros. hnf; intros. reflexivity.
Qed.
Lemma closed_wrtl_tc_FF:
 forall {cs: compspecs} S e, closed_wrt_lvars S (denote_tc_assert (tc_FF e)).
Proof.
 intros. hnf; intros. reflexivity.
Qed.
Hint Resolve closed_wrt_tc_FF closed_wrtl_tc_FF : closed.

Lemma closed_wrt_tc_TT:
 forall {cs: compspecs} S, closed_wrt_vars S (denote_tc_assert (tc_TT)).
Proof.
 intros. hnf; intros. reflexivity.
Qed.
Lemma closed_wrtl_tc_TT:
 forall {cs: compspecs} S, closed_wrt_lvars S (denote_tc_assert (tc_TT)).
Proof.
 intros. hnf; intros. reflexivity.
Qed.
Hint Resolve closed_wrt_tc_TT closed_wrtl_tc_TT : closed.

Lemma closed_wrt_andp: forall S (P Q: environ->mpred),
  closed_wrt_vars S P -> closed_wrt_vars S Q ->
  closed_wrt_vars S (P && Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Lemma closed_wrtl_andp: forall S (P Q: environ->mpred),
  closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
  closed_wrt_lvars S (P && Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Hint Resolve closed_wrt_andp closed_wrtl_andp : closed.

Lemma closed_wrt_exp: forall {A} S (P: A -> environ->mpred),
  (forall a, closed_wrt_vars S (P a)) ->
  closed_wrt_vars S (exp P).
Proof.
intros; hnf in *; intros.
simpl. apply exp_congr. intros a.
specialize (H a).
hnf in H.
eauto.
Qed.

Lemma closed_wrtl_exp: forall {A} S (P: A -> environ->mpred),
  (forall a, closed_wrt_lvars S (P a)) ->
  closed_wrt_lvars S (exp P).
Proof.
intros; hnf in *; intros.
simpl. apply exp_congr. intros a.
specialize (H a).
hnf in H.
eauto.
Qed.
Hint Resolve closed_wrt_exp closed_wrtl_exp : closed.

Lemma closed_wrt_imp: forall S (P Q: environ->mpred),
  closed_wrt_vars S P -> closed_wrt_vars S Q ->
  closed_wrt_vars S (P --> Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Lemma closed_wrtl_imp: forall S (P Q: environ->mpred),
  closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
  closed_wrt_lvars S (P --> Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Hint Resolve closed_wrt_imp closed_wrtl_imp : closed.

Lemma closed_wrt_sepcon: forall S (P Q: environ->mpred),
  closed_wrt_vars S P -> closed_wrt_vars S Q ->
  closed_wrt_vars S (P * Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Lemma closed_wrtl_sepcon: forall S (P Q: environ->mpred),
  closed_wrt_lvars S P -> closed_wrt_lvars S Q ->
  closed_wrt_lvars S (P * Q).
Proof.
intros; hnf in *; intros.
simpl. f_equal; eauto.
Qed.
Hint Resolve closed_wrt_sepcon closed_wrtl_sepcon : closed.

Lemma closed_wrt_emp {A} {ND: NatDed A} {SL: SepLog A}:
  forall S, closed_wrt_vars S emp.
Proof. repeat intro. reflexivity. Qed.
Lemma closed_wrtl_emp {A} {ND: NatDed A} {SL: SepLog A}:
  forall S, closed_wrt_lvars S emp.
Proof. repeat intro. reflexivity. Qed.
Hint Resolve (@closed_wrt_emp mpred Nveric Sveric) (@closed_wrtl_emp mpred Nveric Sveric) : closed.

Lemma closed_wrt_allp: forall A S P,
  (forall x: A, closed_wrt_vars S (P x)) ->
  closed_wrt_vars S (allp P).
Proof.
intros; hnf in *; intros.
simpl.
apply pred_ext; apply allp_right; intro x; apply (allp_left _ x);
specialize (H x rho te' H0);
apply derives_refl'; congruence.
Qed.
Lemma closed_wrtl_allp: forall A S P,
  (forall x: A, closed_wrt_lvars S (P x)) ->
  closed_wrt_lvars S (allp P).
Proof.
intros; hnf in *; intros.
simpl.
apply pred_ext; apply allp_right; intro x; apply (allp_left _ x);
specialize (H x rho ve' H0);
apply derives_refl'; congruence.
Qed.
Hint Resolve closed_wrt_allp closed_wrtl_allp : closed.

Lemma closed_wrt_globvars:
  forall S gv v, closed_wrt_vars S (globvars2pred gv v).
Proof.
intros.
unfold globvars2pred.
hnf; intros. unfold lift2. f_equal.
induction v; simpl map; auto with closed.
simpl.
f_equal; auto.
unfold globvar2pred; destruct a; simpl.
destruct (gvar_volatile g) eqn:?; auto.
forget (readonly2share (gvar_readonly g)) as sh.
forget (gv i) as j.
revert j; induction (gvar_init g); intros; simpl; f_equal; auto.
Qed.

Lemma closed_wrtl_globvars:
  forall S gv v, closed_wrt_lvars S (globvars2pred gv v).
Proof.
intros.
unfold globvars2pred.
hnf; intros. unfold lift2. f_equal.
induction v; simpl map; auto with closed.
simpl.
f_equal; auto.
unfold globvar2pred; destruct a; simpl.
destruct (gvar_volatile g) eqn:?; auto.
forget (readonly2share (gvar_readonly g)) as sh.
forget (gv i) as j.
revert j; induction (gvar_init g); intros; simpl; f_equal; auto.
Qed.
Hint Resolve closed_wrt_globvars closed_wrtl_globvars: closed.

Lemma closed_wrt_main_pre:
  forall prog u v S, closed_wrt_vars S (main_pre prog u v).
Proof.
intros. apply closed_wrt_globvars. Qed.
Lemma closed_wrtl_main_pre:
  forall prog u v S, closed_wrt_lvars S (main_pre prog u v).
Proof.
intros. apply closed_wrtl_globvars. Qed.
Lemma closed_wrt_main_pre_ext:
  forall {Espec : OracleKind} prog z u v S, closed_wrt_vars S (main_pre_ext prog z u v).
Proof.
intros. unfold main_pre_ext. apply closed_wrt_sepcon; [apply closed_wrt_globvars | apply closed_wrt_const].
Qed.
Lemma closed_wrtl_main_pre_ext:
  forall {Espec : OracleKind} prog z u v S, closed_wrt_lvars S (main_pre_ext prog z u v).
Proof.
intros. unfold main_pre_ext. apply closed_wrtl_sepcon; [apply closed_wrtl_globvars | apply closed_wrtl_const].
Qed.
Hint Resolve closed_wrt_main_pre closed_wrtl_main_pre closed_wrt_main_pre_ext closed_wrtl_main_pre_ext : closed.

Lemma closed_wrt_not1:
  forall (i j: ident),
   i<>j ->
   not (eq i j).
Proof.
intros.
hnf.
intros; subst; congruence.
Qed.
Hint Resolve closed_wrt_not1 : closed.

Lemma closed_wrt_tc_andp:
  forall {cs: compspecs} S a b,
  closed_wrt_vars S (denote_tc_assert a) ->
  closed_wrt_vars S (denote_tc_assert b) ->
  closed_wrt_vars S (denote_tc_assert (tc_andp a b)).
Proof.
 intros.
 hnf; intros.
 repeat rewrite denote_tc_assert_andp; simpl; f_equal; auto.
Qed.

Lemma closed_wrt_tc_orp:
  forall {cs: compspecs} S a b,
  closed_wrt_vars S (denote_tc_assert a) ->
  closed_wrt_vars S (denote_tc_assert b) ->
  closed_wrt_vars S (denote_tc_assert (tc_orp a b)).
Proof.
 intros.
 hnf; intros.
 repeat rewrite denote_tc_assert_orp; simpl.
 f_equal; auto.
Qed.

Lemma closed_wrt_tc_bool:
  forall {cs: compspecs} S b e, closed_wrt_vars S (denote_tc_assert (tc_bool b e)).
Proof.
 intros.
 hnf; intros.
 destruct b; simpl; auto.
Qed.

Lemma closed_wrt_tc_int_or_ptr_type:
  forall {cs: compspecs} S t,
  closed_wrt_vars S (denote_tc_assert (tc_int_or_ptr_type t)).
Proof.
 intros.
 apply closed_wrt_tc_bool.
Qed.

Hint Resolve closed_wrt_tc_andp closed_wrt_tc_orp closed_wrt_tc_bool
              closed_wrt_tc_int_or_ptr_type : closed.

Lemma closed_wrtl_tc_andp:
  forall {cs: compspecs} S a b,
  closed_wrt_lvars S (denote_tc_assert a) ->
  closed_wrt_lvars S (denote_tc_assert b) ->
  closed_wrt_lvars S (denote_tc_assert (tc_andp a b)).
Proof.
 intros.
 hnf; intros.
 repeat rewrite denote_tc_assert_andp; simpl; f_equal; auto.
Qed.

Lemma closed_wrtl_tc_orp:
  forall {cs: compspecs} S a b,
  closed_wrt_lvars S (denote_tc_assert a) ->
  closed_wrt_lvars S (denote_tc_assert b) ->
  closed_wrt_lvars S (denote_tc_assert (tc_orp a b)).
Proof.
 intros.
 hnf; intros.
 repeat rewrite denote_tc_assert_orp; simpl.
 f_equal; auto.
Qed.
Lemma closed_wrtl_tc_bool:
  forall {cs: compspecs} S b e, closed_wrt_lvars S (denote_tc_assert (tc_bool b e)).
Proof.
 intros.
 hnf; intros.
 destruct b; simpl; auto.
Qed.
Hint Resolve closed_wrtl_tc_andp closed_wrtl_tc_orp closed_wrtl_tc_bool : closed.

Lemma closed_wrt_tc_test_eq:
  forall {cs: compspecs} S e e',
          expr_closed_wrt_vars S e ->
          expr_closed_wrt_vars S e' ->
  closed_wrt_vars S
     (denote_tc_assert
        (tc_test_eq e e')).
Proof.
intros.
hnf; intros.
rewrite !binop_lemmas2.denote_tc_assert_test_eq'.
simpl. unfold_lift. rewrite H, H0; auto.
Qed.
Lemma closed_wrtl_tc_test_eq:
  forall {cs: compspecs} S e e',
          expr_closed_wrt_lvars S e ->
          expr_closed_wrt_lvars S e' ->
  closed_wrt_lvars S
     (denote_tc_assert
        (tc_test_eq e e')).
Proof.
intros.
hnf; intros.
rewrite !binop_lemmas2.denote_tc_assert_test_eq'.
simpl. unfold_lift. rewrite H, H0; auto.
Qed.
Hint Resolve  closed_wrt_tc_test_eq  closed_wrtl_tc_test_eq : closed.

Lemma closed_wrt_tc_test_order:
  forall {cs: compspecs} S e e',
          expr_closed_wrt_vars S e ->
          expr_closed_wrt_vars S e' ->
  closed_wrt_vars S
     (denote_tc_assert
        (tc_test_order e e')).
Proof.
intros.
hnf; intros.
rewrite !binop_lemmas2.denote_tc_assert_test_order'.
simpl. unfold_lift. rewrite H, H0; auto.
Qed.
Lemma closed_wrtl_tc_test_order:
  forall {cs: compspecs} S e e',
          expr_closed_wrt_lvars S e ->
          expr_closed_wrt_lvars S e' ->
  closed_wrt_lvars S
     (denote_tc_assert
        (tc_test_order e e')).
Proof.
intros.
hnf; intros.
rewrite !binop_lemmas2.denote_tc_assert_test_order'.
simpl. unfold_lift. rewrite H, H0; auto.
Qed.
Hint Resolve  closed_wrt_tc_test_order  closed_wrtl_tc_test_order : closed.

Lemma expr_closed_const_int:
  forall {cs: compspecs} S i t, expr_closed_wrt_vars S (Econst_int i t).
Proof.
intros. unfold expr_closed_wrt_vars. simpl; intros.
super_unfold_lift. auto.
Qed.
Lemma expr_closedl_const_int:
  forall S i t, expr_closed_wrt_lvars S (Econst_int i t).
Proof.
intros. unfold expr_closed_wrt_lvars. simpl; intros.
super_unfold_lift. auto.
Qed.
Hint Resolve expr_closed_const_int expr_closedl_const_int : closed.

Lemma closed_wrt_tc_iszero:
  forall {cs: compspecs}  S e, expr_closed_wrt_vars S e ->
    closed_wrt_vars S (expr2.denote_tc_assert (tc_iszero e)).
Proof.
intros.
rewrite binop_lemmas2.denote_tc_assert_iszero'.
simpl.
hnf; intros. hnf in H. specialize (H _ _ H0).
unfold_lift. rewrite <- H. auto.
Qed.
Hint Resolve closed_wrt_tc_iszero : closed.

Lemma closed_wrtl_tc_iszero:
  forall {cs: compspecs}  S e, expr_closed_wrt_lvars S e ->
    closed_wrt_lvars S (expr2.denote_tc_assert (tc_iszero e)).
Proof.
intros.
rewrite binop_lemmas2.denote_tc_assert_iszero'.
hnf; intros. specialize (H _ _ _ H0).
simpl. unfold_lift; simpl. rewrite <- H; auto.
Qed.
Hint Resolve closed_wrtl_tc_iszero : closed.

Lemma closed_wrt_tc_isptr:
 forall {cs: compspecs} S e,
     expr_closed_wrt_vars S e ->
     closed_wrt_vars S (denote_tc_assert (tc_isptr e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ H0).
 simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_isptr : closed.

Lemma closed_wrtl_tc_isptr:
 forall {cs: compspecs} S e,
     expr_closed_wrt_lvars S e ->
     closed_wrt_lvars S (denote_tc_assert (tc_isptr e)).
Proof.
 intros.
 hnf; intros. specialize (H _ _ _ H0).
 simpl. unfold_lift; simpl. rewrite <- H; auto.
Qed.
Hint Resolve closed_wrtl_tc_isptr : closed.

Lemma closed_wrt_tc_isint:
 forall {cs: compspecs} S e,
     expr_closed_wrt_vars S e ->
     closed_wrt_vars S (denote_tc_assert (tc_isint e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ H0).
 simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_isint : closed.

Lemma closed_wrtl_tc_isint:
 forall {cs: compspecs} S e,
     expr_closed_wrt_lvars S e ->
     closed_wrt_lvars S (denote_tc_assert (tc_isint e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ _ H0).
 simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrtl_tc_isint : closed.

Lemma closed_wrt_tc_islong:
 forall {cs: compspecs} S e,
     expr_closed_wrt_vars S e ->
     closed_wrt_vars S (denote_tc_assert (tc_islong e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ H0).
 simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_islong : closed.

Lemma closed_wrtl_tc_islong:
 forall {cs: compspecs} S e,
     expr_closed_wrt_lvars S e ->
     closed_wrt_lvars S (denote_tc_assert (tc_islong e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ _ H0).
 simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrtl_tc_islong : closed.

Lemma closed_wrt_isCastResultType:
  forall {cs: compspecs} S e t t0,
          expr_closed_wrt_vars S e ->
          closed_wrt_vars S
                 (denote_tc_assert (isCastResultType (implicit_deref t) t0 e)).
Proof.
 intros.
rewrite expr_lemmas3.isCastR.
destruct (classify_cast (implicit_deref t) t0) eqn:?;
  simpl; auto with closed;
 try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ]; simpl;
                auto with closed; try reflexivity];
  auto with closed;
 repeat simple_if_tac; try destruct si2; simpl; auto with closed.
 apply closed_wrt_tc_test_eq; auto with closed.
 hnf; intros. reflexivity.
Qed.

Lemma closed_wrtl_tc_Zge:
  forall  {cs: compspecs} S e i,
   expr_closed_wrt_lvars S e ->
   closed_wrt_lvars S  (denote_tc_assert (tc_Zge e i)).
Proof.
intros.
hnf; intros. simpl. unfold_lift. rewrite (H _ _ _ H0). auto.
Qed.

Lemma closed_wrtl_tc_Zle:
  forall  {cs: compspecs} S e i,
   expr_closed_wrt_lvars S e ->
   closed_wrt_lvars S  (denote_tc_assert (tc_Zle e i)).
Proof.
intros.
hnf; intros. simpl. unfold_lift. rewrite (H _ _ _ H0). auto.
Qed.
Hint Resolve closed_wrtl_tc_Zge closed_wrtl_tc_Zle : closed.

Lemma closed_wrtl_isCastResultType:
  forall {cs: compspecs} S e t t0,
          expr_closed_wrt_lvars S e ->
          closed_wrt_lvars S
                 (denote_tc_assert (isCastResultType (implicit_deref t) t0 e)).
Proof.
 intros.
rewrite expr_lemmas3.isCastR.

change expr2.denote_tc_assert with denote_tc_assert.
destruct (classify_cast (implicit_deref t) t0) eqn:?;
  auto with closed;
 try solve [destruct t0 as [ | [ | | | ] [|] | [|] | [ | ] |  | | | | ]; simpl;
                auto with closed; try reflexivity];
repeat simple_if_tac;  auto with closed;
 try destruct si2; auto with closed.
 apply closed_wrtl_tc_test_eq; auto with closed.
 hnf; intros. reflexivity.
Qed.

Hint Resolve closed_wrt_isCastResultType closed_wrtl_isCastResultType : closed.

Lemma closed_wrt_tc_temp_id :
  forall {cs: compspecs} Delta S e id t, expr_closed_wrt_vars S e ->
                         expr_closed_wrt_vars S (Etempvar id t) ->
             closed_wrt_vars S (tc_temp_id id t Delta e).
Proof.
intros.
unfold tc_temp_id.
unfold typecheck_temp_id.
destruct ( (temp_types Delta) ! id) eqn:?; try destruct p; simpl; auto with closed.
Qed.

Lemma closed_wrtl_tc_temp_id :
  forall {cs: compspecs} Delta S e id t, expr_closed_wrt_lvars S e ->
                         expr_closed_wrt_lvars S (Etempvar id t) ->
             closed_wrt_lvars S (tc_temp_id id t Delta e).
Proof.
intros.
unfold tc_temp_id.
unfold typecheck_temp_id.
destruct ( (temp_types Delta) ! id) eqn:?; try destruct p; simpl; auto with closed.
Qed.

Hint Resolve closed_wrt_tc_temp_id closed_wrtl_tc_temp_id : closed.

Lemma expr_closed_tempvar:
 forall {cs: compspecs} S i t, ~ S i -> expr_closed_wrt_vars S (Etempvar i t).
Proof.
intros.
hnf; intros.
simpl. unfold eval_id. f_equal.
destruct (H0 i); auto.
contradiction.
Qed.
Lemma expr_closedl_tempvar:
 forall S i t, expr_closed_wrt_lvars S (Etempvar i t).
Proof.
intros.
hnf; intros.
simpl. unfold eval_id. f_equal.
Qed.
Hint Resolve expr_closed_tempvar expr_closedl_tempvar : closed.

Hint Extern 1 (not (@eq ident _ _)) => (let Hx := fresh in intro Hx; inversion Hx) : closed.

Lemma expr_closed_cast: forall {cs: compspecs} S e t,
     expr_closed_wrt_vars S e ->
     expr_closed_wrt_vars S (Ecast e t).
Proof.
 unfold expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift.
 destruct (H rho te' H0); auto.
Qed.
Lemma expr_closedl_cast: forall S e t,
     expr_closed_wrt_lvars S e ->
     expr_closed_wrt_lvars S (Ecast e t).
Proof.
 unfold expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift.
 destruct (H cs rho ve' H0); auto.
Qed.
Hint Resolve expr_closed_cast expr_closedl_cast : closed.

Lemma expr_closed_field: forall {cs: compspecs} S e f t,
  lvalue_closed_wrt_vars S e ->
  expr_closed_wrt_vars S (Efield e f t).
Proof.
 unfold lvalue_closed_wrt_vars, expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift.
 f_equal.
 apply H.  auto.
Qed.
Lemma expr_closedl_field: forall S e f t,
  lvalue_closed_wrt_lvars S e ->
  expr_closed_wrt_lvars S (Efield e f t).
Proof.
 unfold lvalue_closed_wrt_lvars, expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift.
 f_equal.
 apply H.  auto.
Qed.
Hint Resolve expr_closed_field expr_closedl_field : closed.

Lemma expr_closed_binop: forall {cs: compspecs} S op e1 e2 t,
     expr_closed_wrt_vars S e1 ->
     expr_closed_wrt_vars S e2 ->
     expr_closed_wrt_vars S (Ebinop op e1 e2 t).
Proof.
 unfold expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift. f_equal; auto.
Qed.
Lemma expr_closedl_binop: forall S op e1 e2 t,
     expr_closed_wrt_lvars S e1 ->
     expr_closed_wrt_lvars S e2 ->
     expr_closed_wrt_lvars S (Ebinop op e1 e2 t).
Proof.
 unfold expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift. f_equal; auto.
Qed.
Hint Resolve expr_closed_binop expr_closedl_binop : closed.

Lemma expr_closed_unop: forall {cs: compspecs} S op e t,
     expr_closed_wrt_vars S e ->
     expr_closed_wrt_vars S (Eunop op e t).
Proof.
 unfold expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift. f_equal; auto.
Qed.
Lemma expr_closedl_unop: forall S op e t,
     expr_closed_wrt_lvars S e ->
     expr_closed_wrt_lvars S (Eunop op e t).
Proof.
 unfold expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift. f_equal; auto.
Qed.
Hint Resolve expr_closed_unop expr_closedl_unop : closed.

Lemma closed_wrt_stackframe_of:
  forall {cs: compspecs} S f, closed_wrt_vars S (stackframe_of f).
Proof.
intros.
unfold stackframe_of.
induction (fn_vars f); auto.
apply closed_wrt_emp.
apply closed_wrt_sepcon; [ | apply IHl].
clear. destruct a; unfold var_block.
hnf; intros. reflexivity.
Qed.
Hint Resolve closed_wrt_stackframe_of : closed.

Definition included {U} (S S': U -> Prop) := forall x, S x -> S' x.

Lemma closed_wrt_TT:
 forall  (S: ident -> Prop),
  closed_wrt_vars S (@TT (environ -> mpred) _).
Proof.
intros. hnf; intros. reflexivity.
Qed.
Lemma closed_wrtl_TT:
 forall  (S: ident -> Prop),
  closed_wrt_lvars S (@TT (environ -> mpred) _).
Proof.
intros. hnf; intros. reflexivity.
Qed.
Hint Resolve closed_wrt_TT closed_wrtl_TT : closed.

Lemma closed_wrt_subset:
  forall (S S': ident -> Prop) (H: included S' S) B (f: environ -> B),
       closed_wrt_vars S f -> closed_wrt_vars S' f.
Proof.
intros. hnf. intros. specialize (H0 rho te').
apply H0.
intro i; destruct (H1 i); auto.
Qed.
Lemma closed_wrtl_subset:
  forall (S S': ident -> Prop) (H: included S' S) B (f: environ -> B),
       closed_wrt_lvars S f -> closed_wrt_lvars S' f.
Proof.
intros. hnf. intros. specialize (H0 rho ve').
apply H0.
intro i; destruct (H1 i); auto.
Qed.
Hint Resolve closed_wrt_subset closed_wrtl_subset : closed.

Lemma closed_wrt_Forall_subset:
  forall S S' (H: included S' S) B (f: list (environ -> B)),
 Forall (closed_wrt_vars S) f ->
 Forall (closed_wrt_vars S') f.
Proof.
induction f; simpl; auto.
intro.
inv H0.
constructor.
apply (closed_wrt_subset _ _ H). auto.
auto.
Qed.
Lemma closed_wrtl_Forall_subset:
  forall S S' (H: included S' S) B (f: list (environ -> B)),
 Forall (closed_wrt_lvars S) f ->
 Forall (closed_wrt_lvars S') f.
Proof.
induction f; simpl; auto.
intro.
inv H0.
constructor.
apply (closed_wrtl_subset _ _ H). auto.
auto.
Qed.

Lemma lvalue_closed_tempvar:
 forall {cs: compspecs} S i t, ~ S i -> lvalue_closed_wrt_vars S (Etempvar i t).
Proof.
simpl; intros.
hnf; intros.
simpl. reflexivity.
Qed.
Lemma lvalue_closedl_tempvar:
 forall S i t, lvalue_closed_wrt_lvars S (Etempvar i t).
Proof.
simpl; intros.
hnf; intros.
simpl. reflexivity.
Qed.
Hint Resolve lvalue_closed_tempvar lvalue_closedl_tempvar : closed.

Lemma expr_closed_addrof: forall {cs: compspecs} S e t,
     lvalue_closed_wrt_vars S e ->
     expr_closed_wrt_vars S (Eaddrof e t).
Proof.
 unfold lvalue_closed_wrt_vars, expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift. apply H.  auto.
Qed.
Lemma expr_closedl_addrof: forall S e t,
     lvalue_closed_wrt_lvars S e ->
     expr_closed_wrt_lvars S (Eaddrof e t).
Proof.
 unfold lvalue_closed_wrt_lvars, expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift. apply H.  auto.
Qed.
Hint Resolve expr_closed_addrof expr_closedl_addrof : closed.

Lemma lvalue_closed_field: forall {cs: compspecs} S e f t,
  lvalue_closed_wrt_vars S e ->
  lvalue_closed_wrt_vars S (Efield e f t).
Proof.
 unfold lvalue_closed_wrt_vars, expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift. f_equal; apply H.  auto.
Qed.
Lemma lvalue_closedl_field: forall S e f t,
  lvalue_closed_wrt_lvars S e ->
  lvalue_closed_wrt_lvars S (Efield e f t).
Proof.
 unfold lvalue_closed_wrt_lvars, expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift. f_equal; apply H.  auto.
Qed.
Hint Resolve lvalue_closed_field lvalue_closedl_field : closed.

Lemma lvalue_closed_deref: forall {cs: compspecs} S e t,
  expr_closed_wrt_vars S e ->
  lvalue_closed_wrt_vars S (Ederef e t).
Proof.
 unfold lvalue_closed_wrt_vars, expr_closed_wrt_vars; intros.
 simpl.
 super_unfold_lift. apply H.  auto.
Qed.
Lemma lvalue_closedl_deref: forall S e t,
  expr_closed_wrt_lvars S e ->
  lvalue_closed_wrt_lvars S (Ederef e t).
Proof.
 unfold lvalue_closed_wrt_lvars, expr_closed_wrt_lvars; intros.
 simpl.
 super_unfold_lift. apply H.  auto.
Qed.
Hint Resolve lvalue_closed_deref lvalue_closedl_deref: closed.

Fixpoint closed_eval_expr (j: ident) (e: expr) : bool :=
 match e with
 | Econst_int i ty => true
 | Econst_long i ty => true
 | Econst_float f ty => true
 | Econst_single f ty => true
 | Etempvar id ty => negb (eqb_ident j id)
 | Eaddrof a ty => closed_eval_lvalue j a
 | Eunop op a ty =>  closed_eval_expr j a
 | Ebinop op a1 a2 ty =>  andb (closed_eval_expr j a1) (closed_eval_expr j a2)
 | Ecast a ty => closed_eval_expr j a
 | Evar id ty => true
 | Ederef a ty => closed_eval_expr j a
 | Efield a i ty => closed_eval_lvalue j a
 | Esizeof _ _ => true
 | Ealignof _ _ => true
 end

 with closed_eval_lvalue (j: ident) (e: expr) : bool :=
 match e with
 | Evar id ty => true
 | Ederef a ty => closed_eval_expr j a
 | Efield a i ty => closed_eval_lvalue j a
 | _  => false
 end.

Lemma closed_eval_expr_e:
    forall {cs: compspecs} j e, closed_eval_expr j e = true -> closed_wrt_vars (eq j) (eval_expr e)
with closed_eval_lvalue_e:
    forall {cs: compspecs} j e, closed_eval_lvalue j e = true -> closed_wrt_vars (eq j) (eval_lvalue e).
Proof.
intros cs j e; clear closed_eval_expr_e; induction e; intros; simpl; auto with closed.
simpl in H. destruct (eqb_ident j i) eqn:?; inv H.
apply Pos.eqb_neq in Heqb. auto with closed.
simpl in H.
rewrite andb_true_iff in H. destruct H.
auto with closed.
intros Delta j e; clear closed_eval_lvalue_e; induction e; intros; simpl; auto with closed.
Qed.

Hint Extern 2 (closed_wrt_vars (eq _) (@eval_expr _ _)) => (apply closed_eval_expr_e; reflexivity) : closed.
Hint Extern 2 (closed_wrt_vars (eq _) (@eval_lvalue _ _)) => (apply closed_eval_lvalue_e; reflexivity) : closed.

Lemma closed_wrt_eval_expr: forall {cs: compspecs} S e,
  expr_closed_wrt_vars S e ->
  closed_wrt_vars S (eval_expr e).
Proof.
unfold expr_closed_wrt_vars, closed_wrt_vars.
intros.
apply H; auto.
Qed.
(* Hint Resolve closed_wrt_eval_expr : closed. *)

Lemma closed_wrt_lvalue: forall {cs: compspecs} S e,
  access_mode (typeof e) = By_reference ->
  closed_wrt_vars S (eval_expr e) -> closed_wrt_vars S (eval_lvalue e).
Proof.
intros.
destruct e; simpl in *; auto with closed;
unfold closed_wrt_vars in *;
intros; specialize (H0 _ _ H1); clear H1; super_unfold_lift;
auto.
Qed.
(* Hint Resolve closed_wrt_lvalue : closed. *)

Lemma closed_wrt_ideq: forall {cs: compspecs} a b e,
  a <> b ->
  closed_eval_expr a e = true ->
  closed_wrt_vars (eq a) (fun rho => !! (eval_id b rho = eval_expr e rho)).
Proof.
intros.
hnf; intros.
simpl. f_equal.
f_equal.
specialize (H1 b).
destruct H1; [contradiction | ].
unfold eval_id; simpl. rewrite H1. auto.
clear b H.
eapply closed_eval_expr_e in H0.
apply H0; auto.
Qed.

Hint Extern 2 (closed_wrt_vars (eq _) _) =>
      (apply closed_wrt_ideq; [solve [let Hx := fresh in (intro Hx; inv Hx)] | reflexivity]) : closed.

Lemma closed_wrt_tc_nonzero:
 forall {cs: compspecs} S e,
     closed_wrt_vars S (eval_expr e) ->
     closed_wrt_vars S (denote_tc_assert (tc_nonzero e)).
Proof.
 intros.
 hnf; intros.
 specialize (H _ _ H0).
 repeat rewrite binop_lemmas2.denote_tc_assert_nonzero.
 rewrite <- H; auto.
Qed.
Hint Resolve closed_wrt_tc_nonzero : closed.

Lemma closed_wrt_binarithType:
  forall {cs: compspecs} S t1 t2 t a b,
  closed_wrt_vars S (denote_tc_assert (binarithType t1 t2 t a b)).
Proof.
 intros.
 unfold binarithType.
 destruct (Cop.classify_binarith t1 t2); simpl; auto with closed.
Qed.
Hint Resolve closed_wrt_binarithType : closed.

Lemma closed_wrt_tc_samebase :
 forall {cs: compspecs} S e1 e2,
 closed_wrt_vars S (eval_expr e1) ->
 closed_wrt_vars S (eval_expr e2) ->
 closed_wrt_vars S (denote_tc_assert (tc_samebase e1 e2)).
Proof.
 intros;  hnf; intros. simpl. unfold_lift. f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_samebase : closed.

Lemma closed_wrt_tc_ilt:
  forall {cs: compspecs} S e n,
    closed_wrt_vars S (eval_expr e) ->
    closed_wrt_vars S (denote_tc_assert (tc_ilt e n)).
Proof.
 intros; hnf; intros.
 repeat rewrite binop_lemmas2.denote_tc_assert_ilt'.
 simpl. unfold_lift. f_equal. auto.
Qed.
Hint Resolve closed_wrt_tc_ilt : closed.

Lemma closed_wrt_tc_llt:
  forall {cs: compspecs} S e n,
    closed_wrt_vars S (eval_expr e) ->
    closed_wrt_vars S (denote_tc_assert (tc_llt e n)).
Proof.
 intros; hnf; intros.
 repeat rewrite binop_lemmas2.denote_tc_assert_llt'.
 simpl. unfold_lift. f_equal. auto.
Qed.
Hint Resolve closed_wrt_tc_llt : closed.

Lemma closed_wrt_tc_Zge:
  forall {cs: compspecs} S e n,
    closed_wrt_vars S (eval_expr e) ->
    closed_wrt_vars S (denote_tc_assert (tc_Zge e n)).
Proof.
 intros; hnf; intros.
 simpl. unfold_lift; f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_Zge : closed.
Lemma closed_wrt_tc_Zle:
  forall {cs: compspecs} S e n,
    closed_wrt_vars S (eval_expr e) ->
    closed_wrt_vars S (denote_tc_assert (tc_Zle e n)).
Proof.
 intros; hnf; intros.
 simpl. unfold_lift; f_equal; auto.
Qed.
Hint Resolve closed_wrt_tc_Zle : closed.

Lemma closed_wrt_replace_nth:
  forall {B} S n R (R1: environ -> B),
    closed_wrt_vars S R1 ->
    Forall (closed_wrt_vars S) R ->
    Forall (closed_wrt_vars S) (replace_nth n R R1).
Proof.
intros.
revert R H0; induction n; destruct R; simpl; intros; auto with closed;
inv H0; constructor; auto with closed.
Qed.
Hint Resolve @closed_wrt_replace_nth : closed.

Lemma closed_wrt_tc_nodivover :
 forall {cs: compspecs} S e1 e2,
 closed_wrt_vars S (eval_expr e1) ->
 closed_wrt_vars S (eval_expr e2) ->
 closed_wrt_vars S (denote_tc_assert (tc_nodivover e1 e2)).
Proof.
 intros;  hnf; intros.
 repeat rewrite binop_lemmas2.denote_tc_assert_nodivover.
 rewrite <- H0; auto. rewrite <- H; auto.
Qed.
Hint Resolve closed_wrt_tc_nodivover : closed.

Lemma closed_wrt_tc_nosignedover:
  forall op {CS: compspecs} S e1 e2,
  closed_wrt_vars S (eval_expr e1) ->
  closed_wrt_vars S (eval_expr e2) ->
  closed_wrt_vars S (denote_tc_assert (tc_nosignedover op e1 e2)).
Proof.
intros; hnf; intros.
simpl. unfold_lift.
rewrite <- H; auto.
rewrite <- H0; auto.
Qed.
Hint Resolve closed_wrt_tc_nosignedover : closed.

Lemma closed_wrt_tc_nobinover:
  forall op {CS: compspecs} S e1 e2,
  closed_wrt_vars S (eval_expr e1) ->
  closed_wrt_vars S (eval_expr e2) ->
  closed_wrt_vars S (denote_tc_assert (tc_nobinover op e1 e2)).
Proof.
intros.
unfold tc_nobinover.
unfold if_expr_signed.
destruct (typeof e1); auto with closed.
destruct s; auto with closed.
destruct (eval_expr e1 any_environ); auto with closed;
destruct (eval_expr e2 any_environ); auto with closed.
all: repeat simple_if_tac; auto with closed.
destruct (eval_expr e1 any_environ); auto with closed;
destruct (eval_expr e2 any_environ); auto with closed.
all: try destruct s; repeat simple_if_tac; auto with closed.
Qed.

Hint Resolve closed_wrt_tc_nobinover : closed.

Lemma closed_wrt_tc_expr:
  forall {cs: compspecs} Delta j e, closed_eval_expr j e = true ->
             closed_wrt_vars (eq j) (tc_expr Delta e)
 with closed_wrt_tc_lvalue:
  forall {cs: compspecs} Delta j e, closed_eval_lvalue j e = true ->
             closed_wrt_vars (eq j) (tc_lvalue Delta e).
Proof.
* clear closed_wrt_tc_expr.
unfold tc_expr.
induction e; simpl; intros;
try solve [destruct t  as [ | [ | | | ] [ | ] | | [ | ] | | | | | ]; simpl; auto with closed].
+
  destruct (access_mode t);  simpl; auto with closed;
  destruct (get_var_type Delta i); simpl; auto with closed.
+
  destruct ((temp_types Delta) ! i); simpl; auto with closed.
  destruct (is_neutral_cast t0 t || same_base_type t0 t)%bool; simpl; auto with closed.
  clear -  H.
  hnf; intros.
  specialize (H0 i).
  pose proof (eqb_ident_spec j i).
  destruct (eqb_ident j i); inv H.
  destruct H0. apply H1 in H; inv H.
  unfold denote_tc_initialized;  simpl.
  f_equal.
  apply exists_ext; intro v.
  f_equal. rewrite H; auto.
+ destruct (access_mode t) eqn:?H; simpl; auto with closed.
  apply closed_wrt_tc_andp; auto with closed.
  apply closed_wrt_tc_isptr; auto with closed.
  apply closed_eval_expr_e; auto.
+
 apply closed_wrt_tc_andp; auto with closed.
 apply closed_wrt_tc_lvalue; auto.
+
 specialize (IHe H).
 apply closed_eval_expr_e in H.
 repeat apply closed_wrt_tc_andp; auto with closed.
 unfold isUnOpResultType.
 destruct u;
 destruct (typeof e) as   [ | [ | | | ] [ | ] | | [ | ] | | | | | ];
   simpl; repeat apply closed_wrt_tc_andp; auto 50 with closed;
  rewrite binop_lemmas2.denote_tc_assert_test_eq';
  simpl; unfold_lift;
  hnf; intros ? ? H8; simpl;
  rewrite <- (H _ _ H8); auto.
+
  rewrite andb_true_iff in H. destruct H.
 specialize (IHe1 H). specialize (IHe2 H0).
 apply closed_eval_expr_e in H; apply closed_eval_expr_e in H0.
 repeat apply closed_wrt_tc_andp; auto with closed.
 unfold isBinOpResultType.
 destruct b; auto 50 with closed;
 try solve [destruct (Cop.classify_binarith (typeof e1) (typeof e2));
                try destruct s;  auto with closed];
 try solve [destruct (Cop.classify_cmp (typeof e1) (typeof e2));
                 simpl; auto 50 with closed].
 destruct (Cop.classify_add (typeof e1) (typeof e2)); auto 50 with closed.
 destruct (Cop.classify_sub (typeof e1) (typeof e2)); auto 50 with closed.
 destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with closed.
 destruct (Cop.classify_shift (typeof e1) (typeof e2)); auto 50 with closed.

+
 apply closed_wrt_tc_andp; auto with closed.
 specialize (IHe H).
 apply closed_eval_expr_e in H.
 unfold isCastResultType.
 destruct (classify_cast (typeof e) t); auto with closed;
   try solve [ destruct t as [ | [ | | | ] [ | ]| [ | ] | [ | ] | | | | | ]; auto with closed].
all: repeat simple_if_tac; try destruct si2; auto with closed.
 apply closed_wrt_tc_test_eq; auto with closed.
 hnf; intros; reflexivity.
 hnf; intros; reflexivity.
+
 clear IHe.
 destruct (access_mode t); simpl; auto with closed.
 repeat apply closed_wrt_tc_andp; auto with closed.
 apply closed_wrt_tc_lvalue; auto.
 destruct (typeof e); simpl; auto with closed;
 destruct (cenv_cs ! i0); simpl; auto with closed.
 destruct (field_offset cenv_cs i (co_members c)); simpl; auto with closed.
*
 clear closed_wrt_tc_lvalue.
 unfold tc_lvalue.
 induction e; simpl; intros; auto with closed.
 +
 destruct (get_var_type Delta i); simpl; auto with closed.
 +
 specialize (closed_wrt_tc_expr cs Delta _ _ H).
 apply closed_eval_expr_e in H.
 auto 50 with closed.
 +
 specialize (IHe H).
 apply closed_eval_lvalue_e  in H.
 repeat apply closed_wrt_tc_andp; auto with closed.
 destruct (typeof e); simpl; auto with closed;
 destruct (cenv_cs ! i0); simpl; auto with closed.
 destruct (field_offset cenv_cs i (co_members c)); simpl; auto with closed.
Qed.

Hint Resolve closed_wrt_tc_expr : closed.
Hint Resolve closed_wrt_tc_lvalue : closed.

Lemma closed_wrt_lift1':
      forall (A B : Type) (S : ident -> Prop) (f : A -> B)
         (P : environ -> A),
       closed_wrt_vars S P -> closed_wrt_vars S (`f P).
Proof.
intros.
apply closed_wrt_lift1.
hnf; intros. simpl. f_equal.
apply H. auto.
Qed.
Hint Resolve closed_wrt_lift1' : closed.

Lemma closed_wrt_Econst_int:
  forall {cs: compspecs} S i t, closed_wrt_vars S (eval_expr (Econst_int i t)).
Proof.
simpl; intros.
auto with closed.
Qed.
Hint Resolve closed_wrt_Econst_int : closed.

Lemma closed_wrt_PROPx:
 forall S P Q, closed_wrt_vars S Q -> closed_wrt_vars S (PROPx P Q).
Proof.
intros.
apply closed_wrt_andp; auto.
hnf; intros. reflexivity.
Qed.
Lemma closed_wrtl_PROPx:
 forall S P Q, closed_wrt_lvars S Q -> closed_wrt_lvars S (PROPx P Q).
Proof.
intros.
apply closed_wrtl_andp; auto.
hnf; intros. reflexivity.
Qed.
Hint Resolve closed_wrt_PROPx closed_wrtl_PROPx: closed.

Lemma closed_wrt_LOCALx:
 forall S Q R, Forall (closed_wrt_vars S) (map locald_denote Q) ->
                    closed_wrt_vars S R ->
                    closed_wrt_vars S (LOCALx Q R).
Proof.
intros.
apply closed_wrt_andp; auto.
clear - H.
induction Q; simpl; intros.
auto with closed.
normalize. autorewrite with norm1 norm2; normalize.
inv H.
apply closed_wrt_andp; auto with closed.
Qed.

Lemma closed_wrtl_LOCALx:
 forall S Q R, Forall (closed_wrt_lvars S) (map locald_denote Q) ->
                    closed_wrt_lvars S R ->
                    closed_wrt_lvars S (LOCALx Q R).
Proof.
intros.
apply closed_wrtl_andp; auto.
clear - H.
induction Q; simpl; intros.
auto with closed.
normalize. autorewrite with norm1 norm2; normalize.
inv H.
apply closed_wrtl_andp; auto with closed.
Qed.
(*
Lemma closed_wrt_LOCALx:
 forall S Q R, Forall (fun q => closed_wrt_vars S (local q)) Q ->
                    closed_wrt_vars S R ->
                    closed_wrt_vars S (LOCALx Q R).
Proof.
intros.
apply closed_wrt_andp; auto.
clear - H.
induction Q; simpl; intros.
auto with closed.
normalize.
inv H.
apply closed_wrt_andp; auto with closed.
Qed.
*)

Hint Resolve closed_wrt_LOCALx closed_wrtl_LOCALx: closed.

Lemma closed_wrt_SEPx: forall S P,
     closed_wrt_vars S (SEPx P).
Proof.
intros.
unfold SEPx.
auto with closed.
Qed.

Lemma closed_wrtl_SEPx: forall S P,
     closed_wrt_lvars S (SEPx P).
Proof.
intros.
unfold SEPx.
auto with closed.
Qed.
Hint Resolve closed_wrt_SEPx closed_wrtl_SEPx: closed.

Lemma not_not_a_param_i:
  forall (L: list (ident * type)) i,
   In i (map (@fst _ _) L) ->
   ~ not_a_param L i.
Proof.
intros.
intro. apply H0; auto.
Qed.
Hint Resolve not_not_a_param_i : closed.

Lemma in_map_fst1:
 forall (i: ident) (t: type) L,
   In i (map (@fst _ _) ((i,t)::L)).
Proof.
intros. left. reflexivity.
Qed.
Hint Resolve in_map_fst1 : closed.

Lemma in_map_fst2:
 forall (i: ident) a (L: list (ident*type)),
   In i (map (@fst _ _) L) ->
   In i (map (@fst _ _) (a::L)).
Proof.
intros; right; auto.
Qed.
Hint Resolve in_map_fst2 : closed.

Ltac precondition_closed :=
 match goal with |- precondition_closed _ _ => idtac end;
 let x := fresh "x" in intro x;
 split;
  repeat match goal with
          | |- closed_wrt_vars _ (let (y,z) := ?x in _) => is_var x; destruct x
          | |- closed_wrt_lvars _ (let (y,z) := ?x in _) => is_var x; destruct x
          end;
  [simpl not_a_param; auto 50 with closed
  | simpl is_a_local; auto 50 with closed ].

Lemma Forall_map_cons:
  forall {A B} (F: A -> Prop) (g: B -> A) b bl,
  F (g b) -> Forall F (map g bl) ->
  Forall F (map g (b::bl)).
Proof.
simpl.
intros.
constructor; auto.
Qed.

Lemma Forall_map_nil:
  forall {A B} (F: A -> Prop) (g: B -> A),
  Forall F (map g nil).
Proof.
simpl.
intros.
constructor; auto.
Qed.
Hint Resolve @Forall_map_cons @Forall_map_nil : closed.
Hint Resolve Forall_cons Forall_nil : closed.


(* GENERIC *)

Require Export MinBFTgen.
Require Export MinBFTcount_gen_tacs.

Section MinBFTcount_gen1.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext        }.
  Context { minbft_context      : MinBFT_context      }.
  Context { m_initial_keys      : MinBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys   }.
  Context { usig_hash           : USIG_hash           }.
  Context { minbft_auth         : MinBFT_auth         }.

  Context { ti : TrustedInfo }.

  Lemma accepted_if_executed_previous_step :
    forall {eo  : EventOrdering}
           (e   : Event)
           (req : Request)
           (i   : nat)
           (l   : list name)
           (r   : Rep)
           (s   : MAIN_state)
           (subs : n_procs 1),
      In (send_accept (accept req i) l)
         (M_output_ls_on_this_one_event (MinBFTlocalSys_newP r s subs) e)
      -> i = S (cexec s).
  Proof.
    introv h.
    apply in_M_output_ls_on_this_one_event_implies in h; exrepnd; simpl in *; minbft_simp.
    autorewrite with minbft comp in *.
    Time minbft_dest_msg Case; simpl in *; tcsp; ginv; repeat smash_minbft2;
      repndors; tcsp;
        try (complete (inversion h0; subst; GC; eauto 4 with minbft));
        repeat (try gdest; smash_minbft1_at_ h1; repeat hide_break; repnd;
                simpl in *; repndors; ginv; tcsp; eauto 2 with minbft).
  Qed.

End MinBFTcount_gen1.