Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import ZArith.
Require Import Strings.String.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Require Import depoolContract.SolidityNotations.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

Definition toErrorProp {E X} (l: list (X -> (Prop*E))) (x: X) (e:E):=
let fix f l x := match l with
| nil => [ ]
| p::ls => let p' := f ls x in
            ((fst (p x))::(hd (@nil Prop) p'))::p'
end  in
let l' := List.map (fun t => (hd True t) :: (List.map (fun (p:Prop) => ~p) (tl t))) (f l x) in
let l'':= List.map (fun t => match t with
                             | [ ] => True
                             | x::xs => fold_left and xs x
                             end) l'  in
let l''' :=  l'' in
let fix g m l :=
match m, l with
| xm::ms, xl::ls => (xm /\ e = (snd xl)) :: (g ms ls)
| _, _ => [ ]
end in let l'''' := g l''' (List.map (fun p => p x) l) in
let l''''':= match l'''' with
| [ ] => False
| x::xs => fold_left or xs x
end in l'''''.

Definition toValueProp {X E} (l: list (X -> (Prop*E))) (x: X):=
let l' := List.map (fun p => ~ (fst (p x))) l in
match l' with
     | [ ] => True
     | x::xs => fold_left and xs x
end.

Definition toErrorList {E X} (l: list (X -> (Prop*E))) (x: X) :=
map (fun f => (snd (f x))) l.

Notation "$0"  := (prod_curry)       (at level 60, right associativity).
Notation "$1"  := (prod_curry ∘ $0)  (at level 60, right associativity).
Notation "$2"  := (prod_curry ∘ $1)  (at level 60, right associativity).
Notation "$3"  := (prod_curry ∘ $2)  (at level 60, right associativity).
Notation "$4"  := (prod_curry ∘ $3)  (at level 60, right associativity).
Notation "$5"  := (prod_curry ∘ $4)  (at level 60, right associativity).
Notation "$6"  := (prod_curry ∘ $5)  (at level 60, right associativity).
Notation "$7"  := (prod_curry ∘ $6)  (at level 60, right associativity).

Notation "#0"  := (prod_uncurry)       (at level 60, right associativity).
Notation "#1"  := ( prod_uncurry ∘ #0 )  (at level 60, right associativity).
Notation "#2"  := ( prod_uncurry ∘ #1 )  (at level 60, right associativity).
Notation "#3"  := ( prod_uncurry ∘ #2 )  (at level 60, right associativity).
Notation "#4"  := ( prod_uncurry ∘ #3 )  (at level 60, right associativity).
Notation "#5"  := ( prod_uncurry ∘ #4 )  (at level 60, right associativity).
Notation "#6"  := ( prod_uncurry ∘ #5 )  (at level 60, right associativity).
Notation "#7"  := ( prod_uncurry ∘ #6 )  (at level 60, right associativity).

Module XTypesSig <: SolidityNotations.XTypesSig.
Definition XBool := bool.
Definition XInteger := Z.

(*Definition XInteger256 := Z.*)
Definition XString := string.
Definition XMaybe := option.
Definition XList := list.
Definition XProd := prod.
Definition XHMap := listPair.
Definition XErrorValue := ErrorValue.

(* constants used as literals *)
Definition xInt1000000000 := 1000000000%Z.
Definition xInt10000000000 := 10000000000%Z.
Definition xInt104 := 104%Z.
Definition xInt100000000000 := 100000000000%Z.
Definition xInt103 := 103%Z.
Definition xInt4 := 4%Z.
Definition xInt18 := 18%Z.
Definition xInt2 := 2%Z.
Definition xInt100 := 100%Z.
Definition xInt64 := 64%Z.
Definition xInt102 := 102%Z.
Definition xInt101 := 101%Z.
Definition xInt1 := 1%Z.
Definition xInt17 := 17%Z.
Definition xInt15 := 15%Z.
Definition xInt32 := 32%Z.
Definition xInt34 := 34%Z.
Definition xInt0 := 0%Z.
Definition xInt65536 := 65536%Z.
Definition xInt3 := 3%Z.
Definition xInt1_000_000_000 := 1000000000%Z.
Definition xInt228_000_000 := 228000000%Z.
Definition xInt8 := 8%Z.
Definition x1_ton := 1000000000%Z.
Definition xInt1E9 := 1000000000%Z.
Definition xInt5 := 5%Z.
Definition xInt6 := 6%Z.
Definition xInt7 := 7%Z.
Definition xInt9 := 9%Z.
Definition xInt365 := 365%Z.
Definition x1_day := 86400%Z.
Definition xInt128 := 128%Z.
Definition xInt200 := 200%Z.

(*funrec classes*)
Definition bfr := boolFunRec.
Definition pfr := prodFunRec.
Definition mfr := maybeFunRec.
Definition ifr := intFunRec.
Definition lfr := listFunRec.
Definition sfr := strFunRec.
Definition hmfr:= hmapFunRec.
Definition evfr:= errorFunRec.
End XTypesSig.

(* Module Type A.

Set Universe Polymorphism.
Set Printing Universes.
Unset Cumulativity Weak Constraints.

Section UniSection.
Polymorphic Universes i j k.
Polymorphic Constraint i <= simpleState.u0.
Polymorphic Constraint j <= simpleState.u1.
Polymorphic Constraint i <= k.
Polymorphic Constraint j <= k.

Polymorphic Axiom StateT: Type@{i} -> Type@{j} -> Type@{k}.

End UniSection.

(*Module*) Monomorphic Axiom monadStateT: forall S, Monad (StateT S).
Existing Instance monadStateT.
(*Module*) Monomorphic Axiom monadStateStateT : forall S, MonadState (M:=StateT S) S.
End A.  *)

Module StateMonadSig <: SolidityNotations.StateMonadSig.

(* Polymorphic Definition StateT (S X: Type): Type.
 refine (simpleState S X).
 Defined. *)

 Definition StateT := simpleState.

(*
 Check simpleStateMonad. *)

 Definition monadStateT := simpleStateMonad.

(*  Polymorphic Definition monadStateT : forall S, Monad (StateT S).
 refine (simpleStateMonad).
 Defined. *)

 Definition monadStateStateT := simpleStateMonadState.
(*
 Polymorphic Definition monadStateStateT := simpleStateMonadState. *)

End StateMonadSig.

Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import ZArith.
Require Import Lists.List.
Require Import Ascii.
Require Import Strings.String.
Require Import Coq.Strings.Byte.

Require Import depoolContract.Lib.HexNotations.
Import HexNotations.
Require Import depoolContract.DePoolConsts.

Module DePoolConstsTypesSig <: DePoolConstsTypesSig XTypesSig StateMonadSig .

Module SolidityNotations := SolidityNotations XTypesSig StateMonadSig.

Local Open Scope solidity_scope_hex.
Local Open Scope solidity_scope_dec.

Local Notation "a 'e' b" := ( (a * 10^b)%Z )(at level 60, right associativity) .
Local Notation "'0.09' '*' 'ton'" := (90000000%Z).
Local Notation "'0.5' '*' 'ton'" := (500000000%Z).

Definition ton := 1000000000%Z .
Definition milliton := 1000%Z .
Definition minutes := 60%Z .

Definition Errors_ι_IS_NOT_OWNER := 101%Z .
Definition Errors_ι_IS_NOT_PROXY := 107%Z .
Definition Errors_ι_IS_EXT_MSG := 108%Z .
Definition Errors_ι_IS_NOT_VALIDATOR := 113%Z .
Definition Errors_ι_DEPOOL_IS_CLOSED := 114%Z .
Definition Errors_ι_NO_SUCH_PARTICIPANT := 116%Z .
Definition Errors_ι_IS_NOT_DEPOOL := 120%Z .
Definition Errors_ι_INVALID_ROUND_STEP := 125%Z .
Definition Errors_ι_INVALID_QUERY_ID := 126%Z .
Definition Errors_ι_IS_NOT_ELECTOR := 127%Z .
Definition Errors_ι_BAD_STAKES := 129%Z .
Definition Errors_ι_CONSTRUCTOR_NO_PUBKEY := 130%Z .
Definition Errors_ι_VALIDATOR_IS_NOT_STD := 133%Z .
Definition Errors_ι_BAD_PART_REWARD := 138%Z .
Definition Errors_ι_BAD_PROXY_CODE := 141%Z .
Definition Errors_ι_NOT_WORKCHAIN0 := 142%Z .
Definition Errors_ι_NEW_VALIDATOR_FRACTION_MUST_BE_GREATER_THAN_OLD := 143%Z .
Definition Errors_ι_FRACTION_MUST_NOT_BE_ZERO := 144%Z .
Definition Errors_ι_BAD_BALANCE_THRESHOLD := 145%Z .
Definition Errors_ι_BAD_ACCOUNT_BALANCE := 146%Z .
Definition InternalErrors_ι_ERROR507 := 507%Z .
Definition InternalErrors_ι_ERROR508 := 508%Z .
Definition InternalErrors_ι_ERROR509 := 509%Z .
Definition InternalErrors_ι_ERROR511 := 511%Z .
Definition InternalErrors_ι_ERROR513 := 513%Z .
Definition InternalErrors_ι_ERROR516 := 516%Z .
Definition InternalErrors_ι_ERROR517 := 517%Z .
Definition InternalErrors_ι_ERROR518 := 518%Z .
Definition InternalErrors_ι_ERROR519 := 519%Z .
Definition InternalErrors_ι_ERROR521 := 521%Z .
Definition InternalErrors_ι_ERROR522 := 522%Z .
Definition InternalErrors_ι_ERROR523 := 523%Z .
Definition InternalErrors_ι_ERROR524 := 524%Z .
Definition InternalErrors_ι_ERROR525 := 525%Z .
Definition InternalErrors_ι_ERROR526 := 526%Z .
Definition InternalErrors_ι_ERROR527 := 527%Z .
Definition InternalErrors_ι_ERROR528 := 528%Z .
Definition DePoolLib_ι_PROXY_FEE := (0.09 * ton )%Z .
Definition DePoolLib_ι_MIN_PROXY_BALANCE := (1 * ton )%Z .
Definition DePoolLib_ι_PROXY_CONSTRUCTOR_FEE := (1 * ton )%Z .
Definition DePoolLib_ι_DEPOOL_CONSTRUCTOR_FEE := (1 * ton )%Z .
Definition DePoolLib_ι_ELECTOR_FEE := (1 * ton )%Z .
Definition DePoolLib_ι_MAX_UINT64 := "FFFFFFFFFFFFFFFF" .
Definition DePoolLib_ι_MAX_TIME := "FFFFFFFF" .
Definition DePoolLib_ι_ELECTOR_UNFREEZE_LAG := (1 * minutes )%Z .
Definition DePool_ι_STAKE_FEE := (0.5 * ton )%Z .
Definition DePool_ι_RET_OR_REINV_FEE := (50 * milliton )%Z .
Definition DePool_ι_MAX_MSGS_PER_TR := 25%Z .
Definition DePool_ι_MAX_QTY_OF_OUT_ACTIONS := 250%Z .
Definition DePool_ι_VALUE_FOR_SELF_CALL := (1 * ton )%Z .
Definition DePool_ι_PROXY_CODE_HASH := "481d7f583b458a1672ee602f66e8aa8d2f99d3cd9ece2eaa20e25c7ddf4c7f4a".
Definition DePool_ι_STATUS_SUCCESS := 0%Z .
Definition DePool_ι_STATUS_STAKE_TOO_SMALL := 1%Z .
Definition DePool_ι_STATUS_DEPOOL_CLOSED := 3%Z .
Definition DePool_ι_STATUS_NO_PARTICIPANT := 6%Z .
Definition DePool_ι_STATUS_PARTICIPANT_ALREADY_HAS_VESTING := 9%Z .
Definition DePool_ι_STATUS_WITHDRAWAL_PERIOD_GREATER_TOTAL_PERIOD := 10%Z .
Definition DePool_ι_STATUS_TOTAL_PERIOD_MORE_18YEARS := 11%Z .
Definition DePool_ι_STATUS_WITHDRAWAL_PERIOD_IS_ZERO := 12%Z .
Definition DePool_ι_STATUS_TOTAL_PERIOD_IS_NOT_DIVISIBLE_BY_WITHDRAWAL_PERIOD := 13%Z .
Definition DePool_ι_STATUS_REMAINING_STAKE_LESS_THAN_MINIMAL := 16%Z .
Definition DePool_ι_STATUS_PARTICIPANT_ALREADY_HAS_LOCK := 17%Z .
Definition DePool_ι_STATUS_TRANSFER_AMOUNT_IS_TOO_BIG := 18%Z .
Definition DePool_ι_STATUS_TRANSFER_SELF := 19%Z .
Definition DePool_ι_STATUS_TRANSFER_TO_OR_FROM_VALIDATOR := 20%Z .
Definition DePool_ι_STATUS_FEE_TOO_SMALL := 21%Z .
Definition DePool_ι_STATUS_INVALID_ADDRESS := 22%Z .
Definition DePool_ι_STATUS_INVALID_BENEFICIARY := 23%Z .
Definition DePool_ι_STATUS_NO_ELECTION_ROUND := 24%Z .
Definition DePool_ι_STATUS_INVALID_ELECTION_ID := 25%Z .
Definition DePool_ι_CRITICAL_THRESHOLD := (10 * ton )%Z .
Definition DePoolHelper_ι_TICKTOCK_FEE := 1 e 9 .
Definition DePoolHelper_ι__timerRate := 400000%Z .
Definition DePoolHelper_ι__fwdFee := 1000000%Z .
Definition DePoolHelper_ι__epsilon := 1 e 9 .
Definition DePoolProxyContract_ι_ERROR_IS_NOT_DEPOOL := 102%Z .
Definition DePoolProxyContract_ι_ERROR_BAD_BALANCE := 103%Z .

End DePoolConstsTypesSig.

(* Module B (xt: XTypesSig) (sm: StateMonadSig).
(* Module LedgerClass := LedgerClass xt sm .
Import LedgerClass.
Import SolidityNotations. *)
(*
Module Type DePoolSpecSig.
Import xt. Import sm. *)

End B.

Module B' := B XTypesSig StateMonadSig. *)


Require Import List Arith Bool.
Require Import MirrorShard.Expr MirrorShard.Env.
Require Import MirrorShard.Prover.
Require Import MirrorShard.provers.ReflexivityProver.
Require Import Word.
Require Import sep.Locals.

Set Implicit Arguments.
Set Strict Implicit.

(** * The Word Prover **)

Require Import Arith ILEnv Memory.

Section LocalsProver.
  Variable types' : list type.
  Definition types := Locals.types types'.
  Variable funcs' : functions types.
  Definition funcs := Locals.funcs funcs'.

  Definition localsSimplify (e : expr types) : expr types :=
    match e with
      | Func 11 (vs :: Const t nm :: nil) =>
        match t return tvarD types t -> _ with
          | tvType 6 => fun nm => sym_sel vs nm
          | _ => fun _ => e
        end nm
      | _ => e
    end.

  Definition localsProve (_ : unit) (goal : expr types) :=
    match goal with
      | Equal _ x y => expr_seq_dec (localsSimplify x) (localsSimplify y)
      | _ => false
    end.

  Lemma localsSimplify_correct : forall uvars vars (e : expr types) t v,
    exprD funcs uvars vars e t = Some v
    -> exprD funcs uvars vars (localsSimplify e) t = Some v.
    destruct e; simpl; intuition idtac.
    do 12 (destruct f; try assumption).
    do 2 (destruct l; try assumption).
    destruct e0; try assumption.
    destruct l; try assumption.
    destruct t0; try assumption.
    do 7 (destruct n; try assumption).
    simpl in *.
    destruct (equiv_dec (tvType 0) t); try discriminate.
    hnf in e0; subst.
    generalize (sym_sel_correct funcs' uvars vars t1 e).
    unfold funcs in *.
    match type of H with
      | match ?E with Some _ => _ | _ => _ end _ _ = _ => destruct E; try discriminate
    end.
    injection H; clear H; intros; subst.
    auto.
  Qed.

  Theorem localsProveCorrect : ProverCorrect funcs reflexivityValid localsProve.
  Proof.
    apply ProverCorrect_ProverCorrect'.
    unfold localsProve; hnf; simpl; intros.

    destruct goal; try discriminate.
    destruct H1.
    apply expr_seq_dec_correct in H0.
    hnf.
    simpl in *.
    generalize (localsSimplify_correct uvars vars goal1 t).
    generalize (localsSimplify_correct uvars vars goal2 t).
    destruct (exprD funcs uvars vars goal1 t); try discriminate.
    destruct (exprD funcs uvars vars goal2 t); try discriminate.
    intros.
    specialize (H2 _ (refl_equal _)).
    specialize (H3 _ (refl_equal _)).
    congruence.
  Qed.

  Definition localsProver : ProverT types :=
    {| Facts := unit
      ; Summarize := reflexivitySummarize
      ; Learn := reflexivityLearn
      ; Prove := localsProve |}.

  Definition localsProver_correct : ProverT_correct localsProver funcs.
    eapply Build_ProverT_correct with (Valid := reflexivityValid : _ -> _ -> Facts localsProver -> Prop); unfold reflexivityValid; eauto.
    apply localsProveCorrect.
  Qed.

End LocalsProver.

Definition LocalsProver : ProverPackage :=
{| ProverTypes := Locals.types_r
 ; ProverFuncs := Locals.funcs_r
 ; Prover_correct := localsProver_correct
|}.


Require Import Iron.Language.SystemF2Store.TyJudge.
Require Export Iron.Data.Context.
Require Export Iron.Data.Chain.

(********************************************************************)
(*  Evaluation contexts for expressions.
    This describes a place in the exp AST where the sub-expression
    there is able to take an evaluation step *)
Inductive exp_ctx : (exp -> exp) -> Prop :=

 (* The top level context names the entire expression *)
 | XcTop
   : exp_ctx  (fun x => x)

 (* Left of an application *)
 | XcApp1
   :  forall x2
   ,  exp_ctx  (fun xx => XApp xx x2)

 (* The right of an application can step only when the left is
    already a value. *)
 | XcApp2
   :  forall v1
   ,  value v1
   -> exp_ctx  (fun xx => XApp v1 xx)

 | XcAPP
   :  forall t2
   ,  exp_ctx  (fun xx => XAPP xx t2)

 (* As the XCon constructor contains a list of sub-expressions,
    we need an additional exps_ctx context to indicate which one
    we're talking about. *)
 | XcCon
   :  forall dc ts C
   ,  exps_ctx wnfX C
   -> exp_ctx  (fun xx => XCon dc ts (C xx))

 (* We need to reduce the discriminant of a case to a value. *)
 | XcCase
   :  forall alts
   ,  exp_ctx  (fun xx => XCase xx alts)

 (* Reduce the object to be updated *)
 | XcUpdate1
   :  forall cn i tsParam xField
   ,  exp_ctx  (fun xx => XUpdate cn i tsParam xx xField)

 (* Reduce the new field value *)
 | XcUpdate2
   :  forall cn i tsParam vObj
   ,  value vObj
   -> exp_ctx  (fun xx => XUpdate cn i tsParam vObj xx).

Hint Constructors exp_ctx.


(** * Cat, the precategory of strict categories *)
Require Import Category.Core Category.Objects InitialTerminalCategory.Core InitialTerminalCategory.Functors Functor.Core Category.Strict Category.Univalent Functor.Paths.
Require Import Functor.Identity Functor.Composition.Core Functor.Composition.Laws.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope functor_scope.

Section sub_pre_cat.
  Context `{Funext}.

  (** We use a slight generalization; we look at a full 1-precategory
      of the 2-precategory Cat, such that all types of functors are
      hSets.  It might be possible to prove that this doesn't buy you
      anything, because it's probably the case that [IsHSet (Functor C
      C) → IsStrictCategory C]. *)

  Variable P : PreCategory -> Type.
  Context `{HF : forall C D, P C -> P D -> IsHSet (Functor C D)}.

  (** There is a precategory of precategories which satisfy the proposition P *)

  Definition sub_pre_cat : PreCategory
    := @Build_PreCategory
         { C : PreCategory | P C }
         (fun C D => Functor C.1 D.1)
         (fun C => identity C.1)
         (fun _ _ _ F G => F o G)
         (fun _ _ _ _ _ _ _ => associativity _ _ _)
         (fun _ _ _ => left_identity _)
         (fun _ _ _ => right_identity _)
         (fun s d => HF s.2 d.2).
End sub_pre_cat.

Arguments sub_pre_cat {_} P {_}, {_} P _.

Definition strict_cat `{Funext} : PreCategory
  := sub_pre_cat (fun C => IsStrictCategory C).

(*Definition Cat `{Funext} : PreCategory.
  refine (@sub_pre_cat _ (fun C => IsCategory C) _).
  *)

(** ** The initial and terminal categories are initial and terminal objects in cat *)
Section objects.
  Context `{Funext}.

  Variable P : PreCategory -> Type.
  Context `{forall C, IsHProp (P C)}.
  Context `{HF : forall C D, P C -> P D -> IsHSet (Functor C D)}.

  Lemma is_terminal_object__is_terminal_category
        `(IsTerminalCategory one)
        (HT : P one)
  : IsTerminalObject (sub_pre_cat P HF) (one; HT).
  Proof.
    typeclasses eauto.
  Defined.

  Lemma is_initial_object__is_initial_category
        `(IsInitialCategory zero)
        (HI : P zero)
  : IsInitialObject (sub_pre_cat P HF) (zero; HI).
  Proof.
    typeclasses eauto.
  Defined.
End objects.


Require Import Infrastructure.
Require Import SourceProperty.
Require Import LR.
Require Import Assumed.
Require Import TargetProperty.
Require Import Disjoint.

(* ********************************************************************** *)
(** * Coercion Compatibility *)

Lemma E_coercion2 : forall A1 A2 A0 c p d d' e1 e2,
    sub d' A1 A2 c ->
    same_stctx d d' ->
    swfte d ->
    rel_d d p ->
    E A0 (mtsubst_in_sty p A1) e2 e1 ->
    E A0 (mtsubst_in_sty p A2) e2 (exp_capp c e1).
Proof with eauto.
  introv ? ? ? ? EH.
  apply E_sym in EH.
  apply E_sym.
  eapply E_coercion1...
Qed.

(* BEGIN_COERCION_COMPAT *)
Lemma coercion_compatibility1 : forall A0 A1 A2 c D G e1 e2,
    sub D A1 A2 c ->
    swfte D ->
    E_open D G e1 e2 A1 A0 ->
    E_open D G (exp_capp c e1) e2 A2 A0.
Proof with eauto using subtype_well_type, swft_wft, E_coercion1.
  introv Sub Uniq H.
  destruct H as (? & ? & ? & ? & EH).

  lets (? & ?): sub_swft Sub.

  splits...
  introv RelD RelG.
  specializes EH RelD RelG.
  autorewrite with lr_rewrite...
Qed.

Lemma coercion_compatibility2 : forall A0 A1 A2 c D G e1 e2,
    sub D A1 A2 c ->
    swfte D ->
    E_open D G e1 e2 A0 A1 ->
    E_open D G e1 (exp_capp c e2) A0 A2.
Proof with eauto using subtype_well_type, swft_wft, E_coercion2.
  introv Sub Uniq H.
  destruct H as (? & ? & ? & ? & EH).

  lets (? & ?): sub_swft Sub.

  splits...
  introv RelD RelG.
  specializes EH RelD RelG.
  autorewrite with lr_rewrite...
Qed.

Hint Extern 1 (swfte ?E) =>
  match goal with
  | H: has_type _ _ _ _ _ _ |- _ => apply (proj2 (proj2 (proj2 (styping_regular _ _ _ _ _ _ H))))
  end.

Hint Extern 1 (swft ?A ?B) =>
  match goal with
  | H: has_type _ _ _ _ _ _ |- _ => apply (proj1 (proj2 (proj2 (styping_regular _ _ _ _ _ _ H))))
  end.

Lemma disjoint_compatibility : forall Δ Γ E1 e1 A1 E2 e2 A2 dir dir',
    has_type Δ Γ E1 dir A1 e1 ->
    has_type Δ Γ E2 dir' A2 e2 ->
    disjoint Δ A1 A2 ->
    E_open Δ Γ e1 e2 A1 A2.
Proof with eauto using swft_wft, swfe_wfe, elaboration_well_type, swft_from_swfe, mtsubst_swft, uniq_from_swfte.
  introv Ty1 Ty2 Dis.
  splits...
  introv RelD RelG.
  forwards (? & ?): rel_d_uniq RelD.
  forwards : rel_d_same RelD...
  forwards Ty3 : elaboration_well_type Ty1...
  forwards Ty4 : elaboration_well_type Ty2...
  forwards (Ty5 & ?) : subst_close RelD RelG Ty3.
  forwards (? & Ty6) : subst_close RelD RelG Ty4.
  splits...
  lets (v1 & ? & ?) : normalization Ty5.
  lets (v2 & ? & ?) : normalization Ty6.
  exists v1 v2.
  splits...
  eapply disjoint_value...
  apply preservation_multi_step with (e := msubst_in_exp g1 (mtsubst_in_exp p e1))...
  apply preservation_multi_step with (e := msubst_in_exp g2 (mtsubst_in_exp p e2))...
Qed.

(* BEGIN_MERGE_COMPAT *)
Lemma pair_compatibility : forall D G e1 e2 e1' e2' A B A' B',
    E_open D G e1 e1' A A' ->
    E_open D G e2 e2' B B' ->
    swfte D ->
    disjoint D A B' ->
    disjoint D A' B ->
    E_open D G (exp_pair e1 e2) (exp_pair e1' e2') (sty_and A B) (sty_and A' B').
Proof with eauto using preservation_multi_step.
  introv EH1 EH2 Wfte Dis1 Dis2.

  destruct EH1 as (? & ? & ? & ? & EH1).
  destruct EH2 as (? & ? & ? & ? & EH2).

  splits; simpls...
  introv RelD RelG.
  specializes EH1 RelD RelG.
  specializes EH2 RelD RelG.

  destruct EH1 as (? & ? & ? & ? & v1 & v1' & ? & ? & ? & ? & VH1).
  destruct EH2 as (? & ? & ? & ? & v2 & v2' & ? & ? & ? & ? & VH2).

  splits; autorewrite with lr_rewrite; simpls...

  exists (exp_pair v1 v2) (exp_pair v1' v2').
  splits...

  apply V_andl...
  splits...
  apply V_andr...
  splits...
  eapply disjoint_value...
  apply V_andr...
  splits...
  eapply disjoint_value...
  eapply disjoint_symmetric...
Qed.


(* begin hide *)
From ITree Require Import
     Basics.Basics
     Basics.Category
     Core.ITreeDefinition
     Indexed.Sum.

Import ITreeNotations.
Local Open Scope itree_scope.

(* end hide *)
(** * General recursion *)

(** *** Mutual recursion *)

(* Implementation of the fixpoint combinator over interaction
 * trees.
 *
 * The implementation is based on the discussion here
 *   https://gmalecha.github.io/reflections/2018/compositional-coinductive-recursion-in-coq
 *)

(* The indexed type [D : Type -> Type] gives the signature of
   a set of functions. For example, a pair of mutually recursive
   [even : nat -> bool] and [odd : nat -> bool] can be declared
   as follows:

[[
   Inductive D : Type -> Type :=
   | Even : nat -> D bool
   | Odd  : nat -> D bool.
]]

   Their mutually recursive definition can then be written finitely
   (without [Fixpoint]):

[[
   Definition def : D ~> itree (D +' void1) := fun _ d =>
     match d with
     | Even n => match n with
                 | O => ret true
                 | S m => trigger (Odd m)
                 end
     | Odd n => match n with
                | O => ret false
                | S m => trigger (Even m)
                end
     end.
]]

   The function [interp_mrec] below then ties the knot.

[[
   Definition f : D ~> itree void1 :=
     interp_mrec def.

   Definition even (n : nat) : itree void1 bool := f _ (Even n).
   Definition odd  (n : nat) : itree void1 bool := f _ (Odd n).
]]

   The result is still in the [itree] monad of possibly divergent
   computations, because [mutfix_itree] doesn't care whether
   the mutually recursive definition is well-founded.

 *)

(** Interpret an itree in the context of a mutually recursive
    definition ([ctx]). *)
Definition interp_mrec {D E : Type -> Type}
           (ctx : D ~> itree (D +' E)) : itree (D +' E) ~> itree E :=
  fun R =>
    ITree.iter (fun t : itree (D +' E) R =>
      match observe t with
      | RetF r => Ret (inr r)
      | TauF t => Ret (inl t)
      | VisF (inl1 d) k => Ret (inl (ctx _ d >>= k))
      | VisF (inr1 e) k => Vis e (fun x => Ret (inl (k x)))
      end).

Arguments interp_mrec {D E} ctx [T].

(** Unfold a mutually recursive definition into separate trees,
    resolving the mutual references. *)
Definition mrec {D E : Type -> Type}
           (ctx : D ~> itree (D +' E)) : D ~> itree E :=
  fun R d => interp_mrec ctx (ctx _ d).

Arguments mrec {D E} ctx [T].

(** Make a recursive call in the handler argument of [mrec]. *)
Definition trigger_inl1 {D E : Type -> Type} : D ~> itree (D +' E)
  := fun _ d => ITree.trigger (inl1 d).

Arguments trigger_inl1 {D E} [T].

(** Here's some syntactic sugar with a notation [mrec-fix]. *)

(** Short for endofunctions, used in [mrec_fix] and [rec_fix]. *)
Local Notation endo T := (T -> T).

Definition mrec_fix {D E : Type -> Type}
           (ctx : endo (D ~> itree (D +' E)))
  : D ~> itree E
  := mrec (ctx trigger_inl1).

Notation "'mrec-fix' f d := g" :=
	(let D := _ in
	 mrec_fix (D := D) (fun (f : forall T, D T -> _) T (d : D T) => g))
  (at level 200, f name, d pattern).
(* No idea what a good level would be. *)

(** *** Simple recursion *)

Inductive callE (A B : Type) : Type -> Type :=
| Call : A -> callE A B B.

Arguments Call {A B}.

(** Get the [A] contained in a [callE A B]. *)
Definition unCall {A B T} (e : callE A B T) : A :=
  match e with
  | Call a => a
  end.

(** Lift a function on [A] to a morphism on [callE]. *)
Definition calling {A B} {F : Type -> Type}
           (f : A -> F B) : callE A B ~> F :=
  fun _ e =>
    match e with
    | Call a => f a
    end.

(* TODO: This is identical to [callWith] but [rec] finds a universe
   inconsistency with [calling], and not with [calling'].
   The inconsistency now pops up later (currently in [Events.Env]) *)
Definition calling' {A B} {F : Type -> Type}
           (f : A -> itree F B) : callE A B ~> itree F :=
  fun _ e =>
    match e with
    | Call a => f a
    end.

(* Interpret a single recursive definition. *)
Definition rec {E : Type -> Type} {A B : Type}
           (body : A -> itree (callE A B +' E) B) :
  A -> itree E B :=
  fun a => mrec (calling' body) (Call a).

(** An easy way to construct an event suitable for use with [rec].
    [call] is an event representing the recursive call.  Since in general, the
    function might have other events of type [E], the resulting itree has
    type [(callE A B +' E)].
*)
Definition call {E A B} (a:A) : itree (callE A B +' E) B := ITree.trigger (inl1 (Call a)).

(** Here's some syntactic sugar with a notation [mrec-fix]. *)

Definition rec_fix {E : Type -> Type} {A B : Type}
           (body : endo (A -> itree (callE A B +' E) B))
  : A -> itree E B
  := rec (body call).

Notation "'rec-fix' f a := g" := (rec_fix (fun f a => g))
  (at level 200, f name, a pattern).
(* No idea what a good level would be. *)


(* First a simplification of the bug *)

Set Printing Universes.

Inductive enc (A:Type (*1*)) (* : Type.1 *) := C : A -> enc A.

Definition id (X:Type(*4*)) (x:X) := x.

Lemma test : let S := Type(*5 : 6*) in enc S -> S.
simpl; intros.
refine (enc _).
apply id.
apply Prop.
Defined.

(* Then the original bug *)

Require Import List.

Inductive a : Set := (* some dummy inductive *)
b : (list a) -> a.   (* i don't know if this *)
                     (* happens for smaller  *)
                     (* ones                 *)

Inductive sg : Type := Sg. (* single *)

Definition ipl2 (P : a -> Type) :=   (* in Prop, that means P is true forall *)
  fold_right (fun x => fun A => prod (P x) A) sg. (* the elements of a given list         *)

Definition ind
     : forall S : a -> Type,
       (forall ls : list a, ipl2 S ls -> S (b ls)) -> forall s : a, S s :=
fun (S : a -> Type)
  (X : forall ls : list a, ipl2 S ls -> S (b ls)) =>
fix ind2 (s : a) :=
match s as a return (S a) with
| b l =>
    X l
      (list_rect (fun l0 : list a => ipl2 S l0) Sg
         (fun (a0 : a) (l0 : list a) (IHl : ipl2 S l0) =>
          pair (ind2 a0) IHl) l)
end. (* some induction principle *)

Arguments ind [S].

Lemma k : a -> Type. (* some ininteresting lemma *)
intro;pattern H;apply ind;intros.
  assert (K : Type).
    induction ls.
      exact sg.
      exact sg.
  exact (prod K sg).
Defined.

Lemma k' : a -> Type. (* same lemma but with our bug *)
intro;pattern H;apply ind;intros.
  refine (prod _ _).
    induction ls.
      exact sg.
      exact sg.
    exact sg. (* Proof complete *)
Defined. (* bug *)


(* Mohamed Sami Cherif and Paolo Torrini,
   Universite' Lille-1 - CRIStAL-CNRS
*)
(* Pip base module *)

Require Import EnvLibA.
Require Import PRelLibA.
Require Import IdModTypeA.

Require Import Coq.Lists.List.
Require Import Coq.Strings.String.
Require Import Coq.Arith.PeanoNat.
Require Import Coq.Arith.Peano_dec.
Require Import Coq.Arith.EqNat.
Require Import Pip_state.

Module IdModP <: IdModType.

  Definition Id := string.

  Definition IdEqDec := string_dec.

  Instance IdEq2 : DEq Id :=
  {
  dEq := IdEqDec
  }.

  Definition IdEq := IdEq2.

  Definition W := state.

  Definition Loc_PI := valTyp_irrelevance.

  Definition BInit := {|
          currentPartition :=  defaultPage;
          memory:= @nil (paddr * value);
                      |}.

  Instance WP2 : PState W :=
  {
  loc_pi := Loc_PI;

  b_init := BInit
  }.

  Definition WP := WP2.

End IdModP.


Require Import VST.floyd.base2.
Require Import VST.floyd.client_lemmas.
Import LiftNotation.
Import compcert.lib.Maps.
Local Open Scope logic.

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.
#[export] 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.

#[export] Hint Rewrite subst_eval_id_eq : subst.
#[export] Hint Rewrite subst_eval_id_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 => `(if complete_type cenv_cs t
                             then Vptrofs (Ptrofs.repr (sizeof t))
                             else Vundef)
 | Ealignof t ty => `(if complete_type cenv_cs t
                              then Vptrofs (Ptrofs.repr (alignof t))
                              else Vundef)
 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.
      auto.
-
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.

#[export] 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.
#[export] Hint Rewrite @closed_wrt_map_subst using safe_auto_with_closed : subst.
#[export] 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.

#[export] 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.
#[export] Hint Rewrite @closed_wrt_subst_eval_expr using solve [auto 50 with closed] : subst.
#[export] Hint Rewrite @closed_wrt_subst_eval_lvalue using solve [auto 50 with closed] : subst.

#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] Hint Resolve closed_wrtl_eval_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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.

Definition closed_wrt_emp_mpred := @closed_wrt_emp mpred Nveric Sveric.
Definition closed_wrtl_emp_mpred := @closed_wrtl_emp mpred Nveric Sveric.
#[export] Hint Resolve closed_wrt_emp_mpred closed_wrtl_emp_mpred  : 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.
#[export] Hint Resolve closed_wrt_allp closed_wrtl_allp : closed.

Lemma closed_wrt_not1:
  forall (i j: ident),
   i<>j ->
   not (eq i j).
Proof.
intros.
hnf.
intros; subst; congruence.
Qed.
#[export] 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.

#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.

#[export] 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.

#[export] 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.
#[export] Hint Resolve expr_closed_tempvar expr_closedl_tempvar : closed.

#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.

#[export] Hint Extern 2 (closed_wrt_vars (eq _) (@eval_expr _ _)) => (apply closed_eval_expr_e; reflexivity) : closed.
#[export] 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.

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.

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.

#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
destruct (typeof e1)  as [ | _ [ | ] _ | | | | | | | ];
destruct (typeof e2)  as [ | _ [ | ] _ | | | | | | | ];
rewrite <- H; auto;
rewrite <- H0; auto.
Qed.
#[export] 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;
repeat simple_if_tac; auto with closed;
destruct (typeof e2); auto with closed;
destruct s; auto with closed.
Qed.

#[export] 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)) as [[? [|]]|]; simpl; auto with closed.
 destruct (union_field_offset cenv_cs i (co_members c)) as [[[ | | ] [|]]|]; 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)) as [[? [|]]|]; simpl; auto with closed.
 destruct (union_field_offset cenv_cs i (co_members c)) as [[[ | | ] [|]]|]; simpl; auto with closed.
Qed.

#[export] Hint Resolve closed_wrt_tc_expr : closed.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.

#[export] 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.
#[export] 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.
#[export] 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.
#[export] 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.
#[export] Hint Resolve in_map_fst2 : 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.
#[export] Hint Resolve Forall_map_cons Forall_map_nil : closed.
#[export] Hint Resolve Forall_cons Forall_nil : closed.