Require Import VST.veric.juicy_base.
Require Import VST.veric.juicy_mem VST.veric.juicy_mem_lemmas VST.veric.juicy_mem_ops.
Require Import VST.veric.res_predicates.
Require Import VST.veric.extend_tc.
Require Import VST.veric.Clight_seplog.
Require Import VST.veric.Clight_assert_lemmas.
Require Import VST.veric.Clight_new.
Require Import VST.sepcomp.extspec.
Require Import VST.sepcomp.step_lemmas.
Require Import VST.veric.tycontext.
Require Import VST.veric.expr2.
Require Import VST.veric.expr_lemmas.
Require Import VST.veric.juicy_extspec.
Require Import VST.veric.semax.
Require Import VST.veric.Clight_lemmas.
Require Import VST.veric.own.

Local Open Scope pred.

Hint Resolve @now_later @andp_derives @sepcon_derives.

Lemma no_dups_swap:
  forall F V a b c, @no_dups F V (a++b) c -> @no_dups F V (b++a) c.
Proof.
(* Goal: forall (F V : Type) (a b : list (prod ident F)) (c : list (prod ident (globvar V))) (_ : @no_dups F V (@app (prod ident F) a b) c), @no_dups F V (@app (prod ident F) b a) c *)
unfold no_dups; intros.
(* Goal: @list_norepet ident (@app ident (@map (prod ident F) ident (@fst ident F) (@app (prod ident F) b a)) (@map (prod ident (globvar V)) ident (var_name V) c)) *)
rewrite map_app in *.
(* Goal: @list_norepet ident (@app ident (@app ident (@map (prod ident F) ident (@fst ident F) b) (@map (prod ident F) ident (@fst ident F) a)) (@map (prod ident (globvar V)) ident (var_name V) c)) *)
forget (map (@fst _ _) b) as bb.
(* Goal: @list_norepet ident (@app ident (@app ident bb (@map (prod ident F) ident (@fst ident F) a)) (@map (prod ident (globvar V)) ident (var_name V) c)) *)
forget (map (@fst _ _) a) as aa.
(* Goal: @list_norepet ident (@app ident (@app ident bb aa) (@map (prod ident (globvar V)) ident (var_name V) c)) *)
forget (map (var_name V) c) as cc.
(* Goal: @eq (option cont) (find_label lbl s k2) (@Some (list cont') (@app cont' x k2)) *)
clear - H.
(* Goal: @list_norepet ident (@app ident (@app ident bb aa) cc) *)
destruct (list_norepet_append_inv _ _ _ H) as [? [? ?]].
(* Goal: @list_norepet ident (@app ident (@app ident bb aa) cc) *)
apply list_norepet_append; auto.
(* Goal: @list_norepet ident (@app ident bb aa) *)
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
apply list_norepet_append_commut; auto.
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
clear - H2.
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
unfold Coqlib.list_disjoint in *.
(* Goal: forall (x y : ident) (_ : @In ident x (@app ident bb aa)) (_ : @In ident y cc), not (@eq ident x y) *)
intros; apply H2; auto.
(* Goal: @eq (option cont) (find_label lbl s k2) (@Some (list cont') (@app cont' x k2)) *)
clear - H.
(* Goal: @In ident x (@app ident aa bb) *)
rewrite in_app in *.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
intuition.
Qed.

Lemma join_sub_share_top: forall sh, join_sub Share.top sh -> sh = Share.top.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @eq Share.t sh Share.top *)
generalize (top_correct' sh); intro.
(* Goal: @eq Share.t sh Share.top *)
apply join_sub_antisym; auto.
Qed.


Lemma opt2list2opt: forall {A:Type} (l: option A), list2opt (opt2list l) = l.
(* Goal: forall (A : Type) (l : option A), @eq (option A) (@list2opt A (@opt2list A l)) l *)
destruct l; auto.
Qed.


Lemma nat_of_Z_minus_le : forall z a b,
  b <= a ->
  (nat_of_Z (z - a) <= nat_of_Z (z - b))%nat.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: le (nat_of_Z (Z.sub z a)) (nat_of_Z (Z.sub z b)) *)
  apply inj_le_rev.
(* Goal: Z.le (Z.of_nat (nat_of_Z (Z.sub z a))) (Z.of_nat (nat_of_Z (Z.sub z b))) *)
  do 2 rewrite nat_of_Z_max.
(* Goal: Z.le Z0 (Z.max (Z.sub z b) Z0) *)
  rewrite Coqlib.Zmax_spec.
(* Goal: Z.le (if zlt Z0 (Z.sub z a) then Z.sub z a else Z0) (Z.max (Z.sub z b) Z0) *)
  destruct (zlt 0 (z-a)).
(* Goal: Z.le Z0 (Z.max (Z.sub z b) Z0) *)
  rewrite Coqlib.Zmax_spec.
(* Goal: Z.le (Z.sub z a) (if zlt Z0 (Z.sub z b) then Z.sub z b else Z0) *)
(* Goal: Z.le Z0 (Z.max (Z.sub z b) Z0) *)
  destruct (zlt 0 (z-b)).
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
  omega.
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
  omega.
(* Goal: Z.le Z0 (Z.max (Z.sub z b) Z0) *)
  rewrite Coqlib.Zmax_spec.
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
  destruct (zlt 0 (z-b)); omega.
Qed.

Section SemaxContext.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma universal_imp_unfold {A} {agA: ageable A}:
   forall B (P Q: B -> pred A) w,
     (ALL psi : B, P psi --> Q psi) w = (forall psi : B, (P psi --> Q psi) w).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
apply prop_ext; split; intros.
(* Goal: @app_pred A agA Q n *)
eapply H; eauto.
(* Goal: @app_pred A agA (@allp A agA B (fun psi : B => @imp A agA (P psi) (Q psi))) w *)
intro b; apply H.
Qed.

Lemma guard_environ_put_te':
 forall ge te ve Delta id v k,
 guard_environ Delta k (mkEnviron ge ve te)  ->
    (forall t,
        (temp_types Delta) ! id = Some t -> tc_val' t v) ->
 guard_environ Delta k (mkEnviron ge ve (Map.set id v te)).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
(* Goal: guard_environ Delta k (mkEnviron ge ve (@Map.set val id v te)) *)
 destruct H; split.
(* Goal: typecheck_environ Delta (mkEnviron ge ve (@Map.set val id v te)) *)
(* Goal: match k with | Some f' => and (match_venv (ve_of (mkEnviron ge ve (@Map.set val id v te))) (fn_vars f')) (@eq type (ret_type Delta) (fn_return f')) | None => True end *)
 apply typecheck_environ_put_te; auto.
(* Goal: match k with | Some f' => and (match_venv (ve_of (mkEnviron ge ve (@Map.set val id v te))) (fn_vars f')) (@eq type (ret_type Delta) (fn_return f')) | None => True end *)
 destruct k; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma prop_imp_derives {A}{agA: ageable A}:
  forall (P: Prop) (Q Q': pred A),  (P -> Q |-- Q') -> !!P --> Q |-- !!P --> Q'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
 repeat intro.
(* Goal: @app_pred A agA Q' a' *)
 apply H; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma prop_imp {A}{agA: ageable A}:
  forall (P: Prop) (Q Q': pred A),  (P -> Q = Q') -> !!P --> Q = !!P --> Q'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @eq (@pred A agA) (@imp A agA (@prop A agA P) Q) (@imp A agA (@prop A agA P) Q') *)
  apply pred_ext; apply prop_imp_derives.
  + intros; rewrite H by auto; auto.
  + intros; rewrite H by auto; auto.
Qed.

Lemma age_laterR {A} `{ageable A}: forall {x y}, age x y -> laterR x y.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros. constructor 1; auto.
Qed.
Hint Resolve @age_laterR.

Lemma typecheck_environ_sub:
  forall Delta Delta', tycontext_sub Delta Delta' ->
   forall rho,
   typecheck_environ Delta' rho -> typecheck_environ Delta rho.
Proof.
intros ? ? [? [? [? [? Hs]]]] ?  [? [? ?]].
split; [ | split].
* clear - H H3.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 hnf; intros.
 specialize (H id); rewrite H0 in H.
 destruct ((temp_types Delta') ! id) eqn:?H; try contradiction.
 destruct H; subst.
 specialize (H3 id ty H1).
 destruct H3 as [v [? ?]].
 exists v; split; auto.
* clear - H0 H4.
  red in H4|-*.
 intros id ty. specialize (H4 id ty). rewrite <- H4.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
 rewrite H0. clear; intuition.
* clear - H2 H5.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 hnf; intros. eapply H5.
 specialize (H2 id). hnf in H2. rewrite H in H2. eauto.
Qed.

Lemma funassert_resource: forall Delta rho a a' (Hl: level a = level a')
  (Hr: resource_at a = resource_at a'),
  funassert Delta rho a -> funassert Delta rho a'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
  destruct H as [H1 H2]; split; repeat intro.
  - destruct (H1 _ _ _ (rt_refl _ _ _) H0) as (b1 & ? & ?).
(* Goal: @app_pred rmap ag_rmap (@exp rmap ag_rmap block (fun b1 : block => @andp rmap ag_rmap (@prop rmap ag_rmap (@eq (option block) (@Map.get block (ge_of rho) b) (@Some block b1))) (func_at b0 (@pair block Z b1 Z0)))) a'0 *)
    exists b1; split; auto.
    destruct b0; simpl in *.
(* Goal: @eq resource (resource_at a'0 (@pair block Z b1 Z0)) (PURE (FUN f c) (SomeP (SpecTT A) (fun (i : list Type) (a : _functor (dependent_type_functor_rec i A) (@pred rmap ag_rmap)) (a0 : bool) (a1 : environ) => approx (@level rmap ag_rmap a'0) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a) a0 a1)))) *)
    rewrite Hr in H4.
(* Goal: @ex preds (fun b0 : preds => @eq resource (resource_at a' (@pair block Z b Z0)) (PURE (FUN f c) (preds_fmap (approx (@level rmap ag_rmap a')) (approx (@level rmap ag_rmap a')) b0))) *)
    pose proof (necR_level _ _ H).
    eapply necR_PURE in H; eauto.
(* Goal: @eq resource (resource_at a'0 (@pair block Z b1 Z0)) (PURE (FUN f c) (SomeP (SpecTT A) (fun (i : list Type) (a : _functor (dependent_type_functor_rec i A) (@pred rmap ag_rmap)) (a0 : bool) (a1 : environ) => approx (@level rmap ag_rmap a'0) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a) a0 a1)))) *)
    rewrite H; simpl; f_equal; f_equal.
(* Goal: @eq (forall (i : list Type) (_ : _functor (dependent_type_functor_rec i A) (@pred rmap ag_rmap)) (_ : bool) (_ : environ), @pred rmap ag_rmap) (fun (i : list Type) (a0 : _functor (dependent_type_functor_rec i A) (@pred rmap ag_rmap)) (a1 : bool) (a2 : environ) => approx (@level rmap ag_rmap a'0) (approx (@level rmap ag_rmap a) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a)) (approx (@level rmap ag_rmap a)) (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a0)) a1 a2))) (fun (i : list Type) (a : _functor (dependent_type_functor_rec i A) (@pred rmap ag_rmap)) (a0 : bool) (a1 : environ) => approx (@level rmap ag_rmap a'0) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a) a0 a1)) *)
    extensionality i a0 a1 a2.
    match goal with |-context[compcert_rmaps.R.approx ?a (approx ?b ?c)] =>
      change (compcert_rmaps.R.approx a (approx b c)) with ((approx a oo approx b) c) end.
(* Goal: @eq (@pred rmap ag_rmap) (@compose (@pred rmap ag_rmap) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a)) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a)) (approx (@level rmap ag_rmap a)) (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a0)) a1 a2)) (approx (@level rmap ag_rmap a'0) (@packPQ A P Q i (@fmap (dependent_type_functor_rec i A) (@pred rmap ag_rmap) (@pred rmap ag_rmap) (approx (@level rmap ag_rmap a'0)) (approx (@level rmap ag_rmap a'0)) a0) a1 a2)) *)
    rewrite fmap_app, approx_oo_approx', approx'_oo_approx by omega; auto.
  - specialize (H2 b b0).
    destruct b0; simpl in *.
(* Goal: @ex ident (fun b0 : ident => and (@eq (option block) (@Map.get block (ge_of rho) b0) (@Some block b)) (@ex funspec (fun fs : funspec => @eq (option funspec) (@PTree.get funspec b0 (glob_specs Delta)) (@Some funspec fs)))) *)
    apply (H2 _ (rt_refl _ _ _)).
(* Goal: @ex preds (fun b0 : preds => @eq resource (resource_at a (@pair block Z b Z0)) (PURE (FUN f c) (preds_fmap (approx (@level rmap ag_rmap a)) (approx (@level rmap ag_rmap a)) b0))) *)
    rewrite Hr, Hl.
(* Goal: @ex preds (fun b0 : preds => @eq resource (resource_at a' (@pair block Z b Z0)) (PURE (FUN f c) (preds_fmap (approx (@level rmap ag_rmap a')) (approx (@level rmap ag_rmap a')) b0))) *)
    destruct H0 as [p Hp].
(* Goal: @ex preds (fun b0 : preds => @eq resource (resource_at a' (@pair block Z b Z0)) (PURE (FUN f c) (preds_fmap (approx (@level rmap ag_rmap a')) (approx (@level rmap ag_rmap a')) b0))) *)
    pose proof (necR_level _ _ H).
    rewrite <- resource_at_approx.
    eapply necR_PURE' in H as [? ->]; simpl; eauto.
Qed.

Lemma cl_corestep_fun': forall ge, corestep_fun (cl_core_sem ge).
Proof.  repeat intro. eapply cl_corestep_fun; simpl in *; eauto. Qed.
Hint Resolve cl_corestep_fun'.

Lemma derives_skip:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {CS: compspecs} {Espec: OracleKind} p Delta (R: ret_assert),
      (forall rho, p rho |-- proj_ret_assert R EK_normal None rho) ->
(* Goal: EqDec floatsize *)
        semax Espec Delta p Clight.Sskip R.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros ? ? ? ?; intros.
(* Goal: @semax CS Espec Delta p Sskip R *)
intros n.
(* Goal: @eq Prop (@app_pred nat ag_nat (@semax' CS Espec Delta P c R) w) (forall _ : @app_pred nat ag_nat (@TT nat ag_nat) w, @app_pred nat ag_nat (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) w) *)
rewrite semax_fold_unfold.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat genv (fun gx : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv gx) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' gx Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta' (frame_ret_assert R F) k)) (guard Espec gx Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) n *)
intros psi Delta'.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))) n *)
apply prop_imp_i; intros [? HGG].
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars Sskip F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k)))))) n *)
clear H0 Delta. rename Delta' into Delta.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@believe CS Espec Delta psi Delta) (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars Sskip F)) (rguard Espec psi Delta (frame_ret_assert R F) k)) (guard Espec psi Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k)))))) n *)
intros ?w _ _. clear n.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars Sskip F)) (rguard Espec psi Delta (frame_ret_assert R F) k)) (guard Espec psi Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k))))) w *)
intros k F.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars Sskip F)) (rguard Espec psi Delta (frame_ret_assert R F) k)) (guard Espec psi Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k))) w *)
intros ?w _ ?.
(* Goal: @app_pred nat ag_nat (guard Espec psi Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k)) w0 *)
clear w. rename w0 into n.
(* Goal: @app_pred nat ag_nat (guard Espec psi Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho)) (@cons cont' (Kseq Sskip) k)) n *)
intros te ve w ?.
(* Goal: @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) (construct_rho (filter_genv psi) ve te))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv psi) ve te)) (p (construct_rho (filter_genv psi) ve te)))) (funassert Delta (construct_rho (filter_genv psi) ve te))) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) (construct_rho (filter_genv psi) ve te))) w *)
destruct H0 as [H0' H0].
(* Goal: @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) (construct_rho (filter_genv psi) ve te))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv psi) ve te)) (p (construct_rho (filter_genv psi) ve te)))) (funassert Delta (construct_rho (filter_genv psi) ve te))) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) (construct_rho (filter_genv psi) ve te))) w *)
specialize (H0 EK_normal None te ve w H1).
(* Goal: @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) (construct_rho (filter_genv psi) ve te))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv psi) ve te)) (p (construct_rho (filter_genv psi) ve te)))) (funassert Delta (construct_rho (filter_genv psi) ve te))) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) (construct_rho (filter_genv psi) ve te))) w *)
simpl exit_cont in H0.
(* Goal: @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) (construct_rho (filter_genv psi) ve te))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv psi) ve te)) (p (construct_rho (filter_genv psi) ve te)))) (funassert Delta (construct_rho (filter_genv psi) ve te))) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) (construct_rho (filter_genv psi) ve te))) w *)
simpl in H0'. clear n H1. remember ((construct_rho (filter_genv psi) ve te)) as rho.
(* Goal: @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) rho)) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho))) (funassert Delta rho)) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) rho)) w *)
revert w H0.
(* Goal: forall (w : rmap) (_ : @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function k) rho)) (proj_ret_assert (frame_ret_assert R F) EK_normal (@None val) rho)) (funassert Delta rho)) (assert_safe Espec psi ve te k rho)) w), @app_pred rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function (@cons cont' (Kseq Sskip) k)) rho)) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (p rho))) (funassert Delta rho)) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) rho)) w *)
apply imp_derives; auto.
(* Goal: @derives rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) *)
apply andp_derives; auto.
(* Goal: @derives rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) *)
apply andp_derives; auto.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
repeat intro. (* simpl exit_tycon. *)
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
simpl.
(* Goal: @app_pred rmap ag_rmap (RA_normal (frame_ret_assert R F) rho) a *)
(* Goal: @derives rmap ag_rmap (assert_safe Espec psi ve te k rho) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) rho) *)
specialize (H rho). destruct R; simpl in H. simpl tycontext.RA_normal.
(* Goal: @eq (@pred A AG) (@sepcon A JA PA AG XA P (@FF A AG)) (@FF A AG) *)
rewrite sepcon_comm.
(* Goal: @app_pred rmap ag_rmap (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (RA_normal rho)) a *)
(* Goal: @derives rmap ag_rmap (assert_safe Espec psi ve te k rho) (assert_safe Espec psi ve te (@cons cont' (Kseq Sskip) k) rho) *)
eapply sepcon_derives; try apply H0; auto.

(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
repeat intro.
(* Goal: @ex ghost (fun b : ghost => and (@joins ghost ghost_join b (ghost_fmap (approx (@level rmap ag_rmap a)) (approx (@level rmap ag_rmap a)) c)) (@ex rmap (fun m' : rmap => and (@eq nat (@level rmap ag_rmap m') (@level rmap ag_rmap a)) (and (@eq (forall _ : AV.address, resource) (resource_at m') (resource_at a)) (and (@eq ghost (ghost_of m') b) (@app_pred rmap ag_rmap (@exist (forall _ : rmap, Prop) (fun p : forall _ : rmap, Prop => @hereditary rmap (@age rmap ag_rmap) p) (fun w : rmap => forall (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) w) (_ : @eq environ rho (construct_rho (filter_genv psi) ve te)) (_ : @eq rmap (m_phi jm) w), @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap w) ora (State ve te (@cons cont' (Kseq Sskip) k)) jm) (semax.assert_safe_obligation_1 Espec psi ve te (@cons cont' (Kseq Sskip) k) rho)) m')))))) *)
destruct (H0 _ H1) as (b & ? & m' & ? & ? & ? & HP).
(* Goal: @ex ghost (fun b : ghost => and (@joins ghost ghost_join b (ghost_fmap (approx (@level rmap ag_rmap a)) (approx (@level rmap ag_rmap a)) c)) (@ex rmap (fun m' : rmap => and (@eq nat (@level rmap ag_rmap m') (@level rmap ag_rmap a)) (and (@eq (forall _ : AV.address, resource) (resource_at m') (resource_at a)) (and (@eq ghost (ghost_of m') b) (@app_pred rmap ag_rmap (@exist (forall _ : rmap, Prop) (fun p : forall _ : rmap, Prop => @hereditary rmap (@age rmap ag_rmap) p) (fun w : rmap => forall (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) w) (_ : @eq environ rho (construct_rho (filter_genv psi) ve te)) (_ : @eq rmap (m_phi jm) w), @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap w) ora (State ve te (@cons cont' (Kseq Sskip) k)) jm) (semax.assert_safe_obligation_1 Espec psi ve te (@cons cont' (Kseq Sskip) k) rho)) m')))))) *)
exists b; split; auto; exists m'; repeat split; auto.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
repeat intro.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap m') ora (State ve te (@cons cont' (Kseq Sskip) k)) jm *)
specialize (HP ora jm H6 H7 H8).
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap m') ora (State ve te (@cons cont' (Kseq Sskip) k)) jm *)
destruct (@level rmap _ m').
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
constructor.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (S n) ora (State ve te (@cons cont' (Kseq Sskip) k)) jm *)
apply convergent_controls_jsafe with (State ve te k); auto.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
simpl.

(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
destruct H9 as [? [? ?]].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
split3; auto.

econstructor; eauto.
Qed.

Lemma jsafe_corestep_forward:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} ge c m c' m' n z,
    jstep (cl_core_sem ge) c m c' m' -> jsafeN (@OK_spec Espec) ge (S n) z c m ->
    jm_bupd z (jsafeN (@OK_spec Espec) ge n z c') m'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @ex corestate (fun st' : corestate => @ex juicy_mem (fun m' : juicy_mem => and (@jstep corestate (cl_core_sem psi) st m st' m') (@jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora st') m'))) *)
  inv H0.
  assert ((c',m') = (c'0,m'0)).
  { eapply juicy_core_sem_preserves_corestep_fun with (csem := cl_core_sem ge); eauto. }
(* Goal: @semantics.corestep corestate mem (cl_core_sem ge) (State ve te k) (m_dry m) c' (m_dry m') *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n0) ora (State ve te k) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge n ora (State ve te k) m *)
  inv H0; auto.
  setoid_rewrite (semantics.corestep_not_at_external (juicy_core_sem _)) in H2; eauto; congruence.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_unfold {CS: compspecs} {Espec: OracleKind}:
  semax Espec = fun Delta P c R =>
(* Goal: EqDec floatsize *)
    forall (psi: Clight.genv) Delta' (w: nat)
          (TS: tycontext_sub Delta Delta')
          (HGG: genv_cenv psi = cenv_cs)
           (Prog_OK: believe Espec Delta' psi Delta' w) (k: cont) (F: assert),
        closed_wrt_modvars c F ->
       rguard Espec psi Delta' (frame_ret_assert R F) k w ->
       guard Espec psi Delta' (fun rho => F rho * P rho) (Kseq c :: k) w.
Proof.
(* Goal: @eq Prop (@app_pred nat ag_nat (@semax' CS Espec Delta P c R) w) (forall _ : @app_pred nat ag_nat (@TT nat ag_nat) w, @app_pred nat ag_nat (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) w) *)
unfold semax; rewrite semax_fold_unfold.
(* Goal: @eq (forall (_ : tycontext) (_ : assert) (_ : statement) (_ : ret_assert), Prop) (fun (Delta : tycontext) (P : assert) (c : statement) (Q : ret_assert) => forall n : nat, @app_pred nat ag_nat (@allp nat ag_nat genv (fun gx : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv gx) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' gx Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta' (frame_ret_assert Q F) k)) (guard Espec gx Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) n) (fun (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert) => forall (psi : genv) (Delta' : tycontext) (w : nat) (_ : tycontext_sub Delta Delta') (_ : @eq composite_env (genv_cenv psi) (@cenv_cs CS)) (_ : @app_pred nat ag_nat (@believe CS Espec Delta' psi Delta') w) (k : cont) (F : assert) (_ : closed_wrt_modvars c F) (_ : @app_pred nat ag_nat (rguard Espec psi Delta' (frame_ret_assert R F) k) w), @app_pred nat ag_nat (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)) w) *)
extensionality Delta P c R.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
apply prop_ext; split; intros.
eapply (H w); eauto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto. split; auto.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat genv (fun gx : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv gx) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' gx Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta' (frame_ret_assert R F) k)) (guard Espec gx Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) n *)
intros psi Delta'.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))) n *)
apply prop_imp_i; intros [? HGG].
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))) n *)
intros w' ? ? k F w'' ? [? ?].
(* Goal: @app_pred A agA Q n *)
eapply H; eauto.
eapply pred_nec_hereditary; eauto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Fixpoint list_drop (A: Type) (n: nat) (l: list A) {struct n} : list A :=
  match n with O => l | S i => match l with nil => nil | _ :: l' => list_drop A i l' end end.
Arguments list_drop [A] _ _.

(* Goal: EqDec floatsize *)
Definition straightline (c: Clight.statement) :=
 forall ge ve te k m ve' te' k' m',
        cl_step ge (State ve te (Kseq c :: k)) m (State ve' te' k') m' ->  k=k'.

Lemma straightline_assign: forall e0 e, straightline (Clight.Sassign e0 e).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
unfold straightline; intros.
(* Goal: @eq (option (@psepalg.lifted A JA)) a b *)
inv H; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma extract_exists_pre_later {CS: compspecs} {Espec: OracleKind}:
  forall  (A : Type) (Q: assert) (P : A -> assert) c Delta (R: ret_assert),
  (forall x, semax Espec Delta (fun rho => Q rho && |> P x rho) c R) ->
   semax Espec Delta (fun rho => Q rho && |> exp (fun x => P x rho)) c R.
Proof.
rewrite semax_unfold in *.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (@exp rmap ag_rmap A (fun x : A => P x rho))) (@cons cont' (Kseq c) k)) w *)
intros te ve ?w ? ?w ? ?.
destruct H4.
destruct H4.
destruct H6 as [w2 [w3 [? [? [HQ ?]]]]].
destruct (age1 w2) as [w2' | ] eqn:?.
*
destruct (@age1_join _ _ _ _ _ _ _ _ H6 Heqo)
  as [w3' [w1' [? [? ?]]]].
hnf in H8.
specialize (H8 _ (age_laterR H10)).
destruct H8 as [x H8].
specialize (H x psi Delta' w TS HGG Prog_OK k F H0 H1).
unfold guard, _guard in H.
specialize (H te ve).
cbv beta in H.
specialize (H w0 H2 w1 H3).
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
apply H.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto. split; auto.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
exists w2, w3. split3; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
intros w3x ?.
eapply pred_nec_hereditary; [ | apply H8].
clear - H10 H12.
eapply age_later_nec; eauto.
*
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
assert (level w1 = O). {
  clear - H6 Heqo.
  apply join_level in H6. destruct H6.
  rewrite <- H. apply age1_level0.  auto.
}
hnf.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
eexists; split.
apply H10.
exists w1.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
split3; auto. split; auto.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
simpl.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
rewrite H9.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
constructor.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma extract_exists_pre {CS: compspecs} {Espec: OracleKind}:
  forall  (A : Type) (P : A -> assert) c Delta (R: ret_assert),
  (forall x, semax Espec Delta (P x) c R) ->
   semax Espec Delta (fun rho => exp (fun x => P x rho)) c R.
Proof.
rewrite semax_unfold in *.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (@exp rmap ag_rmap A (fun x : A => P x rho))) (@cons cont' (Kseq c) k)) w *)
intros te ve ?w ? ?w ? ?.
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec psi ve te (@cons cont' (Kseq c) k) (construct_rho (filter_genv psi) ve te)) w1 *)
rewrite exp_sepcon2 in H4.
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec psi ve te (@cons cont' (Kseq c) k) (construct_rho (filter_genv psi) ve te)) w1 *)
destruct H4 as [[TC [x H5]] ?].
(*destruct H4 as [[[TC [x H5]] ?] ?].*)
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec psi ve te (@cons cont' (Kseq c) k) (construct_rho (filter_genv psi) ve te)) w1 *)
specialize (H x).
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec psi ve te (@cons cont' (Kseq c) k) (construct_rho (filter_genv psi) ve te)) w1 *)
specialize (H psi Delta' w TS HGG Prog_OK k F H0).
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
spec H. {
 clear - H1.
 unfold rguard in *.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => _guard Espec psi Delta' (proj_ret_assert (frame_ret_assert R F) ek vl) (current_function k) (exit_cont ek vl k)))) w *)
 intros ek vl tx vx. specialize (H1 ek vl tx vx).
(* Goal: @app_pred nat ag_nat (let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R (fun rho0 : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho0) (F rho0))) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
 red in H1.
(* Goal: @app_pred nat ag_nat (let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R F) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
 eapply subp_trans'; [| apply H1 ].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))))) w *)
 apply derives_subp.
(* Goal: @derives rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) (construct_rho (filter_genv psi) vx tx))) (proj_ret_assert (frame_ret_assert R F) ek vl (construct_rho (filter_genv psi) vx tx))) (funassert Delta' (construct_rho (filter_genv psi) vx tx))) *)
 apply andp_derives; auto.
}
(* Goal: @app_pred A agA Q n *)
eapply H; eauto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
Qed.

Definition G0: funspecs := nil.

(* Goal: EqDec floatsize *)
Definition empty_genv prog_pub cenv: Clight.genv :=
(* Goal: EqDec floatsize *)
   Build_genv (Genv.globalenv (AST.mkprogram (F:=Clight.fundef)(V:=type) nil prog_pub (1%positive))) cenv.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma empty_program_ok {CS: compspecs} {Espec: OracleKind}: forall Delta ge w,
    glob_specs Delta = PTree.empty _ ->
    believe Espec Delta ge Delta w.
Proof.
(* Goal: forall (Delta : tycontext) (ge : genv) (w : nat) (_ : @eq (PTree.t funspec) (glob_specs Delta) (PTree.empty funspec)), @app_pred nat ag_nat (@believe CS Espec Delta ge Delta) w *)
intros Delta ge w ?.
(* Goal: @app_pred nat ag_nat (@believe CS Espec Delta ge Delta) w *)
intro b.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat funsig (fun fsig : funsig => @allp nat ag_nat calling_convention (fun cc : calling_convention => @allp nat ag_nat TypeTree (fun A : TypeTree => @allp nat ag_nat (forall ts : list Type, _functor (dependent_type_functor_rec ts (AssertTT A)) (@pred rmap ag_rmap)) (fun P : forall ts : list Type, _functor (dependent_type_functor_rec ts (AssertTT A)) (@pred rmap ag_rmap) => @allp nat ag_nat (forall ts : list Type, _functor (dependent_type_functor_rec ts (AssertTT A)) (@pred rmap ag_rmap)) (fun Q : forall ts : list Type, _functor (dependent_type_functor_rec ts (AssertTT A)) (@pred rmap ag_rmap) => @imp nat ag_nat (@prop nat ag_nat (claims ge Delta b fsig cc A P Q)) (@orp nat ag_nat (believe_external Espec ge b fsig cc A P Q) (@believe_internal CS Espec ge Delta b fsig cc A P Q)))))))) w *)
intros fsig cc A P Q.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@prop nat ag_nat (claims ge Delta b fsig cc A P Q)) (@orp nat ag_nat (believe_external Espec ge b fsig cc A P Q) (@believe_internal CS Espec ge Delta b fsig cc A P Q))) w *)
intros ?n ? ?.
(* Goal: @app_pred nat ag_nat (@orp nat ag_nat (believe_external Espec ge b fsig cc A P Q) (@believe_internal CS Espec ge Delta b fsig cc A P Q)) n *)
destruct H1 as [id [? [b0 [? ?]]]].
(* Goal: @app_pred nat ag_nat (@orp nat ag_nat (believe_external Espec ge b fsig cc A P Q) (@believe_internal CS Espec ge Delta b fsig cc A P Q)) n *)
rewrite H in H1. rewrite PTree.gempty in H1.
(* Goal: @app_pred nat ag_nat (@orp nat ag_nat (believe_external Espec ge b fsig cc A P Q) (@believe_internal CS Espec ge Delta b fsig cc A P Q)) n *)
inv H1.
Qed.

Definition all_assertions_computable  :=
  forall (Espec: OracleKind) psi tx vx (Q: assert), 
     exists k,  assert_safe Espec psi tx vx k = Q.
(* This is not generally true, but could be made true by adding an "assert" operator
  to the programming language
*)

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma ewand_TT_emp {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{CA: Canc_alg A}:
    ewand TT emp = emp.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
apply pred_ext; intros w ?.
destruct H as [w1 [w3 [? [? ?]]]].
hnf; eapply split_identity.
eapply join_comm; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
exists w; exists w; split; auto.
change (identity w) in H.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
apply identity_unit'; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma subp_derives' {A}{agA: ageable A}:
  forall P Q: pred A, (forall n, (P >=> Q) n) -> P |-- Q.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred A agA Q n *)
intros n ?. eapply H; eauto.
Qed.

Lemma guard_environ_sub:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Delta Delta' f rho},
   tycontext_sub Delta Delta' ->
   guard_environ Delta' f rho ->
   guard_environ Delta f rho.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H0; split; auto.
eapply typecheck_environ_sub; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct f; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H1; split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct H as [? [? [? ?]]]. rewrite H4; auto.
Qed.

Lemma guard_environ_eqv:
  forall Delta Delta' f rho,
  tycontext_eqv Delta Delta' ->
  guard_environ Delta f rho -> guard_environ Delta' f rho.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: guard_environ Delta' f rho *)
  rewrite tycontext_eqv_spec in H.
  eapply guard_environ_sub; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  tauto.
Qed.

Lemma proj_frame_ret_assert:
 forall (R: ret_assert) (F: assert) ek vl,
  proj_ret_assert (frame_ret_assert R F) ek vl = 
  seplog.sepcon (proj_ret_assert R ek vl) F.
Proof.
intros; extensionality rho; destruct R, ek; simpl;
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
rewrite ?sepcon_andp_prop1; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_extensionality0 {CS: compspecs} {Espec: OracleKind}:
       TT |--
      ALL Delta:tycontext, ALL Delta':tycontext,
      ALL P:assert, ALL P':assert,
      ALL c: statement, ALL R:ret_assert, ALL R':ret_assert,
       ((!! tycontext_sub Delta Delta'
       &&  (ALL ek: exitkind, ALL  vl : option val, ALL rho: environ,  
               (proj_ret_assert R ek vl rho >=> proj_ret_assert R' ek vl rho))
      && (ALL rho:environ, P' rho >=> P rho)  && semax' Espec Delta P c R) >=> semax' Espec Delta' P' c R').
Proof.
(* Goal: @derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat tycontext (fun Delta : tycontext => @allp nat ag_nat tycontext (fun Delta' : tycontext => @allp nat ag_nat assert (fun P : assert => @allp nat ag_nat assert (fun P' : assert => @allp nat ag_nat statement (fun c : statement => @allp nat ag_nat ret_assert (fun R : ret_assert => @allp nat ag_nat ret_assert (fun R' : ret_assert => @fash nat ag_nat (@imp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (tycontext_sub Delta Delta')) (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R' ek vl rho))))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P' rho) (P rho))))) (@semax' CS Espec Delta P c R)) (@semax' CS Espec Delta' P' c R')))))))))) *)
apply loeb.
(* Goal: @derives nat ag_nat (@box nat ag_nat (@laterM nat ag_nat) (@allp nat ag_nat tycontext (fun Delta : tycontext => @allp nat ag_nat tycontext (fun Delta' : tycontext => @allp nat ag_nat assert (fun P : assert => @allp nat ag_nat assert (fun P' : assert => @allp nat ag_nat statement (fun c : statement => @allp nat ag_nat ret_assert (fun R : ret_assert => @allp nat ag_nat ret_assert (fun R' : ret_assert => @fash nat ag_nat (@imp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (tycontext_sub Delta Delta')) (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R' ek vl rho))))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P' rho) (P rho))))) (@semax' CS Espec Delta P c R)) (@semax' CS Espec Delta' P' c R'))))))))))) (@allp nat ag_nat tycontext (fun Delta : tycontext => @allp nat ag_nat tycontext (fun Delta' : tycontext => @allp nat ag_nat assert (fun P : assert => @allp nat ag_nat assert (fun P' : assert => @allp nat ag_nat statement (fun c : statement => @allp nat ag_nat ret_assert (fun R : ret_assert => @allp nat ag_nat ret_assert (fun R' : ret_assert => @fash nat ag_nat (@imp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (tycontext_sub Delta Delta')) (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R' ek vl rho))))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P' rho) (P rho))))) (@semax' CS Espec Delta P c R)) (@semax' CS Espec Delta' P' c R')))))))))) *)
intros w ? Delta Delta' P P' c R R'.
(* Goal: @app_pred nat ag_nat (@fash nat ag_nat (@imp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (tycontext_sub Delta Delta')) (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R' ek vl rho))))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P' rho) (P rho))))) (@semax' CS Espec Delta P c R)) (@semax' CS Espec Delta' P' c R'))) w *)
intros w1 ? w2 ? [[[? ?] ?] ?].
(* Goal: @app_pred nat ag_nat (@semax' CS Espec Delta' P' c R') w2 *)
do 3 red in H2.
(* Goal: @app_pred nat ag_nat (@semax' CS Espec Delta' P' c R') w2 *)
rewrite semax_fold_unfold; rewrite semax_fold_unfold in H5.
(* Goal: @app_pred nat ag_nat (@allp nat ag_nat genv (fun gx : genv => @allp nat ag_nat tycontext (fun Delta'0 : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta' Delta'0) (@eq composite_env (genv_cenv gx) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta'0 gx Delta'0) (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta'0 (frame_ret_assert R' F) k)) (guard Espec gx Delta'0 (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k))))))))) w2 *)
intros gx Delta''.
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta' Delta'') (@eq composite_env (genv_cenv gx) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta'' gx Delta'') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta'' (frame_ret_assert R' F) k)) (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k))))))) w2 *)
apply prop_imp_i; intros [TS HGG].
(* Goal: @app_pred nat ag_nat (@imp nat ag_nat (@believe CS Espec Delta'' gx Delta'') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta'' (frame_ret_assert R' F) k)) (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)))))) w2 *)
intros w3 ? ?.
specialize (H5 gx Delta'' _ (necR_refl _)
  (conj (tycontext_sub_trans _ _ _ H2 TS) HGG)
                  _ H6 H7).

(* Goal: @app_pred nat ag_nat (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec gx Delta'' (frame_ret_assert R' F) k)) (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k))))) w3 *)
intros k F w4 Hw4 [? ?].
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
specialize (H5 k F w4 Hw4).
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
assert ((rguard Espec gx Delta'' (frame_ret_assert R F) k) w4).
(* Goal: @app_pred nat ag_nat (rguard Espec gx Delta'' (frame_ret_assert R F) k) w4 *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
do 9 intro.
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec gx b2 b1 (exit_cont b b0 k) (construct_rho (filter_genv gx) b2 b1)) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
apply (H9 b b0 b1 b2 y H10 a' H11).
(* Goal: @app_pred rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta'' (current_function k) (construct_rho (filter_genv gx) b2 b1))) (proj_ret_assert (frame_ret_assert R' F) b b0 (construct_rho (filter_genv gx) b2 b1))) (funassert Delta'' (construct_rho (filter_genv gx) b2 b1))) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
destruct H12; split; auto; clear H13.
(* Goal: @app_pred rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta'' (current_function k) (construct_rho (filter_genv gx) b2 b1))) (proj_ret_assert (frame_ret_assert R' F) b b0 (construct_rho (filter_genv gx) b2 b1))) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
pose proof I.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H12; split; auto.
(* unfold frame_ret_assert in H14|-*. *)
rewrite proj_frame_ret_assert in H14|-*.
(* Goal: @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert R' b b0) F (construct_rho (filter_genv gx) b2 b1)) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
clear H12 H13.
(* Goal: @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert R' b b0) F (construct_rho (filter_genv gx) b2 b1)) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
revert a' H11 H14.
(* Goal: forall (a' : rmap) (_ : @necR rmap ag_rmap y a') (_ : @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert R b b0) F (construct_rho (filter_genv gx) b2 b1)) a'), @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert R' b b0) F (construct_rho (filter_genv gx) b2 b1)) a' *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
apply sepcon_subp' with (level w2).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R b b0 (construct_rho (filter_genv gx) b2 b1)) (proj_ret_assert R' b b0 (construct_rho (filter_genv gx) b2 b1)))) (@level nat ag_nat w2) *)
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap (F (construct_rho (filter_genv gx) b2 b1)) (F (construct_rho (filter_genv gx) b2 b1)))) (@level nat ag_nat w2) *)
(* Goal: ge (@level nat ag_nat w2) (@level rmap ag_rmap y) *)
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
apply H3.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
auto.
(* Goal: ge (@level nat ag_nat w2) (@level rmap ag_rmap y) *)
apply necR_level in H6.
(* Goal: ge (@level nat ag_nat w2) (@level rmap ag_rmap y) *)
apply necR_level in Hw4.
(* Goal: le w4 (@level nat ag_nat w2) *)
eapply le_trans; try eassumption.
(* Goal: le w4 (@level nat ag_nat w2) *)
eapply le_trans; try eassumption.

(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
specialize (H5 (conj H8 H10)). clear H8 H9 H10.
(* Goal: @app_pred nat ag_nat (guard Espec gx Delta'' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P' rho)) (@cons cont' (Kseq c) k)) w4 *)
do 7 intro.
(* Goal: @app_pred rmap ag_rmap (assert_safe Espec gx b0 b (@cons cont' (Kseq c) k) (construct_rho (filter_genv gx) b0 b)) a' *)
apply (H5 b b0 y H8 _ H9).
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H10; split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H10; split; auto.
(* Goal: @app_pred rmap ag_rmap (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv gx) b0 b)) (P (construct_rho (filter_genv gx) b0 b))) a' *)
clear H10 H11.
(* Goal: @app_pred rmap ag_rmap (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F (construct_rho (filter_genv gx) b0 b)) (P (construct_rho (filter_genv gx) b0 b))) a' *)
revert a' H9 H12.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
apply sepcon_subp' with (level w2); auto.
(* Goal: ge (@level nat ag_nat w2) (@level rmap ag_rmap y) *)
apply necR_level in H6.
(* Goal: ge (@level nat ag_nat w2) (@level rmap ag_rmap y) *)
apply necR_level in Hw4.
(* Goal: le w4 (@level nat ag_nat w2) *)
eapply le_trans; try eassumption.
(* Goal: le w4 (@level nat ag_nat w2) *)
eapply le_trans; try eassumption.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_extensionality1 {CS: compspecs} {Espec: OracleKind}:
  forall Delta Delta' (P P': assert) c (R R': ret_assert) ,
       tycontext_sub Delta Delta' ->
       ((ALL ek: exitkind, ALL  vl : option val, ALL rho: environ,  
          (proj_ret_assert R ek vl rho >=> proj_ret_assert R' ek vl rho))
      && (ALL rho:environ, P' rho >=> P rho)  && (semax' Espec Delta P c R) |-- semax' Espec Delta' P' c R').
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @derives nat ag_nat (@andp nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R' ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P' rho) (P rho))))) (@semax' CS Espec Delta P c R)) (@semax' CS Espec Delta' P' c R') *)
intros n ?.
(* Goal: @app_pred nat ag_nat (@semax' CS Espec Delta' P' c R') n *)
apply (semax_extensionality0 n I Delta Delta' P P' c R R' _ (le_refl _) _ (necR_refl _)).
destruct H0;
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
destruct H0;
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_frame {CS: compspecs} {Espec: OracleKind}:  forall Delta P s R F,
   closed_wrt_modvars s F ->
  semax Espec Delta P s R ->
    semax Espec Delta (fun rho => P rho * F rho) s (frame_ret_assert R F).
Proof.
(* Goal: forall (Delta : tycontext) (P : assert) (s : statement) (R : ret_assert) (F : assert) (_ : closed_wrt_modvars s F) (_ : @semax CS Espec Delta P s R), @semax CS Espec Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho)) s (frame_ret_assert R F) *)
intros until F. intros CL H.
(* Goal: @semax CS Espec Delta (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho)) s (frame_ret_assert R F) *)
rewrite semax_unfold.
(* Goal: forall (psi : genv) (Delta' : tycontext) (w : nat) (_ : tycontext_sub Delta Delta') (_ : @eq composite_env (genv_cenv psi) (@cenv_cs CS)) (_ : @app_pred nat ag_nat (@believe CS Espec Delta' psi Delta') w) (k : cont) (F0 : assert) (_ : closed_wrt_modvars s F0) (_ : @app_pred nat ag_nat (rguard Espec psi Delta' (frame_ret_assert (frame_ret_assert R F) F0) k) w), @app_pred nat ag_nat (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) (@cons cont' (Kseq s) k)) w *)
rewrite semax_unfold in H.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
pose (F0F := fun rho => F0 rho * F rho).
(* Goal: @app_pred nat ag_nat (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) (@cons cont' (Kseq s) k)) w *)
specialize (H psi Delta' w TS HGG Prog_OK k F0F).
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
spec H. {
(* Goal: @eq (forall _ : environ, @pred rmap ag_rmap) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0F rho) (P rho)) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
 unfold F0F.
 clear - H0 CL.
 hnf in *; intros; simpl in *.
 rewrite <- CL. rewrite <- H0. auto.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
 intuition.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
 intuition.
}
replace (fun rho : environ => F0 rho * (P rho * F rho))
  with  (fun rho : environ => F0F rho * P rho).
*
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
apply H.
unfold F0F; clear - H1.
(* Goal: @app_pred nat ag_nat (let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R F) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
intros ek vl tx vx; specialize (H1 ek vl tx vx).
(* Goal: @app_pred nat ag_nat (let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R (fun rho0 : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho0) (F rho0))) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
red in H1.
(* Goal: @app_pred nat ag_nat (let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R (fun rho0 : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho0) (F rho0))) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
remember ((construct_rho (filter_genv psi) vx tx)) as rho.
(* Goal: @app_pred nat ag_nat (let rho := rho in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta' (current_function k) rho)) (proj_ret_assert (frame_ret_assert R (fun rho0 : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho0) (F rho0))) ek vl rho)) (funassert Delta' rho)) (assert_safe Espec psi vx tx (exit_cont ek vl k) rho))) w *)
red.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
hnf; intros. specialize (H1 _ H).
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
hnf; intros. apply H1; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
destruct H2; split; auto. destruct H2; split; auto.
rewrite proj_frame_ret_assert in H4|-*.
(* Goal: @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert (frame_ret_assert R F) ek vl) F0 rho) a' *)
rewrite proj_frame_ret_assert.
(* Goal: @app_pred rmap ag_rmap (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (@seplog.sepcon assert (@seplog.LiftNatDed environ mpred (@alg_seplog.algNatDed rmap ag_rmap)) (@seplog.LiftSepLog environ mpred (@alg_seplog.algNatDed rmap ag_rmap) (@alg_seplog.algSepLog rmap ag_rmap Join_rmap Perm_rmap Sep_rmap Age_rmap)) (proj_ret_assert R ek vl) F) F0 rho) a' *)
rewrite seplog.sepcon_assoc.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
eapply sepcon_derives; try apply H4; auto. simpl.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
rewrite sepcon_comm; auto.
*
(* Goal: @eq (forall _ : environ, @pred rmap ag_rmap) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0F rho) (P rho)) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
unfold F0F.
(* Goal: @eq (forall _ : environ, @pred rmap ag_rmap) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (F rho)) (P rho)) (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
extensionality rho.
(* Goal: @eq (@pred rmap ag_rmap) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (F rho)) (P rho)) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
rewrite sepcon_assoc.
(* Goal: @eq (@pred rmap ag_rmap) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
f_equal. apply sepcon_comm.
Qed.

Lemma assert_safe_last:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} ge ve te st rho w,
   (forall w', age w w' -> assert_safe Espec ge ve te st rho w) ->
    assert_safe Espec ge ve te st rho w.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
case_eq (age1 w). auto.
(* Goal: @app_pred rmap ag_rmap (mapsto sh t v1 v2) w *)
clear H.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
intro; apply bupd_intro; repeat intro.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level rmap ag_rmap w) ora (State ve te st) jm *)
rewrite (af_level1 age_facts) in H.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level rmap ag_rmap w) ora (State ve te st) jm *)
rewrite H.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
constructor.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma pred_sub_later' {A} `{H: ageable A}:
  forall (P Q: pred A),
           (|> P >=> |> Q)  |--  (|> (P >=> Q)).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
rewrite later_fash; auto.
(* Goal: @derives nat ag_nat (@fash A H (@imp A H (@box A H (@laterM A H) P) (@box A H (@laterM A H) Q))) (@fash A H (@box A H (@laterM A H) (@imp A H P Q))) *)
rewrite later_imp.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
auto.
Qed.

Lemma later_strengthen_safe1:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} (P: pred rmap) ge ve te k rho,
              ((|> P) >=> assert_safe Espec ge ve te k rho) |--   |>  (P >=> assert_safe Espec ge ve te k rho).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @derives nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap (@box rmap ag_rmap (@laterM rmap ag_rmap) P) (assert_safe Espec ge ve te k rho))) (@box nat ag_nat (@laterM nat ag_nat) (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho)))) *)
intros w ?.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
apply (@pred_sub_later' _ _ P  (assert_safe Espec ge ve te k rho)); auto.
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
eapply subp_trans'; try apply H.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap (assert_safe Espec ge ve te k rho) (@box rmap ag_rmap (@laterM rmap ag_rmap) (assert_safe Espec ge ve te k rho)))) w *)
apply derives_subp; clear.
(* Goal: @derives rmap ag_rmap (assert_safe Espec ge ve te k rho) (@box rmap ag_rmap (@laterM rmap ag_rmap) (assert_safe Espec ge ve te k rho)) *)
apply now_later.
Qed.

End SemaxContext.

Hint Resolve @age_laterR.


Fixpoint filter_seq (k: cont) : cont :=
 match k with
  | Kseq s :: k1 => filter_seq k1
  | _ => k
  end.

Lemma cons_app: forall A (x: A) (y: list A), x::y = (x::nil)++y.
Proof. auto. Qed.

Lemma cons_app': forall A (x:A) y z,
      x::y++z = (x::y)++z.
Proof. auto. Qed.

Lemma cat_prefix_empty:
   forall {A} prefix (ctl: list A), ctl =  prefix ++ ctl -> prefix = nil.
Proof.
(* Goal: forall (A : Type) (prefix ctl : list A) (_ : @eq (list A) ctl (@app A prefix ctl)), @eq (list A) prefix (@nil A) *)
do 3 intro.
(* Goal: forall _ : @eq (list A) ctl (@app A prefix ctl), @eq (list A) prefix (@nil A) *)
destruct prefix; auto; intro; elimtype False.
assert (length ctl = length ((a::prefix) ++ ctl)).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
f_equal; auto.
(* Goal: @semantics.corestep corestate mem (cl_core_sem psi) (State ve te (@cons cont' (Kseq (Slabel l c)) k)) (m_dry m) c' (m_dry m') *)
simpl in H0.
(* Goal: False *)
rewrite app_length in H0.
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
omega.
Qed.

Definition true_expr : Clight.expr := Clight.Econst_int Int.one (Tint I32 Signed noattr).


(* BEGIN Lemmas duplicated from Clight_sim. v *)
Lemma dec_skip: forall s, {s=Sskip}+{s<>Sskip}.
Proof.
(* Goal: forall s : statement, sumbool (@eq statement s Sskip) (not (@eq statement s Sskip)) *)
 destruct s; try (left; congruence); right; congruence.
Qed.

Lemma strip_step:  (* This one uses equality, one in Clight_sim uses <->  *)
  forall ge ve te k m st' m',
     cl_step ge (State ve te (strip_skip k)) m st' m' =
    cl_step ge (State ve te k) m st' m'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @eq Prop (cl_step ge (State ve te (strip_skip k)) m st' m') (cl_step ge (State ve te k) m st' m') *)
 apply prop_ext.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 induction k; intros; split; simpl; intros; try destruct IHk; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct a; try destruct s; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  constructor; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct a; try destruct s; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 inv H. auto.
Qed.
(* END lemmas duplicated *)

 Lemma strip_skip_app:
  forall k k', strip_skip k = nil -> strip_skip (k++k') = strip_skip k'.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
Proof. induction k; intros; auto. destruct a; inv H. destruct s; inv H1; auto.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
  simpl. apply IHk. auto.
Qed.

Lemma strip_strip: forall k, strip_skip (strip_skip k) = strip_skip k.
Proof.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
induction k; simpl.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct a; simpl; auto.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
destruct (dec_skip s).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
subst; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct s; auto.
Qed.

Lemma strip_skip_app_cons:
 forall {k c l}, strip_skip k = c::l -> forall k', strip_skip  (k++k') = c::l++k'.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
Proof. intros. revert k H;  induction k; intros. inv H.
  destruct a; try solve [simpl in *; auto];
  try solve [simpl in *; rewrite cons_app'; rewrite H; auto].
 destruct (dec_skip s). subst. simpl in *; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct s; inv H; simpl; auto.
Qed.


Lemma filter_seq_current_function:
  forall ctl1 ctl2, filter_seq ctl1 = filter_seq ctl2 ->
       current_function ctl1 = current_function ctl2.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros ? ? H0. revert ctl2 H0; induction ctl1; simpl; intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  revert H0; induction ctl2; simpl; intros; try destruct a; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct a; auto; revert H0; induction ctl2; simpl; intros; try destruct a; try congruence; auto.
Qed.

Lemma filter_seq_call_cont:
  forall ctl1 ctl2, filter_seq ctl1 = filter_seq ctl2 -> call_cont ctl1 = call_cont ctl2.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros ? ? H0. revert ctl2 H0; induction ctl1; simpl; intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  revert H0; induction ctl2; simpl; intros; try destruct a; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct a; auto; revert H0; induction ctl2; simpl; intros; try destruct a; try congruence; auto.
Qed.

Lemma call_cont_app_nil:
  forall l k, call_cont l = nil -> call_cont (l++k) = call_cont k.
Proof.
 intros l k; revert k; induction l; simpl; intros;
   try destruct a; simpl in *; try congruence; auto.
Qed.
Lemma call_cont_app_cons:
  forall l c l', call_cont l = c::l' -> forall k, call_cont (l++k) = c::l' ++ k.
Proof.
  intros; revert c l' k H; induction l; simpl; intros;
   try destruct a; simpl in *; try congruence; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma and_FF : forall {A} `{ageable A} (P:pred A),
  P && FF = FF.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros. rewrite andp_comm. apply FF_and.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma sepcon_FF : forall {A}{JA: Join A}{PA: Perm_alg A}{AG: ageable A}{XA: Age_alg A} (P:pred A),
  (P * FF = FF)%pred.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros. rewrite sepcon_comm. apply FF_sepcon.
Qed.

Section extensions.

Lemma age1_resource_decay:
  forall jm jm', age jm jm' -> resource_decay (nextblock (m_dry jm)) (m_phi jm) (m_phi jm').
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros. split.
(* Goal: @eq nat N (@level juicy_mem juicy_mem_ageable m') *)
 apply age_level in H.
(* Goal: ge (@level rmap ag_rmap (m_phi jm)) (@level rmap ag_rmap (m_phi jm')) *)
(* Goal: forall l : address, and (forall _ : Pos.ge (@fst block Z l) (nextblock (m_dry jm)), @eq resource (resource_at (m_phi jm) l) (NO Share.bot bot_unreadable)) (or (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (resource_at (m_phi jm') l)) (or (@ex share (fun sh : share => @ex (writable0_share sh) (fun wsh : writable0_share sh => @ex memval (fun v : memval => @ex memval (fun v' : memval => and (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (YES sh (@writable0_readable sh wsh) (VAL v) NoneP)) (@eq resource (resource_at (m_phi jm') l) (YES sh (@writable0_readable sh wsh) (VAL v') NoneP))))))) (or (and (Pos.ge (@fst block Z l) (nextblock (m_dry jm))) (@ex memval (fun v : memval => @eq resource (resource_at (m_phi jm') l) (YES Share.top readable_share_top (VAL v) NoneP)))) (@ex memval (fun v : memval => @ex preds (fun pp : preds => and (@eq resource (resource_at (m_phi jm) l) (YES Share.top readable_share_top (VAL v) pp)) (@eq resource (resource_at (m_phi jm') l) (NO Share.bot bot_unreadable)))))))) *)
 change (level (m_phi jm)) with (level jm).
(* Goal: ge (@level juicy_mem juicy_mem_ageable jm) (@level rmap ag_rmap (m_phi jm')) *)
(* Goal: forall l : address, and (forall _ : Pos.ge (@fst block Z l) (nextblock (m_dry jm)), @eq resource (resource_at (m_phi jm) l) (NO Share.bot bot_unreadable)) (or (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (resource_at (m_phi jm') l)) (or (@ex share (fun sh : share => @ex (writable0_share sh) (fun wsh : writable0_share sh => @ex memval (fun v : memval => @ex memval (fun v' : memval => and (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (YES sh (@writable0_readable sh wsh) (VAL v) NoneP)) (@eq resource (resource_at (m_phi jm') l) (YES sh (@writable0_readable sh wsh) (VAL v') NoneP))))))) (or (and (Pos.ge (@fst block Z l) (nextblock (m_dry jm))) (@ex memval (fun v : memval => @eq resource (resource_at (m_phi jm') l) (YES Share.top readable_share_top (VAL v) NoneP)))) (@ex memval (fun v : memval => @ex preds (fun pp : preds => and (@eq resource (resource_at (m_phi jm) l) (YES Share.top readable_share_top (VAL v) pp)) (@eq resource (resource_at (m_phi jm') l) (NO Share.bot bot_unreadable)))))))) *)
 change (level (m_phi jm')) with (level jm').
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
 omega.
(* Goal: and (forall _ : Pos.ge (@fst block Z l) (nextblock (m_dry jm)), @eq resource (resource_at (m_phi jm) l) (NO Share.bot bot_unreadable)) (or (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (resource_at (m_phi jm') l)) (or (@ex share (fun sh : share => @ex (writable0_share sh) (fun wsh : writable0_share sh => @ex memval (fun v : memval => @ex memval (fun v' : memval => and (@eq resource (resource_fmap (approx (@level rmap ag_rmap (m_phi jm'))) (approx (@level rmap ag_rmap (m_phi jm'))) (resource_at (m_phi jm) l)) (YES sh (@writable0_readable sh wsh) (VAL v) NoneP)) (@eq resource (resource_at (m_phi jm') l) (YES sh (@writable0_readable sh wsh) (VAL v') NoneP))))))) (or (and (Pos.ge (@fst block Z l) (nextblock (m_dry jm))) (@ex memval (fun v : memval => @eq resource (resource_at (m_phi jm') l) (YES Share.top readable_share_top (VAL v) NoneP)))) (@ex memval (fun v : memval => @ex preds (fun pp : preds => and (@eq resource (resource_at (m_phi jm) l) (YES Share.top readable_share_top (VAL v) pp)) (@eq resource (resource_at (m_phi jm') l) (NO Share.bot bot_unreadable)))))))) *)
 intro l. split. apply juicy_mem_alloc_cohere. left.
 symmetry; apply age1_resource_at with (m_phi jm); eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (age1_juicy_mem_unpack _ _ H); auto.
(* Goal: @eq resource (resource_at (m_phi jm) l) (resource_fmap (approx (@level rmap ag_rmap (m_phi jm))) (approx (@level rmap ag_rmap (m_phi jm))) (resource_at (m_phi jm) l)) *)
 symmetry; apply resource_at_approx.
Qed.

Lemma safe_loop_skip:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind}
    ge ora ve te k m,
    jsafeN (@OK_spec Espec) ge (level m) ora
(* Goal: EqDec floatsize *)
           (State ve te (Kseq (Sloop Clight.Sskip Clight.Sskip) :: k)) m.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable m) ora (State ve te (@cons cont' (Kseq (Sloop Sskip Sskip)) k)) m *)
  remember (level m)%nat as N.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq (Sloop Sskip Sskip)) k)) m *)
  destruct N; [constructor|].
  case_eq (age1 m); [intros m' ? |  intro; apply age1_level0 in H; omegaContradiction].
  apply jsafeN_step with
    (c' := State ve te (Kseq Sskip :: Kseq Scontinue :: Kloop1 Sskip Sskip :: k))
    (m'0 := m').
(* Goal: @jstep corestate (cl_core_sem ge) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) m (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) m' *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  split3.
(* Goal: @semantics.corestep corestate mem (cl_core_sem ge) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) (m_dry m) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) (m_dry m') *)
(* Goal: resource_decay (nextblock (m_dry m)) (m_phi m) (m_phi m') *)
(* Goal: and (@eq nat (@level juicy_mem juicy_mem_ageable m) (S (@level juicy_mem juicy_mem_ageable m'))) (@eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m)))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  replace (m_dry m') with (m_dry m) by (destruct (age1_juicy_mem_unpack _ _ H); auto).
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  repeat econstructor.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply age1_resource_decay; auto. split; [apply age_level; auto|].
(* Goal: @eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  apply age_jm_phi in H.
(* Goal: @eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  erewrite (age1_ghost_of _ _ H) by (symmetry; apply ghost_of_approx).
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
  unfold level at 1; simpl.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  repeat intro; auto.
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  assert (N = level m')%nat.
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
  apply age_level in H; omega.
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  clear HeqN m H. rename m' into m.
  intros; eexists; repeat split; eauto.
(* Goal: @jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) m *)
  clear H H1; revert m H0; induction N; intros; simpl; [constructor|].
  case_eq (age1 m); [intros m' ? |  intro; apply age1_level0 in H; omegaContradiction].
  apply jsafeN_step
    with (c' := State ve te (Kseq Sskip :: Kseq Scontinue :: Kloop1 Sskip Sskip :: k))
         (m'0 := m').
(* Goal: @jstep corestate (cl_core_sem ge) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) m (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) m' *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  split3.
(* Goal: @semantics.corestep corestate mem (cl_core_sem ge) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) (m_dry m) (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k)))) (m_dry m') *)
(* Goal: resource_decay (nextblock (m_dry m)) (m_phi m) (m_phi m') *)
(* Goal: and (@eq nat (@level juicy_mem juicy_mem_ageable m) (S (@level juicy_mem juicy_mem_ageable m'))) (@eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m)))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  replace (m_dry m') with (m_dry m) by (destruct (age1_juicy_mem_unpack _ _ H); auto).
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  repeat constructor.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 apply age1_resource_decay; auto. split; [apply age_level; auto|].
(* Goal: @eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  apply age_jm_phi in H.
(* Goal: @eq ghost (ghost_of (m_phi m')) (ghost_fmap (approx (@level juicy_mem juicy_mem_ageable m')) (approx (@level juicy_mem juicy_mem_ageable m')) (ghost_of (m_phi m))) *)
(* Goal: @jm_bupd (@OK_ty Espec) ora (@jsafeN_ genv corestate (@OK_ty Espec) (fun ge : genv => @genv_symb_injective fundef type (genv_genv ge)) (cl_core_sem ge) (@OK_spec Espec) ge N ora (State ve te (@cons cont' (Kseq Sskip) (@cons cont' (Kseq Scontinue) (@cons cont' (Kloop1 Sskip Sskip) k))))) m' *)
  erewrite (age1_ghost_of _ _ H) by (symmetry; apply ghost_of_approx).
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
  unfold level at 1; simpl.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  repeat intro; auto.
  intros; eexists; repeat split; eauto.
  eapply IHN; eauto.
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
  apply age_level in H. omega.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma safe_seq_skip {Espec: OracleKind} ge n ora ve te k m :
  jsafeN OK_spec ge n ora (State ve te k) m ->
  jsafeN OK_spec ge n ora (State ve te (Kseq Sskip :: k)) m.
Proof.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
inversion 1; subst. constructor.
econstructor; eauto. simpl. destruct H0 as (?&?&?). split3; eauto.
eapply step_skip; eauto.
simpl in *; congruence.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma safe_seq_skip' {Espec: OracleKind} ge n ora ve te k m :
  jsafeN OK_spec ge n ora (State ve te (Kseq Sskip :: k)) m ->
  jsafeN OK_spec ge n ora (State ve te k) m.
Proof.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
inversion 1; subst. constructor.
econstructor; eauto. simpl. destruct H0 as (?&?&?). split3; eauto.
(* Goal: @semantics.corestep corestate mem (cl_core_sem ge) (State ve te k) (m_dry m) c' (m_dry m') *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n0) ora (State ve te k) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge n ora (State ve te k) m *)
inv H0; auto.
simpl in *; congruence.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma safe_step_forward {Espec: OracleKind}:
  forall psi n ora st m,
   cl_at_external st = None ->
   jsafeN (@OK_spec Espec) psi (S n) ora st m ->
 exists st', exists m',
   jstep (cl_core_sem psi) st m st' m' /\ jm_bupd ora (jsafeN (@OK_spec Espec) psi n ora  st') m'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
(* Goal: @ex corestate (fun st' : corestate => @ex juicy_mem (fun m' : juicy_mem => and (@jstep corestate (cl_core_sem psi) st m st' m') (@jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora st') m'))) *)
 inv H0.
 eexists; eexists; split; eauto.
(* Goal: @ex corestate (fun st' : corestate => @ex juicy_mem (fun m' : juicy_mem => and (@jstep corestate (cl_core_sem psi) st m st' m') (@jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora st') m'))) *)
(* Goal: @ex corestate (fun st' : corestate => @ex juicy_mem (fun m' : juicy_mem => and (@jstep corestate (cl_core_sem psi) st m st' m') (@jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora st') m'))) *)
 simpl in H2; rewrite H2 in H; congruence.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
 contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma safeN_strip {Espec: OracleKind}:
  forall ge n ora ve te k m,
     jsafeN (@OK_spec Espec) ge n ora (State ve te (strip_skip k)) m =
     jsafeN (@OK_spec Espec) ge n ora (State ve te k) m.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
 destruct n. apply prop_ext; simpl; intuition.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
 constructor. constructor.
(* Goal: @eq Prop (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m) (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te k) m) *)
 apply prop_ext; split; intros H.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
 { induction k. simpl in H. auto. destruct a; auto.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
   destruct (dec_skip s); subst.
   simpl in H|-*. apply IHk in H. apply safe_seq_skip; auto.
   destruct s; simpl in *; congruence. }
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
 { induction k. simpl. auto. destruct a; auto.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
   destruct (dec_skip s); subst.
   simpl in *. apply IHk. apply safe_seq_skip'; auto.
   destruct s; simpl in *; congruence. }
Qed.

Local Open Scope nat_scope.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Definition control_as_safe {Espec: OracleKind} ge n ctl1 ctl2 :=
 forall (ora : OK_ty) (ve : env) (te : temp_env) (m : juicy_mem) (n' : nat),
     n' <= n ->
     jsafeN (@OK_spec Espec) ge n' ora (State ve te ctl1) m ->
     jsafeN (@OK_spec Espec) ge n' ora (State ve te ctl2) m.

Fixpoint prebreak_cont (k: cont) : cont :=
  match k with
  | Kloop1 s e3 :: k' => k
  | Kseq s :: k' => prebreak_cont k'
  | Kloop2 s e3 :: k' => k
  | Kswitch :: k' => k
  | _ =>  nil (* stuck *)
  end.

Lemma prebreak_cont_is: forall k,
  match (prebreak_cont k) with
  | Kloop1 _ _ :: _ => True
  | Kloop2 _ _ :: _ => True
  | Kswitch :: _ => True
  | nil => True
  | _ => False
  end.
Proof.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
induction k; simpl; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct (prebreak_cont k); try contradiction; destruct a; auto.
Qed.

Lemma find_label_prefix:
  forall lbl s ctl k, find_label lbl s ctl = Some k -> exists j, k = j++ctl
with
  find_label_ls_prefix:
  forall lbl s ctl k, find_label_ls lbl s ctl = Some k -> exists j, k = j++ctl.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
  clear find_label_prefix.
  revert ctl k H; induction s; simpl; intros; try congruence.
  revert H; case_eq (find_label lbl s1 (Kseq s2 :: ctl)); intros; [inv H0 | auto ].
  destruct (IHs1 _ _ H) as [j ?]. exists (j++ (Kseq s2::nil)); rewrite app_ass; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  revert H; case_eq (find_label lbl s1 ctl); intros; [inv H0 | auto ]; auto.
  revert H; case_eq (find_label lbl s1 (Kseq Scontinue :: Kloop1 s1 s2 :: ctl)); intros; [inv H0 | auto ].
  destruct (IHs1 _ _ H) as [j ?]. exists (j++ (Kseq Scontinue :: Kloop1 s1 s2::nil)); rewrite app_ass; auto.
  destruct (IHs2 _ _ H0) as [j ?]. exists (j++ (Kloop2 s1 s2::nil)); rewrite app_ass; auto.
  destruct (find_label_ls_prefix _ _ _ _ H) as [j ?]. exists (j++(Kswitch :: nil)); rewrite app_ass; auto.
(* Goal: @eq cont (strip_skip (@app cont' (@nil cont') k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' a k) k')) (@cons cont' c (@app cont' l k')) *)
  if_tac in H. subst l. inv H.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  exists (Kseq s :: nil); auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply IHs; auto.

(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 induction s; simpl; intros. inv H.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 revert H; case_eq (find_label lbl s (Kseq (seq_of_labeled_statement s0) :: ctl)); intros.
(* Goal: @ex corestate (fun st' : corestate => @ex juicy_mem (fun m' : juicy_mem => and (@jstep corestate (cl_core_sem psi) st m st' m') (@jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora st') m'))) *)
 inv H0.
 destruct (find_label_prefix _ _ _ _ H) as [j ?]; exists (j++Kseq (seq_of_labeled_statement s0) ::nil); rewrite app_ass; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 auto.
Qed.


Lemma find_label_None:
  forall lbl s ctl, find_label lbl s ctl = None -> forall ctl', find_label lbl s ctl' = None
with
  find_label_ls_None:
  forall lbl s ctl, find_label_ls lbl s ctl = None ->  forall ctl', find_label_ls lbl s ctl' = None.
Proof.
clear find_label_None; induction s; simpl; intros; try congruence;
 try match type of H with match ?A with Some _ => _| None => _ end = _
                => revert H; case_eq A; intros; [inv H0 | ]
       end;
 try (rewrite (IHs1 _ H); eauto).
 eauto.
 destruct (ident_eq lbl l). inv H. eapply IHs; eauto.

clear find_label_ls_None; induction s; simpl; intros; try congruence;
 try match type of H with match ?A with Some _ => _| None => _ end = _
                => revert H; case_eq A; intros; [inv H0 | ]
       end;
 try (rewrite (IHs1 _ H); eauto).
 eauto.
 rewrite (find_label_None _ _ _ H). eauto.
Qed.

Lemma find_label_prefix2':
 forall lbl s k1 pre, find_label lbl s k1 = Some (pre++k1) ->
               forall k2, find_label lbl s k2 = Some (pre++k2)
with find_label_ls_prefix2':
 forall lbl s k1 pre, find_label_ls lbl s k1 = Some (pre++k1) ->
               forall k2, find_label_ls lbl s k2 = Some (pre++k2) .
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros. clear find_label_prefix2'.
revert pre k1 H k2; induction s; simpl; intros; try congruence;
 try match type of H with match ?A with Some _ => _| None => _ end = _
                => revert H; case_eq A; intros; [inv H0 | ]
       end;
 try
 (destruct (find_label_prefix _ _ _ _ H) as [j Hj];
 rewrite cons_app in Hj; rewrite <- app_ass in Hj; apply app_inv_tail in Hj; subst pre;
  erewrite app_ass in H; simpl in H;
  rewrite (IHs1 _ _ H); rewrite app_ass; reflexivity);
 try solve [erewrite (find_label_None); eauto].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 rewrite (IHs1 _ _ H); auto.
 change (Kseq Scontinue :: Kloop1 s1 s2 :: k1) with ((Kseq Scontinue :: Kloop1 s1 s2 :: nil) ++ k1)
   in H.
 change (Kseq Scontinue :: Kloop1 s1 s2 :: k2) with ((Kseq Scontinue :: Kloop1 s1 s2 :: nil) ++ k2).
destruct (find_label_prefix _ _ _ _ H) as [j Hj];
 rewrite cons_app in Hj; rewrite <- app_ass in Hj; apply app_inv_tail in Hj; subst pre.
  erewrite app_ass in H; simpl in H;
  rewrite (IHs1 _ _ H); rewrite app_ass; reflexivity.
 change (Kseq Scontinue :: Kloop1 s1 s2 :: k1) with ((Kseq Scontinue :: Kloop1 s1 s2 :: nil) ++ k1)
   in H.
 change (Kseq Scontinue :: Kloop1 s1 s2 :: k2) with ((Kseq Scontinue :: Kloop1 s1 s2 :: nil) ++ k2).
 erewrite (find_label_None); eauto.
 destruct (find_label_prefix _ _ _ _ H0) as [j Hj];
  rewrite cons_app in Hj; rewrite <- app_ass in Hj; apply app_inv_tail in Hj; subst pre.
  erewrite app_ass in H0; simpl in H0;
  rewrite (IHs2 _ _ H0); rewrite app_ass; reflexivity.
destruct (find_label_ls_prefix _ _ _ _ H) as [j Hj];
 rewrite cons_app in Hj; rewrite <- app_ass in Hj; apply app_inv_tail in Hj; subst pre.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (@nil cont')) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (@cons cont' a k)) m *)
  erewrite app_ass in H; simpl in H.
  rewrite (find_label_ls_prefix2' _ _ _ _ H); rewrite app_ass; reflexivity.
(* Goal: @eq cont (strip_skip (@app cont' (@nil cont') k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' a k) k')) (@cons cont' c (@app cont' l k')) *)
  if_tac. inv H. rewrite cons_app in H2. apply app_inv_tail in H2; subst. reflexivity.
  eauto.

(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros. clear find_label_ls_prefix2'.
revert pre k1 H k2; induction s; simpl; intros; try congruence;
 try match type of H with match ?A with Some _ => _| None => _ end = _
                => revert H; case_eq A; intros; [inv H0 | ]
       end;
 eauto.
 (destruct (find_label_prefix _ _ _ _ H) as [j Hj];
 rewrite cons_app in Hj; rewrite <- app_ass in Hj; apply app_inv_tail in Hj; subst pre;
  erewrite app_ass in H; simpl in H).
  rewrite (find_label_prefix2' _ _ _ _ H); rewrite app_ass; reflexivity;
 try solve [erewrite (find_label_ls_None); eauto].
  erewrite (find_label_None); eauto.
Qed.

Lemma find_label_prefix2:
  forall lbl s pre j ctl1 ctl2,
   find_label lbl s (pre++ctl1) = Some (j++ctl1) ->
   find_label lbl s (pre++ctl2) = Some (j++ctl2).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @eq (option cont) (find_label lbl s (@app cont' pre ctl2)) (@Some (list cont') (@app cont' j ctl2)) *)
 destruct (find_label_prefix _ _ _ _ H).
 rewrite <- app_ass in H0.
(* Goal: @eq (option cont) (find_label lbl s (@app cont' pre ctl2)) (@Some (list cont') (@app cont' j ctl2)) *)
 apply  app_inv_tail in H0. subst j.
 rewrite app_ass in *.
 forget (pre++ctl1) as k1. forget (pre++ctl2) as k2.
(* Goal: @eq (option cont) (find_label lbl s k2) (@Some (list cont') (@app cont' x k2)) *)
 clear - H. rename x into pre.
 eapply find_label_prefix2'; eauto.
Qed.

Lemma control_as_safe_bupd {Espec: OracleKind}: forall ge n ctl1 ctl2, control_as_safe ge n ctl1 ctl2 ->
 forall (ora : OK_ty) (ve : env) (te : temp_env) (m : juicy_mem) (n' : nat),
     n' <= n ->
     jm_bupd ora (jsafeN (@OK_spec Espec) ge n' ora (State ve te ctl1)) m ->
     jm_bupd ora (jsafeN (@OK_spec Espec) ge n' ora (State ve te ctl2)) m.
Proof.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
  repeat intro.
  destruct (H1 _ H2) as (? & ? & ? & ?); eauto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma corestep_preservation_lemma {Espec: OracleKind}:
   forall ge ctl1 ctl2 ora ve te m n c l c' m',
       filter_seq ctl1 = filter_seq ctl2 ->
      (forall k : list cont', control_as_safe ge n (k ++ ctl1) (k ++ ctl2)) ->
      control_as_safe ge (S n) ctl1 ctl2 ->
      jstep (cl_core_sem ge) (State ve te (c :: l ++ ctl1)) m c' m' ->
      jm_bupd ora (jsafeN (@OK_spec Espec) ge n ora c') m' ->
   exists c2 : corestate,
     exists m2 : juicy_mem,
       jstep (cl_core_sem ge) (State ve te (c :: l ++ ctl2)) m c2 m2 /\
       jm_bupd ora (jsafeN (@OK_spec Espec) ge n ora c2) m2.
Proof. intros until m'. intros H0 H4 CS0 H H1.
  remember (State ve te (c :: l ++ ctl1)) as q. rename c' into q'.
  destruct H as [H [Hb [Hc Hg]]].
  remember (m_dry m) as dm; remember (m_dry m') as dm'.
  revert c l m Heqdm m' Heqdm' Hb Hc Hg H1 Heqq; induction H; intros; try inv Heqq.
  (* assign *)
  do 2 eexists; split; [split3; [econstructor; eauto | auto | auto ] | eapply control_as_safe_bupd; auto ].
  (* set *)
  do 2 eexists; split; [split3; [ | eassumption | auto ] | ].
  rewrite <- Heqdm'; econstructor; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  eapply control_as_safe_bupd; auto.
  (* call_internal *)
  do 2 eexists; split; [split3; [econstructor; eauto | auto | auto ] |  ].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  do 3 rewrite cons_app'. eapply control_as_safe_bupd; auto.
  (* call_external *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
{ do 2 eexists; split; [split3; [ | eassumption | auto ] | ].
  rewrite <- Heqdm';  eapply step_call_external; eauto.
  intros ? HC J; specialize (H5 _ HC J) as (m'' & J' & Hupd & H5).
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists m''; split; auto; split; auto.
  destruct n; [constructor|].
  inv H5.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  { destruct H7 as (?&?&?). inv H5. }
  { eapply jsafeN_external; eauto.
    intros ret m'0 z'' n'' Hargsty Hretty Hle H10 H11; specialize (H9 ret m'0 z'' n'' Hargsty Hretty Hle H10 H11).
    destruct H9 as [c' [? ?]]. simpl in H5. unfold cl_after_external in *.
    destruct ret as [ret|]. destruct optid.
    exists (State ve (PTree.set i ret te) (l ++ ctl2)); split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    inv H5. eapply control_as_safe_bupd; auto.
    destruct H10 as (?&?&?). inv H5.
    exists (State ve te (l ++ ctl2)); split; auto. eapply control_as_safe_bupd; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    destruct optid; auto.
    exists (State ve (PTree.set i Vundef te) (l ++ ctl2)); split; auto.  inv H5. eapply control_as_safe_bupd; auto.
    exists (State ve te (l ++ ctl2)); split; auto. eapply control_as_safe_bupd; auto.
    inv H5. auto. }
   contradiction. }
  (* sequence  *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  { destruct (IHcl_step (Kseq s1) (Kseq s2 :: l)
            _ (eq_refl _) _ (eq_refl _) Hb Hc Hg H1 (eq_refl _))
      as [c2 [m2 [? ?]]]; clear IHcl_step.
    destruct H2 as [H2 [H2b H2c]].
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
    exists c2, m2; split; auto. split3; auto. constructor. apply H2. }
  (* skip *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  { destruct l.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (@nil cont')) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (@cons cont' a k)) m *)
    simpl in H.
   assert (jsafeN (@OK_spec Espec) ge (S n) ora (State ve te ctl1) m0).
   { econstructor; eauto; split3; eauto. }
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
   apply CS0 in H2; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    eapply safe_step_forward in H2; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
   destruct H2 as [st2 [m2 [? ?]]]; exists st2; exists m2; split; auto.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
   simpl.
     destruct H2 as [H2 [H2b H2c]].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
    split3; auto.
    simpl; rewrite <- strip_step. simpl. rewrite strip_step; auto.
    destruct (IHcl_step c l _ (eq_refl _) _ (eq_refl _) Hb Hc Hg H1 (eq_refl _))
      as [c2 [m2 [? ?]]]; clear IHcl_step.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
    exists c2; exists m2; split; auto.
    destruct H2 as [H2 [H2b H2c]].
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
   simpl.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
   split3; auto.
   simpl; rewrite <- strip_step.
   change (strip_skip (Kseq Sskip :: c :: l ++ ctl2)) with (strip_skip (c::l++ctl2)).
   rewrite strip_step; auto. }
  (* continue *)
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  case_eq (continue_cont l); intros.
  assert (continue_cont (l++ctl1) = continue_cont (l++ctl2)).
  clear - H0 H2.
  induction l; simpl in *.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 revert ctl2 H0; induction ctl1; simpl; intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; simpl; intros; auto.
 destruct a; simpl in *; auto. inv H0. inv H0.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct a; auto.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 revert H0; induction ctl2; simpl; intros. inv H0.
 destruct a; try congruence. rewrite <- (IHctl2 H0).
(* Goal: @eq (@pred rmap ag_rmap) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho))) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F0 rho) (@sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (P rho) (F rho))) *)
 f_equal.
 revert H0; induction ctl2; simpl; intros; try destruct a; try congruence.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 auto.
 revert H0; induction ctl2; simpl; intros; try destruct a; try congruence.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 auto.
 revert H0; induction ctl2; simpl; intros; try destruct a; try congruence.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct a; try congruence. auto. auto.
  rewrite H3 in H.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists st', m'0; split; auto.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  constructor. auto.
  assert (forall k, continue_cont (l++k) = c::l0++k).
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
  clear - H2. revert H2; induction l; intros; try destruct a; simpl in *; auto; try discriminate.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  repeat rewrite cons_app'. f_equal; auto.
  rewrite H3 in H, IHcl_step.
  destruct (IHcl_step _ _ _ (eq_refl _) _ (eq_refl _) Hb Hc Hg H1 (eq_refl _)) as [c2 [m2 [? ?]]]; clear IHcl_step.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2,m2; split; auto.
   destruct H5 as [H5 [H5b H5c]].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
 split3; auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
 constructor. rewrite H3; auto.
  (* break *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
{
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  case_eq (prebreak_cont l); intros.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  {
  assert (break_cont (l++ctl1) = break_cont (l++ctl2)).
  clear - H0 H2.
  revert H2; induction l; simpl; intros; try destruct a; try congruence.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  revert ctl2 H0; induction ctl1; simpl; intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; simpl; intros; try destruct a; try congruence. auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct a. auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; try destruct a; simpl; intros; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; try destruct a; simpl; intros; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; try destruct a; simpl; intros; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 revert H0; induction ctl2; try destruct a; simpl; intros; try congruence; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 destruct s; auto.
  rewrite H3 in H.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists st', m'0; split; auto.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  constructor. auto.
  }
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  {
  assert (PB:= prebreak_cont_is l); rewrite H2 in PB.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  destruct c; try contradiction.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  {
  assert (forall k, break_cont (l++k) = l0++k).
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
  clear - H2.
  revert H2; induction l; intros; try destruct a; simpl in *; auto; congruence.
  rewrite H3 in H.
  destruct l0; simpl in *.
  hnf in CS0.
  specialize (CS0 ora ve te m0 (S n)).
  assert (semantics.corestep (juicy_core_sem (cl_core_sem ge)) (State ve te ctl1) m0 st' m'0).
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
  pose proof (@jsafeN_step genv _ _ genv_symb_injective (cl_core_sem ge) OK_spec ge _ _ _ _ _ _ H5 H1).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply CS0 in H6; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (safe_step_forward ge n ora (State ve te ctl2) m0) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2; exists m2; split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct H7;  constructor; auto. constructor; auto. rewrite H3. auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (IHcl_step c l0 m0 (eq_refl _) m'0 (eq_refl _)) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  rewrite H3; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2,m2; split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  destruct H5; split; auto. constructor; auto. rewrite H3; auto.
  }
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  {
  assert (forall k, break_cont (l++k) = l0++k).
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
  clear - H2.
  revert H2; induction l; intros; try destruct a; simpl in *; auto; congruence.
  rewrite H3 in H.
  destruct l0; simpl in *.
  hnf in CS0.
  specialize (CS0 ora ve te m0 (S n)).
  assert (semantics.corestep (juicy_core_sem (cl_core_sem ge)) (State ve te ctl1) m0 st' m'0).
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
  pose proof (@jsafeN_step genv _ _ genv_symb_injective  (cl_core_sem ge) OK_spec ge _ _ _ _ _ _ H5 H1).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply CS0 in H6; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (safe_step_forward ge n ora (State ve te ctl2) m0) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2; exists m2; split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct H7;  constructor; auto. constructor; auto. rewrite H3. auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (IHcl_step c l0 m0 (eq_refl _) m'0 (eq_refl _)) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  rewrite H3; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2,m2; split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  destruct H5; split; auto. constructor; auto. rewrite H3; auto.
  }
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  {
  assert (forall k, break_cont (l++k) = l0++k).
(* Goal: @list_disjoint ident (@app ident bb aa) cc *)
  clear - H2.
  revert H2; induction l; intros; try destruct a; simpl in *; auto; congruence.
  rewrite H3 in H.
  destruct l0; simpl in *.
  hnf in CS0.
  specialize (CS0 ora ve te m0 (S n)).
  assert (semantics.corestep (juicy_core_sem (cl_core_sem ge)) (State ve te ctl1) m0 st' m'0).
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
  pose proof (@jsafeN_step genv _ _ genv_symb_injective  (cl_core_sem ge) OK_spec ge _ _ _ _ _ _ H5 H1).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply CS0 in H6; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (safe_step_forward ge n ora (State ve te ctl2) m0) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2; exists m2; split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct H7;  constructor; auto. constructor; auto. rewrite H3. auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct (IHcl_step c l0 m0 (eq_refl _) m'0 (eq_refl _)) as [c2 [m2 [? ?]]]; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  rewrite H3; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2,m2; split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  destruct H5; split; auto. constructor; auto. rewrite H3; auto.
  }
  }
}
  (* ifthenelse *)
  exists (State ve te (Kseq (if b then s1 else s2) :: l ++ ctl2)), m'.
  split. split3; auto. rewrite <- Heqdm'. econstructor; eauto.
  rewrite cons_app. rewrite <- app_ass.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  eapply control_as_safe_bupd; auto.
  (* loop *)
  change (Kseq s1 :: Kseq Scontinue :: Kloop1 s1 s2 :: l ++ ctl1) with
               ((Kseq s1 :: Kseq Scontinue :: Kloop1 s1 s2 :: l) ++ ctl1) in H1.
  eapply control_as_safe_bupd in H1; eauto.
  do 2 eexists; split; eauto.
   split3; eauto. rewrite <- Heqdm'.
  econstructor; eauto.
  (* loop2 *)
  change (Kseq s :: Kseq Scontinue :: Kloop1 s a3 :: l ++ ctl1) with
              ((Kseq s :: Kseq Scontinue :: Kloop1 s a3 :: l) ++ ctl1) in H1.
  eapply control_as_safe_bupd in H1; eauto.
  do 2 eexists; split; eauto.   split3; eauto. rewrite <- Heqdm'.  econstructor; eauto.
 (* return *)
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  case_eq (call_cont l); intros.
  rewrite call_cont_app_nil in * by auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists (State ve' te'' k'), m'0; split; auto.
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  econstructor; try eassumption. rewrite call_cont_app_nil; auto.
  rewrite <- (filter_seq_call_cont _ _ H0); auto.
(* Goal: @eq cont (strip_skip (@app cont' (@nil cont') k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' a k) k')) (@cons cont' c (@app cont' l k')) *)
  rewrite (call_cont_app_cons _ _ _ H6) in H. inv H.
  do 2 eexists; split.
  split3; eauto.
  econstructor; try eassumption.
 rewrite (call_cont_app_cons _ _ _ H6). reflexivity.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  eapply control_as_safe_bupd; auto.
 (* switch *)
  do 2 eexists; split; [split3; [| eauto | eauto] | ].
  rewrite <- Heqdm'. econstructor; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  do 2 rewrite cons_app'. eapply control_as_safe_bupd; auto.
 (* label *)
  destruct (IHcl_step _ _  _ (eq_refl _) _ (eq_refl _) Hb Hc Hg H1 (eq_refl _)) as [c2 [m2 [? ?]]]; clear IHcl_step.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists c2, m2; split; auto.
   destruct H2 as [H2 [H2b H2c]].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  constructor; auto.
 (* goto *)
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  case_eq (call_cont l); intros.
  do 2 eexists; split; [ | apply H1].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
  rewrite <- Heqdm'; econstructor. 2: rewrite call_cont_app_nil; auto.
  instantiate (1:=f).
  generalize (filter_seq_current_function ctl1 ctl2 H0); intro.
  clear - H3 H2 CUR.
  revert l H3 H2 CUR; induction l; simpl; try destruct a; intros; auto; try congruence.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  rewrite call_cont_app_nil in H by auto.
  rewrite <- (filter_seq_call_cont ctl1 ctl2 H0); eauto.
  rewrite (call_cont_app_cons _ _ _ H2) in H.
  assert (exists j, k' = j ++ ctl1).
  clear - H2 H.
  assert (exists id, exists f, exists ve, exists te, c =  Kcall id f ve te).
  clear - H2; induction l; [inv H2 | ].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  destruct a; simpl in H2; auto. inv H2; do 4 eexists; reflexivity.
  destruct H0 as [id [ff [ve [te ?]]]]. clear H2; subst c.
  change (find_label lbl (fn_body f)
      ((Kseq (Sreturn None) :: Kcall id ff ve te :: l0) ++ ctl1) = Some k') in H.
  forget (Kseq (Sreturn None) :: Kcall id ff ve te :: l0) as pre.
  assert (exists j, k' = j++ (pre++ctl1));
   [ | destruct H0 as [j H0]; exists (j++pre); rewrite app_ass; auto ].
(* Goal: @eq (option cont) (find_label lbl s k2) (@Some (list cont') (@app cont' x k2)) *)
  forget (pre++ctl1) as ctl. forget (fn_body f) as s;  clear - H.
 eapply find_label_prefix; eauto.
  destruct H3 as [j ?].
  subst k'.
  exists (State ve te (j++ctl2)), m'; split; [ | eapply control_as_safe_bupd; eauto].
(* Goal: @jstep corestate (cl_core_sem psi) (State ve te (@cons cont' (Kseq Sskip) k)) jm q' m'0 *)
  split3; auto.
  rewrite <- Heqdm'; econstructor.
  instantiate (1:=f).
  clear - CUR H2.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  revert f c l0 CUR H2; induction l; simpl; intros. inv H2.
  destruct a; simpl in *; eauto.
  rewrite (call_cont_app_cons _ _ _ H2).
  clear - H2 H.
  change (Kseq (Sreturn None) :: c :: l0 ++ ctl1) with ((Kseq (Sreturn None) :: c :: l0) ++ ctl1) in H.
  change (Kseq (Sreturn None) :: c :: l0 ++ ctl2) with ((Kseq (Sreturn None) :: c :: l0) ++ ctl2).
  forget (Kseq (Sreturn None) :: c :: l0)  as pre.
(* Goal: @eq (option cont) (find_label lbl s k2) (@Some (list cont') (@app cont' x k2)) *)
clear - H.
 eapply find_label_prefix2; eauto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma control_as_safe_le {Espec: OracleKind}:
  forall n' n ge ctl1 ctl2, n' <= n -> control_as_safe ge n ctl1 ctl2 -> control_as_safe ge n' ctl1 ctl2.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros. intro; intros. eapply H0; auto; omega.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma control_suffix_safe {Espec: OracleKind}:
    forall
      ge n ctl1 ctl2 k,
      filter_seq ctl1 = filter_seq ctl2 ->
      control_as_safe ge n ctl1 ctl2 ->
      control_as_safe ge n (k ++ ctl1) (k ++ ctl2).
  Proof.
(* Goal: forall (ge : genv) (n : nat) (ctl1 ctl2 : cont) (k : list cont') (_ : @eq cont (filter_seq ctl1) (filter_seq ctl2)) (_ : @control_as_safe Espec ge n ctl1 ctl2), @control_as_safe Espec ge n (@app cont' k ctl1) (@app cont' k ctl2) *)
    intro ge. induction n using (well_founded_induction lt_wf).
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros. hnf; intros.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge n' ora (State ve te (@app cont' k ctl2)) m *)
    destruct n'; [ constructor | ].
    assert (forall k, control_as_safe ge n' (k ++ ctl1) (k ++ ctl2)).
(* Goal: le n' n *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@app cont' k ctl2)) m *)
    intro; apply H; auto. apply control_as_safe_le with n; eauto. omega.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
   case_eq (strip_skip k); intros.
    rewrite <- safeN_strip in H3|-*.  rewrite strip_skip_app in H3|-* by auto.
   rewrite safeN_strip in H3|-*.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    auto.
   assert (ZZ: forall k, strip_skip (c::l++k) = c::l++k)
    by (clear - H5; intros; rewrite <- (strip_skip_app_cons H5); rewrite strip_strip; auto).
  rewrite <- safeN_strip in H3|-*.
  rewrite (strip_skip_app_cons H5) in H3|-* by auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
  inv H3.
  apply corestep_preservation_lemma
    with (c0 := c) (l0 := l) (ve0 := ve) (te0 := te) (m0 := m)
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
         (ctl3:=ctl1) (ctl4:=ctl2) (n0 := n') in H8; auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
(* Goal: @control_as_safe Espec ge (S n') ctl1 ctl2 *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
   destruct H8 as [? [? [? ?]]].
   econstructor; eauto.
   eapply control_as_safe_le; eauto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n') ora (State ve te (@cons cont' c (@app cont' l ctl2))) m *)
  simpl in H7. congruence.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  simpl in H6. unfold cl_halted in H6. contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma guard_safe_adj {Espec: OracleKind}:
 forall
   psi Delta P k1 k2,
   current_function k1 = current_function k2 ->
  (forall ora m ve te n,
     jsafeN (@OK_spec Espec) psi n ora (State ve te k1) m ->
     jsafeN (@OK_spec Espec) psi n ora (State ve te k2) m) ->
  guard Espec psi Delta P k1 |-- guard Espec psi Delta P k2.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @derives nat ag_nat (guard Espec psi Delta P k1) (guard Espec psi Delta P k2) *)
unfold guard.
(* Goal: @derives nat ag_nat (@allp nat ag_nat env (fun vx : env => let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function k1) rho)) (P rho)) (funassert Delta rho)) (assert_safe Espec psi vx tx k1 rho)))) (@allp nat ag_nat env (fun vx : env => let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function k2) rho)) (P rho)) (funassert Delta rho)) (assert_safe Espec psi vx tx k2 rho)))) *)
apply allp_derives. intros tx.
(* Goal: @derives nat ag_nat (@allp nat ag_nat env (fun vx : env => let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function k1) rho)) (P rho)) (funassert Delta rho)) (assert_safe Espec psi vx tx k1 rho)))) (@allp nat ag_nat env (fun vx : env => let rho := construct_rho (filter_genv psi) vx tx in @fash rmap ag_rmap (@imp rmap ag_rmap (@andp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (guard_environ Delta (current_function k2) rho)) (P rho)) (funassert Delta rho)) (assert_safe Espec psi vx tx k2 rho)))) *)
apply allp_derives. intros vx.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
rewrite H; apply subp_derives; auto.
(* Goal: @derives rmap ag_rmap (assert_safe Espec psi vx tx k1 (construct_rho (filter_genv psi) vx tx)) (assert_safe Espec psi vx tx k2 (construct_rho (filter_genv psi) vx tx)) *)
apply bupd_mono.
(* Goal: @derives rmap ag_rmap (@exist (forall _ : rmap, Prop) (fun p : forall _ : rmap, Prop => @hereditary rmap (@age rmap ag_rmap) p) (fun w : rmap => forall (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) w) (_ : @eq environ (construct_rho (filter_genv psi) vx tx) (construct_rho (filter_genv psi) vx tx)) (_ : @eq rmap (m_phi jm) w), @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap w) ora (State vx tx k1) jm) (semax.assert_safe_obligation_1 Espec psi vx tx k1 (construct_rho (filter_genv psi) vx tx))) (@exist (forall _ : rmap, Prop) (fun p : forall _ : rmap, Prop => @hereditary rmap (@age rmap ag_rmap) p) (fun w : rmap => forall (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) w) (_ : @eq environ (construct_rho (filter_genv psi) vx tx) (construct_rho (filter_genv psi) vx tx)) (_ : @eq rmap (m_phi jm) w), @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi (@level rmap ag_rmap w) ora (State vx tx k2) jm) (semax.assert_safe_obligation_1 Espec psi vx tx k2 (construct_rho (filter_genv psi) vx tx))) *)
intros w ? ? ? ? ? ?.
(* Goal: @eq mpred (F rho') (F (mkEnviron (ge_of rho') (ve_of rho') te')) *)
apply H0.
eapply H1; eauto.
Qed.

Lemma assert_safe_adj:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} ge ve te k k' rho,
      (forall n, control_as_safe ge n k k') ->
     assert_safe Espec ge ve te k rho |-- assert_safe Espec ge ve te k' rho.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros. apply bupd_mono. intros w ? ? ? ? ? ?. specialize (H0 ora jm H1 H2 H3).
(* Goal: @eq mpred (F rho') (F (mkEnviron (ge_of rho') (ve_of rho') te')) *)
 eapply H; try apply H0. apply le_refl.
Qed.

Lemma assert_safe_adj':
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} ge ve te k k' rho P w,
      (forall n, control_as_safe ge n k k') ->
     app_pred (P >=> assert_safe Espec ge ve te k rho) w ->
     app_pred (P >=> assert_safe Espec ge ve te k' rho) w.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k' rho))) w *)
 eapply subp_trans'; [ | apply derives_subp; eapply assert_safe_adj; try eassumption; eauto].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
 auto.
Qed.

Lemma rguard_adj:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
  forall {Espec: OracleKind} ge Delta R k k',
      current_function k = current_function k' ->
      (forall ek vl n, control_as_safe ge n (exit_cont ek vl k) (exit_cont ek vl k')) ->
      rguard Espec ge Delta R k |-- rguard Espec ge Delta R k'.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros.
 intros n H1;  hnf in H1|-*.
(* Goal: forall b : exitkind, @app_pred nat ag_nat (@allp nat ag_nat (option val) (fun vl : option val => _guard Espec ge Delta (proj_ret_assert R b vl) (current_function k') (exit_cont b vl k'))) n *)
 intros ek vl te ve; specialize (H1 ek vl te ve).
 rewrite <- H.
 eapply assert_safe_adj'; eauto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma assert_safe_last': forall {Espec: OracleKind} ge ve te ctl rho w,
            (age1 w <> None -> assert_safe Espec ge ve te ctl rho w) ->
             assert_safe Espec ge ve te ctl rho w.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
 intros. apply assert_safe_last; intros. apply H. rewrite H0. congruence.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma pjoinable_emp_None {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
  forall w: option (psepalg.lifted JA), identity w ->  w=None.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
destruct w; auto.
(* Goal: @eq (option (@psepalg.lifted A JA)) (@Some (@psepalg.lifted A JA) l) (@None (@psepalg.lifted A JA)) *)
elimtype False.
(* Goal: False *)
specialize (H None (Some l)).
(* Goal: False *)
spec H.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi O ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
constructor.
(* Goal: False *)
inversion H.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma pjoinable_None_emp {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}:
           identity (None: option (psepalg.lifted JA)).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros; intro; intros.
(* Goal: @eq (option (@psepalg.lifted A JA)) a b *)
inv H; auto.
Qed.

Lemma unage_mapsto:
  forall sh t v1 v2 w, age1 w <> None -> (|> mapsto sh t v1 v2) w -> mapsto sh t v1 v2 w.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  case_eq (age1 w); intros; try contradiction.
(* Goal: @app_pred rmap ag_rmap (mapsto sh t v1 v2) w *)
  clear H.
(* Goal: @app_pred rmap ag_rmap (mapsto sh t v1 v2) w *)
  specialize (H0 _ (age_laterR H1)).
  unfold mapsto in *.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  revert H0; case_eq (access_mode t); intros; auto.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  destruct (type_is_volatile t); try contradiction.
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m *)
  destruct v1; try contradiction.
(* Goal: @app_pred rmap ag_rmap (if readable_share_dec sh then @orp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (tc_val t v2)) (address_mapsto m v2 sh (@pair block Z b (Ptrofs.unsigned i)))) (@andp rmap ag_rmap (@prop rmap ag_rmap (@eq val v2 Vundef)) (@exp rmap ag_rmap val (fun v2' : val => address_mapsto m v2' sh (@pair block Z b (Ptrofs.unsigned i))))) else @andp rmap ag_rmap (@prop rmap ag_rmap (and (tc_val' t v2) (Z.divide (align_chunk m) (Ptrofs.unsigned i)))) (nonlock_permission_bytes sh (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m))) w *)
  rename H into Hmode.
(* Goal: @app_pred rmap ag_rmap (if readable_share_dec sh then @orp rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (tc_val t v2)) (address_mapsto m v2 sh (@pair block Z b (Ptrofs.unsigned i)))) (@andp rmap ag_rmap (@prop rmap ag_rmap (@eq val v2 Vundef)) (@exp rmap ag_rmap val (fun v2' : val => address_mapsto m v2' sh (@pair block Z b (Ptrofs.unsigned i))))) else @andp rmap ag_rmap (@prop rmap ag_rmap (and (tc_val' t v2) (Z.divide (align_chunk m) (Ptrofs.unsigned i)))) (nonlock_permission_bytes sh (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m))) w *)
  if_tac; rename H into H_READ.
  + destruct H0 as [H0|H0]; [left | right].
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
    destruct H0 as [H0' H0]; split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    destruct H0 as [bl [[] ?]]; exists bl; split; [split|]; auto.
    clear - H0 H1.
(* Goal: @app_pred rmap ag_rmap (@allp rmap ag_rmap address (@jam rmap Join_rmap Perm_rmap ag_rmap Age_rmap address (adr_range (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (fun loc : address => yesat NoneP (VAL (@nth memval (nat_of_Z (Z.sub (@snd block Z loc) (@snd block Z (@pair block Z b (Ptrofs.unsigned i))))) bl Undef)) sh loc) noat)) w *)
(* Goal: @app_pred rmap ag_rmap noghost w *)
     intro loc'; specialize (H0 loc').
     hnf in *.
(* Goal: if adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m) loc' then @app_pred rmap ag_rmap (@andp rmap ag_rmap (shareat loc' sh) (nonlockat loc')) w else @app_pred rmap ag_rmap (noat loc') w *)
     if_tac.
(* Goal: @app_pred rmap ag_rmap (yesat NoneP (VAL (@nth memval (nat_of_Z (Z.sub (@snd block Z loc') (@snd block Z (@pair block Z b (Ptrofs.unsigned i))))) bl Undef)) sh loc') w *)
(* Goal: @app_pred rmap ag_rmap (noat loc') w *)
(* Goal: @app_pred rmap ag_rmap noghost w *)
     destruct H0 as [p ?]; exists p.
     hnf in *.
     rewrite preds_fmap_NoneP in *.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
     apply (age1_YES w r); auto.
     unfold noat in *; simpl in *.
    apply <- (age1_resource_at_identity _ _ loc' H1); auto.
    eapply age1_ghost_of_identity; eauto.
(* Goal: @app_pred rmap ag_rmap (@andp rmap ag_rmap (@prop rmap ag_rmap (@eq val v2 Vundef)) (@exp rmap ag_rmap val (fun v2' : val => address_mapsto m v2' sh (@pair block Z b (Ptrofs.unsigned i))))) w *)
    destruct H0 as [? [v2' [bl [[] ?]]]].
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    hnf in H. subst v2. split; hnf; auto. exists v2', bl; split; [split|]; auto.
    clear - H2 H1; rename H2 into H0.
(* Goal: @app_pred rmap ag_rmap (@allp rmap ag_rmap address (@jam rmap Join_rmap Perm_rmap ag_rmap Age_rmap address (adr_range (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (fun loc : address => yesat NoneP (VAL (@nth memval (nat_of_Z (Z.sub (@snd block Z loc) (@snd block Z (@pair block Z b (Ptrofs.unsigned i))))) bl Undef)) sh loc) noat)) w *)
(* Goal: @app_pred rmap ag_rmap noghost w *)
     intro loc'; specialize (H0 loc').
     hnf in *.
(* Goal: if adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m) loc' then @app_pred rmap ag_rmap (@andp rmap ag_rmap (shareat loc' sh) (nonlockat loc')) w else @app_pred rmap ag_rmap (noat loc') w *)
     if_tac.
(* Goal: @app_pred rmap ag_rmap (yesat NoneP (VAL (@nth memval (nat_of_Z (Z.sub (@snd block Z loc') (@snd block Z (@pair block Z b (Ptrofs.unsigned i))))) bl Undef)) sh loc') w *)
(* Goal: @app_pred rmap ag_rmap (noat loc') w *)
(* Goal: @app_pred rmap ag_rmap noghost w *)
     destruct H0 as [p ?]; exists p.
     hnf in *.
     rewrite preds_fmap_NoneP in *.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
     apply (age1_YES w r); auto.
     unfold noat in *; simpl in *.
    apply <- (age1_resource_at_identity _ _ loc' H1); auto.
    eapply age1_ghost_of_identity; eauto.
  + split; [exact (proj1 H0) |].
(* Goal: @app_pred rmap ag_rmap (nonlock_permission_bytes sh (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) w *)
    destruct H0 as [_ [? Hg]].
(* Goal: @app_pred rmap ag_rmap (nonlock_permission_bytes sh (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) w *)
    split; [|eapply age1_ghost_of_identity; eauto].
(* Goal: @app_pred rmap ag_rmap (@allp rmap ag_rmap address (@jam rmap Join_rmap Perm_rmap ag_rmap Age_rmap address (adr_range (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m)) (fun i : address => @andp rmap ag_rmap (shareat i sh) (nonlockat i)) noat)) w *)
    intro loc'; specialize (H loc').
    hnf in *.
(* Goal: if adr_range_dec (@pair block Z b (Ptrofs.unsigned i)) (size_chunk m) loc' then @app_pred rmap ag_rmap (@andp rmap ag_rmap (shareat loc' sh) (nonlockat loc')) w else @app_pred rmap ag_rmap (noat loc') w *)
    if_tac.
    - unfold shareat in *; simpl in *.
(* Goal: and (@eq (option share) (resource_share (resource_at w loc')) (@Some share sh)) (nonlock (resource_at w loc')) *)
      pose proof H1.
(* Goal: and (@eq (option share) (resource_share (resource_at w loc')) (@Some share sh)) (nonlock (resource_at w loc')) *)
      apply age1_resource_share with (l := loc') in H1.
(* Goal: and (@eq (option share) (resource_share (resource_at w loc')) (@Some share sh)) (nonlock (resource_at w loc')) *)
      apply age1_nonlock with (l := loc') in H2.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
      rewrite H1; tauto.
    - unfold noat in *; simpl in *.
      apply <- (age1_resource_at_identity _ _ loc' H1); auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_extensionality_Delta {CS: compspecs} {Espec: OracleKind}:
  forall Delta Delta' P c R,
       tycontext_sub Delta Delta' ->
     semax Espec Delta P c R -> semax Espec Delta' P c R.
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
unfold semax in *.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @app_pred nat ag_nat (@semax' CS Espec Delta' P c R) n *)
specialize (H0 n).
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
apply (semax_extensionality1 Delta Delta' P P c R R); auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
split; auto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
intros ? ? ?; auto.
Qed.

End extensions.

(* Goal: EqDec floatsize *)
Definition Cnot (e: Clight.expr) : Clight.expr :=
(* Goal: EqDec floatsize *)
   Clight.Eunop Cop.Onotbool e type_bool.

(* Mutually recursive induction scheme for [statement] and [labeled_statements] *)
Section statement_rect.
  Variable P : statement -> Type.
  Variable Q : labeled_statements -> Type.
  Variable f : P Sskip.
  Variable f0 : forall e e0 : expr, P (Sassign e e0).
  Variable f1 : forall (i : ident) (e : expr), P (Sset i e).
  Variable f2 : forall (o : option ident) (e : expr) (l : list expr), P (Scall o e l).
  Variable f3 : forall (o : option ident) (e : external_function) (t : typelist) (l : list expr), P (Sbuiltin o e t l).
  Variable f4 : forall s : statement, P s -> forall s0 : statement, P s0 -> P (Ssequence s s0).
  Variable f5 : forall (e : expr) (s : statement), P s -> forall s0 : statement, P s0 -> P (Sifthenelse e s s0).
  Variable f6 : forall s : statement, P s -> forall s0 : statement, P s0 -> P (Sloop s s0).
  Variable f7 : P Sbreak.
  Variable f8 : P Scontinue.
  Variable f9 : forall o : option expr, P (Sreturn o).
  Variable f10 : forall (e : expr) (l : labeled_statements), Q l -> P (Sswitch e l).
  Variable f11 : forall (l : label) (s : statement), P s -> P (Slabel l s).
  Variable f12 : forall l : label, P (Sgoto l).
  Variable f13 : Q LSnil.
  Variable f14 : forall (o : option Z) (s : statement) (l : labeled_statements), P s -> Q l -> Q (LScons o s l).

  Fixpoint statement_rect (s : statement) : P s :=
  match s as s0 return (P s0) with
  | Sskip => f
  | Sassign e e0 => f0 e e0
  | Sset i e => f1 i e
  | Scall o e l => f2 o e l
  | Sbuiltin o e t l => f3 o e t l
  | Ssequence s0 s1 => f4 s0 (statement_rect s0) s1 (statement_rect s1)
  | Sifthenelse e s0 s1 => f5 e s0 (statement_rect s0) s1 (statement_rect s1)
  | Sloop s0 s1 => f6 s0 (statement_rect s0) s1 (statement_rect s1)
  | Sbreak => f7
  | Scontinue => f8
  | Sreturn o => f9 o
  | Sswitch e l => f10 e l (labeled_statements_rect l)
  | Slabel l s0 => f11 l s0 (statement_rect s0)
  | Sgoto l => f12 l
  end
  with labeled_statements_rect (l : labeled_statements) : Q l :=
  match l as l0 return (Q l0) with
  | LSnil => f13
  | LScons o s l0 => f14 o s l0 (statement_rect s) (labeled_statements_rect l0)
  end.
End statement_rect.

Require Import VST.msl.eq_dec.

(* Equality is decidable on statements *)
Section eq_dec.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  Local Ltac t := hnf; decide equality; auto.

  Let eq_dec_type := type_eq.
  Let eq_dec_float := Float.eq_dec.
  Let eq_dec_float32 := Float32.eq_dec.
  Let eq_dec_int := Int.eq_dec.
  Let eq_dec_int64 := Int64.eq_dec.
  Let eq_dec_ident := ident_eq.
  Let eq_dec_signature := signature_eq.
  Let eq_dec_attr : EqDec attr. repeat t. Qed.
  Let eq_dec_signedness : EqDec signedness. t. Qed.
  Let eq_dec_intsize : EqDec intsize. t. Qed.
  Let eq_dec_floatsize : EqDec floatsize. t. Qed.
  Let eq_dec_Z : EqDec Z. repeat t. Qed.
  Let eq_dec_calling_convention : EqDec calling_convention. repeat t. Qed.
  Lemma eq_dec_external_function : EqDec external_function. repeat t. Qed.
  Let eq_dec_option_ident := option_eq (ident_eq).
  Let eq_dec_option_Z : EqDec (option Z). repeat t. Qed.
  Let eq_dec_typelist : EqDec typelist. repeat t. Qed.

  Lemma eq_dec_expr : EqDec expr.
  Proof. repeat t. Qed.

  Let eq_dec_expr := eq_dec_expr.
  Let eq_dec_option_expr : EqDec (option expr). repeat t. Qed.
  Let eq_dec_list_expr : EqDec (list expr). repeat t. Qed.

  Local Ltac eq_dec a a' :=
    let H := fresh in
    assert (H : {a = a'} + {a <> a'}) by (auto; repeat (decide equality ; auto));
    destruct H; [subst; auto | try (right; congruence)].

  Lemma eq_dec_statement : forall s s' : statement, { s = s' } + { s <> s' }.
  Proof.
    apply
      (statement_rect
         (fun s => forall s', { s = s' } + { s <> s' })
         (fun l => forall l', { l = l' } + { l <> l' }));
      try (intros until s'; destruct s'); intros;
      try (destruct l');
      try solve [right; congruence | left; reflexivity];
      repeat
        match goal with
        | |- context [ ?x ?a          = ?x ?b          ] => eq_dec a b
        | |- context [ ?x ?y ?a       = ?x ?y ?b       ] => eq_dec a b
        | |- context [ ?x ?a _        = ?x ?b _        ] => eq_dec a b
        | |- context [ ?x ?y ?z ?a    = ?x ?y ?z ?b    ] => eq_dec a b
        | |- context [ ?x ?y ?a _     = ?x ?y ?b _     ] => eq_dec a b
        | |- context [ ?x ?a _  _     = ?x ?b _  _     ] => eq_dec a b
        | |- context [ ?x ?y ?z ?t ?a = ?x ?y ?z ?t ?b ] => eq_dec a b
        | |- context [ ?x ?y ?z ?a _  = ?x ?y ?z ?b _  ] => eq_dec a b
        | |- context [ ?x ?y ?a _  _  = ?x ?y ?b _  _  ] => eq_dec a b
        | |- context [ ?x ?a _  _  _  = ?x ?b _  _  _  ] => eq_dec a b
        end.
  Qed.

  Lemma eq_dec_labeled_statements : forall l l' : labeled_statements, { l = l' } + { l <> l' }.
  Proof.
(* Goal: forall l l' : labeled_statements, sumbool (@eq labeled_statements l l') (not (@eq labeled_statements l l')) *)
    decide equality.
(* Goal: EqDec floatsize *)
    apply eq_dec_statement.
  Qed.

End eq_dec.

(* Goal: EqDec floatsize *)
Instance EqDec_statement: EqDec statement := eq_dec_statement.
Instance EqDec_external_function: EqDec external_function := eq_dec_external_function.

Lemma closed_Slabel l c F: closed_wrt_modvars (Slabel l c) F = closed_wrt_modvars c F.
Proof. unfold closed_wrt_modvars. rewrite modifiedvars_Slabel. trivial. Qed.

Lemma closed_Sifthenelse b c1 c2 F: closed_wrt_modvars (Sifthenelse b c1 c2) F <-> closed_wrt_modvars c1 F /\ closed_wrt_modvars c2 F.
Proof.
(* Goal: iff (closed_wrt_modvars (Ssequence c1 c2) F) (and (closed_wrt_modvars c1 F) (closed_wrt_modvars c2 F)) *)
  unfold closed_wrt_modvars.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Sifthenelse b c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_Sifthenelse b c1 c2.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Ssequence c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_computable c1 as TC.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Sifthenelse b c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars (Sifthenelse b c1 c2)) as S.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c1) as S1.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c2) as S2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  clear b c1 c2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  unfold closed_wrt_vars.
(* Goal: iff (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (and (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')))) *)
  split; [intros; split; intros | intros [? ?]; intros].
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + specialize (TC (te_of rho) te').
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    destruct TC as [te'' [? ?]].
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    transitivity (F (mkEnviron (ge_of rho) (ve_of rho) te'')).
    - apply H1.
(* Goal: forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      clear H0 H1.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H3 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H2 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
      destruct H2; [| rewrite <- H0 in *]; tauto.
    - change (mkEnviron (ge_of rho) (ve_of rho) te') with (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te').
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      change te'' with (te_of (mkEnviron (ge_of rho) (ve_of rho) te'')) in H3, H4, H2.
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      forget (mkEnviron (ge_of rho) (ve_of rho) te'') as rho'.
(* Goal: @eq mpred (F rho') (F (mkEnviron (ge_of rho') (ve_of rho') te')) *)
      apply H0.
(* Goal: forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      clear H0 H1 H2 H3 H te''.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      destruct H4; [auto | right; congruence].
Qed.

Lemma closed_Sloop c1 c2 F: closed_wrt_modvars (Sloop c1 c2) F <-> closed_wrt_modvars c1 F /\ closed_wrt_modvars c2 F.
Proof.
(* Goal: iff (closed_wrt_modvars (Ssequence c1 c2) F) (and (closed_wrt_modvars c1 F) (closed_wrt_modvars c2 F)) *)
  unfold closed_wrt_modvars.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Sloop c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_Sloop c1 c2.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Ssequence c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_computable c1 as TC.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Sloop c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars (Sloop c1 c2)) as S.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c1) as S1.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c2) as S2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  clear c1 c2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  unfold closed_wrt_vars.
(* Goal: iff (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (and (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')))) *)
  split; [intros; split; intros | intros [? ?]; intros].
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + specialize (TC (te_of rho) te').
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    destruct TC as [te'' [? ?]].
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    transitivity (F (mkEnviron (ge_of rho) (ve_of rho) te'')).
    - apply H1.
(* Goal: forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      clear H0 H1.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H3 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H2 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
      destruct H2; [| rewrite <- H0 in *]; tauto.
    - change (mkEnviron (ge_of rho) (ve_of rho) te') with (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te').
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      change te'' with (te_of (mkEnviron (ge_of rho) (ve_of rho) te'')) in H3, H4, H2.
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      forget (mkEnviron (ge_of rho) (ve_of rho) te'') as rho'.
(* Goal: @eq mpred (F rho') (F (mkEnviron (ge_of rho') (ve_of rho') te')) *)
      apply H0.
(* Goal: forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      clear H0 H1 H2 H3 H te''.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      destruct H4; [auto | right; congruence].
Qed.

Lemma closed_Ssequence c1 c2 F: closed_wrt_modvars (Ssequence c1 c2) F <-> closed_wrt_modvars c1 F /\ closed_wrt_modvars c2 F.
Proof.
(* Goal: iff (closed_wrt_modvars (Ssequence c1 c2) F) (and (closed_wrt_modvars c1 F) (closed_wrt_modvars c2 F)) *)
  unfold closed_wrt_modvars.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Ssequence c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_Ssequence c1 c2.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Ssequence c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  pose proof modifiedvars_computable c1 as TC.
(* Goal: iff (@closed_wrt_vars mpred (modifiedvars (Ssequence c1 c2)) F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars (Ssequence c1 c2)) as S.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred (modifiedvars c1) F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c1) as S1.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred (modifiedvars c2) F)) *)
  forget (modifiedvars c2) as S2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  clear c1 c2.
(* Goal: iff (@closed_wrt_vars mpred S F) (and (@closed_wrt_vars mpred S1 F) (@closed_wrt_vars mpred S2 F)) *)
  unfold closed_wrt_vars.
(* Goal: iff (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (and (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te'))) (forall (rho : environ) (te' : Map.t val) (_ : forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i))), @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')))) *)
  split; [intros; split; intros | intros [? ?]; intros].
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + apply H0.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
    intros.
(* Goal: or (S i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
    specialize (H1 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
    specialize (H i).
    clear - H H1.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    tauto.
  + specialize (TC (te_of rho) te').
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    destruct TC as [te'' [? ?]].
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
    transitivity (F (mkEnviron (ge_of rho) (ve_of rho) te'')).
    - apply H1.
(* Goal: forall i : ident, or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      clear H0 H1.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H3 i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H i).
(* Goal: or (S2 i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te'' i)) *)
      specialize (H2 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
      destruct H2; [| rewrite <- H0 in *]; tauto.
    - change (mkEnviron (ge_of rho) (ve_of rho) te') with (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te').
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      change te'' with (te_of (mkEnviron (ge_of rho) (ve_of rho) te'')) in H3, H4, H2.
(* Goal: @eq mpred (F (mkEnviron (ge_of rho) (ve_of rho) te'')) (F (mkEnviron (ge_of (mkEnviron (ge_of rho) (ve_of rho) te'')) (ve_of (mkEnviron (ge_of rho) (ve_of rho) te'')) te')) *)
      forget (mkEnviron (ge_of rho) (ve_of rho) te'') as rho'.
(* Goal: @eq mpred (F rho') (F (mkEnviron (ge_of rho') (ve_of rho') te')) *)
      apply H0.
(* Goal: forall i : ident, or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      clear H0 H1 H2 H3 H te''.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
      intros.
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      specialize (H4 i).
(* Goal: or (S1 i) (@eq (option val) (@Map.get val (te_of rho') i) (@Map.get val te' i)) *)
      destruct H4; [auto | right; congruence].
Qed.

Lemma closed_Sswitch e sl F:
  closed_wrt_modvars (Sswitch e sl) F ->
(* Goal: EqDec floatsize *)
  (forall n, closed_wrt_modvars (seq_of_labeled_statement (select_switch (Int.unsigned n) sl)) F).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
  unfold closed_wrt_modvars, closed_wrt_vars in *.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @eq mpred (F rho) (F (mkEnviron (ge_of rho) (ve_of rho) te')) *)
  apply H.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
  intros.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  specialize (H0 i); destruct H0; auto.
(* Goal: or (modifiedvars (Sswitch e sl) i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
  left.
  eapply modifiedvars_Sswitch; eauto.
Qed.

Lemma semax_eq:
(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
 forall {CS: compspecs} {Espec: OracleKind} Delta P c R,
  semax Espec Delta P c R = 
  (TT |-- (ALL psi : genv,
         ALL Delta' : tycontext,
         !! (tycontext_sub Delta Delta' /\ genv_cenv psi = cenv_cs) -->
         believe Espec Delta' psi Delta' -->
         ALL k : cont ,
         ALL F : assert ,
         !! closed_wrt_modvars c F &&
         rguard Espec psi Delta' (frame_ret_assert R F) k -->
         guard Espec psi Delta' (fun rho : environ => F rho * P rho) (Kseq c :: k))).
Proof.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
intros.
(* Goal: @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
extensionality w.
(* Goal: @eq Prop (@app_pred nat ag_nat (@semax' CS Espec Delta P c R) w) (forall _ : @app_pred nat ag_nat (@TT nat ag_nat) w, @app_pred nat ag_nat (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k))))))))) w) *)
rewrite semax_fold_unfold.
(* Goal: forall i : ident, or (modifiedvars s i) (@eq (option val) (@Map.get val (te_of rho) i) (@Map.get val te' i)) *)
apply prop_ext; intuition.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma safe_kseq_Slabel {Espec: OracleKind} psi n ora ve te l c k m :
  @jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora
      (State ve te (@cons cont' (Kseq c) k)) m ->
@jsafeN (@OK_ty Espec) (@OK_spec Espec) psi n ora
  (State ve te (@cons cont' (Kseq (Slabel l c)) k)) m.
Proof.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
inversion 1; subst.
+ constructor.
+ econstructor; eauto. simpl. destruct H0 as (?&?&?). split3; eauto. 
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
  simpl in H0. simpl. eapply step_label; trivial.
+ simpl in *; congruence.
+ simpl in *. unfold cl_halted in H0. contradiction.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma semax_Slabel {cs:compspecs} {Espec: OracleKind}
       (Gamma:tycontext) (P:environ -> mpred) (c:statement) (Q:ret_assert) l:
@semax cs Espec Gamma P c Q -> @semax cs Espec Gamma P (Slabel l c) Q.
(* Goal: forall (CS : compspecs) (Espec : OracleKind) (Delta : tycontext) (P : assert) (c : statement) (R : ret_assert), @eq Prop (@semax CS Espec Delta P c R) (@derives nat ag_nat (@TT nat ag_nat) (@allp nat ag_nat genv (fun psi : genv => @allp nat ag_nat tycontext (fun Delta' : tycontext => @imp nat ag_nat (@prop nat ag_nat (and (tycontext_sub Delta Delta') (@eq composite_env (genv_cenv psi) (@cenv_cs CS)))) (@imp nat ag_nat (@believe CS Espec Delta' psi Delta') (@allp nat ag_nat cont (fun k : cont => @allp nat ag_nat assert (fun F : assert => @imp nat ag_nat (@andp nat ag_nat (@prop nat ag_nat (closed_wrt_modvars c F)) (rguard Espec psi Delta' (frame_ret_assert R F) k)) (guard Espec psi Delta' (fun rho : environ => @sepcon rmap Join_rmap Perm_rmap ag_rmap Age_rmap (F rho) (P rho)) (@cons cont' (Kseq c) k)))))))))) *)
Proof. intros. 
rewrite semax_eq. rewrite semax_eq in H.
(* Goal: @app_pred rmap ag_rmap (mapsto sh t v1 v2) w *)
eapply derives_trans. eassumption. clear H.
apply allp_derives; intros psi.
apply allp_derives; intros Delta.
apply prop_imp_derives; intros TC.
apply imp_derives; [ apply derives_refl | ].
apply allp_derives; intros k.
apply allp_derives; intros F.
apply imp_derives; [ apply derives_refl | ].
apply guard_safe_adj; [ trivial | intros].
(* Goal: @eq Prop (@closed_wrt_vars mpred (modifiedvars c) F) (@closed_wrt_vars mpred (modifiedvars c) F) *)
apply safe_kseq_Slabel; trivial.
Qed.

Lemma denote_tc_resource: forall {cs: compspecs} rho a a' t, resource_at a = resource_at a' ->
  denote_tc_assert t rho a -> denote_tc_assert t rho a'.
Proof.
  induction t; auto; intros; simpl in *.
  - destruct H0; auto.
  - destruct H0; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *; if_tac; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *; if_tac; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho), (eval_expr e0 rho); auto; simpl in *.
    + simple_if_tac; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
      destruct H0; split; auto.
      destruct H1; [left | right]; simpl in *; rewrite <- H; auto.
    + simple_if_tac; auto.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
      destruct H0; split; auto.
      destruct H1; [left | right]; simpl in *; rewrite <- H; auto.
    + unfold test_eq_ptrs in *.
      destruct (sameblock _ _), H0; split; simpl in *; rewrite <- H; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho), (eval_expr e0 rho); auto; simpl in *.
    unfold test_order_ptrs in *.
    destruct (sameblock _ _), H0; split; simpl in *; rewrite <- H; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *; if_tac; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *; if_tac; auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *.
    + destruct (Zoffloat f); auto.
    + destruct (Zofsingle f); auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
    destruct (eval_expr e rho); auto; simpl in *.
    + destruct (Zoffloat f); auto.
    + destruct (Zofsingle f); auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    destruct (eval_expr e rho), (eval_expr e0 rho); auto.
  - unfold liftx in *; simpl in *.
    unfold lift in *; simpl in *.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
    destruct (eval_expr e rho), (eval_expr e0 rho); auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma bupd_denote_tc: forall {cs: compspecs} P t rho a,
  denote_tc_assert t rho a -> bupd P a -> bupd (denote_tc_assert t rho && P) a.
Proof.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
  repeat intro.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
  destruct (H0 _ H1) as (b & ? & m & ? & ? & ? & ?); subst.
  eexists; split; eauto; exists m; repeat split; eauto.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  eapply denote_tc_resource; [|eauto]; auto.
Qed.

(* Goal: @jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (S n) ora (State ve te (strip_skip k)) m *)
Lemma assert_safe_jsafe: forall {Espec: OracleKind} ge ve te ctl ora jm,
  assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te) (m_phi jm) ->
  jm_bupd ora (jsafeN OK_spec ge (level jm) ora (State ve te ctl)) jm.
Proof.
(* Goal: forall (Espec : OracleKind) (ge : genv) (ve : env) (te : temp_env) (ctl : cont) (ora : @OK_ty Espec) (jm : juicy_mem) (_ : @app_pred rmap ag_rmap (assert_safe Espec ge ve te ctl (construct_rho (filter_genv ge) ve te)) (m_phi jm)), @jm_bupd (@OK_ty Espec) ora (@jsafeN (@OK_ty Espec) (@OK_spec Espec) ge (@level juicy_mem juicy_mem_ageable jm) ora (State ve te ctl)) jm *)
  repeat intro.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
  destruct (H _ H1) as (? & ? & ? & Hl & Hr & ? & Hsafe); subst.
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
(* Goal: @eq cont (strip_skip (@app cont' (@cons cont' (Kseq s) k) k')) (@cons cont' c (@app cont' l k')) *)
  destruct (juicy_mem_resource _ _ Hr) as (jm' & ? & ?); subst.
(* Goal: @app_pred nat ag_nat (@andp nat ag_nat (@allp nat ag_nat exitkind (fun ek : exitkind => @allp nat ag_nat (option val) (fun vl : option val => @allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (proj_ret_assert R ek vl rho) (proj_ret_assert R ek vl rho)))))) (@allp nat ag_nat environ (fun rho : environ => @fash rmap ag_rmap (@imp rmap ag_rmap (P rho) (P rho))))) n *)
  exists jm'; repeat split; auto.
  rewrite level_juice_level_phi, <- Hl.
(* Goal: @app_pred nat ag_nat (@fash rmap ag_rmap (@imp rmap ag_rmap P (assert_safe Espec ge ve te k rho))) w *)
  apply Hsafe; auto.
(* Goal: @app_pred rmap ag_rmap (@ext_compat (@OK_ty Espec) ora) (m_phi jm') *)
  simpl.
(* Goal: @joins ghost ghost_join (ghost_of (m_phi jm')) (@cons (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds)) (@Some (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds) (@pair (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds (@ghost_PCM.ext_ref (@OK_ty Espec) ora) NoneP)) (@nil (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds)))) *)
  eapply joins_comm, join_sub_joins_trans, joins_comm, H2.
(* Goal: @join_sub ghost ghost_join (@cons (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds)) (@Some (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds) (@pair (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds (@ghost_PCM.ext_ref (@OK_ty Espec) ora) NoneP)) (@nil (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) preds)))) (ghost_fmap (approx (@level rmap ag_rmap (m_phi jm))) (approx (@level rmap ag_rmap (m_phi jm))) C) *)
  destruct H0.
  change (Some (ghost_PCM.ext_ref ora, NoneP) :: nil) with
    (ghost_approx (m_phi jm) (Some (ghost_PCM.ext_ref ora, NoneP) :: nil)).
  eexists; apply ghost_fmap_join; eauto.
Qed.
