Require Import VST.veric.ghost_PCM.
Require Export VST.msl.iter_sepcon.
Require Export VST.concurrency.semax_conc_pred.
Require Export VST.concurrency.semax_conc.
Require Export VST.floyd.proofauto.
Require Import VST.floyd.library.
Require Export VST.floyd.sublist.

(* general list lemmas *)
Notation vint z := (Vint (Int.repr z)).
Notation vptrofs z := (Vptrofs (Ptrofs.repr z)).

Lemma app_cons_assoc : forall {A} l1 (x : A) l2, l1 ++ x :: l2 = (l1 ++ [x]) ++ l2.
Proof.
(* Goal: forall (A : Type) (l1 : list A) (x : A) (l2 : list A), @eq (list A) (@app A l1 (@cons A x l2)) (@app A (@app A l1 (@cons A x (@nil A))) l2) *)
  intros; rewrite <- app_assoc; auto.
Qed.

Lemma Forall_forall_Znth : forall {A}{d: Inhabitant A} (P : A -> Prop) l,
  Forall P l <-> forall i, 0 <= i < Zlength l -> P (Znth i l).
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (P : forall _ : A, Prop) (l : list A), iff (@Forall A P l) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), P (@Znth A d i l)) *)
  split; intros; [apply Forall_Znth; auto|].
(* Goal: forall (A : Type) (l : list A), @eq (list A) (@map A A (id A) l) l *)
  induction l; auto.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
(* Goal: @NoDup A (@nil A) *)
  constructor.
  - specialize (H 0); rewrite Znth_0_cons in H; apply H.
(* Goal: and (Z.le Z0 Z0) (Z.lt Z0 (Z.succ (@Zlength A l))) *)
    pose proof (Zlength_nonneg l); omega.
  - apply IHl; intros.
(* Goal: P (@Znth A d i l) *)
    specialize (H (i + 1)).
(* Goal: P (@Znth A d i l) *)
    rewrite Znth_pos_cons, Z.add_simpl_r in H by omega.
(* Goal: P (@Znth A d i l) *)
    apply H; omega.
Qed.

Lemma Zmod_smallish : forall x y, y <> 0 -> 0 <= x < 2 * y ->
  x mod y = x \/ x mod y = x - y.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: or (@eq Z (Z.modulo x y) x) (@eq Z (Z.modulo x y) (Z.sub x y)) *)
  destruct (zlt x y); [left; apply Zmod_small; omega|].
  rewrite <- Z.mod_add with (b := -1) by auto.
(* Goal: or (@eq Z (Z.modulo (Z.add x (Z.mul (Zneg xH) y)) y) x) (@eq Z (Z.modulo (Z.add x (Z.mul (Zneg xH) y)) y) (Z.sub x y)) *)
  right; apply Zmod_small; omega.
Qed.

Lemma Zmod_plus_inv : forall a b c d (Hc : c > 0) (Heq : (a + b) mod c = (d + b) mod c),
  a mod c = d mod c.
Proof.
(* Goal: forall (a b c d : Z) (_ : Z.gt c Z0) (_ : @eq Z (Z.modulo (Z.add a b) c) (Z.modulo (Z.add d b) c)), @eq Z (Z.modulo a c) (Z.modulo d c) *)
  intros; rewrite Zplus_mod, (Zplus_mod d) in Heq.
(* Goal: @eq Z (Z.modulo a c) (Z.modulo d c) *)
  pose proof (Z_mod_lt a c Hc).
(* Goal: @eq Z (Z.modulo a c) (Z.modulo d c) *)
  pose proof (Z_mod_lt b c Hc).
(* Goal: @eq Z (Z.modulo a c) (Z.modulo d c) *)
  pose proof (Z_mod_lt d c Hc).
(* Goal: @eq Z (Z.modulo a c) (Z.modulo d c) *)
  destruct (Zmod_smallish (a mod c + b mod c) c), (Zmod_smallish (d mod c + b mod c) c); omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_app : forall {A}{d: Inhabitant A} (l1 l2 : list A) i,
      Zlength l1 = i -> Znth i (l1 ++ l2) = Znth 0 l2.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (l1 l2 : list A) (i : Z) (_ : @eq Z (@Zlength A l1) i), @eq A (@Znth A d i (@app A l1 l2)) (@Znth A d Z0 l2) *)
  intros; subst; rewrite app_Znth2, Zminus_diag; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Corollary Znth_app1 : forall {A}{d: Inhabitant A} l1 (x : A) l2 i,
     Zlength l1 = i -> Znth i (l1 ++ x :: l2) = x.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (l1 : list A) (x : A) (l2 : list A) (i : Z) (_ : @eq Z (@Zlength A l1) i), @eq A (@Znth A d i (@app A l1 (@cons A x l2))) x *)
  intros; rewrite Znth_app, Znth_0_cons; auto.
Qed.

Lemma repable_0 : repable_signed 0.
Proof.
(* Goal: repable_signed Z0 *)
  split; computable.
Qed.
Hint Resolve repable_0.

Definition complete MAX l := l ++ repeat (vptrofs 0) (Z.to_nat MAX - length l).

Lemma upd_complete : forall l x MAX, Zlength l < MAX ->
  upd_Znth (Zlength l) (complete MAX l) x = complete MAX (l ++ [x]).
Proof.
(* Goal: forall (l : list val) (m : Z) (_ : Z.le (@Zlength val l) m), @eq Z (@Zlength val (complete m l)) m *)
  intros; unfold complete.
(* Goal: @eq (list A) (@upd_Znth A (@Zlength A l) (@app A l (@repeat A y (Z.to_nat (Z.sub n (@Zlength A l))))) x) (@app A (@app A l (@cons A x (@nil A))) (@repeat A y (Z.to_nat (Z.sub n (@Zlength A (@app A l (@cons A x (@nil A)))))))) *)
  rewrite upd_Znth_app2, Zminus_diag.
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val Z0 (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite app_length; simpl plus.
(* Goal: @eq (list val) (@app val (@app val l (@app val (@nil val) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (Init.Nat.add (@Datatypes.length val l) (S O))))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  rewrite Zlength_correct, Z2Nat.inj_lt, Nat2Z.id in H; try omega.
  destruct (Z.to_nat MAX - length l)%nat eqn: Hminus; [omega|].
  replace (Z.to_nat MAX - (length l + 1))%nat with n by omega.
(* Goal: @eq (list val) (@app val l (@upd_Znth val Z0 (@repeat val (Vptrofs (Ptrofs.repr Z0)) (S n)) x)) (@app val (@app val l (@cons val x (@nil val))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n)) *)
(* Goal: and (Z.le (@Zlength val l) (@Zlength val l)) (Z.le (@Zlength val l) (Z.add (@Zlength val l) (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))))) *)
  unfold upd_Znth, sublist; simpl.
(* Goal: @eq (list val) (@app val l (@cons val x (@firstn val (Z.to_nat (Z.sub (@Zlength val (@cons val (Vptrofs (Ptrofs.repr Z0)) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n))) (Zpos xH))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n)))) (@app val (@app val l (@cons val x (@nil val))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n)) *)
(* Goal: and (Z.le (@Zlength val l) (@Zlength val l)) (Z.le (@Zlength val l) (Z.add (@Zlength val l) (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))))) *)
  rewrite Zlength_cons.
(* Goal: @eq (list A) (@skipn A n l) (@cons A (@Znth A d (Z.sub (Z.succ (Z.of_nat n)) (Zpos xH)) l) match l with | nil => @nil A | cons a l => @skipn A n l end) *)
  unfold Z.succ; rewrite Z.add_simpl_r.
(* Goal: @eq (list val) (@app val l (@cons val x (@firstn val (Z.to_nat (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) n))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n)))) (@app val (@app val l (@cons val x (@nil val))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) n)) *)
(* Goal: and (Z.le (@Zlength val l) (@Zlength val l)) (Z.le (@Zlength val l) (Z.add (@Zlength val l) (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))))) *)
  rewrite Zlength_correct, Nat2Z.id, firstn_exact_length.
  rewrite <- app_assoc; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { repeat rewrite Zlength_correct; omega. }
Qed.

Lemma Znth_complete : forall n l MAX, n < Zlength l -> 
     Znth n (complete MAX l) = Znth n l.
Proof.
(* Goal: forall (n : Z) (l : list val) (MAX : Z) (_ : Z.lt n (@Zlength val l)), @eq val (@Znth val Inhabitant_val n (complete MAX l)) (@Znth val Inhabitant_val n l) *)
  intros; apply app_Znth1; auto.
Qed.

Lemma remove_complete : forall l x MAX, Zlength l < MAX ->
  upd_Znth (Zlength l) (complete MAX (l ++ [x])) (vptrofs 0) = complete MAX l.
Proof.
(* Goal: forall (l : list val) (m : Z) (_ : Z.le (@Zlength val l) m), @eq Z (@Zlength val (complete m l)) m *)
  intros; unfold complete.
(* Goal: @eq (list val) (@upd_Znth val (@Zlength val l) (@app val (@app val l (@cons val x (@nil val))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val (@app val l (@cons val x (@nil val))))))) (Vptrofs (Ptrofs.repr Z0))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  rewrite upd_Znth_app1 by (rewrite Zlength_app, ?Zlength_cons; rep_omega).
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val Z0 (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite app_length; simpl plus.
(* Goal: @eq (list val) (@app val (@upd_Znth val (@Zlength val l) (@app val l (@cons val x (@nil val))) (Vptrofs (Ptrofs.repr Z0))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (Init.Nat.add (@Datatypes.length val l) (S O))))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  rewrite upd_Znth_app2, Zminus_diag; [|rewrite Zlength_cons; simpl; omega].
(* Goal: @eq (list val) (@app val (@app val l (@upd_Znth val Z0 (@cons val x (@nil val)) (Vptrofs (Ptrofs.repr Z0)))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (Init.Nat.add (@Datatypes.length val l) (S O))))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  unfold upd_Znth, sublist.sublist.
(* Goal: @eq (list val) (@app val (@app val l (@app val (@firstn val (Z.to_nat (Z.sub Z0 Z0)) (@skipn val (Z.to_nat Z0) (@cons val x (@nil val)))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@firstn val (Z.to_nat (Z.sub (@Zlength val (@cons val x (@nil val))) (Z.add Z0 (Zpos xH)))) (@skipn val (Z.to_nat (Z.add Z0 (Zpos xH))) (@cons val x (@nil val))))))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (Init.Nat.add (@Datatypes.length val l) (S O))))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  rewrite Zminus_diag; simpl firstn.
(* Goal: @eq (list val) (@app val (@app val l (@app val (@nil val) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (Init.Nat.add (@Datatypes.length val l) (S O))))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat MAX) (@Datatypes.length val l)))) *)
  rewrite Zlength_correct, Z2Nat.inj_lt, Nat2Z.id in H; try omega.
  destruct (Z.to_nat MAX - length l)%nat eqn: Hminus; [omega|].
  replace (Z.to_nat MAX - (length l + 1))%nat with n by omega.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  simpl.
  rewrite <- app_assoc; auto.
Qed.

Lemma Forall_app : forall {A} (P : A -> Prop) l1 l2,
  Forall P (l1 ++ l2) <-> Forall P l1 /\ Forall P l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; split; auto; intros.
  - destruct H; auto.
  - inversion H as [|??? H']; subst.
(* Goal: and (@Forall A P (@cons A a l1)) (@Forall A P l2) *)
    rewrite IHl1 in H'; destruct H'; split; auto.
  - destruct H as (H & ?); inv H; constructor; auto.
(* Goal: @Forall A P ((fix app (l m : list A) {struct l} : list A := match l with | nil => m | cons a l1 => @cons A a (app l1 m) end) l1 l2) *)
    rewrite IHl1; split; auto.
Qed.

Lemma Forall_incl : forall {A} (P : A -> Prop) l1 l2 (Hall : Forall P l2) (Hincl : incl l1 l2),
  Forall P l1.
Proof.
(* Goal: forall (A : Type) (P : forall _ : A, Prop) (l1 l2 : list A) (_ : @Forall A P l2) (_ : @incl A l1 l2), @Forall A P l1 *)
  intros; rewrite Forall_forall in *; eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma repeat_plus : forall {A} (x : A) i j, repeat x (i + j) = repeat x i ++ repeat x j.
Proof.
(* Goal: forall (A : Type) (x : A) (i j : nat), @eq (list A) (@repeat A x (Init.Nat.add i j)) (@app A (@repeat A x i) (@repeat A x j)) *)
  induction i; auto; simpl; intro.
(* Goal: @eq (list A) (@cons A x (@repeat A x (Init.Nat.add i j))) (@cons A x (@app A (@repeat A x i) (@repeat A x j))) *)
  rewrite IHi; auto.
Qed.

Lemma in_insert_iff : forall {A} (x y : A) l1 l2, In x (l1 ++ y :: l2) <-> x = y \/ In x (l1 ++ l2).
Proof.
(* Goal: forall (A : Type) (x y : A) (l1 l2 : list A), iff (@In A x (@app A l1 (@cons A y l2))) (or (@eq A x y) (@In A x (@app A l1 l2))) *)
  intros; rewrite !in_app; split; simpl; intros [|[|]]; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Definition remove_at {A} i (l : list A) := firstn i l ++ skipn (S i) l.

Lemma Forall_firstn : forall {A} (P : A -> Prop) l i, Forall P l ->
  Forall P (firstn i l).
Proof.
(* Goal: forall (A : Type) (P : forall _ : A, Prop) (l : list A) (i : nat) (_ : @Forall A P l), @Forall A P (@skipn A i l) *)
  intros; rewrite Forall_forall in *.
(* Goal: forall (x : A) (_ : @In A x (@firstn A i l)), P x *)
  intros ? Hin; pose proof (firstn_In _ _ _ Hin); auto.
Qed.

Lemma Forall_skipn : forall {A} (P : A -> Prop) l i, Forall P l ->
  Forall P (skipn i l).
Proof.
(* Goal: forall (A : Type) (P : forall _ : A, Prop) (l : list A) (i : nat) (_ : @Forall A P l), @Forall A P (@skipn A i l) *)
  intros; rewrite Forall_forall in *.
(* Goal: forall (x : A) (_ : @In A x (@skipn A i l)), P x *)
  intros ? Hin; pose proof (skipn_In _ _ _ Hin); auto.
Qed.

Lemma Forall_upd_Znth : forall {A} (P : A -> Prop) x l i, Forall P l -> P x ->
  Forall P (upd_Znth i l x).
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
(* Goal: @Forall A P (@app A (@sublist A Z0 i l) (@cons A x (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
  rewrite Forall_app; split; [|constructor; auto]; apply Forall_sublist; auto.
Qed.

Lemma last_cons : forall {A} (d : A) l x, l <> [] -> last (x :: l) d = last l d.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
(* Goal: @eq A (@last A (@cons A x (@nil A)) d) (@last A (@nil A) d) *)
  contradiction H; auto.
Qed.

Lemma nth_last : forall {A} (d : A) l, nth (length l - 1) l d = last l d.
Proof.
(* Goal: forall (A : Type) (l : list A), @eq (list A) (@map A A (id A) l) l *)
  induction l; auto.
(* Goal: @eq A (@nth A (Init.Nat.sub (@Datatypes.length A (@cons A a l)) (S O)) (@cons A a l) d) (@last A (@cons A a l) d) *)
  simpl nth.
(* Goal: @eq A match Init.Nat.sub (@Datatypes.length A l) O with | O => a | S m => @nth A m l d end (@last A (@cons A a l) d) *)
  destruct (length l) eqn: Hlen.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { destruct l; simpl in *; [auto | omega]. }
(* Goal: @eq A match Init.Nat.sub (S n) O with | O => a | S m => @nth A m l d end (@last A (@cons A a l) d) *)
  rewrite last_cons; simpl in *; [|intro; subst; discriminate].
(* Goal: @eq A (@nth A n l d) (@last A l d) *)
  rewrite NPeano.Nat.sub_0_r in IHl; auto.
Qed.

Lemma Znth_last : forall {A}{d: Inhabitant A} l, Znth (Zlength l - 1) l = last l default.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (i : nat) (l : list A), @eq A (@nth A i l (@default A d)) (@Znth A d (Z.of_nat i) l) *)
  intros; unfold Znth.
  destruct (zlt (Zlength l - 1) 0).
  - destruct l; auto.
(* Goal: @eq A (@default A d) (@last A (@cons A a l) (@default A d)) *)
    rewrite Zlength_correct in *; simpl length in *.
(* Goal: Z.ge (Z.of_nat n) (@Zlength A l1) *)
    rewrite Nat2Z.inj_succ in *; omega.
  - rewrite Z2Nat.inj_sub; [|omega].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    rewrite Zlength_correct, Nat2Z.id; simpl.
(* Goal: @eq A (@nth A (Init.Nat.sub (@Datatypes.length A l) (S O)) l d) (@last A l (@default A d)) *)
    apply nth_last.
Qed.

Lemma last_app : forall {A} l1 l2 (d : A), l2 <> [] -> last (l1 ++ l2) d = last l2 d.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; auto; intros.
(* Goal: @eq A (@last A (@app A (@cons A a l1) l2) d) (@last A l2 d) *)
  setoid_rewrite last_cons; eauto.
(* Goal: not (@eq (list A) ((fix app (l m : list A) {struct l} : list A := match l with | nil => m | cons a l1 => @cons A a (app l1 m) end) l1 l2) (@nil A)) *)
  intro X; apply app_eq_nil in X; tauto.
Qed.

Lemma nat_sorted_list_eq : forall d n l (Hl : forall i, (i < n)%nat <-> In i l) (Hlen : length l = n)
  (Hsorted : forall i j, (i < j < n -> nth i l d < nth j l d)%nat) i (Hi : (i < n)%nat), nth i l d = i.
Proof.
(* Goal: forall (d n : nat) (l : list nat) (_ : forall i : nat, iff (lt i n) (@In nat i l)) (_ : @eq nat (@Datatypes.length nat l) n) (_ : forall (i j : nat) (_ : and (lt i j) (lt j n)), lt (@nth nat i l d) (@nth nat j l d)) (i : nat) (_ : lt i n), @eq nat (@nth nat i l d) i *)
  induction n; intros; [omega|].
(* Goal: @eq nat (@nth nat i l d) i *)
  destruct (eq_dec l []); [subst; discriminate|].
(* Goal: @eq nat (@nth nat i l d) i *)
  destruct (exists_last n0) as (l' & x & ?); subst.
(* Goal: @eq nat (@nth nat i (@app nat l' (@cons nat x (@nil nat))) d) i *)
  rewrite app_length in Hlen; simpl in Hlen.
(* Goal: @eq nat (@nth nat i (@app nat l' (@cons nat x (@nil nat))) d) i *)
  assert (length l' = n) by omega.
(* Goal: @eq nat (@nth nat i (@app nat l' (@cons nat x (@nil nat))) d) i *)
  assert (x = n).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { assert (x < S n)%nat.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { specialize (Hl x); destruct Hl as (_ & Hl); apply Hl.
      rewrite in_app; simpl; auto. }
(* Goal: @eq nat x n *)
    destruct (lt_dec x n); [|omega].
(* Goal: @eq nat x n *)
    assert (n < S n)%nat as Hlt by omega; rewrite Hl in Hlt.
(* Goal: @eq nat x n *)
    rewrite in_app in Hlt; destruct Hlt as [Hin | [? | ?]]; [| omega | contradiction].
(* Goal: @eq nat x n *)
    apply In_nth with (d := d) in Hin; destruct Hin as (j & ? & ?).
(* Goal: @eq nat x n *)
    exploit (Hsorted j (length l')); [omega|].
    rewrite app_nth1, app_nth2, minus_diag by auto; simpl; omega. }
(* Goal: @eq nat (@nth nat i (@app nat l' (@cons nat x (@nil nat))) d) i *)
  destruct (eq_dec i n); subst.
  - rewrite app_nth2, minus_diag by omega; auto.
  - rewrite app_nth1 by omega; apply IHn; auto; try omega.
    + intro j; specialize (Hl j); split; intro Hin.
      * destruct Hl as (Hl & _); exploit Hl; [omega|].
(* Goal: forall _ : @In nat j (@app nat l' (@cons nat (@Datatypes.length nat l') (@nil nat))), @In nat j l' *)
        rewrite in_app; intros [? | [? | ?]]; [auto | omega | contradiction].
      * destruct Hl as (_ & Hl); exploit Hl; [rewrite in_app; auto | intro].
(* Goal: lt j (@Datatypes.length nat l') *)
        apply In_nth with (d := d) in Hin; destruct Hin as (i' & ? & ?).
(* Goal: lt j (@Datatypes.length nat l') *)
        exploit (Hsorted i' (length l')); [omega|].
(* Goal: forall _ : lt (@nth nat i' (@app nat l' (@cons nat (@Datatypes.length nat l') (@nil nat))) d) (@nth nat (@Datatypes.length nat l') (@app nat l' (@cons nat (@Datatypes.length nat l') (@nil nat))) d), lt j (@Datatypes.length nat l') *)
        rewrite app_nth1, app_nth2, minus_diag by auto; simpl; omega.
    + intros i' j' ?; exploit (Hsorted i' j'); [omega|].
(* Goal: forall _ : lt (@nth nat i' (@app nat l' (@cons nat (@Datatypes.length nat l') (@nil nat))) d) (@nth nat j' (@app nat l' (@cons nat (@Datatypes.length nat l') (@nil nat))) d), lt (@nth nat i' l' d) (@nth nat j' l' d) *)
      rewrite !app_nth1 by omega; auto.
Qed.

Lemma Forall2_In_l : forall {A B} (P : A -> B -> Prop) x l1 l2, Forall2 P l1 l2 -> In x l1 ->
  exists y, In y l2 /\ P x y.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction 1; intro Hin; destruct Hin; simpl.
  - subst; eauto.
  - destruct IHForall2 as (? & ? & ?); eauto.
Qed.

Lemma Forall2_In_r : forall {A B} (P : A -> B -> Prop) x l1 l2, Forall2 P l1 l2 -> In x l2 ->
  exists y, In y l1 /\ P y x.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction 1; intro Hin; destruct Hin; simpl.
  - subst; eauto.
  - destruct IHForall2 as (? & ? & ?); eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma last_snoc : forall {A} (d : A) x l, last (l ++ [x]) d = x.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
  destruct (l ++ [x]) eqn: Heq; auto.
(* Goal: @eq A a x *)
  contradiction (app_cons_not_nil l [] x); auto.
Qed.

Lemma iter_sepcon_sepcon: forall {A} f g1 g2 l, (forall b : A, f b = g1 b * g2 b) ->
  iter_sepcon f l = iter_sepcon g1 l * iter_sepcon g2 l.
Proof.
(* Goal: forall (A : Type) (f g1 g2 : forall _ : A, mpred) (l : list A) (_ : forall b : A, @eq mpred (f b) (@sepcon mpred Nveric Sveric (g1 b) (g2 b))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (@iter_sepcon mpred A Nveric Sveric g1 l) (@iter_sepcon mpred A Nveric Sveric g2 l)) *)
  intros; induction l; simpl; normalize.
(* Goal: @eq mpred (@sepcon mpred Nveric Sveric (f a) (@iter_sepcon mpred A Nveric Sveric f l)) (@sepcon mpred Nveric Sveric (@sepcon mpred Nveric Sveric (g1 a) (@iter_sepcon mpred A Nveric Sveric g1 l)) (@sepcon mpred Nveric Sveric (g2 a) (@iter_sepcon mpred A Nveric Sveric g2 l))) *)
  rewrite H, IHl; apply pred_ext; cancel.
Qed.

Lemma sepcon_app : forall l1 l2, fold_right sepcon emp (l1 ++ l2) =
  fold_right sepcon emp l1 * fold_right sepcon emp l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; simpl; intros.
  - rewrite emp_sepcon; auto.
  - rewrite IHl1, sepcon_assoc; auto.
Qed.

Definition rotate {A} (l : list A) n m := sublist (m - n) (Zlength l) l ++
  sublist 0 (m - n) l.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_of_nil : forall {A} i j, sublist i j (@nil A) = [].
Proof.
(* Goal: forall (A : Type) (l : list A) (i j : Z) (_ : Z.le (@Zlength A l) i), @eq (list A) (@sublist A i j l) (@nil A) *)
  intros; unfold sublist.
(* Goal: @eq (list A) (@firstn A (Z.to_nat (Z.sub j i)) (@skipn A (Z.to_nat i) (@nil A))) (@nil A) *)
  rewrite skipn_nil, firstn_nil; auto.
Qed.

Lemma sublist_0_cons : forall {A} j x (l : list A), j > 0 ->
  sublist 0 j (x :: l) = x :: sublist 0 (j - 1) l.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; unfold sublist; simpl.
  destruct (Z.to_nat (j - 0)) eqn: Hminus.
  - apply Z.gt_lt in H; rewrite Z2Nat.inj_lt in H; try omega.
(* Goal: @eq (list A) (@firstn A O (@cons A x l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (Z.sub j (Zpos xH)) Z0)) l)) *)
    rewrite Z2Nat.inj_sub in Hminus; omega.
  - simpl; repeat f_equal.
    rewrite Z.sub_0_r in *.
(* Goal: @eq nat n (Z.to_nat (Z.sub j (Zpos xH))) *)
    rewrite Z2Nat.inj_sub, Hminus; simpl; omega.
Qed.

Lemma sublist_S_cons : forall {A} i j x (l : list A), i > 0 ->
  sublist i j (x :: l) = sublist (i - 1) (j - 1) l.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; unfold sublist; simpl.
(* Goal: @eq (list A) (@app A (@firstn A (Z.to_nat i) (@cons A a l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A (@cons A a l)) (Z.add i (Zpos xH)))) (@skipn A (Z.to_nat (Z.add i (Zpos xH))) (@cons A a l))))) (@cons A a (@app A (@firstn A (Z.to_nat (Z.sub i (Zpos xH))) l) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A l) (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) (@skipn A (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH))) l))))) *)
  destruct (Z.to_nat i) eqn: Hi.
  - apply Z.gt_lt in H; rewrite Z2Nat.inj_lt in H; omega.
  - simpl.
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub m n) (Zpos xH)) (Z.sub (Z.succ (Z.add (@Zlength val l) (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val Z0 (Z.sub (Z.sub m n) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.add n (Zpos xH))) (Z.sub m (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (@Znth val Inhabitant_val (Z.sub m (Zpos xH)) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@sublist val Z0 (Z.sub m (Z.add n (Zpos xH))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) *)
    f_equal; f_equal; try omega.
(* Goal: @eq nat n (Z.to_nat (Z.sub i (Zpos xH))) *)
    rewrite Z2Nat.inj_sub, Hi; simpl; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma upd_rotate : forall {A} i (l : list A) n m x (Hl : Zlength l = m) (Hlt : 0 <= n <= m)
  (Hi : 0 <= i < Zlength l),
  upd_Znth i (rotate l n m) x = rotate (upd_Znth ((i - n) mod m) l x) n m.
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
(* Goal: @eq (list A) (@upd_Znth A i (@app A (@sublist A (Z.sub m n) (@Zlength A l) l) (@sublist A Z0 (Z.sub m n) l)) x) (@app A (@sublist A (Z.sub m n) (@Zlength A (@upd_Znth A (Z.modulo (Z.sub i n) m) l x)) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x)) (@sublist A Z0 (Z.sub m n) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x))) *)
  rewrite upd_Znth_Zlength by (subst; apply Z_mod_lt; omega).
  destruct (zlt i (Zlength l - (m - n))).
  - rewrite upd_Znth_app1 by (rewrite Zlength_sublist; omega).
    assert ((i - n) mod m = m + i - n) as Hmod.
    { rewrite <- Z.mod_add with (b := 1) by omega.
      rewrite Zmod_small; omega. }
(* Goal: @eq (list A) (@app A (@upd_Znth A i (@sublist A (Z.sub m n) (@Zlength A l) l) x) (@sublist A Z0 (Z.sub m n) l)) (@app A (@sublist A (Z.sub m n) (@Zlength A l) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x)) (@sublist A Z0 (Z.sub m n) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x))) *)
    rewrite Hmod, sublist_upd_Znth_lr, sublist_upd_Znth_l by (auto; omega).
    replace (m + i - n - (m - n)) with i by omega; auto.
  - rewrite upd_Znth_app2; rewrite ?Zlength_sublist; try omega.
    assert ((i - n) mod m = i - n) as Hmod.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite Zmod_small; omega. }
(* Goal: @eq (list A) (@app A (@sublist A (Z.sub m n) (@Zlength A l) l) (@upd_Znth A (Z.sub i (Z.sub (@Zlength A l) (Z.sub m n))) (@sublist A Z0 (Z.sub m n) l) x)) (@app A (@sublist A (Z.sub m n) (@Zlength A l) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x)) (@sublist A Z0 (Z.sub m n) (@upd_Znth A (Z.modulo (Z.sub i n) m) l x))) *)
    rewrite Hmod, sublist_upd_Znth_r, sublist_upd_Znth_lr by omega.
    replace (i - (Zlength l - (m - n))) with (i - n - 0) by omega; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_cons_eq : forall {A}{d : Inhabitant A} i x l, 
   Znth i (x :: l) = if eq_dec i 0 then x else Znth (i - 1) l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq A (@Znth A d i (@cons A x l)) (if @eq_dec Z initial_world.EqDec_Z i Z0 then x else @Znth A d (Z.sub i (Zpos xH)) l) *)
  destruct (eq_dec i 0); [subst; apply Znth_0_cons|].
(* Goal: @eq A (@Znth A d i (@cons A x l)) (@Znth A d (Z.sub i (Zpos xH)) l) *)
  destruct (zlt i 0); [rewrite !Znth_underflow; auto; omega|].
(* Goal: @eq A (@Znth A d i (@cons A x l)) (@Znth A d (Z.sub i (Zpos xH)) l) *)
  apply Znth_pos_cons; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_rotate : forall {A} {d : Inhabitant A} i l n, 
    0 <= n <= Zlength l -> 0 <= i < Zlength l ->
  Znth i (rotate l n (Zlength l)) = Znth ((i - n) mod Zlength l) l.
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
(* Goal: @eq A (@Znth A d i (@app A (@sublist A (Z.sub (@Zlength A l) n) (@Zlength A l) l) (@sublist A Z0 (Z.sub (@Zlength A l) n) l))) (@Znth A d (Z.modulo (Z.sub i n) (@Zlength A l)) l) *)
  destruct (zlt i n).
  - rewrite app_Znth1 by (rewrite Zlength_sublist; omega).
(* Goal: @eq A (@Znth A d (Z.sub i (Z.sub (@Zlength A l) (Z.sub (@Zlength A l) n))) (@sublist A Z0 (Z.sub (@Zlength A l) n) l)) (@Znth A d (Z.modulo (Z.sub i n) (@Zlength A l)) l) *)
    rewrite Znth_sublist by omega.
    rewrite <- Z_mod_plus with (b := 1), Zmod_small by omega.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
    f_equal; omega.
  - rewrite app_Znth2; (rewrite Zlength_sublist; try omega).
(* Goal: @eq A (@Znth A d (Z.sub i (Z.sub (@Zlength A l) (Z.sub (@Zlength A l) n))) (@sublist A Z0 (Z.sub (@Zlength A l) n) l)) (@Znth A d (Z.modulo (Z.sub i n) (@Zlength A l)) l) *)
    rewrite Znth_sublist by omega.
(* Goal: @eq A (@Znth A d (Z.add (Z.sub i (Z.sub (@Zlength A l) (Z.sub (@Zlength A l) n))) Z0) l) (@Znth A d (Z.modulo (Z.sub i n) (@Zlength A l)) l) *)
    rewrite Zmod_small by omega.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
    f_equal; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma rotate_nil : forall {A} n m, rotate (@nil A) n m = [].
Proof.
(* Goal: forall (A : Type) (n m : Z), @eq (list A) (@rotate A (@nil A) n m) (@nil A) *)
  intros; unfold rotate; rewrite !sublist_of_nil; auto.
Qed.

Lemma Forall_sublist_le : forall {A} {d : Inhabitant A} (P : A -> Prop) i j l
  (Hrangei : 0 <= i) (Hrangej : j <= Zlength l) (Hi : ~P (Znth i l)) (Hj : Forall P (sublist 0 j l)),
  j <= i.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: Z.le j i *)
  destruct (Z_le_dec j i); auto.
(* Goal: Z.le j i *)
  eapply Forall_Znth with (i0 := i) in Hj; [|rewrite Zlength_sublist; omega].
(* Goal: Z.le j i *)
  rewrite Znth_sublist, Z.add_0_r in Hj by omega.
(* Goal: Z.le j i *)
  contradiction Hi; eauto.
Qed.

Corollary Forall_sublist_first : forall {A} {d : Inhabitant A} (P : A -> Prop) i j l
  (Hrangei : 0 <= i <= Zlength l) (Hi : Forall P (sublist 0 i l)) (Hi' : ~P (Znth i l))
  (Hrangej : 0 <= j <= Zlength l) (Hj : Forall P (sublist 0 j l)) (Hj' : ~P (Znth j l)),
  i = j.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq Z i j *)
  apply Z.le_antisymm; eapply Forall_sublist_le; eauto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma NoDup_Znth_inj : forall {A} {d : Inhabitant A} l i j (HNoDup : NoDup l)
  (Hi : 0 <= i < Zlength l) (Hj : 0 <= j < Zlength l) (Heq : Znth i l = Znth j l ),
  i = j.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; intros.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite Zlength_nil in *; omega. }
(* Goal: @eq Z i j *)
  inv HNoDup.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
(* Goal: @eq Z i j *)
  rewrite !Znth_cons_eq in Heq.
(* Goal: @eq Z i j *)
  destruct (eq_dec i 0), (eq_dec j 0); subst; auto.
  - contradiction H1; apply Znth_In; omega.
  - contradiction H1; apply Znth_In; omega.
  - exploit (IHl (i - 1) (j - 1)); auto; omega.
Qed.

Lemma rotate_In : forall {A} (x : A) n m l, 0 <= m - n <= Zlength l -> In x (rotate l n m) <-> In x l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold rotate; intros.
  replace l with (sublist 0 (m - n) l ++ sublist (m - n) (Zlength l) l) at 4
    by (rewrite sublist_rejoin, sublist_same; auto; omega).
(* Goal: iff (@In A x (@app A (@sublist A (Z.sub m n) (@Zlength A l) l) (@sublist A Z0 (Z.sub m n) l))) (@In A x (@app A (@sublist A Z0 (Z.sub m n) l) (@sublist A (Z.sub m n) (@Zlength A l) l))) *)
  rewrite !in_app; tauto.
Qed.

Lemma rotate_map : forall {A B} (f : A -> B) n m l, rotate (map f l) n m = map f (rotate l n m).
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
(* Goal: @eq (list B) (@app B (@sublist B (Z.sub m n) (@Zlength B (@map A B f l)) (@map A B f l)) (@sublist B Z0 (Z.sub m n) (@map A B f l))) (@map A B f (@app A (@sublist A (Z.sub m n) (@Zlength A l) l) (@sublist A Z0 (Z.sub m n) l))) *)
  rewrite !sublist_map, Zlength_map, map_app; auto.
Qed.

Lemma combine_app : forall {A B} (l1 l2 : list A) (l1' l2' : list B), length l1 = length l1' ->
  combine (l1 ++ l2) (l1' ++ l2') = combine l1 l1' ++ combine l2 l2'.
Proof.
  induction l1; destruct l1'; intros; try discriminate; auto; simpl in *.
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
  rewrite IHl1; auto.
Qed.

Lemma combine_app' : forall {A B} (l1 l2 : list A) (l1' l2' : list B), Zlength l1 = Zlength l1' ->
  combine (l1 ++ l2) (l1' ++ l2') = combine l1 l1' ++ combine l2 l2'.
Proof.
(* Goal: forall (A B : Type) (l1 l2 : list A) (l1' l2' : list B) (_ : @eq Z (@Zlength A l1) (@Zlength B l1')), @eq (list (prod A B)) (@combine A B (@app A l1 l2) (@app B l1' l2')) (@app (prod A B) (@combine A B l1 l1') (@combine A B l2 l2')) *)
  intros; apply combine_app.
  rewrite !Zlength_correct in *; omega.
Qed.

Lemma Forall_rotate : forall {A} P (l : list A) n m, Forall P l ->
  Forall P (rotate l m n).
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
(* Goal: @Forall A P (@app A (@sublist A (Z.sub n m) (@Zlength A l) l) (@sublist A Z0 (Z.sub n m) l)) *)
  rewrite Forall_app; split; apply Forall_sublist; auto.
Qed.

Lemma Forall_repeat : forall {A} (P : A -> Prop) x n, P x -> Forall P (repeat x n).
Proof.
(* Goal: forall (A : Type) (P : forall _ : A, Prop) (x : A) (n : nat) (_ : P x), @Forall A P (@repeat A x n) *)
  induction n; simpl; auto.
Qed.

Lemma Forall_complete : forall P l m, Forall P l -> P (vptrofs 0) ->
  Forall P (complete m l).
Proof.
(* Goal: forall (l : list val) (m : Z) (_ : Z.le (@Zlength val l) m), @eq Z (@Zlength val (complete m l)) m *)
  intros; unfold complete.
(* Goal: @Forall val P (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (@Datatypes.length val l)))) *)
  rewrite Forall_app; split; [|apply Forall_repeat]; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma app_eq_inv : forall {A} (l1 l2 l3 l4 : list A)
  (Heq : l1 ++ l2 = l3 ++ l4) (Hlen : length l1 = length l3), l1 = l3 /\ l2 = l4.
Proof.
(* Goal: forall (A : Type) (l1 l2 l3 l4 : list A) (_ : @eq (list A) (@app A l1 l2) (@app A l3 l4)) (_ : @eq nat (@Datatypes.length A l1) (@Datatypes.length A l3)), and (@eq (list A) l1 l3) (@eq (list A) l2 l4) *)
  induction l1; simpl; intros; destruct l3; try discriminate; auto.
(* Goal: and (@eq (list A) (@cons A a l1) (@cons A a0 l3)) (@eq (list A) l2 l4) *)
  inv Heq; inv Hlen.
(* Goal: and (@eq (list A) (@cons A a0 l1) (@cons A a0 l3)) (@eq (list A) l2 l4) *)
  exploit IHl1; eauto; intros (? & ?); subst; auto.
Qed.

Lemma rotate_inj : forall {A} (l1 l2 : list A) n m, rotate l1 n m = rotate l2 n m ->
  length l1 = length l2 -> 0 <= n <= m -> m <= Zlength l1 -> l1 = l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold rotate; intros.
(* Goal: @eq (list A) l1 l2 *)
  destruct (app_eq_inv _ _ _ _ H) as (Hskip & Hfirst).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { unfold sublist; repeat rewrite firstn_length, skipn_length.
    repeat rewrite Zlength_correct; rewrite H0; omega. }
  erewrite <- sublist_same with (al := l1), <- sublist_rejoin with (mid := m - n); auto; try omega.
(* Goal: @eq (list A) (@app A (@sublist A Z0 (Z.sub m n) l1) (@sublist A (Z.sub m n) (@Zlength A l1) l1)) l2 *)
  rewrite Hfirst, Hskip, sublist_rejoin, sublist_same; auto; try omega.
  repeat rewrite Zlength_correct in *; rewrite H0 in *; omega.
Qed.

Lemma complete_inj : forall l1 l2 m, complete m l1 = complete m l2 ->
  length l1 = length l2 -> l1 = l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold complete; intros.
(* Goal: @eq (list val) l1 l2 *)
  destruct (app_eq_inv _ _ _ _ H); auto.
Qed.

Lemma length_complete : forall l m, Zlength l <= m -> length (complete m l) = Z.to_nat m.
Proof.
(* Goal: forall (l : list val) (m : Z) (_ : Z.le (@Zlength val l) m), @eq Z (@Zlength val (complete m l)) m *)
  intros; unfold complete.
(* Goal: @eq nat (@Datatypes.length val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (@Datatypes.length val l))))) (Z.to_nat m) *)
  rewrite app_length, repeat_length; rewrite Zlength_correct in H.
(* Goal: @eq nat (Init.Nat.add (@Datatypes.length val l) (Init.Nat.sub (Z.to_nat m) (@Datatypes.length val l))) (Z.to_nat m) *)
  rep_omega.
Qed.

Lemma Zlength_rotate : forall {A} (l : list A) n m, 0 <= n <= m -> m <= Zlength l ->
  Zlength (rotate l n m) = Zlength l.
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
(* Goal: @eq Z (@Zlength A (@app A (@sublist A (Z.sub m n) (@Zlength A l) l) (@sublist A Z0 (Z.sub m n) l))) (@Zlength A l) *)
  rewrite Zlength_app; repeat rewrite Zlength_sublist; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_repeat : forall {A} (x : A) n, Zlength (repeat x n) = Z.of_nat n.
Proof.
(* Goal: forall (A : Type) (x : A) (n : nat), @eq Z (@Zlength A (@repeat A x n)) (Z.of_nat n) *)
  intros; rewrite Zlength_correct, repeat_length; auto.
Qed.

Lemma Zlength_complete : forall l m, Zlength l <= m -> Zlength (complete m l) = m.
Proof.
(* Goal: forall (l : list val) (m : Z) (_ : Z.le (@Zlength val l) m), @eq Z (@Zlength val (complete m l)) m *)
  intros; unfold complete.
  rewrite Zlength_app, Zlength_repeat; rewrite Zlength_correct in *; rep_omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma combine_eq : forall {A B} (l : list (A * B)), combine (map fst l) (map snd l) = l.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
(* Goal: @eq (list (prod A B)) (@cons (prod A B) (@pair A B (@fst A B a) (@snd A B a)) (@combine A B (@map (prod A B) A (@fst A B) l) (@map (prod A B) B (@snd A B) l))) (@cons (prod A B) a l) *)
  destruct a; rewrite IHl; auto.
Qed.

Lemma signed_inj : forall i1 i2, Int.signed i1 = Int.signed i2 -> i1 = i2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq Int.int i1 i2 *)
  apply int_eq_e.
(* Goal: @eq bool (Int.eq i1 i2) true *)
  rewrite Int.eq_signed, H.
(* Goal: @eq bool (if zeq (Int.signed i2) (Int.signed i2) then true else false) true *)
  apply zeq_true.
Qed.

Lemma mods_repr : forall a b, 0 <= a <= Int.max_signed -> 0 < b <= Int.max_signed ->
  Int.mods (Int.repr a) (Int.repr b) = Int.repr (a mod b).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq Int.int (Int.mods (Int.repr a) (Int.repr b)) (Int.repr (Z.modulo a b)) *)
  unfold Int.mods.
(* Goal: @eq Int.int (Int.repr (Z.rem (Int.signed (Int.repr a)) (Int.signed (Int.repr b)))) (Int.repr (Z.modulo a b)) *)
  pose proof Int.min_signed_neg.
(* Goal: @eq Int.int (Int.repr (Z.rem (Int.signed (Int.repr a)) (Int.signed (Int.repr b)))) (Int.repr (Z.modulo a b)) *)
  rewrite Zquot.Zrem_Zmod_pos; repeat rewrite Int.signed_repr; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma repeat_list_repeat : forall {A} n (x : A), repeat x n = list_repeat n x.
Proof.
(* Goal: forall (A : Type) (n : nat) (x : A), @eq (list A) (@repeat A x n) (@list_repeat A n x) *)
  induction n; auto; simpl; intro.
(* Goal: @eq (list A) (@cons A x (@repeat A x n)) (@cons A x (@list_repeat A n x)) *)
  rewrite IHn; auto.
Qed.

Lemma sublist_repeat : forall {A} i j k (v : A), 0 <= i -> i <= j <= k ->
  sublist i j (repeat v (Z.to_nat k)) = repeat v (Z.to_nat (j - i)).
Proof.
(* Goal: forall (A : Type) (i j k : Z) (v : A) (_ : Z.le Z0 i) (_ : and (Z.le i j) (Z.le j k)), @eq (list A) (@sublist A i j (@repeat A v (Z.to_nat k))) (@repeat A v (Z.to_nat (Z.sub j i))) *)
  intros; repeat rewrite repeat_list_repeat; apply sublist_list_repeat; auto.
Qed.

Lemma Znth_head : forall reqs head m, Zlength reqs <= m -> 0 <= head < m ->
  Zlength reqs > 0 ->
  Znth head (rotate (complete m reqs) head m) = Znth 0 reqs.
Proof.
(* Goal: forall (reqs : list val) (head m : Z) (_ : Z.le (@Zlength val reqs) m) (_ : and (Z.le Z0 head) (Z.lt head m)) (_ : Z.gt (@Zlength val reqs) Z0), @eq val (@Znth val Inhabitant_val head (@rotate val (complete m reqs) head m)) (@Znth val Inhabitant_val Z0 reqs) *)
  intros; unfold rotate.
  assert (Zlength (sublist (m - head) (Zlength (complete m reqs)) (complete m reqs)) = head) as Hlen.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { 
rewrite Zlength_sublist; rewrite Zlength_complete; omega. }
(* Goal: @eq val (@Znth val Inhabitant_val head (@app val (@sublist val (Z.sub m head) (@Zlength val (complete m reqs)) (complete m reqs)) (@sublist val Z0 (Z.sub m head) (complete m reqs)))) (@Znth val Inhabitant_val Z0 reqs) *)
  rewrite app_Znth2; rewrite Hlen; [|omega].
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val (Z.sub (@Zlength Z l) (@Zlength Z l)) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite Zminus_diag.
(* Goal: @eq val (@Znth val Inhabitant_val Z0 (@sublist val Z0 (Z.sub m head) (complete m reqs))) (@Znth val Inhabitant_val Z0 reqs) *)
  rewrite Znth_sublist; try omega.
(* Goal: @eq val (@Znth val Inhabitant_val (Z.add Z0 Z0) (complete m reqs)) (@Znth val Inhabitant_val Z0 reqs) *)
  rewrite Znth_complete; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_repeat : forall {A} {x : Inhabitant A} n i, Znth i (repeat default n) = default.
Proof.
(* Goal: forall n m : nat, @eq (list Z) (upto (Init.Nat.add n m)) (@app Z (upto n) (@map Z Z (fun i : Z => Z.add (Z.of_nat n) i) (upto m))) *)
  induction n; simpl; intro.
  - apply Znth_nil.
  - destruct (Z_lt_dec i 0); [apply Znth_underflow; auto|].
(* Goal: @eq A (@Znth A x i (@cons A (@default A x) (@repeat A (@default A x) n))) (@default A x) *)
    destruct (eq_dec i 0); [subst; apply Znth_0_cons | rewrite Znth_pos_cons; eauto; omega].
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_repeat' : forall {A} {d: Inhabitant A} (x : A) n i, 
    0 <= i < Z.of_nat n -> Znth i (repeat x n)  = x.
Proof.
  induction n; intros; [simpl in *; omega|].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite Nat2Z.inj_succ in H; simpl.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; apply Znth_0_cons.
  - rewrite Znth_pos_cons by omega; apply IHn; omega.
Qed.

Lemma rotate_1 : forall v l n m, 0 <= n < m -> Zlength l < m ->
  rotate (upd_Znth 0 (complete m (v :: l)) (vptrofs 0)) n m =
  rotate (complete m l) ((n + 1) mod m) m.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  unfold complete at 1; simpl.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  unfold upd_Znth; simpl.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite Zlength_cons; simpl.
(* Goal: @eq (list val) (@rotate val (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val (Zpos xH) (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (@cons val v (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) n m) (@rotate val (complete m l) (Z.modulo (Z.add n (Zpos xH)) m) m) *)
  rewrite sublist_1_cons, sublist_same; auto; [|omega].
(* Goal: @eq mpred (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) lP) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@rotate mpred lP m n)) *)
  unfold rotate.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite Zlength_cons; simpl.
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub m n) (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (@sublist val Z0 (Z.sub m n) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.modulo (Z.add n (Zpos xH)) m)) (@Zlength val (complete m l)) (complete m l)) (@sublist val Z0 (Z.sub m (Z.modulo (Z.add n (Zpos xH)) m)) (complete m l))) *)
  rewrite sublist_S_cons; [|omega].
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub m n) (Zpos xH)) (Z.sub (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@sublist val Z0 (Z.sub m n) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.modulo (Z.add n (Zpos xH)) m)) (@Zlength val (complete m l)) (complete m l)) (@sublist val Z0 (Z.sub m (Z.modulo (Z.add n (Zpos xH)) m)) (complete m l))) *)
  rewrite sublist_0_cons; [|omega].
  destruct (eq_dec (n + 1) m).
  - subst; rewrite Z.mod_same; [|omega].
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub (Z.add n (Zpos xH)) n) (Zpos xH)) (Z.sub (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat (Z.add n (Zpos xH))) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat (Z.add n (Zpos xH))) (S (@Datatypes.length val l)))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val Z0 (Z.sub (Z.sub (Z.add n (Zpos xH)) n) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat (Z.add n (Zpos xH))) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub (Z.add n (Zpos xH)) Z0) (@Zlength val (complete (Z.add n (Zpos xH)) l)) (complete (Z.add n (Zpos xH)) l)) (@sublist val Z0 (Z.sub (Z.add n (Zpos xH)) Z0) (complete (Z.add n (Zpos xH)) l))) *)
    autorewrite with sublist.
(* Goal: @eq (list val) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat (Z.add n (Zpos xH))) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val))) (@app val (@sublist val (Z.add n (Zpos xH)) (@Zlength val (complete (Z.add n (Zpos xH)) l)) (complete (Z.add n (Zpos xH)) l)) (@sublist val Z0 (Z.add n (Zpos xH)) (complete (Z.add n (Zpos xH)) l))) *)
    rewrite Zlength_complete, sublist_nil; [|omega].
(* Goal: @eq (list val) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat (Z.add n (Zpos xH))) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val))) (@app val (@nil val) (@sublist val Z0 (Z.add n (Zpos xH)) (complete (Z.add n (Zpos xH)) l))) *)
    rewrite sublist_same; auto; [|rewrite Zlength_complete; omega].
    rewrite <- app_assoc; unfold complete.
(* Goal: @eq nat (Init.Nat.sub (S (Z.to_nat (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) *)
    repeat rewrite Z2Nat.inj_add; try omega.
    rewrite NPeano.Nat.add_sub_swap with (p := length l); [|rewrite Zlength_correct in *; rep_omega].
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
    rewrite repeat_plus; simpl; do 3 f_equal; omega.
  - rewrite Zmod_small; [|omega].
    rewrite (sublist_split (m - (n + 1)) (Zlength (complete m l) - 1)); try rewrite Zlength_complete; try omega.
    rewrite <- app_assoc, (sublist_one (m - 1)); try rewrite Zlength_complete; try omega; simpl.
    assert (length l < Z.to_nat m)%nat by (rewrite Zlength_correct in *; rep_omega).
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub m n) (Zpos xH)) (Z.sub (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val Z0 (Z.sub (Z.sub m n) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.add n (Zpos xH))) (Z.sub m (Zpos xH)) (complete m l)) (@cons val (@Znth val Inhabitant_val (Z.sub m (Zpos xH)) (complete m l)) (@sublist val Z0 (Z.sub m (Z.add n (Zpos xH))) (complete m l)))) *)
    unfold complete.
    replace (Z.to_nat m - length l)%nat with (Z.to_nat m - S (length l) + 1)%nat; [|omega].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    rewrite repeat_plus, app_assoc; simpl.
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub m n) (Zpos xH)) (Z.sub (Z.succ (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val Z0 (Z.sub (Z.sub m n) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.add n (Zpos xH))) (Z.sub m (Zpos xH)) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@cons val (@Znth val Inhabitant_val (Z.sub m (Zpos xH)) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@sublist val Z0 (Z.sub m (Z.add n (Zpos xH))) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))))) *)
    repeat rewrite Zlength_app.
    assert (m - 1 = Zlength l + Zlength (repeat (vptrofs 0) (Z.to_nat m - S (Datatypes.length l)))) as Heq.
    { rewrite Zlength_repeat, Nat2Z.inj_sub, Z2Nat.id, Nat2Z.inj_succ, <- Zlength_correct; omega. }
    rewrite (sublist_app1 _ _ _ (_ ++ _)%list); rewrite ?Zlength_app; try omega.
    rewrite (sublist_app1 _ _ _ (_ ++ _)%list); try rewrite Zlength_app; try omega.
(* Goal: @eq (list val) (@app val (@sublist val (Z.sub (Z.sub m n) (Zpos xH)) (Z.sub (Z.succ (Z.add (@Zlength val l) (@Zlength val (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))))) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@sublist val Z0 (Z.sub (Z.sub m n) (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) (@app val (@sublist val (Z.sub m (Z.add n (Zpos xH))) (Z.sub m (Zpos xH)) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) (@cons val (@Znth val Inhabitant_val (Z.sub m (Zpos xH)) (@app val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l))))) (@cons val (Vptrofs (Ptrofs.repr Z0)) (@nil val)))) (@sublist val Z0 (Z.sub m (Z.add n (Zpos xH))) (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))))) *)
    f_equal; f_equal; try omega.
    + rewrite app_Znth2, Zlength_app, Heq, Zminus_diag, Znth_0_cons; auto.
(* Goal: Z.ge (Z.sub m (Zpos xH)) (@Zlength val (@app val l (@repeat val (Vptrofs (Ptrofs.repr Z0)) (Init.Nat.sub (Z.to_nat m) (S (@Datatypes.length val l)))))) *)
      rewrite Zlength_app; omega.
    + f_equal; omega.
Qed.

Lemma upd_complete_gen : forall {A} (l : list A) x n y, Zlength l < n ->
  upd_Znth (Zlength l) (l ++ repeat y (Z.to_nat (n - Zlength l))) x =
  (l ++ [x]) ++ repeat y (Z.to_nat (n - Zlength (l ++ [x]))).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list A) (@upd_Znth A (@Zlength A l) (@app A l (@repeat A y (Z.to_nat (Z.sub n (@Zlength A l))))) x) (@app A (@app A l (@cons A x (@nil A))) (@repeat A y (Z.to_nat (Z.sub n (@Zlength A (@app A l (@cons A x (@nil A)))))))) *)
  rewrite upd_Znth_app2, Zminus_diag.
  destruct (Z.to_nat (n - Zlength l)) eqn: Hn.
  - apply Z2Nat.inj with (m := 0) in Hn; omega.
  - simpl; rewrite upd_Znth0, Zlength_cons, sublist_1_cons.
(* Goal: @eq (list A) (@app A l (@cons A x (@sublist A Z0 (Z.sub (Z.succ (@Zlength A (@repeat A y n0))) (Zpos xH)) (@repeat A y n0)))) (@app A (@app A l (@cons A x (@nil A))) (@repeat A y (Z.to_nat (Z.sub n (@Zlength A (@app A l (@cons A x (@nil A)))))))) *)
    unfold Z.succ; rewrite Z.add_simpl_r, sublist_same; auto.
    rewrite <- app_assoc, Zlength_app, Zlength_cons, Zlength_nil; simpl.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    rewrite Z.sub_add_distr, Z2Nat.inj_sub, Hn by computable; simpl.
(* Goal: @eq (list A) (@app A l (@cons A x (@repeat A y n0))) (@app A l (@cons A x (@repeat A y (Init.Nat.sub n0 O)))) *)
    rewrite Nat.sub_0_r; auto.
  - pose proof (Zlength_nonneg (repeat y (Z.to_nat (n - Zlength l)))); omega.
Qed.

Lemma upd_complete' : forall l x n, (length l < n)%nat ->
  upd_Znth (Zlength l) (map Vint (map Int.repr l) ++ repeat Vundef (n - length l)) (Vint (Int.repr x)) =
  map Vint (map Int.repr (l ++ [x])) ++ repeat Vundef (n - length (l ++ [x])).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list val) (@upd_Znth val (@Zlength Z l) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l)))) (Vint (Int.repr x))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite upd_Znth_app2; [|repeat rewrite Zlength_map; repeat rewrite Zlength_correct; omega].
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val (Z.sub (@Zlength Z l) (@Zlength val (@map Int.int val Vint (@map Z Int.int Int.repr l)))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  repeat rewrite Zlength_map.
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val (Z.sub (@Zlength Z l) (@Zlength Z l)) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite Zminus_diag.
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@upd_Znth val Z0 (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z l))) (Vint (Int.repr x)))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr (@app Z l (@cons Z x (@nil Z))))) (@repeat val Vundef (Init.Nat.sub n (@Datatypes.length Z (@app Z l (@cons Z x (@nil Z))))))) *)
  rewrite app_length; simpl plus.
  destruct (n - length l)%nat eqn: Hminus; [omega|].
  replace (n - (length l + 1))%nat with n0 by omega.
  rewrite upd_Znth0, !map_app, <- app_assoc; simpl.
(* Goal: @eq (list val) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@cons val (Vint (Int.repr x)) (@sublist val (Zpos xH) (@Zlength val (@cons val Vundef (@repeat val Vundef n0))) (@cons val Vundef (@repeat val Vundef n0))))) (@app val (@map Int.int val Vint (@map Z Int.int Int.repr l)) (@cons val (Vint (Int.repr x)) (@repeat val Vundef n0))) *)
  rewrite sublist_1_cons, Zlength_cons, sublist_same; auto; omega.
Qed.

(*
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_indep : forall {A} i (l : list A) d d', 
   0 <= i < Zlength l -> Znth i l d = Znth i l d'.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (i : nat) (l : list A), @eq A (@nth A i l (@default A d)) (@Znth A d (Z.of_nat i) l) *)
  intros; unfold Znth.
  destruct (zlt i 0); [omega|].
  apply nth_indep.
  rewrite Zlength_correct in *; rep_omega.
Qed.
*)

Fixpoint upto n :=
  match n with
  | O => []
  | S n' => 0 :: map Z.succ (upto n')
  end.

Opaque Z.of_nat.

Lemma upto_app : forall n m, upto (n + m) = upto n ++ map (fun i => Z.of_nat n + i) (upto m).
Proof.
(* Goal: forall n m : nat, @eq (list Z) (upto (Init.Nat.add n m)) (@app Z (upto n) (@map Z Z (fun i : Z => Z.add (Z.of_nat n) i) (upto m))) *)
  induction n; simpl; intro.
  - rewrite map_id; auto.
  - rewrite IHn, map_app, map_map, Nat2Z.inj_succ; f_equal; f_equal.
(* Goal: @eq (list Z) (@map Z Z (fun x : Z => Z.succ (Z.add (Z.of_nat n) x)) (upto m)) (@map Z Z (fun i : Z => Z.add (Z.succ (Z.of_nat n)) i) (upto m)) *)
    apply map_ext; intro; omega.
Qed.

Lemma upto_length : forall n, length (upto n) = n.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction n; auto; simpl.
(* Goal: @eq nat (S (@Datatypes.length Z (@map Z Z Z.succ (upto n)))) (S n) *)
  rewrite map_length, IHn; auto.
Qed.

Corollary Zlength_upto : forall n, Zlength (upto n) = Z.of_nat n.
Proof.
(* Goal: forall n : nat, @eq Z (@Zlength Z (upto n)) (Z.of_nat n) *)
  intro; rewrite Zlength_correct, upto_length; auto.
Qed.

Lemma skipn_cons : forall {A}{d: Inhabitant A} n (l : list A), (length l > n)%nat ->
  skipn n l = Znth (Z.of_nat n) l :: skipn (S n) l.
Proof.
  induction n; intros; simpl; destruct l; simpl in *; try omega; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { inversion H. }
(* Goal: @eq (list A) (@skipn A n l) (@cons A (@Znth A d (Z.of_nat (S n)) (@cons A a l)) match l with | nil => @nil A | cons a l => @skipn A n l end) *)
  rewrite Nat2Z.inj_succ.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.succ a0) (@cons A a l)) *)
  rewrite Znth_pos_cons; [|omega].
(* Goal: @eq (list A) (@skipn A n l) (@cons A (@Znth A d (Z.sub (Z.succ (Z.of_nat n)) (Zpos xH)) l) match l with | nil => @nil A | cons a l => @skipn A n l end) *)
  unfold Z.succ; rewrite Z.add_simpl_r.
(* Goal: @eq (list A) (@skipn A n l) (@cons A (@Znth A d (Z.of_nat n) l) match l with | nil => @nil A | cons a l => @skipn A n l end) *)
  erewrite IHn; auto; omega.
Qed.

(*
Lemma Znth_map' : forall {A B} i (f : A -> B) al b,
           Znth i (map f al) (f b) = f (Znth i al b).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold Znth; intros.
(* Goal: @eq (prod A B) (if zlt i Z0 then @default (prod A B) (@Inhabitant_pair A B a b) else @nth (prod A B) (Z.to_nat i) (@combine A B l1 l2) (@Inhabitant_pair A B a b)) (@pair A B (if zlt i Z0 then @default A a else @nth A (Z.to_nat i) l1 a) (if zlt i Z0 then @default B b else @nth B (Z.to_nat i) l2 b)) *)
  destruct (zlt i 0); auto.
  apply map_nth.
Qed.
*)

Lemma Znth_upto : forall d m n, 
  0 <= n < Z.of_nat m -> @Znth _ d n (upto m) = n.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction m; simpl; intros.
  - rewrite Znth_nil; simpl in *; rewrite Nat2Z.inj_0 in *; omega.
  - destruct (eq_dec n 0).
    + subst; apply Znth_0_cons.
    + rewrite Nat2Z.inj_succ in *.
(* Goal: le (@Datatypes.length A (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) a l))) (Init.Nat.add (@Datatypes.length A a) (@Datatypes.length A (@concat A l))) *)
      rewrite Znth_pos_cons by omega.
(* Goal: @eq Z (@Znth Z d (Z.sub n (Zpos xH)) (@map Z Z Z.succ (upto m))) n *)
      rewrite Znth_map. rewrite IHm. omega. omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      rewrite Zlength_upto. omega.
Qed.

Transparent Z.of_nat.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma In_Znth : forall {A} {d: Inhabitant A} (l : list A) x,
    In x l ->
    exists i, 0 <= i < Zlength l /\ Znth i l = x.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold Znth; intros.
(* Goal: @ex Z (fun i : Z => and (and (Z.le Z0 i) (Z.lt i (@Zlength A l))) (@eq A (if zlt i Z0 then @default A d else @nth A (Z.to_nat i) l d) x)) *)
  apply In_nth with (d := d) in H; destruct H as (n & ? & ?).
(* Goal: @ex Z (fun i : Z => and (and (Z.le Z0 i) (Z.lt i (@Zlength A l))) (@eq A (if zlt i Z0 then @default A d else @nth A (Z.to_nat i) l d) x)) *)
  exists (Z.of_nat n); split.
  - rewrite Zlength_correct; omega.
  - destruct (zlt (Z.of_nat n) 0); [omega|].
(* Goal: @eq A (@nth A i l (@default A d)) (@nth A (Z.to_nat (Z.of_nat i)) l d) *)
    rewrite Nat2Z.id; auto.
Qed.

Lemma In_upd_Znth_old : forall {A}{d: Inhabitant A} i (x y : A) l, In x l -> x <> Znth i l -> 0 <= i <= Zlength l ->
  In x (upd_Znth i l y).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @In A x (@upd_Znth A i l y) *)
  apply In_Znth in H; destruct H as (j & ? & ?); subst.
(* Goal: @In A (@Znth A d j l) (@upd_Znth A i l y) *)
  unfold upd_Znth.
(* Goal: @In A (@Znth A d j l) (@app A (@sublist A Z0 i l) (@cons A y (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
  destruct (eq_dec j i); [subst; contradiction|].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite in_app; simpl.
(* Goal: or (@In A (@Znth A d j l) (@sublist A Z0 i l)) (or (@eq A y (@Znth A d j l)) (@In A (@Znth A d j l) (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
  destruct (zlt j i); [left | right; right].
  - erewrite <- (Z.add_0_r j), <- Znth_sublist; [apply Znth_In; rewrite Zlength_sublist| |]; auto; omega.
  - erewrite <- (Z.sub_simpl_r _ (i + 1)), <- Znth_sublist; [apply Znth_In; rewrite Zlength_sublist| |]; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_combine : forall {A B} {a: Inhabitant A} {b: Inhabitant B} i (l1: list A) (l2: list B), 
   Zlength l1 = Zlength l2 ->
  Znth i (combine l1 l2) = (Znth i l1, Znth i l2).
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (i : nat) (l : list A), @eq A (@nth A i l (@default A d)) (@Znth A d (Z.of_nat i) l) *)
  intros; unfold Znth.
(* Goal: @eq (prod A B) (if zlt i Z0 then @default (prod A B) (@Inhabitant_pair A B a b) else @nth (prod A B) (Z.to_nat i) (@combine A B l1 l2) (@Inhabitant_pair A B a b)) (@pair A B (if zlt i Z0 then @default A a else @nth A (Z.to_nat i) l1 a) (if zlt i Z0 then @default B b else @nth B (Z.to_nat i) l2 b)) *)
  destruct (zlt i 0); auto.
(* Goal: @eq (prod A B) (@nth (prod A B) (Z.to_nat i) (@combine A B l1 l2) (@Inhabitant_pair A B a b)) (@pair A B (@nth A (Z.to_nat i) l1 a) (@nth B (Z.to_nat i) l2 b)) *)
  apply combine_nth.
  rewrite !Zlength_correct in *; rep_omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_combine : forall {A B} (l : list A) (l' : list B),
  Zlength (combine l l') = Z.min (Zlength l) (Zlength l').
Proof.
(* Goal: forall (A B : Type) (l : list A) (l' : list B), @eq Z (@Zlength (prod A B) (@combine A B l l')) (Z.min (@Zlength A l) (@Zlength B l')) *)
  intros; rewrite !Zlength_correct, combine_length, Nat2Z.inj_min; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma nth_Znth : forall {A}{d: Inhabitant A} i l, nth i l default = Znth (Z.of_nat i) l.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (i : nat) (l : list A), @eq A (@nth A i l (@default A d)) (@Znth A d (Z.of_nat i) l) *)
  intros; unfold Znth.
(* Goal: @eq A (@nth A i l (@default A d)) (if zlt (Z.of_nat i) Z0 then @default A d else @nth A (Z.to_nat (Z.of_nat i)) l d) *)
  destruct (zlt (Z.of_nat i) 0); [omega|].
(* Goal: @eq A (@nth A i l (@default A d)) (@nth A (Z.to_nat (Z.of_nat i)) l d) *)
  rewrite Nat2Z.id; auto.
Qed.

Lemma upd_Znth_cons : forall {A} i a l (x : A), i > 0 ->
  upd_Znth i (a :: l) x = a :: upd_Znth (i - 1) l x.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; unfold upd_Znth, sublist.sublist; simpl.
(* Goal: @eq (list A) (@app A (@firstn A (Z.to_nat (Z.sub i Z0)) (@cons A a l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A (@cons A a l)) (Z.add i (Zpos xH)))) (@skipn A (Z.to_nat (Z.add i (Zpos xH))) (@cons A a l))))) (@cons A a (@app A (@firstn A (Z.to_nat (Z.sub (Z.sub i (Zpos xH)) Z0)) l) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A l) (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) (@skipn A (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH))) l))))) *)
  repeat rewrite Z.sub_0_r.
(* Goal: @eq (list A) (@app A (@firstn A (Z.to_nat i) (@cons A a l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A (@cons A a l)) (Z.add i (Zpos xH)))) (@skipn A (Z.to_nat (Z.add i (Zpos xH))) (@cons A a l))))) (@cons A a (@app A (@firstn A (Z.to_nat (Z.sub i (Zpos xH))) l) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A l) (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) (@skipn A (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH))) l))))) *)
  destruct (Z.to_nat i) eqn: Hi.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { exploit Z2Nat_inj_0; eauto; omega. }
(* Goal: @eq nat (Init.Nat.sub (S (Z.to_nat (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) *)
  rewrite Zlength_cons; repeat rewrite Z2Nat.inj_add; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  repeat rewrite Z2Nat.inj_sub; try omega.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite Hi; simpl.
(* Goal: @eq (list A) (@cons A a (@app A (@firstn A n l) (@cons A x (@firstn A (Init.Nat.sub (Z.to_nat (Z.succ (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (@skipn A (Init.Nat.add n (S O)) l))))) (@cons A a (@app A (@firstn A (Init.Nat.sub n O) l) (@cons A x (@firstn A (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) (@skipn A (Init.Nat.add (Init.Nat.sub n O) (S O)) l))))) *)
  rewrite Nat.sub_0_r.
(* Goal: @eq (list A) (@cons A a (@app A (@firstn A n l) (@cons A x (@firstn A (Init.Nat.sub (Z.to_nat (Z.succ (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (@skipn A (Init.Nat.add n (S O)) l))))) (@cons A a (@app A (@firstn A n l) (@cons A x (@firstn A (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) (@skipn A (Init.Nat.add n (S O)) l))))) *)
  do 4 f_equal.
(* Goal: @eq nat (Init.Nat.sub (Z.to_nat (Z.succ (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) *)
  rewrite Z2Nat.inj_succ; [|rewrite Zlength_correct; omega].
(* Goal: @eq nat (Init.Nat.sub (S (Z.to_nat (@Zlength A l))) (Z.to_nat (Z.add i (Zpos xH)))) (Init.Nat.sub (Z.to_nat (@Zlength A l)) (Z.to_nat (Z.add (Z.sub i (Zpos xH)) (Zpos xH)))) *)
  repeat rewrite Z2Nat.inj_add; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z2Nat.inj_sub; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  simpl plus; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma upd_Znth_triv : forall {A}{d: Inhabitant A} i (l : list A) x (Hi : 0 <= i < Zlength l),
  Znth i l = x -> upd_Znth i l x = l.
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
  setoid_rewrite <- (firstn_skipn (Z.to_nat i) l) at 4.
  erewrite skipn_cons, Z2Nat.id, H; try omega; [|rewrite Zlength_correct in *; rep_omega].
(* Goal: @eq (list A) (@app A (@sublist A Z0 i l) (@cons A x (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) (@app A (@firstn A (Z.to_nat i) l) (@cons A x (@skipn A (S (Z.to_nat i)) l))) *)
  unfold sublist.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z.sub_0_r, Z2Nat.inj_add, NPeano.Nat.add_1_r; try omega.
(* Goal: @eq (list A) (@app A (@firstn A (Z.to_nat i) (@skipn A (Z.to_nat Z0) l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (@Zlength A l) (Z.add i (Zpos xH)))) (@skipn A (S (Z.to_nat i)) l)))) (@app A (@firstn A (Z.to_nat i) l) (@cons A x (@skipn A (S (Z.to_nat i)) l))) *)
  setoid_rewrite firstn_same at 2; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z2Nat.inj_sub, Zlength_correct, Nat2Z.id, Z2Nat.inj_add, skipn_length; simpl; omega.
Qed.

Lemma combine_upd_Znth : forall {A B} (l1 : list A) (l2 : list B) i x1 x2, 0 <= i < Zlength l1 ->
  Zlength l1 = Zlength l2 -> combine (upd_Znth i l1 x1) (upd_Znth i l2 x2) = upd_Znth i (combine l1 l2) (x1, x2).
Proof.
  induction l1; simpl; intros; [rewrite Zlength_nil in *; omega|].
  destruct l2; [rewrite Zlength_nil in *; omega|].
  rewrite !Zlength_cons in *.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; rewrite !upd_Znth0, !Zlength_cons, !sublist_1_cons, !sublist_same; auto; omega.
  - rewrite !upd_Znth_cons; try omega; simpl.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite IHl1; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Corollary combine_upd_Znth1 : forall {A B}{d: Inhabitant B} (l1 : list A) (l2 : list B) i x,
   0 <= i < Zlength l1 ->
  Zlength l1 = Zlength l2 ->
   combine (upd_Znth i l1 x) l2 = upd_Znth i (combine l1 l2) (x, Znth i l2).
Proof.
  intros; rewrite <- combine_upd_Znth by auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  erewrite upd_Znth_triv with (l := l2); eauto; omega.
Qed.

Corollary combine_upd_Znth2 : forall {A B}{d: Inhabitant A} (l1 : list A) (l2 : list B) i x, 0 <= i < Zlength l1 ->
  Zlength l1 = Zlength l2 -> combine l1 (upd_Znth i l2 x) = upd_Znth i (combine l1 l2) (Znth i l1, x).
Proof.
  intros; rewrite <- combine_upd_Znth by auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  erewrite upd_Znth_triv with (l := l1); eauto; omega.
Qed.

Lemma in_concat : forall {A} (l : list (list A)) x, In x (concat l) <-> exists l1, In x l1 /\ In l1 l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; simpl; intros.
  - split; [|intros (? & ? & ?)]; contradiction.
  - rewrite in_app, IHl; split.
    + intros [? | (? & ? & ?)]; eauto.
    + intros (? & ? & [? | ?]); subst; eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma length_concat : forall {A} (l : list (list A)), length (concat l) = fold_right plus O (map (@length A) l).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
(* Goal: @eq nat (@Datatypes.length A (@app A a (@concat A l))) (Init.Nat.add (@Datatypes.length A a) (@fold_right nat nat Init.Nat.add O (@map (list A) nat (@Datatypes.length A) l))) *)
  rewrite app_length, IHl; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma length_concat_min : forall {A}{d: Inhabitant A} (l : list (list A)) i (Hi : 0 <= i < Zlength l),
  (length (Znth i l) <= length (concat l))%nat.
Proof.
  induction l; simpl; intros; [rewrite Zlength_nil in *; omega|].
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  rewrite app_length; destruct (eq_dec i 0).
  - subst; rewrite Znth_0_cons; omega.
  - rewrite Znth_pos_cons by omega.
    rewrite Zlength_cons in *; etransitivity; [apply IHl|]; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma length_concat_upd : forall {A} {d: Inhabitant A} l i (l' : list A) (Hi : 0 <= i < Zlength l),
  length (concat (upd_Znth i l l')) = (length (concat l) + length l' - length (Znth i l))%nat.
Proof.
  induction l; intros; [rewrite Zlength_nil in *; omega|].
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; rewrite upd_Znth0, Znth_0_cons, sublist_1_cons.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    rewrite Zlength_cons in *; rewrite sublist_same by (auto; omega); simpl.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite !app_length; omega.
  - rewrite upd_Znth_cons, Znth_pos_cons by omega; simpl.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
    rewrite Zlength_cons in *.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite !app_length, IHl by omega.
    exploit (length_concat_min l (i - 1)); omega.
Qed.

Lemma sepcon_rev : forall l, fold_right sepcon emp (rev l) = fold_right sepcon emp l.
Proof.
(* Goal: forall l : list mpred, @eq mpred (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@rev mpred l)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l) *)
  induction l; simpl; auto.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite sepcon_app; simpl.
(* Goal: @eq mpred (@sepcon mpred Nveric Sveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@rev mpred l)) (@sepcon mpred Nveric Sveric a (@emp mpred Nveric Sveric))) (@sepcon mpred Nveric Sveric a (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l)) *)
  rewrite sepcon_emp, sepcon_comm, IHl; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma incl_nil : forall {A} (l : list A), incl [] l.
Proof.
(* Goal: forall (A : Type) (l : list A), @incl A (@nil A) l *)
  repeat intro; contradiction.
Qed.
Hint Resolve incl_nil.

Lemma incl_cons_out : forall {A} (a : A) l1 l2, incl l1 (a :: l2) -> ~In a l1 -> incl l1 l2.
Proof.
(* Goal: forall (A : Type) (a : A) (l1 l2 : list A) (_ : @incl A l1 (@cons A a l2)) (_ : not (@In A a l1)), @incl A l1 l2 *)
  intros; intros ? Hin; specialize (H _ Hin); destruct H; auto; subst; contradiction.
Qed.

Lemma In_upto : forall n i, In i (upto n) <-> 0 <= i < Z.of_nat n.
Proof.
(* Goal: forall (n : nat) (i : Z), iff (@In Z i (upto n)) (and (Z.le Z0 i) (Z.lt i (Z.of_nat n))) *)
  induction n; intro.
  - simpl; split; try contradiction; omega.
  - rewrite Nat2Z.inj_succ; simpl.
(* Goal: iff (or (@eq Z Z0 i) (@In Z i (@map Z Z Z.succ (upto n)))) (and (Z.le Z0 i) (Z.lt i (Z.succ (Z.of_nat n)))) *)
    rewrite in_map_iff; split.
    + intros [? | ?]; [omega|].
      destruct H as (? & ? & ?); subst; rewrite IHn in *; omega.
    + intro; destruct (eq_dec i 0); [auto | right].
      exists (i - 1); rewrite IHn; omega.
Qed.

Lemma combine_fst : forall {A B} (l : list A) (l' : list B), length l = length l' ->
  map fst (combine l l') = l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; destruct l'; try discriminate; auto; intros.
(* Goal: @eq (list B) (@map (prod A B) B (@snd A B) (@combine A B (@cons A a l) (@cons B b l'))) (@cons B b l') *)
  inv H; simpl; rewrite IHl; auto.
Qed.

Lemma combine_snd : forall {A B} (l : list A) (l' : list B), length l = length l' ->
  map snd (combine l l') = l'.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; destruct l'; try discriminate; auto; intros.
(* Goal: @eq (list B) (@map (prod A B) B (@snd A B) (@combine A B (@cons A a l) (@cons B b l'))) (@cons B b l') *)
  inv H; simpl; rewrite IHl; auto.
Qed.

Lemma rev_combine : forall {A B} (l1 : list A) (l2 : list B), length l1 = length l2 ->
  rev (combine l1 l2) = combine (rev l1) (rev l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; destruct l2; try discriminate; auto; simpl; intros.
(* Goal: @eq (list (prod A B)) (@app (prod A B) (@rev (prod A B) (@combine A B l1 l2)) (@cons (prod A B) (@pair A B a b) (@nil (prod A B)))) (@combine A B (@app A (@rev A l1) (@cons A a (@nil A))) (@app B (@rev B l2) (@cons B b (@nil B)))) *)
  inv H; rewrite combine_app; [|rewrite !rev_length; auto].
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
  rewrite IHl1; auto.
Qed.

Lemma combine_map_snd : forall {A B C} (l1 : list A) (l2 : list B) (f : B -> C),
  combine l1 (map f l2) = map (fun x => let '(a, b) := x in (a, f b)) (combine l1 l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; auto; simpl; intros.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  destruct l2; auto; simpl.
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
  rewrite IHl1; auto.
Qed.

Lemma combine_const1 : forall {A B} (l1 : list A) (x : B) n, Z.of_nat n >= Zlength l1 ->
  combine l1 (repeat x n) = map (fun a => (a, x)) l1.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; auto; simpl; intros.
  rewrite Zlength_cons in *; destruct n; [rewrite Zlength_correct in *; simpl in *; omega | simpl].
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
  rewrite IHl1; auto.
(* Goal: Z.ge (Z.of_nat n) (@Zlength A l1) *)
  rewrite Nat2Z.inj_succ in *; omega.
Qed.

Lemma combine_const2 : forall {A B} (x : A) n (l2 : list B), Z.of_nat n >= Zlength l2 ->
  combine (repeat x n) l2 = map (fun b => (x, b)) l2.
Proof.
  induction n; destruct l2; auto; intros; rewrite ?Nat2Z.inj_succ, ?Zlength_nil, ?Zlength_cons in *;
    simpl in *; try (rewrite Zlength_correct in *; omega).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite IHn; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma map_const: forall {A B} (c : A) (l : list B), map (fun _ => c) l = repeat c (length l).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
(* Goal: @eq (list (list A)) (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@sublist (list A) i (Z.sub j (Zpos xH)) (@extendr A l ls))) (@extendr A (@cons A a (@sublist A i (Z.sub j (Zpos xH)) l)) (@cons (list A) l0 (@sublist (list A) i (Z.sub j (Zpos xH)) ls))) *)
  rewrite IHl; auto.
Qed.

Lemma In_upd_Znth : forall {A} i l (x y : A), In x (upd_Znth i l y) -> x = y \/ In x l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold upd_Znth; intros.
(* Goal: or (@eq A x y) (@In A x l) *)
  rewrite in_app in H; destruct H as [? | [? | ?]]; auto; right; eapply sublist_In; eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma upd_Znth_In : forall {A} i l (x : A), In x (upd_Znth i l x).
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
(* Goal: @In A x (@app A (@sublist A Z0 i l) (@cons A x (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
  rewrite in_app; simpl; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma NoDup_Znth_iff : forall {A}{d: Inhabitant A} (l : list A),
  NoDup l <-> forall i j (Hi : 0 <= i < Zlength l)
                            (Hj : 0 <= j < Zlength l), Znth i l = Znth j l -> i = j.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (l : list A), iff (@NoDup A l) (forall (i j : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))) (_ : and (Z.le Z0 j) (Z.lt j (@Zlength A l))) (_ : @eq A (@Znth A d i l) (@Znth A d j l)), @eq Z i j) *)
  split; intros; [eapply NoDup_Znth_inj; eauto|].
(* Goal: @NoDup A (@nil A) *)
  induction l; rewrite ?Zlength_cons in *; constructor.
  - intro Hin; eapply In_Znth in Hin; destruct Hin as (j & ? & Hj).
    exploit (H 0 (j + 1)); try omega.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    rewrite !Znth_cons_eq; simpl.
(* Goal: @eq A (if @eq_dec Z initial_world.EqDec_Z (Z.add i (Zpos xH)) Z0 then a else @Znth A d i l) (if @eq_dec Z initial_world.EqDec_Z (Z.add j (Zpos xH)) Z0 then a else @Znth A d j l) *)
    if_tac; [omega|].
(* Goal: @eq A a (@Znth A d (Z.sub (Z.add j (Zpos xH)) (Zpos xH)) l) *)
    rewrite Z.add_simpl_r; eauto.
  - apply IHl; intros.
    exploit (H (i + 1) (j + 1)); try omega.
(* Goal: @eq A (@Znth A d (Z.add i (Zpos xH)) (@cons A a l)) (@Znth A d (Z.add j (Zpos xH)) (@cons A a l)) *)
    rewrite !Znth_cons_eq, !Z.add_simpl_r.
(* Goal: @eq A (if @eq_dec Z initial_world.EqDec_Z (Z.add i (Zpos xH)) Z0 then a else @Znth A d i l) (if @eq_dec Z initial_world.EqDec_Z (Z.add j (Zpos xH)) Z0 then a else @Znth A d j l) *)
    if_tac; [omega|].
(* Goal: @eq A (@Znth A d i l) (if @eq_dec Z initial_world.EqDec_Z (Z.add j (Zpos xH)) Z0 then a else @Znth A d j l) *)
    if_tac; [omega | auto].
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma concat_less_incl : forall {A} l i (l1 l2 : list A) (Hi : 0 <= i < Zlength l)
  (Hless : Znth i l = l1 ++ l2), incl (concat (upd_Znth i l l1)) (concat l).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @incl A (@filter A (fun x : A => if @in_dec A (@eq_dec A A_eq) x l then true else false) l') l *)
  intros ? Hin.
  rewrite in_concat in Hin; rewrite in_concat.
  destruct Hin as (? & ? & Hin).
  apply In_upd_Znth in Hin; destruct Hin; eauto; subst.
  do 2 eexists; [rewrite in_app; left; eauto|].
  rewrite <- Hless; apply Znth_In; auto.
Qed.

Lemma NoDup_app : forall {A} (l1 l2 : list A), NoDup (l1 ++ l2) ->
  NoDup l1 /\ NoDup l2 /\ forall x, In x l1 -> ~In x l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; intros.
(* Goal: @NoDup A (@nil A) *)
  - repeat split; auto; constructor.
  - inv H.
(* Goal: and (@NoDup A (@cons A a l1)) (and (@NoDup A l2) (forall (x : A) (_ : @In A x (@cons A a l1)), not (@In A x l2))) *)
    exploit IHl1; eauto; intros (? & ? & ?).
    rewrite in_app in *.
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    repeat split; auto.
    + constructor; auto.
    + intros ? [? | ?]; auto; subst; auto.
Qed.

Lemma NoDup_app_iff : forall {A} (l1 l2 : list A), NoDup (l1 ++ l2) <->
  NoDup l1 /\ NoDup l2 /\ forall x, In x l1 -> ~In x l2.
Proof.
(* Goal: forall (A : Type) (l1 l2 : list A), iff (@NoDup A (@app A l1 l2)) (and (@NoDup A l1) (and (@NoDup A l2) (forall (x : A) (_ : @In A x l1), not (@In A x l2)))) *)
  intros; split; [apply NoDup_app|].
(* Goal: forall _ : and (@NoDup A l1) (and (@NoDup A l2) (forall (x : A) (_ : @In A x l1), not (@In A x l2))), @NoDup A (@app A l1 l2) *)
  intros (? & ? & Hsep); induction l1; auto.
(* Goal: @NoDup A (@nil A) *)
  inv H; simpl; constructor.
  - rewrite in_app_iff; intros [? | ?]; [contradiction|].
(* Goal: False *)
    eapply Hsep; simpl; eauto.
  - apply IHl1; auto.
(* Goal: forall (x : A) (_ : @In A x l1), not (@In A x l2) *)
    intros; apply Hsep; simpl; auto.
Qed.

Corollary NoDup_app_swap : forall {A} (l1 l2 : list A), NoDup (l1 ++ l2) <-> NoDup (l2 ++ l1).
Proof.
  intros; rewrite !NoDup_app_iff; split; intros (? & ? & Hsep); repeat split; auto; repeat intro; eapply Hsep;
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma NoDup_concat_less : forall {A} l i (l1 l2 : list A) (Hl : NoDup (concat l))
  (Hi : 0 <= i < Zlength l) (Hless : Znth i l = l1 ++ l2),
  NoDup (concat (upd_Znth i l l1)).
Proof.
  induction l; simpl; intros; [rewrite Zlength_nil in *; omega|].
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; rewrite upd_Znth0, Zlength_cons, sublist_1_cons, sublist_same by (auto; omega); simpl.
(* Goal: @NoDup A (@app A l1 (@concat A l)) *)
    rewrite Znth_0_cons in Hless; subst.
    rewrite <- app_assoc, NoDup_app_swap, <- app_assoc, NoDup_app_iff, NoDup_app_swap in Hl; tauto.
  - rewrite upd_Znth_cons by omega; simpl.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite Znth_pos_cons in Hless by omega.
(* Goal: @NoDup A (@app A a (@concat A (@upd_Znth (list A) (Z.sub i (Zpos xH)) l l1))) *)
    rewrite NoDup_app_iff in Hl; rewrite NoDup_app_iff.
(* Goal: and (@NoDup A a) (and (@NoDup A (@concat A (@upd_Znth (list A) (Z.sub i (Zpos xH)) l l1))) (forall (x : A) (_ : @In A x a), not (@In A x (@concat A (@upd_Znth (list A) (Z.sub i (Zpos xH)) l l1))))) *)
    destruct Hl as (? & ? & Hsep).
(* Goal: and (@NoDup A a) (and (@NoDup A (@concat A (@upd_Znth (list A) (Z.sub i (Zpos xH)) l l1))) (forall (x : A) (_ : @In A x a), not (@In A x (@concat A (@upd_Znth (list A) (Z.sub i (Zpos xH)) l l1))))) *)
    split; [auto|]; split.
    + eapply IHl; eauto; omega.
    + intros ?? Hin; eapply Hsep; eauto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      eapply concat_less_incl; eauto; omega.
Qed.

Lemma Forall2_Znth : forall {A B}{d1: Inhabitant A}{d2: Inhabitant B} (P : A -> B -> Prop) l1 l2 (Hall : Forall2 P l1 l2) i
  (Hi : 0 <= i < Zlength l1), P (Znth i l1) (Znth i l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction 1; intros.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite Zlength_nil in *; omega. }
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; rewrite !Znth_0_cons; auto.
  - rewrite !Znth_pos_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    apply IHHall; omega.
Qed.

Lemma Forall2_app_inv : forall {A B} (P : A -> B -> Prop) l1 l2 l3 l4 (Hlen : length l1 = length l3),
  Forall2 P (l1 ++ l2) (l3 ++ l4) -> Forall2 P l1 l3 /\ Forall2 P l2 l4.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; destruct l3; try discriminate; auto; intros.
(* Goal: and (@Forall2 A B P (@cons A a l1) (@cons B b l3)) (@Forall2 A B P l2 l4) *)
  inv H; inv Hlen.
(* Goal: and (@Forall2 A B P (@cons A a l1) (@cons B b l3)) (@Forall2 A B P l2 l4) *)
  exploit IHl1; eauto; intros (? & ?); split; [constructor|]; auto.
Qed.

Lemma Forall2_firstn : forall {A B} (P : A -> B -> Prop) l1 l2 n, Forall2 P l1 l2 ->
  Forall2 P (firstn n l1) (firstn n l2).
Proof.
(* Goal: forall (A B : Type) (P : forall (_ : A) (_ : B), Prop) (l1 : list A) (l2 : list B) (n : nat) (_ : @Forall2 A B P l1 l2), @Forall2 A B P (@firstn A n l1) (@firstn B n l2) *)
  intros; revert n; induction H; intro.
  - rewrite !firstn_nil; auto.
  - destruct n; simpl; auto.
Qed.

Lemma Forall2_upd_Znth : forall {A B} (P : A -> B -> Prop) l1 l2 i x1 x2, Forall2 P l1 l2 ->
  P x1 x2 -> 0 <= i <= Zlength l1 -> Forall2 P (upd_Znth i l1 x1) (upd_Znth i l2 x2).
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
(* Goal: @Forall2 A B P (@app A (@sublist A Z0 i l1) (@cons A x1 (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1))) (@app B (@sublist B Z0 i l2) (@cons B x2 (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
  pose proof (mem_lemmas.Forall2_Zlength H) as Hlen.
  erewrite <- sublist_same with (al := l1), sublist_split with (mid := i) in H; auto; try omega.
  erewrite <- sublist_same with (al := l2), sublist_split with (al := l2)(mid := i) in H; auto; try omega.
(* Goal: @Forall2 A B P (@app A (@sublist A Z0 i l1) (@cons A x1 (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1))) (@app B (@sublist B Z0 i l2) (@cons B x2 (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
  apply Forall2_app_inv in H.
(* Goal: @Forall2 A B P (@app A (@sublist A Z0 i l1) (@cons A x1 (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1))) (@app B (@sublist B Z0 i l2) (@cons B x2 (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
(* Goal: @eq nat (@Datatypes.length A (@sublist A Z0 i l1)) (@Datatypes.length B (@sublist B Z0 i l2)) *)
  destruct H as (? & Hall); apply Forall2_app; auto.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
  constructor; auto.
(* Goal: @Forall A P (@sublist A (Z.max i j) (@Zlength A l2) l2) *)
  destruct (eq_dec i (Zlength l1)).
  - rewrite !sublist_nil_gen; auto; omega.
  - rewrite Z.add_comm.
    replace (Zlength l1) with (Zlength l1 - i + i) by omega.
    replace (Zlength l2) with (Zlength l2 - i + i) by omega.
    erewrite <- !sublist_sublist with (j := Zlength l1); try omega.
(* Goal: @Forall2 A B P (@sublist A (Zpos xH) (Z.sub (@Zlength A l1) i) (@sublist A i (@Zlength A l1) l1)) (@sublist B (Zpos xH) (Z.sub (@Zlength B l2) i) (@sublist B i (@Zlength A l1) l2)) *)
    inversion Hall as [Hl1 Hl2 | ?????? Hl1 Hl2].
    + rewrite !Hlen, <- Hl2.
(* Goal: @eq (list (prod A B)) (@sublist (prod A B) i j (@nil (prod A B))) (@combine A B (@sublist A i j (@nil A)) (@sublist B i j l2)) *)
      unfold sublist; rewrite !skipn_nil, !firstn_nil; auto.
    + rewrite sublist_1_cons, !Hlen, <- Hl2, sublist_1_cons.
(* Goal: @Forall2 A B P (@sublist A Z0 (Z.sub (Z.sub (@Zlength B l2) i) (Zpos xH)) l) (@sublist B Z0 (Z.sub (Z.sub (@Zlength B l2) i) (Zpos xH)) l') *)
      unfold sublist; simpl; apply Forall2_firstn; auto.
  - apply Nat2Z.inj; rewrite <- !Zlength_correct.
(* Goal: @eq Z (@Zlength A (@sublist A Z0 i l1)) (@Zlength B (@sublist B Z0 i l2)) *)
    autorewrite with sublist; auto.
Qed.

Lemma Forall2_impl' : forall {A B} (P Q : A -> B -> Prop) l1 l2,
  (forall a b, In a l1 -> In b l2 -> P a b -> Q a b) -> Forall2 P l1 l2 -> Forall2 Q l1 l2.
Proof.
  induction 2; simpl in *; auto.
Qed.

Lemma Forall2_impl : forall {A B} (P Q : A -> B -> Prop), (forall a b, P a b -> Q a b) ->
  forall l1 l2, Forall2 P l1 l2 -> Forall2 Q l1 l2.
Proof.
(* Goal: forall (A B : Type) (P Q : forall (_ : A) (_ : B), Prop) (_ : forall (a : A) (b : B) (_ : P a b), Q a b) (l1 : list A) (l2 : list B) (_ : @Forall2 A B P l1 l2), @Forall2 A B Q l1 l2 *)
  induction 2; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma map_id_eq : forall {A} (l : list A), map (@id A) l = l.
Proof.
(* Goal: forall (A : Type) (l : list A), @eq (list A) (@map A A (id A) l) l *)
  induction l; auto.
(* Goal: @eq (list A) (@map A A (id A) (@cons A a l)) (@cons A a l) *)
  simpl; apply f_equal; auto.
Qed.

Lemma Forall2_map : forall {A B C D} (P : A -> B -> Prop) (f1 : C -> A) (f2 : D -> B) l1 l2,
  Forall2 P (map f1 l1) (map f2 l2) <-> Forall2 (fun a b => P (f1 a) (f2 b)) l1 l2.
Proof.
(* Goal: forall (A B C D : Type) (P : forall (_ : A) (_ : B), Prop) (f1 : forall _ : C, A) (f2 : forall _ : D, B) (l1 : list C) (l2 : list D), iff (@Forall2 A B P (@map C A f1 l1) (@map D B f2 l2)) (@Forall2 C D (fun (a : C) (b : D) => P (f1 a) (f2 b)) l1 l2) *)
  induction l1.
  - split; intro H.
    + destruct l2; auto; inv H.
    + inv H; simpl; auto.
  - split; intro H.
    + destruct l2; inv H.
      rewrite IHl1 in *; constructor; auto.
    + inv H; simpl; constructor; auto.
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
      rewrite IHl1; auto.
Qed.

Corollary Forall2_map1 : forall {A B C} (P : A -> B -> Prop) (f : C -> A) l1 l2, Forall2 P (map f l1) l2 <->
  Forall2 (fun a b => P (f a) b) l1 l2.
Proof.
  intros; rewrite <- (map_id_eq l2) at 1; apply Forall2_map.
Qed.

Corollary Forall2_map2 : forall {A B C} (P : A -> B -> Prop) (f : C -> B) l1 l2, Forall2 P l1 (map f l2) <->
  Forall2 (fun a b => P a (f b)) l1 l2.
Proof.
  intros; rewrite <- (map_id_eq l1) at 1; apply Forall2_map.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_max_length : forall {A} i j (al : list A), Zlength (sublist i j al) <= Zlength al.
Proof.
(* Goal: forall (A : Type) (l : list A) (i j : Z) (_ : Z.le (@Zlength A l) i), @eq (list A) (@sublist A i j l) (@nil A) *)
  intros; unfold sublist.
(* Goal: Z.le (@Zlength A (@firstn A (Z.to_nat (Z.sub j i)) (@skipn A (Z.to_nat i) al))) (@Zlength A al) *)
  rewrite Zlength_firstn, Zlength_skipn.
(* Goal: Z.le (Z.min (Z.max Z0 (Z.sub j i)) (Z.max Z0 (Z.sub (@Zlength A al) (Z.max Z0 i)))) (@Zlength A al) *)
  rewrite Z.min_le_iff; right.
(* Goal: Z.le (Z.max Z0 (Z.sub (@Zlength A al) (Z.max Z0 i))) (@Zlength A al) *)
  pose proof (Zlength_nonneg al).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply Z.max_lub; try omega.
  rewrite <- Z.le_sub_nonneg; apply Z.le_max_l.
Qed.

Lemma Forall2_sublist : forall {A B} (P : A -> B -> Prop) l1 l2 i j, Forall2 P l1 l2 -> 0 <= i ->
  Forall2 P (sublist i j l1) (sublist i j l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros; revert j; revert dependent i; induction H; intros.
(* Goal: @NoDup A (@nil A) *)
  - rewrite !sublist_of_nil; constructor.
  - destruct (Z_le_dec j i); [rewrite !sublist_nil_gen; auto; constructor|].
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
    destruct (eq_dec i 0).
    + subst; rewrite !sublist_0_cons by omega.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
      constructor; auto.
    + rewrite !sublist_S_cons by omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      apply IHForall2; omega.
Qed.

Lemma Forall_last : forall {A} (P : A -> Prop) d l, Forall P l -> P d -> P (last l d).
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
(* Goal: forall (_ : @Forall A P (@cons A a l)) (_ : P d), P (@last A (@cons A a l) d) *)
  exploit (@app_removelast_last _ (a :: l) d); [discriminate | intro Hlast].
(* Goal: forall (_ : @Forall A P (@cons A a l)) (_ : P d), P (@last A (@cons A a l) d) *)
  intros; rewrite Forall_forall in H; apply H.
(* Goal: @In A x (@app A (@sublist A Z0 i l) (@cons A x (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
  rewrite Hlast at 2; rewrite in_app; simpl; auto.
Qed.

Lemma last_map : forall {A B} (f : A -> B) d l, f (last l d) = last (map f l) (f d).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

Lemma In_removelast : forall {A} (l : list A) x, In x (removelast l) -> In x l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; auto; simpl; intros.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
  destruct H; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Definition nil_dec {A} (l : list A) : {l = []} + {l <> []}.
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
(* Goal: sumbool (@eq (list A) (@cons A a l) (@nil A)) (not (@eq (list A) (@cons A a l) (@nil A))) *)
  right; discriminate.
Qed.

Lemma Forall2_upd_Znth_l : forall {A B}{d: Inhabitant B} (P : A -> B -> Prop) l1 l2 i x, Forall2 P l1 l2 ->
  P x (Znth i l2) -> 0 <= i < Zlength l1 -> Forall2 P (upd_Znth i l1 x) l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  erewrite <- upd_Znth_triv with (l := l2)(i0 := i); eauto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply Forall2_upd_Znth; eauto; omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply mem_lemmas.Forall2_Zlength in H; omega.
Qed.

Lemma Forall2_upd_Znth_r : forall {A B}{d: Inhabitant A} (P : A -> B -> Prop) l1 l2 i x, Forall2 P l1 l2 ->
  P (Znth i l1) x -> 0 <= i < Zlength l1 -> Forall2 P l1 (upd_Znth i l2 x).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  erewrite <- upd_Znth_triv with (l := l1)(i0 := i) by (eauto; omega).
(* Goal: @Forall2 A B P (@upd_Znth A i l1 (@Znth A d i l1)) (@upd_Znth B i l2 x) *)
  apply Forall2_upd_Znth; eauto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply mem_lemmas.Forall2_Zlength in H; omega.
Qed.

Lemma Forall2_eq_upto : forall {A B}{d1: Inhabitant A}{d2: Inhabitant B} (P : A -> B -> Prop) l1 l2, Forall2 P l1 l2 <->
  Zlength l1 = Zlength l2 /\ Forall (fun i => P (Znth i l1) (Znth i l2)) (upto (Z.to_nat (Zlength l1))).
Proof.
  induction l1; destruct l2; rewrite ?Zlength_cons, ?Zlength_nil; try solve [split; intro H; inv H;
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    try (rewrite Zlength_correct in *; omega)]; simpl.
  - change (upto 0) with (@nil Z); split; auto.
  - rewrite Z2Nat.inj_succ by (apply Zlength_nonneg).
    rewrite <- Nat.add_1_l, upto_app, Forall_app, Forall_map.
(* Goal: forall l2 : list D, iff (@Forall2 A B P (@map C A f1 (@cons C a l1)) (@map D B f2 l2)) (@Forall2 C D (fun (a : C) (b : D) => P (f1 a) (f2 b)) (@cons C a l1) l2) *)
    change (upto 1) with [0]; split; intro H.
    + inversion H as [|????? Hall]; subst.
(* Goal: and (@eq Z (Z.succ (@Zlength A l1)) (Z.succ (@Zlength B l2))) (and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1))))) *)
      rewrite IHl1 in Hall; destruct Hall as (? & Hall).
(* Goal: and (@eq Z (Z.succ (@Zlength A l1)) (Z.succ (@Zlength B l2))) (and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1))))) *)
      split; [congruence|].
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
      split; auto.
      rewrite Forall_forall in *; intros ? Hin.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
      specialize (Hall _ Hin); simpl.
(* Goal: P (@Znth A d1 x l1) (@Znth B d2 x l2) *)
      rewrite In_upto in Hin.
(* Goal: P (@Znth A d1 (Z.add (Zpos xH) x) (@cons A a l1)) (@Znth B d2 (Z.add (Zpos xH) x) (@cons B b l2)) *)
      rewrite !Znth_pos_cons, Z.add_simpl_l by omega; auto.
    + destruct H as (? & Ha & Hall); inversion Ha as [|?? HP]; subst.
(* Goal: @Forall2 A B P (@cons A a l1) (@cons B b l2) *)
      rewrite !Znth_0_cons in HP.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
      constructor; auto.
(* Goal: @Forall2 A B P l1 l2 *)
      rewrite IHl1; split; [omega|].
      rewrite Forall_forall in *; intros ? Hin.
      specialize (Hall _ Hin); simpl in *.
(* Goal: P (@Znth A d1 x l1) (@Znth B d2 x l2) *)
      rewrite In_upto in Hin.
(* Goal: P (@Znth A d1 x l1) (@Znth B d2 x l2) *)
      rewrite !Znth_pos_cons, Z.add_simpl_l in Hall by omega; auto.
Qed.

Lemma Forall2_forall_Znth : forall {A B}{d1: Inhabitant A}{d2: Inhabitant B}  (P : A -> B -> Prop) l1 l2,
  Forall2 P l1 l2 <->
  Zlength l1 = Zlength l2 /\ (forall i, 0 <= i < Zlength l1 -> P (Znth i l1) (Znth i l2)).
Proof.
(* Goal: forall (A B : Type) (d1 : Inhabitant A) (d2 : Inhabitant B) (P : forall (_ : A) (_ : B), Prop) (l1 : list A) (l2 : list B), iff (@Forall2 A B P l1 l2) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
  intros; rewrite Forall2_eq_upto, Forall_forall.
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : @In Z x (upto (Z.to_nat (@Zlength A l1)))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
  setoid_rewrite In_upto.
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (Z.of_nat (Z.to_nat (@Zlength A l1))))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
  rewrite Z2Nat.id by (apply Zlength_nonneg).
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (@Zlength A l1))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
  reflexivity.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Znth_inbounds : forall {A}{d: Inhabitant A} i (l : list A), 
    Znth i l <> default -> 0 <= i < Zlength l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: and (Z.le Z0 i) (Z.lt i (@Zlength A l)) *)
  destruct (zlt i 0); [contradiction H; apply Znth_underflow; auto|].
(* Goal: and (Z.le Z0 i) (Z.lt i (@Zlength A l)) *)
  destruct (Z_lt_dec i (Zlength l)); [omega|].
(* Goal: and (Z.le Z0 i) (Z.lt i (@Zlength A l)) *)
  rewrite Znth_overflow in H; [contradiction H; auto | omega].
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_next : forall {A}{d: Inhabitant A} i j l,
      0 <= i < j -> j <= Zlength l ->
  sublist i j l = Znth i l :: sublist (i + 1) j l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list A) (@sublist A i j l) (@cons A (@Znth A d i l) (@sublist A (Z.add i (Zpos xH)) j l)) *)
  rewrite Znth_cons_sublist; [|omega].
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply sublist_split; omega.
Qed.

Lemma upd_init : forall {A} (l : list A) i b v v', i < b -> Zlength l = i ->
  upd_Znth i (l ++ repeat v (Z.to_nat (b - i))) v' = l ++ v' :: repeat v (Z.to_nat (b - (i + 1))).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite upd_Znth_app2; rewrite ?Zlength_repeat, ?Z2Nat.id; try omega.
(* Goal: @eq (list A) (@app A l (@upd_Znth A (Z.sub i (@Zlength A l)) (@repeat A v (Z.to_nat (Z.sub b i))) v')) (@app A l (@cons A v' (@repeat A v (Z.to_nat (Z.sub b (Z.add i (Zpos xH))))))) *)
  subst; rewrite Zminus_diag, upd_Znth0.
  destruct (Z.to_nat (b - Zlength l)) eqn: Hi.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { change O with (Z.to_nat 0) in Hi; apply Z2Nat.inj in Hi; omega. }
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  simpl; rewrite sublist_1_cons, sublist_same; try rewrite Zlength_cons, !Zlength_repeat; try omega.
  replace (Z.to_nat (b - (Zlength l + 1))) with n; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z.sub_add_distr, Z2Nat.inj_sub; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  setoid_rewrite Hi; simpl; omega.
Qed.

Corollary upd_init_const : forall {A} i b (v v' : A), 0 <= i < b ->
  upd_Znth i (repeat v' (Z.to_nat i) ++ repeat v (Z.to_nat (b - i))) v' =
  repeat v' (Z.to_nat (i + 1)) ++ repeat v (Z.to_nat (b - (i + 1))).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite upd_init; try rewrite Zlength_repeat, Z2Nat.id; auto; try omega.
  rewrite Z2Nat.inj_add, repeat_plus, <- app_assoc; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma list_Znth_eq : forall {A}{d: Inhabitant A} (l : list A),
    l = map (fun j => Znth j l) (upto (length l)).
Proof.
(* Goal: forall (A B : Type) (f : forall _ : A, B) (a : positive) (l : list (prod positive A)) (t : PTree.t B) (_ : not (@In positive a (@map (prod positive A) positive (@fst positive A) l))), @eq (option B) (@PTree.get B a (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@PTree.get B a t) *)
  induction l; simpl; intros; auto.
(* Goal: @eq (list A) (@cons A a l) (@cons A (@Znth A d Z0 (@cons A a l)) (@map Z A (fun j : Z => @Znth A d j (@cons A a l)) (@map Z Z Z.succ (upto (@Datatypes.length A l))))) *)
  rewrite Znth_0_cons, IHl, map_map, map_length, upto_length.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  f_equal; apply map_ext_in; intros.
  rewrite Znth_pos_cons, <- IHl.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
(* Goal: Z.lt Z0 (Z.succ a0) *)
  unfold Z.succ; rewrite Z.add_simpl_r; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite In_upto in *; omega. }
Qed.

Arguments eq_dec _ _ _ _ : simpl never.

Lemma upd_Znth_eq : forall {A} {EqDec : EqDec A} {d: Inhabitant A} (x : A) (l : list A) i, 0 <= i < Zlength l ->
  upd_Znth i l x = map (fun j => if eq_dec j i then x else Znth j l) (upto (length l)).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; simpl; intros.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite Zlength_nil in *; omega. }
(* Goal: @eq (list A) (@upd_Znth A i (@cons A a l) x) (@cons A (if @eq_dec Z initial_world.EqDec_Z Z0 i then x else @Znth A d Z0 (@cons A a l)) (@map Z A (fun j : Z => if @eq_dec Z initial_world.EqDec_Z j i then x else @Znth A d j (@cons A a l)) (@map Z Z Z.succ (upto (@Datatypes.length A l))))) *)
  destruct (eq_dec 0 i).
  - subst; rewrite upd_Znth0, Zlength_cons, sublist_1_cons, sublist_same; auto; try omega.
(* Goal: @eq (list A) (@cons A x l) (@cons A x (@map Z A (fun j : Z => if @eq_dec Z initial_world.EqDec_Z j Z0 then x else @Znth A d j (@cons A a l)) (@map Z Z Z.succ (upto (@Datatypes.length A l))))) *)
    rewrite list_Znth_eq with (l0 := l) at 1.
(* Goal: @eq (list A) (@cons A x (@map Z A (fun j : Z => @Znth A d j l) (upto (@Datatypes.length A l)))) (@cons A x (@map Z A (fun j : Z => if @eq_dec Z initial_world.EqDec_Z j Z0 then x else @Znth A d j (@cons A a l)) (@map Z Z Z.succ (upto (@Datatypes.length A l))))) *)
    rewrite map_map.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
    f_equal; apply map_ext_in; intros.
    rewrite In_upto in *.
(* Goal: @eq A (@Znth A d a0 l) (if @eq_dec Z initial_world.EqDec_Z (Z.succ a0) Z0 then x else @Znth A d (Z.succ a0) (@cons A a l)) *)
    destruct (eq_dec (Z.succ a0) 0); [omega|].
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.succ a0) (@cons A a l)) *)
    rewrite Znth_pos_cons; [|omega].
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
    f_equal; omega.
  - rewrite Znth_0_cons, upd_Znth_cons; [|omega].
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
    rewrite Zlength_cons in *.
(* Goal: @eq (list A) (@cons A a (@upd_Znth A (Z.sub i (Zpos xH)) l x)) (@cons A a (@map Z A (fun j : Z => if @eq_dec Z initial_world.EqDec_Z j i then x else @Znth A d j (@cons A a l)) (@map Z Z Z.succ (upto (@Datatypes.length A l))))) *)
    rewrite IHl, map_map; [|omega].
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
    f_equal; apply map_ext_in; intros.
    rewrite In_upto in *.
    destruct (eq_dec a0 (i - 1)), (eq_dec (Z.succ a0) i); try omega; auto.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.succ a0) (@cons A a l)) *)
    rewrite Znth_pos_cons; [|omega].
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
    f_equal; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma upd_Znth_diff' : forall {A}{d: Inhabitant A} i j l (u : A),
    0 <= j < Zlength l -> i <> j ->
  Znth i (upd_Znth j l u) = Znth i l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  destruct (zlt i 0).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !Znth_underflow; auto. }
(* Goal: @eq A (@Znth A d i (@upd_Znth A j l u)) (@Znth A d i l) *)
  destruct (zlt i (Zlength l)).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply upd_Znth_diff; auto; omega.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !Znth_overflow; auto.
    rewrite upd_Znth_Zlength; auto. }
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma list_nth_error_eq : forall {A} (l1 l2 : list A)
  (Heq : forall j, nth_error l1 j = nth_error l2 j), l1 = l2.
Proof.
  induction l1; destruct l2; auto; intros; try (specialize (Heq O); simpl in Heq; discriminate).
  erewrite IHl1.
  - specialize (Heq O); inv Heq; eauto.
  - intro j; specialize (Heq (S j)); auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma list_Znth_eq' : forall {A} {d: Inhabitant A} (l1 l2 : list A)
  (Hlen : Zlength l1 = Zlength l2)
  (Heq : forall j, 0 <= j < Zlength l1 -> Znth j l1 = Znth j l2), l1 = l2.
Proof.
  induction l1; destruct l2; intros; rewrite ?Zlength_cons in *; rewrite ?Zlength_nil in *;
    auto; try (rewrite Zlength_correct in *; omega).
(* Goal: @eq (list A) (@cons A a l1) (@cons A a0 l2) *)
  exploit (Heq 0); [rewrite Zlength_correct; omega|].
(* Goal: forall _ : @eq A (@Znth A d Z0 (@cons A a l1)) (@Znth A d Z0 (@cons A a0 l2)), @eq (list A) (@cons A a l1) (@cons A a0 l2) *)
  rewrite !Znth_0_cons; intro; subst.
(* Goal: @eq (list A) (@cons A a0 l1) (@cons A a0 l2) *)
  f_equal; apply IHl1; [omega|].
  intros; specialize (Heq (j + 1)); rewrite !Znth_pos_cons in Heq; try omega.
  rewrite !Z.add_simpl_r in *; apply Heq; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Corollary upd_Znth_eq' : forall {A}{d: Inhabitant A} x (l1 l2 : list A) i (Hi : 0 <= i < Zlength l1)
  (Hlen : Zlength l1 = Zlength l2)
  (Heq : forall j, 0 <= j < Zlength l1 -> j <> i -> Znth j l1 = Znth j l2),
  upd_Znth i l1 x = upd_Znth i l2 x.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list A) (@upd_Znth A i l1 x) (@upd_Znth A i l2 x) *)
  assert (Zlength (upd_Znth i l1 x) = Zlength (upd_Znth i l2 x)).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !upd_Znth_Zlength; auto; omega. }
(* Goal: @eq (list A) (@upd_Znth A i l1 x) (@upd_Znth A i l2 x) *)
  apply list_Znth_eq'; auto.
(* Goal: forall (j : Z) (_ : and (Z.le Z0 j) (Z.lt j (@Zlength A (@upd_Znth A i l1 x)))), @eq A (@Znth A d j (@upd_Znth A i l1 x)) (@Znth A d j (@upd_Znth A i l2 x)) *)
  intros ? Hj; destruct (eq_dec j i).
  - subst; rewrite !upd_Znth_same; auto; omega.
  - rewrite !upd_Znth_diff'; rewrite upd_Znth_Zlength in Hj; auto; omega.
Qed.

Lemma upd_Znth_twice : forall {A} i l (x y : A), 0 <= i < Zlength l ->
  upd_Znth i (upd_Znth i l x) y = upd_Znth i l y.
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite !sublist_app; rewrite ?Zlength_app, ?Zlength_cons, ?Zlength_sublist; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite 2Z.min_l, 2Z.min_r, 2Z.max_r, 2Z.max_l; try omega.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite !sublist_nil, app_nil_r; simpl.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_S_cons, !sublist_sublist; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  f_equal; f_equal; [|f_equal]; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma hd_Znth : forall {A}{d: Inhabitant A} (l : list A), hd default l = Znth 0 l.
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

Lemma NoDup_filter : forall {A} (f : A -> bool) l, NoDup l -> NoDup (filter f l).
Proof.
(* Goal: forall (A B : Type) (f : forall _ : A, B) (a : positive) (l : list (prod positive A)) (t : PTree.t B) (_ : not (@In positive a (@map (prod positive A) positive (@fst positive A) l))), @eq (option B) (@PTree.get B a (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@PTree.get B a t) *)
  induction l; simpl; intros; auto.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  inv H.
(* Goal: @eq (list A) (if f a then @cons A a (@app A (@filter A f l1) (@filter A f l2)) else @app A (@filter A f l1) (@filter A f l2)) (@app A (if f a then @cons A a (@filter A f l1) else @filter A f l1) (@filter A f l2)) *)
  destruct (f a); auto.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
  constructor; auto.
(* Goal: not (@In A a (@filter A f l)) *)
  rewrite filter_In; intros (? & ?); contradiction.
Qed.

Lemma Permutation_Zlength : forall {A} (l1 l2 : list A), Permutation.Permutation l1 l2 ->
  Zlength l1 = Zlength l2.
Proof.
(* Goal: forall (A : Type) (l1 l2 : list A) (_ : @Permutation A l1 l2), @eq Z (@Zlength A l1) (@Zlength A l2) *)
  intros; apply Z2Nat.inj; try apply Zlength_nonneg.
(* Goal: @eq nat (Z.to_nat (@Zlength A l1)) (Z.to_nat (@Zlength A l2)) *)
  rewrite !ZtoNat_Zlength; apply Permutation.Permutation_length; auto.
Qed.

Lemma Permutation_filter : forall {A} (f : A -> bool) l1 l2, Permutation.Permutation l1 l2 ->
  Permutation.Permutation (filter f l1) (filter f l2).
Proof.
(* Goal: forall (A : Type) (f : forall _ : A, bool) (l1 l2 : list A) (_ : @Permutation A l1 l2), @Permutation A (@filter A f l1) (@filter A f l2) *)
  induction 1; simpl; auto.
  - destruct (f x); auto.
  - destruct (f x); auto. destruct (f y); auto.
(* Goal: @NoDup A (@nil A) *)
    constructor.
  - etransitivity; eauto.
Qed.

Lemma NoDup_add : forall {A} l1 l2 (x : A), NoDup (l1 ++ l2) -> ~In x (l1 ++ l2) -> NoDup (l1 ++ x :: l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; simpl; intros.
  - constructor; auto.
  - inv H; constructor; auto.
    rewrite in_app in *; simpl; intros [? | [? | ?]]; subst; tauto.
Qed.

Lemma list_in_count : forall {A} {A_eq : EqDec A} (l l' : list A), NoDup l' ->
  (length (filter (fun x => if in_dec eq_dec x l then true else false) l') <= length l)%nat.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: le (@Datatypes.length A (@filter A (fun x : A => if @in_dec A (@eq_dec A A_eq) x l then true else false) l')) (@Datatypes.length A l) *)
  apply NoDup_incl_length; [apply NoDup_filter; auto|].
(* Goal: @incl A (@filter A (fun x : A => if @in_dec A (@eq_dec A A_eq) x l then true else false) l') l *)
  intros ? Hin.
(* Goal: @In A a l *)
  rewrite filter_In in Hin; destruct Hin.
(* Goal: @In A a l *)
  destruct (in_dec eq_dec a l); [auto | discriminate].
Qed.

Lemma filter_length : forall {A} (f : A -> bool) l,
  length l = (length (filter f l) + length (filter (fun x => negb (f x)) l))%nat.
Proof.
(* Goal: forall (A B : Type) (f : forall _ : A, B) (a : positive) (l : list (prod positive A)) (t : PTree.t B) (_ : not (@In positive a (@map (prod positive A) positive (@fst positive A) l))), @eq (option B) (@PTree.get B a (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@PTree.get B a t) *)
  induction l; simpl; intros; auto.
(* Goal: @eq nat (S (@Datatypes.length A l)) (Init.Nat.add (@Datatypes.length A (if f a then @cons A a (@filter A f l) else @filter A f l)) (@Datatypes.length A (if negb (f a) then @cons A a (@filter A (fun x : A => negb (f x)) l) else @filter A (fun x : A => negb (f x)) l))) *)
  rewrite IHl.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  destruct (f a); simpl; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_filter : forall {A} f (l : list A), Zlength (filter f l) <= Zlength l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: Z.le (@Zlength A (@filter A f l)) (@Zlength A l) *)
  setoid_rewrite Zlength_correct at 2.
(* Goal: Z.le (@Zlength A (@filter A f l)) (Z.of_nat (@Datatypes.length A l)) *)
  rewrite filter_length with (f0 := f).
(* Goal: Z.le (@Zlength A (@filter A f l)) (Z.of_nat (Init.Nat.add (@Datatypes.length A (@filter A f l)) (@Datatypes.length A (@filter A (fun x : A => negb (f x)) l)))) *)
  rewrite Nat2Z.inj_add.
  rewrite <- Zlength_correct; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_concat : forall {A} (l : list (list A)),
  Zlength (concat l) = fold_right Z.add 0 (map (@Zlength A) l).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq Z (@Zlength A (@concat A l)) (@fold_right Z Z Z.add Z0 (@map (list A) Z (@Zlength A) l)) *)
  rewrite Zlength_correct, length_concat.
(* Goal: @eq Z (Z.of_nat (@fold_right nat nat Init.Nat.add O (@map (list A) nat (@Datatypes.length A) l))) (@fold_right Z Z Z.add Z0 (@map (list A) Z (@Zlength A) l)) *)
  change 0 with (Z.of_nat O).
(* Goal: @eq Z (Z.of_nat (@fold_right nat nat Init.Nat.add O (@map (list A) nat (@Datatypes.length A) l))) (@fold_right Z Z Z.add (Z.of_nat O) (@map (list A) Z (@Zlength A) l)) *)
  forget O as n.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  revert n; induction l; auto; simpl; intros.
(* Goal: @eq Z (Z.of_nat (Init.Nat.add (@Datatypes.length A a) (@fold_right nat nat Init.Nat.add n (@map (list A) nat (@Datatypes.length A) l)))) (Z.add (@Zlength A a) (@fold_right Z Z Z.add (Z.of_nat n) (@map (list A) Z (@Zlength A) l))) *)
  rewrite Nat2Z.inj_add, IHl, Zlength_correct; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_concat_le : forall {A} (l : list (list A)) n,
  Forall (fun l => Zlength l <= n) l -> Zlength (concat l) <= n * Zlength l.
Proof.
(* Goal: forall (A : Type) (l : list (list A)) (n : Z) (_ : @Forall (list A) (fun l0 : list A => Z.le (@Zlength A l0) n) l), Z.le (@Zlength A (@concat A l)) (Z.mul n (@Zlength (list A) l)) *)
  intros; rewrite Zlength_concat.
  rewrite <- (Z.add_0_l (n * Zlength l)).
(* Goal: Z.le (@fold_right Z Z Z.add Z0 (@map (list A) Z (@Zlength A) l)) (Z.add Z0 (Z.mul n (@Zlength (list A) l))) *)
  forget 0 as m; revert m.
(* Goal: forall m : Z, Z.le (@fold_right Z Z Z.add m (@map (list A) Z (@Zlength A) l)) (Z.add m (Z.mul n (@Zlength (list A) l))) *)
  induction H; simpl; intro.
  - rewrite Zlength_nil; omega.
  - rewrite Zlength_cons, Z.mul_succ_r.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    specialize (IHForall m); omega.
Qed.

Lemma filter_app : forall {A} (f : A -> bool) l1 l2, filter f (l1 ++ l2) = filter f l1 ++ filter f l2.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l1; auto; intros; simpl.
(* Goal: @eq (list A) (if f a then @cons A a (@app A (@filter A f l1) (@filter A f l2)) else @app A (@filter A f l1) (@filter A f l2)) (@app A (if f a then @cons A a (@filter A f l1) else @filter A f l1) (@filter A f l2)) *)
  rewrite IHl1. destruct (f a); auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma filter_concat : forall {A} f (l : list (list A)),
  filter f (concat l) = concat (map (filter f) l).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; auto; simpl.
(* Goal: @eq (list A) (@filter A f (@app A a (@concat A l))) (@app A (@filter A f a) (@concat A (@map (list A) (list A) (@filter A f) l))) *)
  rewrite filter_app, IHl; auto.
Qed.

Lemma NoDup_upto : forall n, NoDup (upto n).
Proof.
(* Goal: @NoDup A (@nil A) *)
  induction n; simpl; constructor.
  - rewrite in_map_iff.
    intros (? & ? & ?); rewrite In_upto in *; omega.
  - apply FinFun.Injective_map_NoDup; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    intros ???; omega.
Qed.

Lemma In_remove : forall {A} {A_eq : EqDec A} (x y : A) l, In x (remove A_eq y l) <-> In x l /\ x <> y.
Proof.
(* Goal: forall (A : Type) (A_eq : EqDec A) (x y : A) (l : list A), iff (@In A x (@remove A A_eq y l)) (and (@In A x l) (not (@eq A x y))) *)
  induction l; simpl; intros; [tauto|].
(* Goal: iff (@In A x (if A_eq y a then @remove A A_eq y l else @cons A a (@remove A A_eq y l))) (and (or (@eq A a x) (@In A x l)) (not (@eq A x y))) *)
  destruct (A_eq y a); simpl; rewrite IHl; repeat split; try tauto.
  - destruct H as [[|]]; auto; subst; contradiction.
  - destruct H as [|[]]; subst; auto.
Qed.

Lemma remove_NoDup : forall {A} {A_eq : EqDec A} (x : A) l, NoDup l -> NoDup (remove A_eq x l).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction 1; simpl.
(* Goal: @NoDup A (@nil A) *)
  - constructor.
  - if_tac; auto.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
    constructor; auto.
(* Goal: not (@In A x0 (@remove A A_eq x l)) *)
    intro X; apply In_remove in X; destruct X; contradiction.
Qed.

Lemma remove_out : forall {A} {A_eq : EqDec A} (x : A) l, ~In x l -> remove A_eq x l = l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; auto; simpl; intros.
(* Goal: @eq (list A) (if A_eq x a then @remove A A_eq x l else @cons A a (@remove A A_eq x l)) (@cons A a l) *)
  rewrite IHl by auto.
(* Goal: @eq (list A) (if A_eq x a then l else @cons A a l) (@cons A a l) *)
  if_tac; auto; subst; tauto.
Qed.

Lemma remove_from_NoDup : forall {A} {A_eq : EqDec A} (x : A) l1 l2, NoDup (l1 ++ x :: l2) ->
  remove A_eq x (l1 ++ x :: l2) = l1 ++ l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; simpl; intros.
  - if_tac; [|contradiction].
(* Goal: @eq (list A) (@remove A A_eq x l2) l2 *)
    inv H; apply remove_out; auto.
  - inversion H as [|?? Hx]; subst.
(* Goal: @eq (list A) (if A_eq x a then @remove A A_eq x (@app A l1 (@cons A x l2)) else @cons A a (@remove A A_eq x (@app A l1 (@cons A x l2)))) (@cons A a (@app A l1 l2)) *)
    rewrite IHl1 by auto.
(* Goal: @eq (list A) (if A_eq x a then @app A l1 l2 else @cons A a (@app A l1 l2)) (@cons A a (@app A l1 l2)) *)
    if_tac; auto.
(* Goal: @In A x (@app A (@sublist A Z0 i l) (@cons A x (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l))) *)
    subst; contradiction Hx; rewrite in_app; simpl; auto.
Qed.

Lemma incl_remove_add : forall {A} {A_eq : EqDec A} (x : A) l1 l2, incl l1 l2 -> incl l1 (x :: remove A_eq x l2).
Proof.
(* Goal: forall (A : Type) (A_eq : EqDec A) (x : A) (l1 l2 : list A) (_ : @incl A l1 l2), @incl A l1 (@cons A x (@remove A A_eq x l2)) *)
  intros; intros ? Hin; specialize (H _ Hin).
(* Goal: @In A a (@cons A x (@remove A A_eq x l2)) *)
  simpl; rewrite In_remove.
(* Goal: or (@eq A x a) (and (@In A a l2) (not (@eq A a x))) *)
  destruct (eq_dec a x); auto.
Qed.

Lemma list_pigeonhole : forall l n, Zlength l < n -> exists a, 0 <= a < n /\ ~In a l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @ex Z (fun a : Z => and (and (Z.le Z0 a) (Z.lt a n)) (not (@In Z a l))) *)
  pose proof (filter_length (fun x => if in_dec eq_dec x l then true else false) (upto (Z.to_nat n))) as Hlen.
(* Goal: @ex Z (fun a : Z => and (and (Z.le Z0 a) (Z.lt a n)) (not (@In Z a l))) *)
  rewrite upto_length in Hlen.
(* Goal: @ex Z (fun a : Z => and (and (Z.le Z0 a) (Z.lt a n)) (not (@In Z a l))) *)
  assert (length (filter (fun x => negb (if in_dec eq_dec x l then true else false)) (upto (Z.to_nat n))) > 0)%nat.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { exploit (list_in_count l (upto (Z.to_nat n))).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { apply NoDup_upto. }
(* Goal: forall _ : le (@Datatypes.length Z (@filter Z (fun x : Z => if @in_dec Z (@eq_dec Z initial_world.EqDec_Z) x l then true else false) (upto (Z.to_nat n)))) (@Datatypes.length Z l), gt (@Datatypes.length Z (@filter Z (fun x : Z => negb (if @in_dec Z (@eq_dec Z initial_world.EqDec_Z) x l then true else false)) (upto (Z.to_nat n)))) O *)
    rewrite Zlength_correct in H.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    apply Z2Nat.inj_lt in H; try omega.
    rewrite Nat2Z.id in H; omega. }
  destruct (filter (fun x => negb (if in_dec eq_dec x l then true else false)) (upto (Z.to_nat n))) eqn: Hfilter;
    [simpl in *; omega|].
  assert (In z (filter (fun x => negb (if in_dec eq_dec x l then true else false)) (upto (Z.to_nat n)))) as Hin
    by (rewrite Hfilter; simpl; auto).
  rewrite filter_In, In_upto, Z2Nat.id in Hin; [|rewrite Zlength_correct in *; omega].
(* Goal: @ex Z (fun a : Z => and (and (Z.le Z0 a) (Z.lt a n)) (not (@In Z a l))) *)
  destruct Hin; destruct (in_dec eq_dec z l); try discriminate; eauto.
Qed.

Lemma In_sublist_upto : forall n x i j, In x (sublist i j (upto n)) -> 0 <= i ->
  i <= x < j /\ x < Z.of_nat n.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction n; intros.
  - unfold sublist in H; rewrite skipn_nil, firstn_nil in H; contradiction.
  - rewrite Nat2Z.inj_succ; simpl in *.
(* Goal: and (and (Z.le i x) (Z.lt x j)) (Z.lt x (Z.succ (Z.of_nat n))) *)
    destruct (zlt 0 j).
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
    destruct (eq_dec i 0).
    + subst; rewrite sublist_0_cons in H; try omega; destruct H; [omega|].
(* Goal: and (and (Z.le i x) (Z.lt x j)) (Z.lt x (Z.succ (Z.of_nat n))) *)
      rewrite sublist_map, in_map_iff in H; destruct H as (? & ? & H); subst.
      destruct (zlt 0 (j - 1)).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      exploit IHn; eauto; omega.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
      { rewrite sublist_nil_gen in H; [contradiction | omega]. }
    + rewrite sublist_S_cons in H; [|omega].
(* Goal: and (and (Z.le i x) (Z.lt x j)) (Z.lt x (Z.succ (Z.of_nat n))) *)
      rewrite sublist_map, in_map_iff in H; destruct H as (? & ? & H); subst.
      destruct (zlt 0 (j - 1)).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      exploit IHn; eauto; omega.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
      { rewrite sublist_nil_gen in H; [contradiction | omega]. }
    + rewrite sublist_nil_gen in H; [contradiction | omega].
Qed.

Lemma incl_cons_iff : forall {A} (a : A) b c, incl (a :: b) c <-> In a c /\ incl b c.
Proof.
(* Goal: forall (A : Type) (a : A) (b c : list A), iff (@incl A (@cons A a b) c) (and (@In A a c) (@incl A b c)) *)
  split; intro.
  - split; [|eapply incl_cons_inv; eauto].
(* Goal: @In A a c *)
    specialize (H a); apply H; simpl; auto.
  - destruct H; intros ? [? | ?]; subst; auto.
Qed.

Lemma lt_le_1 : forall i j, i < j <-> i + 1 <= j.
Proof.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  intros; omega.
Qed.

Lemma firstn_all : forall {A} n (l : list A), (length l <= n)%nat -> firstn n l = l.
Proof.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  induction n; destruct l; auto; simpl; intros; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite IHn; auto; omega.
Qed.

Lemma sublist_all : forall {A} i (l : list A), Zlength l <= i -> sublist 0 i l = l.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; unfold sublist; simpl.
(* Goal: @eq (list A) (@firstn A (Z.to_nat (Z.sub i Z0)) l) l *)
  apply firstn_all.
  rewrite Zlength_correct in *; rep_omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_prefix : forall {A} i j (l : list A), sublist 0 i (sublist 0 j l) = sublist 0 (Z.min i j) l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list (list A)) (@sublist (list A) i j (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@extendr A (@sublist A i j (@cons A a l)) (@sublist (list A) i j (@cons (list A) l0 ls))) *)
  destruct (Z_le_dec i 0).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !sublist_nil_gen; auto.
    rewrite Z.min_le_iff; auto. }
  destruct (Z.min_spec i j) as [(? & ->) | (? & ->)].
  - rewrite sublist_sublist, !Z.add_0_r by omega; auto.
  - apply sublist_all.
(* Goal: Z.le (@Zlength A (@sublist A Z0 j l)) i *)
    destruct (Z_le_dec j 0); [rewrite sublist_nil_gen; auto; rewrite Zlength_nil; omega|].
(* Goal: Z.le (@Zlength A (@sublist A Z0 j l)) i *)
    destruct (Z_le_dec j (Zlength l)).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite Zlength_sublist; try omega.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { pose proof (sublist_max_length 0 j l); omega. }
Qed.

Lemma sublist_suffix : forall {A} i j (l : list A), 0 <= i -> 0 <= j ->
  sublist i (Zlength l - j) (sublist j (Zlength l) l) = sublist (i + j) (Zlength l) l.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  destruct (Z_le_dec (Zlength l - j) i).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !sublist_nil_gen; auto; omega. }
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_sublist by omega.
(* Goal: @eq (list A) (@sublist A (Z.add i j) (Z.add (Z.sub (@Zlength A l) j) j) l) (@sublist A (Z.add i j) (@Zlength A l) l) *)
  rewrite Z.sub_simpl_r; auto.
Qed.

Lemma sublist_parts1 : forall {A} i j (l : list A), 0 <= i -> sublist i j l = sublist i j (sublist 0 j l).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list A) (@sublist A i j l) (@sublist A Z0 (Z.sub j i) (@sublist A i (@Zlength A l) l)) *)
  destruct (Z_le_dec j i).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !sublist_nil_gen; auto. }
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_sublist by omega.
(* Goal: @eq (list A) (@sublist A i j l) (@sublist A (Z.add i Z0) (Z.add j Z0) l) *)
  rewrite !Z.add_0_r; auto.
Qed.

Lemma sublist_parts2 : forall {A} i j (l : list A), 0 <= i -> j <= Zlength l ->
  sublist i j l = sublist 0 (j - i) (sublist i (Zlength l) l).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (list A) (@sublist A i j l) (@sublist A Z0 (Z.sub j i) (@sublist A i (@Zlength A l) l)) *)
  destruct (Z_le_dec j i).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite !sublist_nil_gen; auto; omega. }
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_sublist; try omega.
(* Goal: @eq (list A) (@sublist A i j l) (@sublist A (Z.add Z0 i) (Z.add (Z.sub j i) i) l) *)
  rewrite Z.add_0_l, Z.sub_simpl_r; auto.
Qed.

Lemma Forall_Forall2 : forall {A} (P : A -> Prop) Q l1 l2 (HP : Forall P l1) (HQ : Forall2 Q l1 l2)
  (Htransfer : forall x y, P x -> Q x y -> P y), Forall P l2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction 2; auto; intros.
(* Goal: @Forall A P (@cons A y l') *)
  inv HP.
(* Goal: @Forall A P (@cons A y l') *)
  constructor; eauto.
Qed.

Lemma Forall_suffix_max : forall {A} (P : A -> Prop) l1 l2 i j
  (Hi : 0 <= i <= Zlength l1) (Hj : 0 <= j <= Zlength l1)
  (Hl1 : Forall P (sublist j (Zlength l1) l1))
  (Hl2 : sublist i (Zlength l1) l1 = sublist i (Zlength l2) l2),
  Forall P (sublist (Z.max i j) (Zlength l2) l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @Forall A P (@sublist A (Z.max i j) (@Zlength A l2) l2) *)
  destruct (eq_dec i (Zlength l1)).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { subst; rewrite sublist_nil in Hl2.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite Z.max_l by omega.
    rewrite <- Hl2; auto. }
(* Goal: @Forall A P (@sublist A (Z.max i j) (@Zlength A l2) l2) *)
  assert (Zlength l1 = Zlength l2) as Heq.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { assert (Zlength (sublist i (Zlength l1) l1) = Zlength (sublist i (Zlength l2) l2)) as Heq by congruence.
(* Goal: @eq Z (@Zlength A l1) (@Zlength A l2) *)
    destruct (Z_le_dec (Zlength l2) i).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite sublist_nil_gen with (l0 := l2), Zlength_nil in Heq; auto.
      rewrite !Zlength_sublist in Heq; omega. }
    rewrite !Zlength_sublist in Heq; omega. }
  intros; destruct (Z.max_spec i j) as [(? & ->) | (? & ->)].
  - replace (sublist _ _ _) with (sublist (j - i) (Zlength l2 - i) (sublist i (Zlength l2) l2)).
    rewrite <- Hl2, sublist_sublist, !Z.sub_simpl_r by omega.
    rewrite <- Heq; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite sublist_sublist, !Z.sub_simpl_r by omega; auto. }
  - rewrite <- Hl2.
    replace (sublist _ _ _) with (sublist (i - j) (Zlength l1 - j) (sublist j (Zlength l1) l1)).
(* Goal: @Forall A P (@sublist A (Z.sub i j) (Z.sub (@Zlength A l1) j) (@sublist A j (@Zlength A l1) l1)) *)
(* Goal: @eq (list A) (@sublist A (Z.sub i j) (Z.sub (@Zlength A l1) j) (@sublist A j (@Zlength A l1) l1)) (@sublist A i (@Zlength A l1) l1) *)
    apply Forall_sublist; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite sublist_sublist, !Z.sub_simpl_r; auto; omega. }
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Fixpoint extend {A} (l : list A) ls :=
  match l, ls with
  | x :: xs, y :: ys => (x :: y) :: extend xs ys
  | _, _ => ls
  end.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_extend : forall {A} (l : list A) ls, Zlength (extend l ls) = Zlength ls.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; destruct ls; auto; simpl.
(* Goal: @eq Z (@Zlength (list A) (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Zlength (list A) (@cons (list A) l0 ls)) *)
  rewrite !Zlength_cons, IHl; auto.
Qed.

Lemma Znth_extend_in : forall {A}{d: Inhabitant A}  (l : list A) ls i, 0 <= i < Zlength l -> Zlength l <= Zlength ls ->
  Znth i (extend l ls) = Znth i l :: Znth i ls.
Proof.
  induction l; destruct ls; simpl; intros; try rewrite Zlength_nil in *; try omega.
  rewrite !Zlength_cons in *.
(* Goal: @eq nat O (Z.to_nat i) *)
  destruct (eq_dec i 0); subst; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite !Znth_pos_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply IHl; omega.
Qed.

Lemma Znth_extend_ge : forall {A}{d: Inhabitant A}  (l : list A) ls i, Zlength l <= i ->
  Znth i (extend l ls) = Znth i ls.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; destruct ls; auto; simpl; intros.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  destruct (zlt i 0); [rewrite !Znth_underflow; auto|].
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
  destruct (eq_dec i 0); [rewrite Zlength_correct in *; omega|].
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite !Znth_pos_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply IHl; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Fixpoint extendr {A} (l : list A) ls :=
  match l, ls with
  | x :: xs, y :: ys => (y ++ [x]) :: extendr xs ys
  | _, _ => ls
  end.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma Zlength_extendr : forall {A} (l : list A) ls, Zlength (extendr l ls) = Zlength ls.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; destruct ls; auto; simpl.
(* Goal: @eq Z (@Zlength (list A) (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Zlength (list A) (@cons (list A) l0 ls)) *)
  rewrite !Zlength_cons, IHl; auto.
Qed.

Lemma Znth_extendr_in : forall {A}{d: Inhabitant A}  (l : list A) ls i, 0 <= i < Zlength l -> Zlength l <= Zlength ls ->
  Znth i (extendr l ls) = Znth i ls ++ [Znth i l].
Proof.
  induction l; destruct ls; simpl; intros; try rewrite Zlength_nil in *; try omega.
  rewrite !Zlength_cons in *.
(* Goal: @eq nat O (Z.to_nat i) *)
  destruct (eq_dec i 0); subst; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite !Znth_pos_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply IHl; omega.
Qed.

Lemma Znth_extendr_ge : forall {A}{d: Inhabitant A}  (l : list A) ls i, Zlength l <= i ->
  Znth i (extendr l ls) = Znth i ls.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; destruct ls; auto; simpl; intros.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  destruct (zlt i 0); [rewrite !Znth_underflow; auto|].
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
  rewrite Zlength_cons in *.
  destruct (eq_dec i 0); [rewrite Zlength_correct in *; omega|].
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite !Znth_pos_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  apply IHl; omega.
Qed.

Lemma list_join_eq : forall (b : list share) a c c'
  (Hc : sepalg_list.list_join a b c) (Hc' : sepalg_list.list_join a b c'), c = c'.
Proof.
(* Goal: forall (b : list share) (a c c' : share) (_ : @sepalg_list.list_join share Share.Join_ba a b c) (_ : @sepalg_list.list_join share Share.Join_ba a b c'), @eq share c c' *)
  induction b; intros; inv Hc; inv Hc'; auto.
(* Goal: @eq share c c' *)
  assert (w0 = w1) by (eapply sepalg.join_eq; eauto).
(* Goal: @eq share c c' *)
  subst; eapply IHb; eauto.
Qed.

Lemma readable_share_list_join : forall sh shs sh', sepalg_list.list_join sh shs sh' ->
  readable_share sh \/ Exists readable_share shs -> readable_share sh'.
Proof.
(* Goal: forall (sh : share) (shs : list share) (sh' : share) (_ : @sepalg_list.list_join share Share.Join_ba sh shs sh') (_ : or (readable_share sh) (@Exists share readable_share shs)), readable_share sh' *)
  induction 1; intros [? | Hexists]; try inv Hexists; auto.
  - apply IHfold_rel; left; eapply readable_share_join; eauto.
  - apply IHfold_rel; left; eapply readable_share_join; eauto.
Qed.

Lemma sublist_0_cons' : forall {A} i j (x : A) l, i <= 0 -> j > i -> sublist i j (x :: l) =
  x :: sublist i (j - 1) l.
Proof.
(* Goal: forall (A : Type) (l : list A) (i j : Z) (_ : Z.le (@Zlength A l) i), @eq (list A) (@sublist A i j l) (@nil A) *)
  intros; unfold sublist.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  replace (Z.to_nat i) with O; simpl.
  assert (0 < j - i) as Hgt by omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z2Nat.inj_lt in Hgt; try omega.
  destruct (Z.to_nat (j - i)) eqn: Hj; [omega|].
(* Goal: @eq (list A) (@firstn A (S n) (@cons A x l)) (@cons A x (@firstn A (Z.to_nat (Z.sub (Z.sub j (Zpos xH)) i)) l)) *)
(* Goal: @eq nat O (Z.to_nat i) *)
  simpl; f_equal; f_equal.
  replace (j - 1 - i) with (j - i - 1) by omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z2Nat.inj_sub; simpl; omega.
(* Goal: @eq nat O (Z.to_nat i) *)
  destruct (eq_dec i 0); subst; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Z2Nat_neg; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_combine : forall {A B} (l1 : list A) (l2 : list B) i j,
  sublist i j (combine l1 l2) = combine (sublist i j l1) (sublist i j l2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l1; simpl; intros.
  - unfold sublist; rewrite !skipn_nil, !firstn_nil; auto.
  - destruct l2.
    + unfold sublist at 1 3; rewrite !skipn_nil, !firstn_nil.
(* Goal: @eq (list (prod A B)) (@nil (prod A B)) (@combine A B (@sublist A i j (@cons A a l1)) (@nil B)) *)
      destruct (sublist i j (a :: l1)); auto.
    + destruct (Z_le_dec j i); [rewrite !sublist_nil_gen; auto|].
(* Goal: @eq (list (list A)) (@sublist (list A) i j (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@extendr A (@sublist A i j (@cons A a l)) (@sublist (list A) i j (@cons (list A) l0 ls))) *)
      destruct (Z_le_dec i 0).
      * subst; rewrite !sublist_0_cons'; try omega.
(* Goal: @Forall2 A B P (@map C A f1 l1) (@map D B f2 l') *)
        simpl; rewrite IHl1; auto.
      * rewrite !sublist_S_cons; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
        apply IHl1; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma extend_nil : forall {A} (l : list A), extend l [] = [].
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma extend_cons : forall {A} (l : list A) l1 ls, extend l (l1 :: ls) =
  match l with [] => l1 :: ls | a :: l' => (a :: l1) :: extend l' ls end.
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_extend : forall {A} (l : list A) ls i j,
  sublist i j (extend l ls) = extend (sublist i j l) (sublist i j ls).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; simpl; intros.
  - unfold sublist; rewrite skipn_nil, firstn_nil; auto.
  - destruct ls.
    + unfold sublist; rewrite skipn_nil, firstn_nil, extend_nil; auto.
    + destruct (Z_le_dec j i); [rewrite !sublist_nil_gen; auto|].
(* Goal: @eq (list (list A)) (@sublist (list A) i j (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@extendr A (@sublist A i j (@cons A a l)) (@sublist (list A) i j (@cons (list A) l0 ls))) *)
      destruct (Z_le_dec i 0).
      * subst; rewrite !sublist_0_cons'; try omega.
(* Goal: @eq (list (list A)) (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@sublist (list A) i (Z.sub j (Zpos xH)) (@extendr A l ls))) (@extendr A (@cons A a (@sublist A i (Z.sub j (Zpos xH)) l)) (@cons (list A) l0 (@sublist (list A) i (Z.sub j (Zpos xH)) ls))) *)
        rewrite IHl; auto.
      * rewrite !sublist_S_cons; auto; omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma extendr_nil : forall {A} (l : list A), extendr l [] = [].
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma extendr_cons : forall {A} (l : list A) l1 ls, extendr l (l1 :: ls) =
  match l with [] => l1 :: ls | a :: l' => (l1 ++ [a]) :: extendr l' ls end.
Proof.
(* Goal: forall (A : Type) (l l1 : list A) (ls : list (list A)), @eq (list (list A)) (@extendr A l (@cons (list A) l1 ls)) match l with | nil => @cons (list A) l1 ls | cons a l' => @cons (list A) (@app A l1 (@cons A a (@nil A))) (@extendr A l' ls) end *)
  destruct l; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sublist_extendr : forall {A} (l : list A) ls i j,
  sublist i j (extendr l ls) = extendr (sublist i j l) (sublist i j ls).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; simpl; intros.
  - unfold sublist; rewrite skipn_nil, firstn_nil; auto.
  - destruct ls.
    + unfold sublist; rewrite skipn_nil, firstn_nil, extendr_nil; auto.
    + destruct (Z_le_dec j i); [rewrite !sublist_nil_gen; auto|].
(* Goal: @eq (list (list A)) (@sublist (list A) i j (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@extendr A (@sublist A i j (@cons A a l)) (@sublist (list A) i j (@cons (list A) l0 ls))) *)
      destruct (Z_le_dec i 0).
      * subst; rewrite !sublist_0_cons'; try omega.
(* Goal: @eq (list (list A)) (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@sublist (list A) i (Z.sub j (Zpos xH)) (@extendr A l ls))) (@extendr A (@cons A a (@sublist A i (Z.sub j (Zpos xH)) l)) (@cons (list A) l0 (@sublist (list A) i (Z.sub j (Zpos xH)) ls))) *)
        rewrite IHl; auto.
      * rewrite !sublist_S_cons; auto; omega.
Qed.

Lemma sublist_over : forall {A} (l : list A) i j, Zlength l <= i -> sublist i j l = [].
Proof.
(* Goal: forall (A : Type) (l : list A) (i j : Z) (_ : Z.le (@Zlength A l) i), @eq (list A) (@sublist A i j l) (@nil A) *)
  intros; unfold sublist.
(* Goal: @eq (list A) (@firstn A (Z.to_nat (Z.sub j i)) (@skipn A (Z.to_nat i) l)) (@nil A) *)
  rewrite skipn_short, firstn_nil; auto.
  rewrite Zlength_correct in *; rep_omega.
Qed.

Lemma make_tycontext_s_distinct : forall a l (Ha : In a l) (Hdistinct : NoDup (map fst l)),
  (make_tycontext_s l) ! (fst a) = Some (snd a).
Proof.
(* Goal: forall (a : prod positive funspec) (l : list (prod positive funspec)) (_ : @In (prod positive funspec) a l) (_ : @NoDup positive (@map (prod positive funspec) positive (@fst positive funspec) l)), @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (make_tycontext_s l)) (@Some funspec (@snd positive funspec a)) *)
  intros a l. unfold make_tycontext_s.
(* Goal: forall (_ : @In (prod positive funspec) a l) (_ : @NoDup positive (@map (prod positive funspec) positive (@fst positive funspec) l)), @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) l)) (@Some funspec (@snd positive funspec a)) *)
  change (@ptree_set) with (@PTree.set).
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; simpl; intros. 
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.Leaf funspec)) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (let (id, f) := a0 in @PTree.set funspec id f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id0 f0 as b) r => @PTree.set funspec id0 f0 (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  contradiction.
  inv Hdistinct. destruct a0. simpl in *.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  destruct Ha. subst.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  simpl. rewrite PTree.gss. auto.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite PTree.gso.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply IHl; auto.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intro; subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply H1; apply in_map. auto.
Qed.

Lemma lookup_distinct : forall {A B} (f : A -> B) a l t (Ha : In a l) (Hdistinct : NoDup (map fst l)),
  (fold_right (fun v : ident * A => PTree.set (fst v) (f (snd v))) t l) ! (fst a) =
  Some (f (snd a)).
Proof.
(* Goal: forall (A B : Type) (f : forall _ : A, B) (a : prod positive A) (l : list (prod positive A)) (t : PTree.t B) (_ : @In (prod positive A) a l) (_ : @NoDup positive (@map (prod positive A) positive (@fst positive A) l)), @eq (option B) (@PTree.get B (@fst positive A a) (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@Some B (f (@snd positive A a))) *)
  induction l; simpl; intros; [contradiction|].
(* Goal: @eq (option B) (@PTree.get B (@fst positive A a) (@PTree.set B (@fst ident A a0) (f (@snd ident A a0)) (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l))) (@Some B (f (@snd positive A a))) *)
  inv Hdistinct.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
  rewrite PTree.gsspec.
(* Goal: @eq (option B) (if peq (@fst positive A a) (@fst ident A a0) then @Some B (f (@snd ident A a0)) else @PTree.get B (@fst positive A a) (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@Some B (f (@snd positive A a))) *)
  destruct (peq (fst a) (fst a0)) eqn: Heq; setoid_rewrite Heq.
  - destruct Ha; [subst; auto|].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    contradiction H1; rewrite in_map_iff; eauto.
  - apply IHl; auto.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    destruct Ha; auto; subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    contradiction n; auto.
Qed.

Lemma lookup_out : forall {A B} (f : A -> B) a l t (Ha : ~In a (map fst l)),
  (fold_right (fun v : ident * A => PTree.set (fst v) (f (snd v))) t l) ! a = t ! a.
Proof.
(* Goal: forall (A B : Type) (f : forall _ : A, B) (a : positive) (l : list (prod positive A)) (t : PTree.t B) (_ : not (@In positive a (@map (prod positive A) positive (@fst positive A) l))), @eq (option B) (@PTree.get B a (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@PTree.get B a t) *)
  induction l; simpl; intros; auto.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
  rewrite PTree.gsspec.
(* Goal: @eq (option B) (if peq a (@fst ident A a0) then @Some B (f (@snd ident A a0)) else @PTree.get B a (@fold_right (PTree.t B) (prod ident A) (fun v : prod ident A => @PTree.set B (@fst ident A v) (f (@snd ident A v))) t l)) (@PTree.get B a t) *)
  destruct (peq a (fst a0)) eqn: Heq; setoid_rewrite Heq.
  - contradiction Ha; auto.
  - apply IHl.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    intro; contradiction Ha; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at__eq : forall {cs : compspecs} sh t p, data_at_ sh t p = data_at sh t (default_val t) p.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; unfold data_at_, data_at, field_at_; auto.
Qed.

Lemma func_tycontext_sub : forall f V G A V2 G2 (HV : incl V V2) (HG : incl G G2)
  (Hdistinct : NoDup (map fst V2 ++ map fst G2)),
  tycontext_sub (func_tycontext f V G A) (func_tycontext f V2 G2 A).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  unfold func_tycontext, make_tycontext, tycontext_sub; simpl.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply NoDup_app in Hdistinct; destruct Hdistinct as (? & ? & Hdistinct); auto.
(* Goal: and (forall id : positive, match @PTree.get type id (make_tycontext_t (fn_params f) (fn_temps f)) with | Some t => match @PTree.get type id (make_tycontext_t (fn_params f) (fn_temps f)) with | Some t' => @eq type t t' | None => False end | None => True end) (and (forall id : positive, @eq (option type) (@PTree.get type id (make_tycontext_v (fn_vars f))) (@PTree.get type id (make_tycontext_v (fn_vars f)))) (and (@eq type (fn_return f) (fn_return f)) (and (forall id : positive, @sub_option type (@PTree.get type id (make_tycontext_g V G)) (@PTree.get type id (make_tycontext_g V2 G2))) (and (forall id : positive, @sub_option funspec (@PTree.get funspec id (make_tycontext_s G)) (@PTree.get funspec id (make_tycontext_s G2))) (forall id : positive, Annotation_sub (@PTree.get Annotation id (make_tycontext_a A)) (@PTree.get Annotation id (make_tycontext_a A))))))) *)
  repeat split; auto; intro.
  - destruct (PTree.get _ _); auto.
  - unfold make_tycontext_g.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    revert dependent G2; revert dependent V2; revert V; induction G; simpl.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
    + induction V; simpl; intros.
      * rewrite PTree.gempty; simpl; auto.
      * rewrite incl_cons_iff in HV; destruct HV.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
        rewrite PTree.gsspec.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
        destruct (peq id (fst a)); eauto; subst; simpl.
(* Goal: @eq (option type) (@PTree.get type (@fst ident type a) (@fold_right (PTree.t type) (prod ident funspec) (fun var : prod ident funspec => @PTree.set type (@fst ident funspec var) (type_of_funspec (@snd ident funspec var))) (@fold_right (PTree.t type) (prod ident type) (fun v : prod ident type => @PTree.set type (@fst ident type v) (@snd ident type v)) (PTree.empty type) V2) G2)) (@Some type (@snd ident type a)) *)
        rewrite lookup_out.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
        apply lookup_distinct with (f0:=@id type); auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
        { apply Hdistinct.
          rewrite in_map_iff; eexists; split; eauto. }
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
    + intros.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
      rewrite incl_cons_iff in HG; destruct HG.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
      rewrite PTree.gsspec.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
      destruct (peq id (fst a)); eauto; subst; simpl.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply lookup_distinct; auto.
  - unfold make_tycontext_s.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
    revert dependent G2; induction G; simpl; intros.
    + rewrite PTree.gempty; simpl; auto.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    + destruct a; simpl. hnf.
      change @ptree_set with @PTree.set in * at 1.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
      rewrite incl_cons_iff in HG; destruct HG.
(* Goal: match @PTree.get funspec id (@PTree.set funspec i f0 ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
      rewrite PTree.gsspec.
(* Goal: match (if peq id i then @Some funspec f0 else @PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G)) with | Some x' => @eq (option funspec) (@PTree.get funspec id ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @ptree_set funspec id f (make_tycontext_s r) end) G2)) (@Some funspec x') | None => True end *)
      change (@PTree.set) with @ptree_set in IHG.
      fold make_tycontext_s in *.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
      destruct (peq id i); eauto; subst; simpl.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply make_tycontext_s_distinct with (a:=(i,f0)); auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      destruct ((make_tycontext_s G) ! id); auto. 
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply IHG; auto.
  - apply Annotation_sub_refl.
Qed.

(* This lets us use a library as a client. *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma semax_body_mono : forall V G {cs : compspecs} f s V2 G2
  (HV : incl V V2) (HG : incl G G2) (Hdistinct : NoDup (map fst V2 ++ map fst G2)),
  semax_body V G f s -> semax_body V2 G2 f s.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold semax_body; intros.
(* Goal: let (_, f0) := s in match f0 with | mk_funspec f1 cc A P Q NEP NEQ => forall (Espec : OracleKind) (ts : list Type) (x : _functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i0 : I0 => dtfr (f i0)) | rmaps.ListType T0 => flist (dtfr T0) end) A) mpred), semax cs Espec (func_tycontext f V2 G2 (@nil (prod ident Annotation))) (@sepcon (_functor (ffunc (fconst environ) fidentity) mpred) (@LiftNatDed' (_functor fidentity mpred) Nveric) (@LiftSepLog' (_functor fidentity mpred) Nveric Sveric) (P ts x) (@stackframe_of cs f)) (Ssequence (fn_body f) (Sreturn (@None expr))) (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (@stackframe_of cs f)) end *)
  destruct s, f0.
(* Goal: forall (Espec : OracleKind) (ts : list Type) (x : _functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A => fconst A | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) A) mpred), semax cs Espec (func_tycontext f V2 G2 (@nil (prod ident Annotation))) (@sepcon (_functor (ffunc (fconst environ) fidentity) mpred) (@LiftNatDed' (_functor fidentity mpred) Nveric) (@LiftSepLog' (_functor fidentity mpred) Nveric Sveric) (P ts x) (@stackframe_of cs f)) (Ssequence (fn_body f) (Sreturn (@None expr))) (frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (@stackframe_of cs f)) *)
  intros; eapply semax_extensionality_Delta, H.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply func_tycontext_sub; auto.
Qed.

(* We could also consider an alpha-renaming axiom, although this may be unnecessary. *)

(* exclusive *)
Lemma weak_exclusive_conflict : forall P,
  predicates_hered.derives ((weak_exclusive_mpred P && emp) * P * P) FF.
Proof.
(* Goal: forall P : mpred, @predicates_hered.derives compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_sl.sepcon compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.Join_rmap compcert_rmaps.RML.R.Perm_rmap compcert_rmaps.RML.R.ag_rmap compcert_rmaps.RML.R.Age_rmap (@predicates_sl.sepcon compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.Join_rmap compcert_rmaps.RML.R.Perm_rmap compcert_rmaps.RML.R.ag_rmap compcert_rmaps.RML.R.Age_rmap (@predicates_hered.andp compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (weak_exclusive_mpred P) (@emp (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric)) P) P) (@FF (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric) *)
  intros ?? (r1 & r2 & ? & (? & ? & Hj & [Hexclusive Hemp] & ?) & ?).
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@FF (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric) a *)
  destruct (age_sepalg.join_level _ _ _ H), (age_sepalg.join_level _ _ _ Hj).
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  apply Hemp in Hj; subst.
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@FF (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric) a *)
  simpl in Hexclusive.
  match goal with H : exclusive_mpred ?P |- _ => change (predicates_hered.derives (P * P) FF) in H end.
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@FF (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric) a *)
  apply Hexclusive.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  do 3 eexists; eauto; repeat split; auto; omega.
Qed.

Lemma exclusive_sepcon1 : forall (P Q : mpred) (HP : exclusive_mpred P), exclusive_mpred (P * Q).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold exclusive_mpred; intros.
  eapply derives_trans, sepcon_FF_derives' with (P := Q * Q), HP; cancel.
Qed.

Lemma exclusive_sepcon2 : forall (P Q : mpred) (HP : exclusive_mpred Q), exclusive_mpred (P * Q).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; rewrite sepcon_comm; apply exclusive_sepcon1; auto.
Qed.

Lemma exclusive_andp1 : forall P Q (HP : exclusive_mpred P), exclusive_mpred (P && Q).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold exclusive_mpred; intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@andp mpred Nveric P Q) (@andp mpred Nveric P Q)) (@FF mpred Nveric) *)
  eapply derives_trans, HP.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply sepcon_derives; apply andp_left1; auto.
Qed.

Lemma exclusive_andp2 : forall P Q (HQ : exclusive_mpred Q), exclusive_mpred (P && Q).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; rewrite andp_comm; apply exclusive_andp1; auto.
Qed.

Lemma lock_inv_exclusive : forall v sh R, exclusive_mpred (lock_inv sh v R).
Proof.
  intros; unfold exclusive_mpred, lock_inv.
  Transparent mpred. Intros b1 ofs1 b2 ofs2. Opaque mpred.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  subst.
  inv H0.
  match goal with |- ?P |-- ?Q => change (predicates_hered.derives P Q) end.
  intros ? (? & ? & ? & Hlock1 & Hlock2).
  exploit (res_predicates.LKspec_precise _ _ _ _ a _ _ Hlock1 Hlock2); try (eexists; eauto).
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; subst.
  destruct Hlock1 as [Hlock1 _]; simpl in Hlock1.
  specialize (Hlock1 (b2, Ptrofs.unsigned ofs2)).
  rewrite if_true in Hlock1 by (split; auto; pose proof lksize.LKSIZE_pos; omega).
  destruct Hlock1 as [? Hl1].
  apply compcert_rmaps.RML.resource_at_join with (loc := (b2, Ptrofs.unsigned ofs2)) in H.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  rewrite Hl1 in H; inv H.
  apply sepalg.join_self in RJ.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  eapply readable_not_identity; eauto.
Qed.

Lemma selflock_exclusive : forall R sh v, exclusive_mpred R -> exclusive_mpred (selflock R v sh).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: exclusive_mpred (selflock R v sh) *)
  rewrite selflock_eq.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply exclusive_sepcon1; auto.
Qed.

Lemma exclusive_FF : exclusive_mpred FF.
Proof.
(* Goal: exclusive_mpred (@FF mpred Nveric) *)
  unfold exclusive_mpred.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite FF_sepcon; auto.
Qed.

Lemma derives_exclusive : forall P Q (Hderives : P |-- Q) (HQ : exclusive_mpred Q),
  exclusive_mpred P.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold exclusive_mpred; intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric P P) (@FF mpred Nveric) *)
  eapply derives_trans, HQ.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply sepcon_derives; auto.
Qed.

Lemma mapsto_exclusive : forall (sh : Share.t) (t : type) (v : val),
  sepalg.nonunit sh -> exclusive_mpred (EX v2 : _, mapsto sh t v v2).
Proof.
(* Goal: exclusive_mpred (@FF mpred Nveric) *)
  intros; unfold exclusive_mpred.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  Intros v1 v2; apply mapsto_conflict; auto.
Qed.

Lemma field_at__exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) (p : val),
  sepalg.nonidentity sh ->
  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (field_at_ sh t fld p).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; apply field_at__conflict; auto.
Qed.

Lemma ex_field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) (p : val),
  sepalg.nonidentity sh ->
  0 < sizeof (nested_field_type t fld) -> exclusive_mpred (EX v : _, field_at sh t fld v p).
Proof.
(* Goal: exclusive_mpred (@FF mpred Nveric) *)
  intros; unfold exclusive_mpred.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  Intros v v'; apply field_at_conflict; auto.
Qed.

Corollary field_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (fld : list gfield) v (p : val),
  sepalg.nonidentity sh -> 0 < sizeof (nested_field_type t fld) -> exclusive_mpred (field_at sh t fld v p).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; eapply derives_exclusive, ex_field_at_exclusive; eauto.
  Exists v; apply derives_refl.
Qed.

Lemma ex_data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (EX v : _, data_at sh t v p).
Proof.
(* Goal: exclusive_mpred (@FF mpred Nveric) *)
  intros; unfold exclusive_mpred.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  Intros v v'; apply data_at_conflict; auto.
Qed.

Corollary data_at_exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) v (p : val),
  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at sh t v p).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; eapply derives_exclusive, ex_data_at_exclusive; eauto.
  Exists v; apply derives_refl.
Qed.

Corollary data_at__exclusive : forall (cs : compspecs) (sh : Share.t) (t : type) (p : val),
  sepalg.nonidentity sh -> 0 < sizeof t -> exclusive_mpred (data_at_ sh t p).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; eapply derives_exclusive, data_at_exclusive; eauto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply data_at__data_at; eauto.
Qed.

Lemma cond_var_exclusive : forall {cs} sh p, sepalg.nonidentity sh ->
  exclusive_mpred (@cond_var cs sh p).
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; apply data_at__exclusive; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  unfold tcond; simpl; omega.
Qed.

Lemma lock_inv_isptr : forall sh v R, lock_inv sh v R = !!isptr v && lock_inv sh v R.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  eapply local_facts_isptr with (P := fun v => lock_inv sh v R); eauto.
  Transparent mpred.
  unfold lock_inv; Intros b o.
  subst; simpl; entailer.
  Opaque mpred.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma cond_var_isptr : forall {cs} sh v, @cond_var cs sh v = !! isptr v && cond_var sh v.
Proof.
(* Goal: forall (cs : compspecs) (sh : Share.t) (v : val), @eq mpred (@cond_var cs sh v) (@andp mpred Nveric (@prop mpred Nveric (isptr v)) (@cond_var cs sh v)) *)
  intros; apply data_at__isptr.
Qed.
Hint Resolve lock_inv_isptr cond_var_isptr : saturate_local.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma cond_var_share_join : forall {cs} sh1 sh2 sh v (Hjoin : sepalg.join sh1 sh2 sh),
  @cond_var cs sh1 v * cond_var sh2 v = cond_var sh v.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; unfold cond_var; apply data_at__share_join; auto.
Qed.

(* Sometimes, in order to prove precise, we actually need to know that the data is the same as well. *)
(* Do we still need this? Probably not.
Lemma mapsto_inj : forall sh t v1 v2 p r1 r2 r
  (Hsh : readable_share sh)
  (Hp1 : predicates_hered.app_pred (mapsto sh t p v1) r1)
  (Hp2 : predicates_hered.app_pred (mapsto sh t p v2) r2)
  (Hr1 : sepalg.join_sub r1 r) (Hr2 : sepalg.join_sub r2 r)
  (Hdef1 : v1 <> Vundef) (Hdef2 : v2 <> Vundef),
  r1 = r2 /\ v1 = v2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  unfold mapsto; intros.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.Leaf funspec)) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (let (id, f) := a0 in @PTree.set funspec id f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id0 f0 as b) r => @PTree.set funspec id0 f0 (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  destruct (access_mode t); try contradiction.
  destruct (type_is_volatile t); [contradiction|].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.Leaf funspec)) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (let (id, f) := a0 in @PTree.set funspec id f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id0 f0 as b) r => @PTree.set funspec id0 f0 (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  destruct p; try contradiction.
  destruct (readable_share_dec sh); [|contradiction n; auto].
  destruct Hp1 as [(? & ?) | (? & ?)]; [|contradiction Hdef1; auto].
  destruct Hp2 as [(? & ?) | (? & ?)]; [|contradiction Hdef2; auto].
  assert (r1 = r2); [|split; auto].
  - eapply ex_address_mapsto_precise; eauto; eexists; eauto.
  - subst; eapply res_predicates.address_mapsto_value_cohere'; eauto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at_int_array_inj : forall {cs} sh z a1 a2 p r1 r2 r
  (Hsh : readable_share sh)
  (Hp1 : predicates_hered.app_pred (@data_at_rec cs sh (tarray tint z) a1 p) r1)
  (Hp2 : predicates_hered.app_pred (@data_at_rec cs sh (tarray tint z) a2 p) r2)
  (Hr1 : sepalg.join_sub r1 r) (Hr2 : sepalg.join_sub r2 r)
  (Hdef1 : Forall (fun v => v <> Vundef) a1) (Hdef2 : Forall (fun v => v <> Vundef) a2)
  (Hlen1 : Zlength a1 = z) (Hlen2 : Zlength a2 = z),
  r1 = r2 /\ a1 = a2.
Proof.
  intros until z.
  remember (Z.to_nat z) as l; revert dependent z.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; intros.
  - destruct a1; [|rewrite <- Hlen1, Zlength_cons, Zlength_correct, Z2Nat.inj_succ in Heql; omega].
    rewrite Zlength_nil in Hlen1.
    destruct a2; [split; auto | rewrite Zlength_cons, Zlength_correct in Hlen2; omega].
    rewrite <- Hlen1 in *.
    rewrite data_at_rec_eq in Hp1, Hp2; simpl in *.
    unfold unfold_reptype in *; simpl in *.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite array_pred_len_0 in Hp1, Hp2; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply sepalg.same_identity with (a := r); auto.
    + destruct Hr1 as (? & H); specialize (Hp1 _ _ H); subst; auto.
    + destruct Hr2 as (? & H); specialize (Hp2 _ _ H); subst; auto.
  - destruct a1 as [|x1 l1].
    { rewrite <- Hlen1, Zlength_nil in Heql; discriminate. }
    destruct a2 as [|x2 l2].
    { rewrite <- Hlen2, Zlength_nil in Heql; discriminate. }
    unfold tarray in *.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
    rewrite Zlength_cons in *.
    assert (0 <= 1 <= z).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite Zlength_correct in *; omega. }
    rewrite data_at_rec_eq in Hp1, Hp2; simpl in *.
    unfold unfold_reptype in *; simpl in *.
    rewrite split_array_pred with (mid := 1) in Hp1; auto; [| rewrite Z.max_r by omega; auto | rewrite Z.max_r by omega; rewrite Zlength_cons; omega].
    rewrite split_array_pred with (mid := 1) in Hp2; auto; [| rewrite Z.max_r by omega; auto | rewrite Z.max_r by omega; rewrite Zlength_cons; omega].
    destruct Hp1 as (r1a & ? & ? & Hh1 & Ht1), Hp2 as (r2a & ? & ? & Hh2 & Ht2).
    repeat rewrite Z.sub_0_r in *.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite sublist_one, array_pred_len_1 in Hh1, Hh2; auto; try rewrite Zlength_cons; try omega.
    rewrite sublist_1_cons in Ht1, Ht2.
    unfold Znth in *; simpl in *.
    unfold at_offset in Hh1, Hh2.
    assert (Zlength l1 = z - 1) by omega.
    assert (Zlength l2 = z - 1) by omega.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite sublist_same in Ht1, Ht2; try rewrite Z.max_r by omega; auto.
    inv Hdef1; inv Hdef2.
    exploit (IHl (Zlength l1)); try assumption.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { subst.
      rewrite Z2Nat.inj_succ in *; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite data_at_rec_eq; simpl.
      instantiate (2 := offset_val 4 p).
      setoid_rewrite at_offset_array_pred.
      instantiate (2 := l1).
      erewrite array_pred_shift; try simple apply Ht1;
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      try rewrite !Z.max_r by omega; auto; try omega.
      intros; unfold at_offset.      
      rewrite offset_offset_val; do 2 f_equal; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite data_at_rec_eq; simpl.
      setoid_rewrite at_offset_array_pred.
      instantiate (2 := l2).
      erewrite array_pred_shift; try simple apply Ht2;
      try rewrite !Z.max_r by omega;
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      auto; try omega.
      intros; unfold at_offset.
      rewrite offset_offset_val; do 2 f_equal; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { omega. }
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    intros (? & ?); subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite by_value_data_at_rec_nonvolatile in Hh1, Hh2; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    exploit (mapsto_inj sh tint x1 x2); eauto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    intros (? & ?); subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    split; [eapply sepalg.join_eq|]; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at_ptr_array_inj : forall {cs} sh t z a1 a2 p r1 r2 r
  (Hsh : readable_share sh)
  (Hp1 : predicates_hered.app_pred (@data_at_rec cs sh (tarray (tptr t) z) a1 p) r1)
  (Hp2 : predicates_hered.app_pred (@data_at_rec cs sh (tarray (tptr t) z) a2 p) r2)
  (Hr1 : sepalg.join_sub r1 r) (Hr2 : sepalg.join_sub r2 r)
  (Hdef1 : Forall (fun v => v <> Vundef) a1) (Hdef2 : Forall (fun v => v <> Vundef) a2)
  (Hlen1 : Zlength a1 = z) (Hlen2 : Zlength a2 = z),
  r1 = r2 /\ a1 = a2.
Proof.
  intros until z.
  remember (Z.to_nat z) as l; revert dependent z.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction l; intros.
  - destruct a1; [|rewrite <- Hlen1, Zlength_cons, Zlength_correct, Z2Nat.inj_succ in Heql; omega].
    rewrite Zlength_nil in Hlen1.
    destruct a2; [split; auto | rewrite Zlength_cons, Zlength_correct in Hlen2; omega].
    rewrite <- Hlen1 in *.
    rewrite data_at_rec_eq in Hp1, Hp2; simpl in *.
    unfold unfold_reptype in *; simpl in *.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite array_pred_len_0 in Hp1, Hp2; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply sepalg.same_identity with (a := r); auto.
    + destruct Hr1 as (? & H); specialize (Hp1 _ _ H); subst; auto.
    + destruct Hr2 as (? & H); specialize (Hp2 _ _ H); subst; auto.
  - destruct a1 as [|x1 l1].
    { rewrite <- Hlen1, Zlength_nil in Heql; discriminate. }
    destruct a2 as [|x2 l2].
    { rewrite <- Hlen2, Zlength_nil in Heql; discriminate. }
    unfold tarray in *.
(* Goal: @eq (list A) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) (@app A l0 (@cons A a (@nil A))) (@extendr A l ls))) (@Znth (list A) (@Inhabitant_list A) i (@cons (list A) l0 ls)) *)
    rewrite Zlength_cons in *.
    assert (0 <= 1 <= z).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite Zlength_correct in *; omega. }
    rewrite data_at_rec_eq in Hp1, Hp2; simpl in *.
    unfold unfold_reptype in *; simpl in *.
    rewrite split_array_pred with (mid := 1) in Hp1; auto; [| rewrite Z.max_r by omega; auto | rewrite Z.max_r by omega; rewrite Zlength_cons; omega].
    rewrite split_array_pred with (mid := 1) in Hp2; auto; [| rewrite Z.max_r by omega; auto | rewrite Z.max_r by omega; rewrite Zlength_cons; omega].
    destruct Hp1 as (r1a & ? & ? & Hh1 & Ht1), Hp2 as (r2a & ? & ? & Hh2 & Ht2).
    repeat rewrite Z.sub_0_r in *.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite sublist_one, array_pred_len_1 in Hh1, Hh2; auto; try rewrite Zlength_cons; try omega.
    rewrite sublist_1_cons in Ht1, Ht2.
    unfold Znth in *; simpl in *.
    unfold at_offset in Hh1, Hh2.
    assert (Zlength l1 = z - 1) by omega.
    assert (Zlength l2 = z - 1) by omega.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite sublist_same in Ht1, Ht2; try rewrite Z.max_r by omega; auto.
    inv Hdef1; inv Hdef2.
    exploit (IHl (Zlength l1)); try assumption.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { subst.
      rewrite Z2Nat.inj_succ in *; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite data_at_rec_eq; simpl.
      instantiate (2 := offset_val 4 p).
      setoid_rewrite at_offset_array_pred.
      instantiate (2 := l1).
      erewrite array_pred_shift; try simple apply Ht1;
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      try rewrite !Z.max_r by omega; auto; try omega.
      intros; unfold at_offset.
      rewrite offset_offset_val; do 2 f_equal; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { rewrite data_at_rec_eq; simpl.
      setoid_rewrite at_offset_array_pred.
      instantiate (2 := l2).
      erewrite array_pred_shift; try simple apply Ht2;
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
      try rewrite !Z.max_r by omega; auto; try omega.
      intros; unfold at_offset.
      rewrite offset_offset_val; do 2 f_equal; omega. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { auto. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { omega. }
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    intros (? & ?); subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite by_value_data_at_rec_nonvolatile in Hh1, Hh2; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    exploit (mapsto_inj sh (tptr t) x1 x2); eauto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eapply sepalg.join_sub_trans; [eexists; eauto | eauto]. }
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    intros (? & ?); subst.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    split; [eapply sepalg.join_eq|]; auto.
Qed. *)

Hint Resolve lock_inv_exclusive selflock_exclusive cond_var_exclusive data_at_exclusive
  data_at__exclusive field_at_exclusive field_at__exclusive selflock_rec.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma eq_dec_refl : forall {A B} {A_eq : EqDec A} (a : A) (b c : B), (if eq_dec a a then b else c) = b.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; destruct (eq_dec a a); [|contradiction n]; auto.
Qed.

(* shares *)
Lemma LKspec_readable lock_size :
  0 < lock_size ->
  forall R sh p, predicates_hered.derives (res_predicates.LKspec lock_size R sh p)
  (!!(readable_share sh)).
Proof.
(* Goal: forall (_ : Z.lt Z0 lock_size) (R : @pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (sh : Share.t) (p : compcert_rmaps.RML.R.AV.address), @predicates_hered.derives compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (res_predicates.LKspec lock_size R sh p) (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) *)
  intros pos R sh p a [H _].
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
  specialize (H p); simpl in H.
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
  destruct (adr_range_dec p lock_size p).
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
  destruct (eq_dec p p); [|contradiction n; auto].
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
(* Goal: @app_pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@predicates_hered.prop compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (readable_share sh)) a *)
  destruct H; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { contradiction n; unfold adr_range.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
    destruct p; split; auto.
    omega. }
Qed.

Lemma lock_inv_share_join : forall sh1 sh2 sh v R (Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2)
  (Hjoin : sepalg.join sh1 sh2 sh),
  lock_inv sh1 v R * lock_inv sh2 v R = lock_inv sh v R.
Proof.
  intros; unfold lock_inv.
  rewrite exp_sepcon1; f_equal; extensionality b.
  rewrite exp_sepcon1; f_equal; extensionality o.
  destruct v; try solve [repeat rewrite prop_false_andp; try discriminate; rewrite FF_sepcon; auto].
  destruct (eq_dec b0 b); [|repeat rewrite prop_false_andp; try (intro X; inv X; contradiction n; auto);
    rewrite FF_sepcon; auto].
  destruct (eq_dec i o); [subst | repeat rewrite prop_false_andp; try (intro X; inv X; contradiction n; auto);
    rewrite FF_sepcon; auto].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  repeat rewrite prop_true_andp; auto.
  evar (P : mpred); replace (exp _) with P.
  - subst P; apply slice.LKspec_share_join; eauto.
  - subst P.
    erewrite exp_uncurry, exp_congr, <- exp_andp1, exp_prop, prop_true_andp; eauto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { instantiate (1 := fun x => Vptr b o = Vptr (fst x) (snd x)); exists (b, o); auto. }
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    intros (?, ?); simpl.
    destruct (eq_dec b0 b); [subst |
      repeat rewrite prop_false_andp; try (intro X; inv X; contradiction n); auto].
    destruct (eq_dec i o); [|repeat rewrite prop_false_andp; try (intro X; inv X; contradiction n); auto].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    subst; repeat rewrite prop_true_andp; auto.
Qed.

Lemma comp_join_top : forall sh, sepalg.join sh (Share.comp sh) Tsh.
Proof.
(* Goal: forall sh : Share.t, @join Share.t Share.Join_ba sh (Share.comp sh) Tsh *)
  intro; pose proof (Share.comp1 sh).
  apply comp_parts_join with (L := sh)(R := Share.comp sh); auto;
    rewrite Share.glb_idem, Share.glb_top.
  - rewrite Share.comp2; auto.
  - rewrite Share.glb_commute, Share.comp2; auto.
Qed.

Lemma unreadable_bot : ~readable_share Share.bot.
Proof.
(* Goal: not (readable_share Share.bot) *)
  unfold readable_share, nonempty_share, sepalg.nonidentity.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite Share.glb_bot; auto.
Qed.
Hint Resolve unreadable_bot.

Definition join_Bot := join_Bot.

Lemma join_Tsh : forall a b, sepalg.join Tsh a b -> b = Tsh /\ a = Share.bot.
Proof.
(* Goal: forall (a b : share) (_ : @join share Share.Join_ba Tsh a b), and (@eq share b Tsh) (@eq share a Share.bot) *)
  intros ?? (? & ?).
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
  rewrite Share.glb_commute, Share.glb_top in H; subst; split; auto.
(* Goal: @eq share (Share.lub Tsh Share.bot) Tsh *)
  apply Share.lub_bot.
Qed.

(* It's often useful to split Tsh in half. *)
Definition gsh1 := fst (slice.cleave Tsh).
Definition gsh2 := snd (slice.cleave Tsh).

Lemma readable_gsh1 : readable_share gsh1.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply slice.cleave_readable1; auto.
Qed.

Lemma readable_gsh2 : readable_share gsh2.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply slice.cleave_readable2; auto.
Qed.

Lemma gsh1_gsh2_join : sepalg.join gsh1 gsh2 Tsh.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply slice.cleave_join; unfold gsh1, gsh2; destruct (slice.cleave Tsh); auto.
Qed.

Hint Resolve readable_gsh1 readable_gsh2 gsh1_gsh2_join.

Lemma gsh1_not_bot : gsh1 <> Share.bot.
Proof.
  intro X; contradiction unreadable_bot; rewrite <- X; auto.
Qed.

Lemma gsh2_not_bot : gsh2 <> Share.bot.
Proof.
  intro X; contradiction unreadable_bot; rewrite <- X; auto.
Qed.
Hint Resolve gsh1_not_bot gsh2_not_bot.

(*
Lemma data_at_Tsh_conflict : forall {cs : compspecs} sh t v v' p, sepalg.nonidentity sh -> 0 < sizeof t ->
  data_at Tsh t v p * data_at sh t v' p |-- FF.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
  assert_PROP (field_compatible t [] p) by entailer!.
  pose proof (comp_join_top sh).
  erewrite <- data_at_share_join by eauto.
  rewrite sepcon_comm, <- sepcon_assoc.
  eapply derives_trans; [apply sepcon_derives, derives_refl | rewrite FF_sepcon; auto].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply data_at_conflict; auto.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
  split; auto.
  unfold field_compatible in *; tauto.
Qed.
*)

Lemma split_readable_share sh :
  readable_share sh ->
  exists sh1, exists sh2,
    readable_share sh1 /\
    readable_share sh2 /\
    sepalg.join sh1 sh2 sh.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @ex share (fun sh1 : share => @ex share (fun sh2 : share => and (readable_share sh1) (and (readable_share sh2) (@join share Share.Join_ba sh1 sh2 sh)))) *)
  pose proof (slice.cleave_readable1 _ H); pose proof (slice.cleave_readable2 _ H).
(* Goal: @ex share (fun sh1 : share => @ex share (fun sh2 : share => and (readable_share sh1) (and (readable_share sh2) (@join share Share.Join_ba sh1 sh2 sh)))) *)
  destruct (slice.cleave sh) as (sh1, sh2) eqn: Hsplit.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  exists sh1, sh2; split; [|split]; auto.
(* Goal: @join share Share.Join_ba sh1 sh2 sh *)
  replace sh1 with (fst (slice.cleave sh)) by (rewrite Hsplit; auto).
(* Goal: @join share Share.Join_ba (@fst Share.t Share.t (slice.cleave sh)) sh2 sh *)
  replace sh2 with (snd (slice.cleave sh)) by (rewrite Hsplit; auto).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply slice.cleave_join; auto.
Qed.

Lemma split_Ews :
  exists sh1, exists sh2,
    readable_share sh1 /\
    readable_share sh2 /\
    sepalg.join sh1 sh2 Ews.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply split_readable_share; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Definition remove_Znth {A} i (al : list A) := sublist 0 i al ++ sublist (i + 1) (Zlength al) al.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma remove_Znth0 : forall {A} (l : list A), remove_Znth 0 l = sublist 1 (Zlength l) l.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite sublist_nil; auto.
Qed.

Lemma remove_Znth_cons : forall {A} i a (l : list A), i > 0 ->
  remove_Znth i (a :: l) = a :: remove_Znth (i - 1) l.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_0_cons, sublist_S_cons, Zlength_cons; auto; try omega.
(* Goal: @eq A (@Znth A d a0 l) (@Znth A d (Z.sub (Z.succ a0) (Zpos xH)) l) *)
  simpl; f_equal; f_equal; f_equal; omega.
Qed.

Lemma Zlength_remove_Znth : forall {A} i (l : list A), 0 <= i < Zlength l ->
  Zlength (remove_Znth i l) = Zlength l - 1.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Zlength_app, !Zlength_sublist; omega.
Qed.

Lemma remove_upd_Znth: forall {A} i l (a : A), 0 <= i < Zlength l ->
  remove_Znth i (upd_Znth i l a) = remove_Znth i l.
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite upd_Znth_Zlength, sublist_upd_Znth_l, sublist_upd_Znth_r; auto; omega.
Qed.

Lemma remove_Znth_map: forall {A B} (f : A -> B) i l,
  remove_Znth i (map f l) = map f (remove_Znth i l).
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite map_app, Zlength_map, !sublist_map; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma remove_Znth_combine: forall {A B} i (l1 : list A) (l2 : list B),
  0 <= i < Zlength l1 -> Zlength l1 = Zlength l2 ->
  remove_Znth i (combine l1 l2) = combine (remove_Znth i l1) (remove_Znth i l2).
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
(* Goal: @eq (list (prod A B)) (@app (prod A B) (@sublist (prod A B) Z0 i (@combine A B l1 l2)) (@sublist (prod A B) (Z.add i (Zpos xH)) (@Zlength (prod A B) (@combine A B l1 l2)) (@combine A B l1 l2))) (@combine A B (@app A (@sublist A Z0 i l1) (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1)) (@app B (@sublist B Z0 i l2) (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
  rewrite !sublist_combine, combine_app' by (rewrite !Zlength_sublist; omega).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite Zlength_combine, Z.min_l by omega.
(* Goal: @eq (list (prod A B)) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength A l1) l2))) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
  congruence.
Qed.

Lemma iter_sepcon_Znth: forall {A} {d : Inhabitant A} f (l : list A) i, 0 <= i < Zlength l ->
  iter_sepcon f l = f (Znth i l) * iter_sepcon f (remove_Znth i l).
Proof.
(* Goal: forall (A : Type) (d : Inhabitant A) (f : forall _ : A, mpred) (l : list A) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l))), @eq mpred (@iter_sepcon mpred A Nveric Sveric f l) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@remove_Znth A i l))) *)
  intros; unfold remove_Znth.
  rewrite <- sublist_same at 1 by auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_split with (mid := i) by omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_next with (i0 := i) by omega.
(* Goal: @eq mpred (@iter_sepcon mpred A Nveric Sveric f (@app A (@sublist A Z0 i l) (@cons A (@Znth A d i l) (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l)))) (@sepcon mpred Nveric Sveric (f (@Znth A d i l)) (@iter_sepcon mpred A Nveric Sveric f (@app A (@sublist A Z0 i l) (@sublist A (Z.add i (Zpos xH)) (@Zlength A l) l)))) *)
  rewrite !iter_sepcon_app; simpl; apply pred_ext; cancel.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma iter_sepcon2_Znth: forall {A B} {d1 : Inhabitant A} {d2 : Inhabitant B}
  f (l1 : list A) (l2 : list B) i, 0 <= i < Zlength l1 -> Zlength l1 = Zlength l2 ->
  iter_sepcon2 f l1 l2 =
  f (Znth i l1) (Znth i l2) * iter_sepcon2 f (remove_Znth i l1) (remove_Znth i l2).
Proof.
(* Goal: forall (A B : Type) (d1 : Inhabitant A) (d2 : Inhabitant B) (f : forall (_ : A) (_ : B), mpred) (l1 : list A) (l2 : list B) (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))) (_ : @eq Z (@Zlength A l1) (@Zlength B l2)), @eq mpred (@iter_sepcon2 mpred A B Nveric Sveric f l1 l2) (@sepcon mpred Nveric Sveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (@iter_sepcon2 mpred A B Nveric Sveric f (@remove_Znth A i l1) (@remove_Znth B i l2))) *)
  intros; rewrite !iter_sepcon2_spec.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  apply pred_ext; Intros l; subst.
  - rewrite Zlength_map in *.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite !remove_Znth_map, !Znth_map, iter_sepcon_Znth with (i0 := i) by auto.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@uncurry A B mpred f (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l)) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) (@remove_Znth (prod A B) i l))) (@sepcon mpred Nveric Sveric (f (@fst A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l)) (@snd A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l))) (@exp mpred Nveric (list (prod A B)) (fun l0 : list (prod A B) => @andp mpred Nveric (@prop mpred Nveric (and (@eq (list A) (@map (prod A B) A (@fst A B) (@remove_Znth (prod A B) i l)) (@map (prod A B) A (@fst A B) l0)) (@eq (list B) (@map (prod A B) B (@snd A B) (@remove_Znth (prod A B) i l)) (@map (prod A B) B (@snd A B) l0)))) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) l0)))) *)
    unfold uncurry at 1.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (f (@fst A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l)) (@snd A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l))) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) (@remove_Znth (prod A B) i l))) (@sepcon mpred Nveric Sveric (f (@fst A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l)) (@snd A B (@Znth (prod A B) (@Inhabitant_pair A B d1 d2) i l))) (@exp mpred Nveric (list (prod A B)) (fun l0 : list (prod A B) => @andp mpred Nveric (@prop mpred Nveric (and (@eq (list A) (@map (prod A B) A (@fst A B) (@remove_Znth (prod A B) i l)) (@map (prod A B) A (@fst A B) l0)) (@eq (list B) (@map (prod A B) B (@snd A B) (@remove_Znth (prod A B) i l)) (@map (prod A B) B (@snd A B) l0)))) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) l0)))) *)
    Exists (remove_Znth i l); entailer!.
  - Exists (combine l1 l2).
    rewrite combine_fst, combine_snd
      by (rewrite <- !ZtoNat_Zlength; apply Nat2Z.inj; rewrite !Z2Nat.id; omega).
    rewrite iter_sepcon_Znth with (i0 := i)(l0 := combine _ _)
      by (rewrite Zlength_combine, Z.min_l; omega).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite Znth_combine, remove_Znth_combine by auto.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) l)) (@andp mpred Nveric (@prop mpred Nveric (and (@eq (list A) l1 l1) (@eq (list B) l2 l2))) (@sepcon mpred Nveric Sveric (@uncurry A B mpred f (@pair A B (@Znth A d1 i l1) (@Znth B d2 i l2))) (@iter_sepcon mpred (prod A B) Nveric Sveric (@uncurry A B mpred f) (@combine A B (@remove_Znth A i l1) (@remove_Znth B i l2))))) *)
    rewrite H1, H2, combine_eq; unfold uncurry; entailer!.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
    apply derives_refl.
Qed.

Instance Inhabitant_share : Inhabitant share := Share.bot. (* TODO: remove this, it's already in sublist.v *) 
Instance Inhabitant_mpred : Inhabitant mpred := @FF mpred Nveric. (* TODO: remove this, it's already in sublist.v *) 

Lemma join_shares_nth : forall shs sh1 sh i, sepalg_list.list_join sh1 shs sh -> 0 <= i < Zlength shs ->
  exists sh', sepalg_list.list_join (Znth i shs) (remove_Znth i shs) sh' /\ sepalg.join sh1 sh' sh.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction shs; simpl; intros.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { rewrite Zlength_nil in *; omega. }
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  inv H.
(* Goal: @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
  destruct (eq_dec i 0).
  - subst; rewrite remove_Znth0, sublist_1_cons, Zlength_cons, sublist_same, Znth_0_cons; auto; try omega.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    eapply sepalg_list.list_join_assoc1; eauto.
  - rewrite Zlength_cons in *; exploit (IHshs w1 sh (i - 1)); auto; try omega.
(* Goal: forall _ : @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) (Z.sub i (Zpos xH)) shs) (@remove_Znth compcert_rmaps.RML.R.ghost (Z.sub i (Zpos xH)) shs) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join w1 sh' sh)), @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) i (@cons compcert_rmaps.RML.R.ghost a shs)) (@remove_Znth compcert_rmaps.RML.R.ghost i (@cons compcert_rmaps.RML.R.ghost a shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
    intros (sh2 & ? & ?).
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite Znth_pos_cons, remove_Znth_cons; try omega.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    exploit (sepalg.join_sub_joins_trans(a := a)(b := sh2)(c := w1)); eauto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { eexists; eapply sepalg.join_comm; eauto. }
(* Goal: forall _ : @joins compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join a sh2, @ex compcert_rmaps.RML.R.ghost (fun sh' : compcert_rmaps.RML.R.ghost => and (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) (Z.sub i (Zpos xH)) shs) (@cons compcert_rmaps.RML.R.ghost a (@remove_Znth compcert_rmaps.RML.R.ghost (Z.sub i (Zpos xH)) shs)) sh') (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh)) *)
    intros (sh' & ?); exists sh'; split.
    + exploit (sepalg_list.list_join_assoc2(a := a)(b := Znth (i - 1) shs)
        (cl := remove_Znth (i - 1) shs)(e := sh')(f := sh2)); auto.
(* Goal: forall _ : @ex compcert_rmaps.RML.R.ghost (fun d : compcert_rmaps.RML.R.ghost => and (@join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join a (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) (Z.sub i (Zpos xH)) shs) d) (@sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join d (@remove_Znth compcert_rmaps.RML.R.ghost (Z.sub i (Zpos xH)) shs) sh')), @sepalg_list.list_join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join (@Znth compcert_rmaps.RML.R.ghost (@Inhabitant_list (option (prod (@sigT ghost.Ghost (fun g : ghost.Ghost => @sig (@ghost.G g) (fun a : @ghost.G g => @ghost.valid g a))) compcert_rmaps.RML.R.preds))) (Z.sub i (Zpos xH)) shs) (@cons compcert_rmaps.RML.R.ghost a (@remove_Znth compcert_rmaps.RML.R.ghost (Z.sub i (Zpos xH)) shs)) sh' *)
      intros (d & ? & ?).
(* Goal: @Forall A P (@cons A y l') *)
      econstructor; eauto.
    + pose proof (sepalg.join_assoc(a := sh1)(b := a)(c := sh2)(d := w1)(e := sh)) as X.
      repeat match goal with X : ?a -> _, H : ?a |- _ => specialize (X H) end.
(* Goal: @join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh *)
      destruct X as (f & Ha' & ?).
(* Goal: @join compcert_rmaps.RML.R.ghost compcert_rmaps.RML.R.ghost_join sh1 sh' sh *)
      assert (f = sh') by (eapply sepalg.join_eq; eauto).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      subst; auto.
Qed.

Lemma list_join_comm : forall (l1 l2 : list share) a b, sepalg_list.list_join a (l1 ++ l2) b ->
  sepalg_list.list_join a (l2 ++ l1) b.
Proof.
(* Goal: forall (l1 l2 : list share) (a b : share) (_ : @sepalg_list.list_join share Share.Join_ba a (@app share l1 l2) b), @sepalg_list.list_join share Share.Join_ba a (@app share l2 l1) b *)
  induction l1; intros; [rewrite app_nil_r; auto|].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  inversion H as [|????? H1 H2]; subst.
(* Goal: @sepalg_list.list_join share Share.Join_ba a0 (@app share l2 (@cons share a l1)) b *)
  apply IHl1, sepalg_list.list_join_unapp in H2.
(* Goal: @sepalg_list.list_join share Share.Join_ba a0 (@app share l2 (@cons share a l1)) b *)
  destruct H2 as (c & Hl2 & Hl1).
(* Goal: @sepalg_list.list_join share Share.Join_ba a0 (@app share l2 (@cons share a l1)) b *)
  apply sepalg.join_comm in H1.
(* Goal: @sepalg_list.list_join share Share.Join_ba a0 (@app share l2 (@cons share a l1)) b *)
  destruct (sepalg_list.list_join_assoc1 H1 Hl2) as (? & ? & ?).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  eapply sepalg_list.list_join_app; eauto.
(* Goal: @Forall A P (@cons A y l') *)
  econstructor; eauto.
Qed.

(* Split a share into an arbitrary number of subshares. *)
Lemma split_shares : forall n sh, readable_share sh ->
  exists sh1 shs, Zlength shs = Z.of_nat n /\ readable_share sh1 /\ Forall readable_share shs /\
                  sepalg_list.list_join sh1 shs sh.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction n; intros.
  - exists sh, []; repeat split; auto.
(* Goal: @sepalg_list.list_join share Share.Join_ba sh (@nil share) sh *)
    apply sepalg_list.fold_rel_nil.
  - destruct (split_readable_share _ H) as (sh1 & sh2 & H1 & ? & ?).
(* Goal: @ex share (fun sh1 : share => @ex (list share) (fun shs : list share => and (@eq Z (@Zlength share shs) (Z.of_nat (S n))) (and (readable_share sh1) (and (@Forall share readable_share shs) (@sepalg_list.list_join share Share.Join_ba sh1 shs sh))))) *)
    destruct (IHn _ H1) as (sh1' & shs & ? & ? & ? & ?).
    exists sh1', (shs ++ [sh2]).
(* Goal: and (@eq Z (@Zlength share (@app share shs (@cons share sh2 (@nil share)))) (Z.of_nat (S n))) (and (readable_share sh1') (and (@Forall share readable_share (@app share shs (@cons share sh2 (@nil share)))) (@sepalg_list.list_join share Share.Join_ba sh1' (@app share shs (@cons share sh2 (@nil share))) sh))) *)
    rewrite Nat2Z.inj_succ, Zlength_app, Zlength_cons, Zlength_nil; split; [omega|].
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite Forall_app; repeat split; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    eapply sepalg_list.list_join_app; eauto.
    rewrite <- sepalg_list.list_join_1; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at_shares_join : forall {cs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh),
  @data_at cs sh1 t v p * fold_right sepcon emp (map (fun sh => data_at sh t v p) shs) =
  data_at sh t v p.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction shs; intros; simpl.
  - inv Hsplit.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite sepcon_emp; auto.
  - inv Hsplit.
    erewrite <- sepcon_assoc, data_at_share_join; eauto.
Qed.

(* These lemmas should probably be in veric. *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma exp_comm : forall {A B} P,
  (EX x : A, EX y : B, P x y) = EX y : B, EX x : A, P x y.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; apply seplog.pred_ext; Intros x y; Exists y x; auto.
Qed.

Lemma mapsto_value_eq: forall sh1 sh2 t p v1 v2, readable_share sh1 -> readable_share sh2 ->
  v1 <> Vundef -> v2 <> Vundef -> mapsto sh1 t p v1 * mapsto sh2 t p v2 |-- !!(v1 = v2).
Proof.
  intros; unfold mapsto.
  destruct (access_mode t); try solve [entailer!].
  destruct (type_is_volatile t); try solve [entailer!].
  destruct p; try solve [entailer!].
  destruct (readable_share_dec sh1); [|contradiction n; auto].
  destruct (readable_share_dec sh2); [|contradiction n; auto].

  Transparent mpred.
  rewrite !prop_false_andp with (P := v1 = Vundef), !orp_FF; auto; Intros.
  rewrite !prop_false_andp with (P := v2 = Vundef), !orp_FF; auto; Intros.
  Opaque mpred.
  apply res_predicates.address_mapsto_value_cohere.
Qed.

Lemma mapsto_value_cohere: forall sh1 sh2 t p v1 v2, readable_share sh1 ->
  mapsto sh1 t p v1 * mapsto sh2 t p v2 |-- mapsto sh1 t p v1 * mapsto sh2 t p v1.
Proof.
  intros; unfold mapsto.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
  destruct (access_mode t); try simple apply derives_refl.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
  destruct (type_is_volatile t); try simple apply derives_refl.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
  destruct p; try simple apply derives_refl.
  destruct (readable_share_dec sh1); [|contradiction n; auto].
  destruct (eq_dec v1 Vundef).
  Transparent mpred.
  - subst; rewrite !prop_false_andp with (P := tc_val t Vundef), !FF_orp, prop_true_andp; auto;
      try apply tc_val_Vundef.
    cancel.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite prop_true_andp with (P := Vundef = Vundef); auto.
    if_tac.
    + apply orp_left; Intros; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      Exists v2; auto.
    + entailer!.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      intro X; contradiction X; auto.
  - rewrite !prop_false_andp with (P := v1 = Vundef), !orp_FF; auto; Intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v2 (offset_val (@nested_field_offset cs t (@nil gfield)) p))) (@andp mpred Nveric (@prop mpred Nveric (and (@field_compatible cs t (@nil gfield) p) (@field_compatible cs t (@nil gfield) p))) (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)))) *)
    apply andp_right; [apply prop_right; auto|].
    if_tac.
    eapply derives_trans with (Q := _ * EX v2' : val,
      res_predicates.address_mapsto m v2' _ _);
      [apply sepcon_derives; [apply derives_refl|]|].
    + destruct (eq_dec v2 Vundef).
      * subst; rewrite prop_false_andp with (P := tc_val t Vundef), FF_orp;
          try apply tc_val_Vundef.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
        rewrite prop_true_andp with (P := Vundef = Vundef); auto.  apply derives_refl.
      * rewrite prop_false_andp with (P := v2 = Vundef), orp_FF; auto; Intros.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
        Exists v2; auto.
    + Intro v2'.
      assert_PROP (v1 = v2') by (apply res_predicates.address_mapsto_value_cohere).
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
      subst; entailer!.
    + entailer!.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      intro; auto.
Opaque mpred.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma struct_pred_value_cohere : forall {cs : compspecs} m sh1 sh2 p t f off v1 v2
  (Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2)
  (IH : Forall (fun it : ident * type => forall v1 v2 (p : val),
        readable_share sh1 -> readable_share sh2 ->
        data_at_rec sh1 (t it) v1 p * data_at_rec sh2 (t it) v2 p |--
        data_at_rec sh1 (t it) v1 p * data_at_rec sh2 (t it) v1 p) m),
  struct_pred m (fun (it : ident * type) v =>
    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p *
  struct_pred m (fun (it : ident * type) v =>
    withspacer sh2 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh2 (t it) v) (f it))) v2 p |--
  struct_pred m (fun (it : ident * type) v =>
    withspacer sh1 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh1 (t it) v) (f it))) v1 p *
  struct_pred m (fun (it : ident * type) v =>
    withspacer sh2 (f it + sizeof (t it)) (off it) (at_offset (data_at_rec sh2 (t it) v) (f it))) v1 p.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  revert v1 v2; induction m; auto; intros.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
  apply derives_refl.
  destruct a; inv IH.
  destruct m.
  - unfold withspacer, at_offset; simpl.
(* Goal: @eq (list A) (if A_eq x a then @app A l1 l2 else @cons A a (@app A l1 l2)) (@cons A a (@app A l1 l2)) *)
    if_tac; auto.
    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
      [cancel|] end.
    eapply derives_trans; [apply sepcon_derives, derives_refl|].
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { apply H1; auto. }
    cancel.
  - rewrite !struct_pred_cons2.
    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
      [cancel|] end.
    match goal with |- _ |-- (?P1 * ?Q1) * (?P2 * ?Q2) => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
      [|cancel] end.
    apply sepcon_derives; [|auto].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    unfold withspacer, at_offset; simpl.
(* Goal: @eq (list A) (if A_eq x a then @app A l1 l2 else @cons A a (@app A l1 l2)) (@cons A a (@app A l1 l2)) *)
    if_tac; auto.
    match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ => apply derives_trans with (Q := (P1 * P2) * (Q1 * Q2));
      [cancel|] end.
    eapply derives_trans; [apply sepcon_derives, derives_refl|].
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
    { apply H1; auto. }
    cancel.
Qed.

Lemma data_at_value_cohere : forall {cs : compspecs} sh1 sh2 t v1 v2 p, readable_share sh1 ->
  type_is_by_value t = true -> type_is_volatile t = false ->
  data_at sh1 t v1 p * data_at sh2 t v2 p |--
  data_at sh1 t v1 p * data_at sh2 t v1 p.
Proof.
(* Goal: forall (cs : compspecs) (sh1 : share) (sh2 : Share.t) (t : type) (v1 v2 : @reptype cs t) (p : val) (_ : readable_share sh1) (_ : @eq bool (type_is_by_value t) true) (_ : @eq bool (type_is_volatile t) false), @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at cs sh1 t v1 p) (@data_at cs sh2 t v2 p)) (@sepcon mpred Nveric Sveric (@data_at cs sh1 t v1 p) (@data_at cs sh2 t v1 p)) *)
  intros; unfold data_at, field_at, at_offset; Intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v2 (offset_val (@nested_field_offset cs t (@nil gfield)) p))) (@andp mpred Nveric (@prop mpred Nveric (and (@field_compatible cs t (@nil gfield) p) (@field_compatible cs t (@nil gfield) p))) (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)))) *)
  apply andp_right; [apply prop_right; auto|].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite !by_value_data_at_rec_nonvolatile by auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply mapsto_value_cohere; auto.
Qed.

Lemma data_at_array_value_cohere : forall {cs : compspecs} sh1 sh2 t z a v1 v2 p, readable_share sh1 ->
  type_is_by_value t = true -> type_is_volatile t = false ->
  data_at sh1 (Tarray t z a) v1 p * data_at sh2 (Tarray t z a) v2 p |--
  data_at sh1 (Tarray t z a) v1 p * data_at sh2 (Tarray t z a) v1 p.
Proof.
(* Goal: forall (cs : compspecs) (sh1 : share) (sh2 : Share.t) (t : type) (v1 v2 : @reptype cs t) (p : val) (_ : readable_share sh1) (_ : @eq bool (type_is_by_value t) true) (_ : @eq bool (type_is_volatile t) false), @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at cs sh1 t v1 p) (@data_at cs sh2 t v2 p)) (@sepcon mpred Nveric Sveric (@data_at cs sh1 t v1 p) (@data_at cs sh2 t v1 p)) *)
  intros; unfold data_at, field_at, at_offset; Intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v2 (offset_val (@nested_field_offset cs t (@nil gfield)) p))) (@andp mpred Nveric (@prop mpred Nveric (and (@field_compatible cs t (@nil gfield) p) (@field_compatible cs t (@nil gfield) p))) (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)))) *)
  apply andp_right; [apply prop_right; auto|].
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite !data_at_rec_eq; simpl.
  unfold array_pred, aggregate_pred.array_pred; Intros.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v2 (offset_val (@nested_field_offset cs t (@nil gfield)) p))) (@andp mpred Nveric (@prop mpred Nveric (and (@field_compatible cs t (@nil gfield) p) (@field_compatible cs t (@nil gfield) p))) (@sepcon mpred Nveric Sveric (@data_at_rec cs sh1 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)) (@data_at_rec cs sh2 (@nested_field_type cs t (@nil gfield)) v1 (offset_val (@nested_field_offset cs t (@nil gfield)) p)))) *)
  apply andp_right; [apply prop_right; auto|].
  rewrite Z.sub_0_r in *.
  erewrite aggregate_pred.rangespec_ext by (intros; rewrite Z.sub_0_r; apply f_equal; auto).
  setoid_rewrite aggregate_pred.rangespec_ext at 2; [|intros; rewrite Z.sub_0_r; apply f_equal; auto].
  setoid_rewrite aggregate_pred.rangespec_ext at 4; [|intros; rewrite Z.sub_0_r; apply f_equal; auto].
  clear H3 H4.
  rewrite Z2Nat_max0 in *.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  forget (offset_val 0 p) as p'; forget (Z.to_nat z) as n; forget 0 as lo; revert dependent lo; induction n; auto; simpl; intros.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
 apply derives_refl.
  match goal with |- (?P1 * ?Q1) * (?P2 * ?Q2) |-- _ =>
    eapply derives_trans with (Q := (P1 * P2) * (Q1 * Q2)); [cancel|] end.
  eapply derives_trans; [apply sepcon_derives|].
  - unfold at_offset.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite 2by_value_data_at_rec_nonvolatile by auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply mapsto_value_cohere; auto.
  - apply IHn.
  - unfold at_offset; rewrite 2by_value_data_at_rec_nonvolatile by auto; cancel.
Qed.

(* This isn't true if the type contains any unions, since in fact the type of the data could be different.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at_rec_value_cohere : forall {cs : compspecs} sh1 sh2 t v1 v2 p,
  readable_share sh1 -> readable_share sh2 ->
  data_at_rec sh1 t v1 p * data_at_rec sh2 t v2 p |--
  data_at_rec sh1 t v1 p * data_at_rec sh2 t v1 p.
Proof.
  intros until t; type_induction.type_induction t; intros; rewrite !data_at_rec_eq; simpl; auto;
    try solve [destruct (type_is_volatile _); [cancel | apply mapsto_value_cohere; auto]].
  - unfold array_pred, aggregate_pred.array_pred.
    rewrite sepcon_andp_prop, !sepcon_andp_prop'.
    repeat (apply derives_extract_prop; intro); entailer'.
    rewrite Z.sub_0_r in *.
    set (lo := 0) at 1 3 5 7; clearbody lo.
    forget (Z.to_nat z) as n; revert lo; induction n; simpl; intro; [cancel|].
    rewrite !sepcon_assoc, <- (sepcon_assoc _ (at_offset _ _ _)), (sepcon_comm _ (at_offset _ _ _)).
    rewrite <- (sepcon_assoc _ (at_offset _ _ _)), (sepcon_comm _ (at_offset _ _ _)).
    rewrite !sepcon_assoc, <- !(sepcon_assoc (at_offset _ _ _) (at_offset _ _ _)).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply sepcon_derives; unfold at_offset; auto.
  - apply struct_pred_value_cohere; auto.
  - 
Qed.

Corollary field_at_value_cohere : forall {cs : compspecs} sh1 sh2 t gfs v1 v2 p, readable_share sh1 ->
  field_at sh1 t gfs v1 p * field_at sh2 t gfs v2 p |--
  field_at sh1 t gfs v1 p * field_at sh2 t gfs v1 p.
Proof.
  intros; destruct (readable_share_dec sh2).
  - unfold field_at, at_offset; Intros; entailer'.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply data_at_rec_value_cohere; auto.
  - assert_PROP (value_fits (nested_field_type t gfs) v1 /\ value_fits (nested_field_type t gfs) v2)
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
      by entailer!.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    setoid_rewrite nonreadable_field_at_eq at 2; eauto; tauto.
Qed.

Corollary data_at_value_cohere : forall {cs : compspecs} sh1 sh2 t v1 v2 p, readable_share sh1 ->
  data_at sh1 t v1 p * data_at sh2 t v2 p |--
  data_at sh1 t v1 p * data_at sh2 t v1 p.
Proof.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros; apply field_at_value_cohere; auto.
Qed.

Corollary data_at__cohere : forall {cs : compspecs} sh1 sh2 t v p, readable_share sh1 ->
  data_at sh1 t v p * data_at_ sh2 t p =
  data_at sh1 t v p * data_at sh2 t v p.
Proof.
  intros; apply mpred_ext.
  - rewrite data_at__eq; apply data_at_value_cohere; auto.
  - entailer!.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma data_at__shares_join : forall {cs} sh t v p shs sh1 (Hsplit : sepalg_list.list_join sh1 shs sh)
  (Hreadable1 : readable_share sh1) (Hreadable : Forall readable_share shs),
  @data_at cs sh1 t v p * fold_right sepcon emp (map (fun sh => data_at_ sh t p) shs) |--
  data_at sh t v p.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction shs; intros; simpl.
  - inv Hsplit.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite sepcon_emp; auto.
  - inv Hsplit.
    inv Hreadable.
    rewrite <- sepcon_assoc, data_at__cohere; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    erewrite data_at_share_join; eauto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    apply IHshs; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    eapply readable_share_join; eauto.
Qed.*)

Lemma extract_nth_sepcon : forall l i, 0 <= i < Zlength l ->
  fold_right sepcon emp l = Znth i l * fold_right sepcon emp (upd_Znth i l emp).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  erewrite <- sublist_same with (al := l) at 1; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_split with (mid := i); try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
  rewrite sublist_next with (i0 := i); try omega.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite sepcon_app; simpl.
  rewrite <- sepcon_assoc, (sepcon_comm _ (Znth i l)).
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  unfold upd_Znth; rewrite sepcon_app, sepcon_assoc; simpl.
(* Goal: @eq mpred (@sepcon mpred Nveric Sveric (@Znth mpred Inhabitant_mpred i l) (@sepcon mpred Nveric Sveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@sublist mpred Z0 i l)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@sublist mpred (Z.add i (Zpos xH)) (@Zlength mpred l) l)))) (@sepcon mpred Nveric Sveric (@Znth mpred Inhabitant_mpred i l) (@sepcon mpred Nveric Sveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@sublist mpred Z0 i l)) (@sepcon mpred Nveric Sveric (@emp mpred Nveric Sveric) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@sublist mpred (Z.add i (Zpos xH)) (@Zlength mpred l) l))))) *)
  rewrite emp_sepcon; auto.
Qed.

Lemma replace_nth_sepcon : forall P l i, P * fold_right sepcon emp (upd_Znth i l emp) =
  fold_right sepcon emp (upd_Znth i l P).
Proof.
(* Goal: forall (P : mpred) (l : list mpred) (i : Z), @eq mpred (@sepcon mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l (@emp mpred Nveric Sveric)))) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@upd_Znth mpred i l P)) *)
  intros; unfold upd_Znth.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  rewrite !sepcon_app; simpl.
  rewrite emp_sepcon, <- !sepcon_assoc, (sepcon_comm P); auto.
Qed.

Lemma sepcon_derives_prop : forall P Q R, P |-- !!R -> P * Q |-- !!R.
Proof.
(* Goal: forall (P Q : mpred) (R : Prop) (_ : @derives mpred Nveric P (@prop mpred Nveric R)), @derives mpred Nveric (@sepcon mpred Nveric Sveric P Q) (@prop mpred Nveric R) *)
  intros; eapply derives_trans; [apply saturate_aux20 with (Q' := True); eauto|].
  - entailer!.
  - apply prop_left; intros (? & ?); apply prop_right; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma sepcon_map : forall {A} P Q (l : list A), fold_right sepcon emp (map (fun x => P x * Q x) l) =
  fold_right sepcon emp (map P l) * fold_right sepcon emp (map Q l).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  induction l; simpl.
  - rewrite sepcon_emp; auto.
  - rewrite !sepcon_assoc, <- (sepcon_assoc (fold_right _ _ _) (Q a)), (sepcon_comm (fold_right _ _ _) (Q _)).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    rewrite IHl; rewrite sepcon_assoc; auto.
Qed.

Lemma sepcon_list_derives : forall l1 l2 (Hlen : Zlength l1 = Zlength l2)
  (Heq : forall i, 0 <= i < Zlength l1 -> Znth i l1 |-- Znth i l2),
  fold_right sepcon emp l1 |-- fold_right sepcon emp l2.
Proof.
  induction l1; destruct l2; auto; simpl; intros; rewrite ?Zlength_nil, ?Zlength_cons in *;
    try (rewrite Zlength_correct in *; omega).
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric a (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l1)) (@sepcon mpred Nveric Sveric m (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l2)) *)
  apply sepcon_derives.
  - specialize (Heq 0); rewrite !Znth_0_cons in Heq; apply Heq.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    rewrite Zlength_correct; omega.
  - apply IHl1; [omega|].
    intros; specialize (Heq (i + 1)); rewrite !Znth_pos_cons, !Z.add_simpl_r in Heq; try omega.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    apply Heq; omega.
Qed.

Lemma sepcon_rotate : forall lP m n, 0 <= n - m < Zlength lP ->
  fold_right sepcon emp lP = fold_right sepcon emp (rotate lP m n).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq mpred (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) lP) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@rotate mpred lP m n)) *)
  unfold rotate.
  rewrite sepcon_app, sepcon_comm, <- sepcon_app, sublist_rejoin, sublist_same by omega; auto.
Qed.

(* wand lemmas *)
Lemma wand_eq : forall P Q R, P = Q * R -> P = Q * (Q -* P).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq mpred P (@sepcon mpred Nveric Sveric Q (@wand mpred Nveric Sveric Q P)) *)
  apply seplog.pred_ext, modus_ponens_wand.
  subst; cancel.
  rewrite <- wand_sepcon_adjoint; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite sepcon_comm; auto.
Qed.

Lemma wand_twice : forall P Q R, P -* Q -* R = P * Q -* R.
Proof.
(* Goal: forall P Q R : mpred, @eq mpred (@wand mpred Nveric Sveric P (@wand mpred Nveric Sveric Q R)) (@wand mpred Nveric Sveric (@sepcon mpred Nveric Sveric P Q) R) *)
  intros; apply seplog.pred_ext.
  - rewrite <- wand_sepcon_adjoint.
    rewrite <- sepcon_assoc, wand_sepcon_adjoint.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@wand mpred Nveric Sveric P Q) P) Q *)
    rewrite sepcon_comm; apply modus_ponens_wand.
  - rewrite <- !wand_sepcon_adjoint.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@sepcon mpred Nveric Sveric (@wand mpred Nveric Sveric (@sepcon mpred Nveric Sveric P Q) R) P) Q) R *)
    rewrite sepcon_assoc, sepcon_comm; apply modus_ponens_wand.
Qed.

Lemma sepcon_In : forall l P, In P l -> exists Q, fold_right sepcon emp l = P * Q.
Proof.
(* Goal: forall (l : list mpred) (P : mpred) (_ : @In mpred P l), @ex mpred (fun Q : mpred => @eq mpred (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l) (@sepcon mpred Nveric Sveric P Q)) *)
  induction l; [contradiction|].
(* Goal: @ex A (fun y : A => and (or (@eq A x0 y) (@In A y l)) (P y x)) *)
  intros ? [|]; simpl; subst; eauto.
  destruct (IHl _ H) as [? ->].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite sepcon_comm, sepcon_assoc; eauto.
Qed.

Lemma extract_wand_sepcon : forall l P, In P l ->
  fold_right sepcon emp l = P * (P -* fold_right sepcon emp l).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: @eq mpred (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l) (@sepcon mpred Nveric Sveric P (@wand mpred Nveric Sveric P (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) l))) *)
  destruct (sepcon_In _ _ H).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  eapply wand_eq; eauto.
Qed.

Lemma wand_sepcon_map : forall {A} (R : A -> mpred) l P Q
  (HR : forall i, In i l -> R i = P i * Q i),
  fold_right sepcon emp (map R l) = fold_right sepcon emp (map P l) *
    (fold_right sepcon emp (map P l) -* fold_right sepcon emp (map R l)).
Proof.
  intros; eapply wand_eq.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  erewrite map_ext_in, sepcon_map; eauto.
  apply HR.
Qed.

Lemma wand_frame : forall P Q R, P -* Q |-- P * R -* Q * R.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  rewrite <- wand_sepcon_adjoint; cancel.
(* Goal: @derives mpred Nveric (@sepcon mpred Nveric Sveric (@wand mpred Nveric Sveric P Q) P) Q *)
  rewrite sepcon_comm; apply modus_ponens_wand.
Qed.

Lemma semax_extract_later_prop'':
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  forall {CS : compspecs} {Espec: OracleKind},
    forall (Delta : tycontext) (PP : Prop) P Q R c post P1 P2,
      P2 |-- !!PP ->
      (PP -> semax Delta (PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))) c post) ->
      semax Delta (PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))) c post.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  erewrite (add_andp P2) by eauto.
(* Goal: semax CS Espec Delta (PROPx P (LOCALx Q (SEPx (@cons mpred (@andp mpred Nveric P1 (@later mpred Nveric Iveric (@andp mpred Nveric P2 (@prop mpred Nveric PP)))) R)))) c post *)
  apply semax_pre0 with (P' := |>!!PP && PROPx P (LOCALx Q (SEPx (P1 && |>P2 :: R)))).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
  { go_lowerx.
    rewrite later_andp, <- andp_assoc, andp_comm, corable_andp_sepcon1; auto.
    apply corable_later; auto. }
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply semax_extract_later_prop; auto.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma field_at_array_inbounds : forall {cs : compspecs} sh t z a i v p,
  field_at sh (Tarray t z a) [ArraySubsc i] v p |-- !!(0 <= i < z).
Proof.
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
  intros; entailer!.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  destruct H as (_ & _ & _ & _ & _ & ?); auto.
Qed.

Lemma valid_pointer_isptr : forall v, valid_pointer v |-- !!(is_pointer_or_null v).
Proof.
Transparent mpred.
Transparent predicates_hered.pred.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
  destruct v; simpl; auto; try apply derives_refl.
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
  entailer!.
Opaque mpred. Opaque predicates_hered.pred.
Qed.

Hint Resolve valid_pointer_isptr : saturate_local.

Lemma approx_imp : forall n P Q, compcert_rmaps.RML.R.approx n (predicates_hered.imp P Q) =
  compcert_rmaps.RML.R.approx n (predicates_hered.imp (compcert_rmaps.RML.R.approx n P)
    (compcert_rmaps.RML.R.approx n Q)).
Proof.
(* Goal: forall (n : nat) (P Q : @pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap), @eq (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (compcert_rmaps.RML.R.approx n (@predicates_hered.imp compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap P Q)) (compcert_rmaps.RML.R.approx n (@predicates_hered.imp compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (compcert_rmaps.RML.R.approx n P) (compcert_rmaps.RML.R.approx n Q))) *)
  intros; apply predicates_hered.pred_ext; intros ? (? & Himp); split; auto; intros ? Ha' HP.
  - destruct HP; split; auto.
  - apply Himp; auto; split; auto.
(* Goal: and (Z.le z z) (Z.lt z (Z.add z lock_size)) *)
    pose proof (ageable.necR_level _ _ Ha'); omega.
Qed.

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Definition super_non_expansive' {A} P := forall n ts x, compcert_rmaps.RML.R.approx n (P ts x) =
  compcert_rmaps.RML.R.approx n (P ts (functors.MixVariantFunctor.fmap (rmaps.dependent_type_functor_rec ts A)
        (compcert_rmaps.RML.R.approx n) (compcert_rmaps.RML.R.approx n) x)).

Lemma approx_sepcon_list: forall n lP, lP <> [] ->
  compcert_rmaps.RML.R.approx n (fold_right sepcon emp lP) =
  fold_right sepcon emp (map (compcert_rmaps.RML.R.approx n) lP).
Proof.
(* Goal: forall (n : nat) (lP : list (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap)) (_ : not (@eq (list (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap)) lP (@nil (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap)))), @eq (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (compcert_rmaps.RML.R.approx n (@fold_right (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@sepcon (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@emp (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) lP)) (@fold_right (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@sepcon (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@emp (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@map (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (compcert_rmaps.RML.R.approx n) lP)) *)
  induction lP; [contradiction | intros].
  destruct lP; simpl in *.
  - simpl; rewrite !sepcon_emp; auto.
  - rewrite approx_sepcon, IHlP; auto; discriminate.
Qed.

Corollary approx_sepcon_list' : forall n lP P,
  compcert_rmaps.RML.R.approx n (fold_right sepcon emp lP)  * compcert_rmaps.RML.R.approx n P =
  fold_right sepcon emp (map (compcert_rmaps.RML.R.approx n) lP) * compcert_rmaps.RML.R.approx n P.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  rewrite <- !approx_sepcon, !(sepcon_comm (fold_right _ _ _)).
(* Goal: @eq (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (compcert_rmaps.RML.R.approx n (@sepcon mpred Nveric Sveric P (@fold_right mpred (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@sepcon (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@emp (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) lP))) (@sepcon (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric (compcert_rmaps.RML.R.approx n P) (@fold_right (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@sepcon (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@emp (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) Nveric Sveric) (@map (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (@pred compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap) (compcert_rmaps.RML.R.approx n) lP))) *)
  setoid_rewrite approx_sepcon_list with (lP := _ :: _); auto; discriminate.
Qed.

Lemma approx_FF : forall n, compcert_rmaps.RML.R.approx n FF = FF.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.Leaf funspec)) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (let (id, f) := a0 in @PTree.set funspec id f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id0 f0 as b) r => @PTree.set funspec id0 f0 (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intro; apply predicates_hered.pred_ext; intros ??; try contradiction.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.Leaf funspec)) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (let (id, f) := a0 in @PTree.set funspec id f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id0 f0 as b) r => @PTree.set funspec id0 f0 (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  destruct H; contradiction.
Qed.

Lemma later_nonexpansive : nonexpansive (@later mpred _ _).
Proof.
(* Goal: @nonexpansive compcert_rmaps.RML.R.rmap compcert_rmaps.RML.R.ag_rmap (@later mpred Nveric Iveric) *)
  apply contractive_nonexpansive, later_contractive.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  intros ??; auto.
Qed.

Lemma eqp_refl : forall (G : Triv) P, G |-- P <=> P.
Proof.
(* Goal: forall (G : Triv) (P : mpred), @derives Triv TrivNatDed G (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric P P) (@imp mpred Nveric P P))) *)
  intros; rewrite andp_dup; apply subp_refl.
Qed.

Lemma eqp_sepcon : forall (G : Triv) (P P' Q Q' : mpred)
  (HP : G |-- P <=> P') (HQ : G |-- Q <=> Q'), G |-- P * Q <=> P' * Q'.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  rewrite fash_andp in HP, HQ |- *.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply andp_right; apply subp_sepcon; auto; intros ? Ha; destruct (HP _ Ha), (HQ _ Ha); auto.
Qed.

Lemma eqp_andp : forall (G : Triv) (P P' Q Q' : mpred)
  (HP : G |-- P <=> P') (HQ : G |-- Q <=> Q'), G |-- P && Q <=> P' && Q'.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  rewrite fash_andp in HP, HQ |- *.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply andp_right; apply subp_andp; auto; intros ? Ha; destruct (HP _ Ha), (HQ _ Ha); auto.
Qed.

Lemma eqp_exp : forall (A : Type) (NA : NatDed A) (IA : Indir A) (RecIndir : RecIndir A)
    (G : Triv) (B : Type) (X Y : B -> A),
  (forall x : B, G |-- X x <=> Y x) ->
  G |-- (EX x : _, X x) <=> (EX x : _, Y x).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  rewrite fash_andp; apply andp_right; apply subp_exp; intro x; specialize (H x); rewrite fash_andp in H;
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    intros ? Ha; destruct (H _ Ha); auto.
Qed.

Lemma fold_right_sepcon_nonexpansive : forall lP1 lP2, Zlength lP1 = Zlength lP2 ->
  (ALL i : Z, Znth i lP1 <=> Znth i lP2) |--
  fold_right sepcon emp lP1 <=> fold_right sepcon emp lP2.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  induction lP1; intros.
  - symmetry in H; apply Zlength_nil_inv in H; subst.
(* Goal: @derives Triv TrivNatDed (@allp Triv TrivNatDed Z (fun i : Z => @fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@nil mpred)) (@Znth mpred Inhabitant_mpred i (@nil mpred))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@nil mpred)) (@Znth mpred Inhabitant_mpred i (@nil mpred)))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@nil mpred)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@nil mpred))) (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@nil mpred)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@nil mpred))))) *)
    apply eqp_refl.
  - destruct lP2; [apply Zlength_nil_inv in H; discriminate|].
(* Goal: @derives Triv TrivNatDed (@allp Triv TrivNatDed Z (fun i : Z => @fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred a lP1)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred m lP2))) (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred m lP2)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred a lP1))))) *)
    rewrite !Zlength_cons in H.
(* Goal: @derives Triv TrivNatDed (@allp Triv TrivNatDed Z (fun i : Z => @fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred a lP1)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred m lP2))) (@imp mpred Nveric (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred m lP2)) (@fold_right mpred mpred (@sepcon mpred Nveric Sveric) (@emp mpred Nveric Sveric) (@cons mpred a lP1))))) *)
    simpl fold_right; apply eqp_sepcon.
    + apply allp_left with 0.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      rewrite !Znth_0_cons; auto.
    + eapply derives_trans, IHlP1; [|omega].
(* Goal: @derives Triv TrivNatDed (@allp Triv TrivNatDed Z (fun i : Z => @fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred i (@cons mpred a lP1)))))) (@allp Triv TrivNatDed Z (fun i : Z => @fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1))))) *)
      apply allp_right; intro i.
      apply allp_left with (i + 1).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
      destruct (zlt i 0).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
      { rewrite !(Znth_underflow _ _ l); apply eqp_refl. }
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      rewrite !Znth_pos_cons, Z.add_simpl_r by omega; auto.
Qed.

(* tactics *)
Lemma void_ret : ifvoid tvoid (` (PROP ( )  LOCAL ()  SEP ()) (make_args [] []))
  (EX v : val, ` (PROP ( )  LOCAL ()  SEP ()) (make_args [ret_temp] [v])) = emp.
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  extensionality; simpl.
(* Goal: @eq mpred (@liftx (Tarrow environ (LiftEnviron mpred)) (PROPx (@nil Prop) (LOCALx (@nil localdef) (SEPx (@nil mpred)))) (fun rho : environ => globals_only rho) x) (@emp mpred Nveric Sveric) *)
  unfold liftx, lift, PROPx, LOCALx, SEPx; simpl; normalize.
Qed.

(*
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma malloc_compat : forall {cs : compspecs} sh t p,
  complete_legal_cosu_type t = true ->
  natural_aligned natural_alignment t = true ->
  malloc_token sh (sizeof t) p = !!field_compatible t [] p && malloc_token sh (sizeof t) p.
Proof.
(* Goal: @derives mpred Nveric Q (@prop mpred Nveric True) *)
  intros; rewrite andp_comm; apply add_andp; entailer!.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  apply malloc_compatible_field_compatible; auto.
Qed.
*)

Ltac lock_props := rewrite ?sepcon_assoc; rewrite <- sepcon_emp at 1; rewrite sepcon_comm; apply sepcon_derives;
  [repeat apply andp_right; auto; eapply derives_trans;
   try (apply exclusive_weak_exclusive || (apply rec_inv_weak_rec_inv; try apply selflock_rec)); auto |
   try timeout 20 cancel].

Ltac join_sub := repeat (eapply sepalg.join_sub_trans;
  [eexists; first [eassumption | simple eapply sepalg.join_comm; eassumption]|]); eassumption.

Ltac join_inj := repeat match goal with H1 : sepalg.join ?a ?b ?c, H2 : sepalg.join ?a ?b ?d |- _ =>
    pose proof (sepalg.join_eq H1 H2); clear H1 H2; subst; auto end.

Ltac fast_cancel := rewrite ?sepcon_emp, ?emp_sepcon; rewrite ?sepcon_assoc;
  repeat match goal with
    | |- ?P |-- ?P => apply derives_refl
    | |- ?P * _ |-- ?P * _ => apply sepcon_derives; [apply derives_refl|]
    | |- _ |-- ?P * _ => rewrite <- !sepcon_assoc, (sepcon_comm _ P), !sepcon_assoc end;
  try cancel_frame.

(*Ltac forward_malloc t n := forward_call (sizeof t); [simpl; try computable |
  Intros n; rewrite malloc_compat by (auto; reflexivity); Intros;
  rewrite memory_block_data_at_ by auto].
*)

(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
Lemma semax_fun_id'' id f gv Espec {cs} Delta P Q R Post c :
  (var_types Delta) ! id = None ->
  (glob_specs Delta) ! id = Some f ->
  (glob_types Delta) ! id = Some (type_of_funspec f) ->
  snd (local2ptree Q) = Some gv ->
  @semax cs Espec Delta
    (PROPx P
      (LOCALx Q
      (SEPx ((func_ptr' f (gv id)) :: R)))) c Post ->
  @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
Proof.
(* Goal: forall (_ : @eq (option type) (@PTree.get type id (var_types Delta)) (@None type)) (_ : @eq (option funspec) (@PTree.get funspec id (glob_specs Delta)) (@Some funspec f)) (_ : @eq (option type) (@PTree.get type id (glob_types Delta)) (@Some type (type_of_funspec f))) (_ : @eq (option globals) (@snd (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (local2ptree Q)) (@Some globals gv)) (_ : semax cs Espec Delta (PROPx P (LOCALx Q (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) c Post), semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post *)
intros V G GS HGV SA.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
apply (semax_fun_id id f Delta); auto.
eapply semax_pre_post; try apply SA; clear SA;
 intros; try apply ENTAIL_refl.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx P (LOCALx Q (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx P (LOCALx Q (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
destruct (local2ptree Q) as [[[T1 T2] Res] GV] eqn:?H.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx P (LOCALx Q (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx P (LOCALx Q (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
simpl in HGV; subst GV.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
erewrite (local2ptree_soundness P) by eauto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
erewrite (local2ptree_soundness P) by eauto.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
go_lowerx.
(* Goal: @derives mpred Nveric (@andp mpred Nveric (fold_right_sepcon R) (func_ptr f (eval_var id (type_of_funspec f) rho))) (@sepcon mpred Nveric Sveric (func_ptr' f (gv id)) (fold_right_sepcon R)) *)
entailer.
(* Goal: @derives mpred Nveric (@andp mpred Nveric (fold_right_sepcon R) (func_ptr f (eval_var id (type_of_funspec f) rho))) (@sepcon mpred Nveric Sveric (func_ptr' f (gv id)) (fold_right_sepcon R)) *)
  unfold func_ptr'.
  rewrite <- andp_left_corable by (apply corable_func_ptr).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite andp_comm; apply andp_derives; auto.
  erewrite <- gvars_eval_var; [apply derives_refl | eauto ..].
(* Goal: locald_denote (gvars gv) rho *)
  pose proof LocalD_sound_gvars gv T1 T2 _ eq_refl.
  clear - H2 H3.
(* Goal: locald_denote (gvars gv) rho *)
  revert H3.
(* Goal: forall _ : @In localdef (gvars gv) (LocalD T1 T2 (@Some globals gv)), locald_denote (gvars gv) rho *)
  generalize (gvars gv).
  rewrite <- Forall_forall.
(* Goal: @Forall localdef (fun x : localdef => locald_denote x rho) (LocalD T1 T2 (@Some globals gv)) *)
  induction (LocalD T1 T2 (Some gv)); [constructor |].
(* Goal: @Forall localdef (fun x : localdef => locald_denote x rho) (@cons localdef a l) *)
  simpl in H2.
(* Goal: @NoDup A (@cons A x0 (@remove A A_eq x l)) *)
  destruct H2; constructor; auto.
Qed.

Ltac get_global_function'' _f :=
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (@Zlength A l1))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
eapply (semax_fun_id'' _f); try reflexivity.

(* revised start_function that mostly works for dependent specs *)
Ltac start_dep_function := 
  match goal with |- semax_body ?V ?G ?F ?spec =>
    let s := fresh "spec" in
    pose (s:=spec); hnf in s;
    match goal with
    | s :=  (DECLARE _ WITH _ : globals
               PRE  [] main_pre _ nil _
               POST [ tint ] main_post _ nil _) |- _ => idtac
    | s := ?spec' |- _ => check_canonical_funspec spec'
   end;
   change (semax_body V G F s); subst s
 end;
 let DependedTypeList := fresh "DependedTypeList" in
 match goal with |- semax_body _ _ _ (pair _ (mk_funspec _ _ _ ?Pre _ _ _)) =>
   match Pre with 
   | (fun x => match _ with (a,b) => _ end) => intros Espec DependedTypeList [a b] 
   | (fun i => _) => intros Espec DependedTypeList i
   end;
   simpl fn_body; simpl fn_params; simpl fn_return
 end;
 simpl functors.MixVariantFunctor._functor in *;
 simpl rmaps.dependent_type_functor_rec;
 repeat match goal with |- @semax _ _ _ (match ?p with (a,b) => _ end * _) _ _ =>
             destruct p as [a b]
           end;
 simplify_func_tycontext;
 repeat match goal with 
 | |- context [Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s) Sskip] =>
       fold (Swhile e s)
 | |- context [Ssequence ?s1 (Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s2) ?s3) ] =>
      match s3 with
      | Sset ?i _ => match s1 with Sset ?i' _ => unify i i' | Sskip => idtac end
      end;
      fold (Sfor s1 e s2 s3)
 end;
 try expand_main_pre;
 process_stackframe_of;
 repeat change_mapsto_gvar_to_data_at;  (* should really restrict this to only in main,
                                  but it needs to come after process_stackframe_of *)
 repeat rewrite <- data_at__offset_zero;
 try apply start_function_aux1;
 repeat (apply semax_extract_PROP; 
              match goal with
              | |- _ ?sh -> _ =>
                 match type of sh with
                 | share => intros ?SH 
                 | Share.t => intros ?SH 
                 | _ => intro
                 end
               | |- _ => intro
               end);
 first [ eapply eliminate_extra_return'; [ reflexivity | reflexivity | ]
        | eapply eliminate_extra_return; [ reflexivity | reflexivity | ]
        | idtac];
 abbreviate_semax.

(* Notations for dependent funspecs *)
Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2) =>
     match x with (x1,x2) => P%assert end)
  (fun (ts: list Type) (x: t1*t2) =>
     match x with (x1,x2) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3) =>
     match x with (x1,x2,x3) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3) =>
     match x with (x1,x2,x3) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4) =>
     match x with (x1,x2,x3,x4) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4) =>
     match x with (x1,x2,x3,x4) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
     match x with (x1,x2,x3,x4,x5) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5) =>
     match x with (x1,x2,x3,x4,x5) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
     match x with (x1,x2,x3,x4,x5,x6) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6) =>
     match x with (x1,x2,x3,x4,x5,x6) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0, 
             x5 at level 0, x6 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
     match x with (x1,x2,x3,x4,x5,x6,x7) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7) =>
     match x with (x1,x2,x3,x4,x5,x6,x7) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0, x10 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
              x10 at level 0, x11 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
              x10 at level 0, x11 at level 0, x12 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
              x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0,
             P at level 100, Q at level 100).

Notation "'TYPE' A 'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
     (mk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default A
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => P%assert end)
  (fun (ts: list Type) (x: t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14) =>
     match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14) => Q%assert end) _ _)
            (at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
             x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
              x10 at level 0, x11 at level 0, x12 at level 0, x13 at level 0, x14 at level 0,
             P at level 100, Q at level 100).

(* automation for dependent funspecs *)
Definition call_setup2'
  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
  (bl: list expr) (vl : list val)
  (Qactuals : PTree.t _)
  (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
  (Frame: list mpred)
  (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
  (Qpre_temp : PTree.t _) GV' :=
 call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals /\
  Pre ts witness = PROPx Ppre (LOCALx Qpre (SEPx Rpre)) /\
  local2ptree Qpre = (Qpre_temp, PTree.empty _, nil, GV') /\
  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
           |-- !! Forall (check_one_temp_spec Qactuals) (PTree.elements Qpre_temp) /\
  check_gvars_spec GV GV' /\
  fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame.

Lemma call_setup2'_i:
 forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty cc ts (A: rmaps.TypeTree) Pre Post NEPre NEPost
  (bl: list expr) (vl : list val)
  (Qactuals : PTree.t _)
  (SETUP1: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals)
  (witness': functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
  (Frame: list mpred)
  (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
  (Qpre_temp : PTree.t _) GV',
  Pre ts witness' = PROPx Ppre (LOCALx Qpre (SEPx Rpre)) ->
  local2ptree Qpre = (Qpre_temp, PTree.empty _, nil, GV') ->
  ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
           |-- !! Forall (check_one_temp_spec Qactuals) (PTree.elements Qpre_temp) ->
  check_gvars_spec GV GV' ->
  fold_right_sepcon R |-- fold_right_sepcon Rpre * fold_right_sepcon Frame ->
  call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness' Frame Ppre Qpre Rpre Qpre_temp GV'.
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
 intros. split. auto. repeat split; auto.
Qed.

Ltac check_witness_type' ts A witness :=
  (unify A (rmaps.ConstType Ridiculous); (* because [is_evar A] doesn't seem to work *)
             elimtype False)
 ||
 let TA := constr:(functors.MixVariantFunctor._functor
     (rmaps.dependent_type_functor_rec ts A) mpred) in
  let TA' := eval cbv 
     [functors.MixVariantFunctor._functor
      functors.MixVariantFunctorGenerator.fpair
      functors.MixVariantFunctorGenerator.fconst
      functors.MixVariantFunctorGenerator.fidentity
      rmaps.dependent_type_functor_rec
      functors.GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
      functors.CovariantFunctorGenerator.fconst
      functors.CovariantFunctorGenerator.fidentity
      functors.CovariantBiFunctor._functor
      functors.CovariantBiFunctorGenerator.Fpair
      functors.GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
      functors.CovariantFunctor._functor
      functors.MixVariantFunctor.fmap
      ] in TA
 in let TA'' := eval simpl in TA'
  in match type of witness with ?T => 
       unify T TA''
      + (fail "Type of witness does not match type required by funspec WITH clause.
Witness value: " witness "
Witness type: " T "
Funspec type: " TA'')
     end.

Ltac prove_call_setup' ts witness :=
 prove_call_setup1 subsume_funspec_refl;
 [ .. | 
 match goal with |- call_setup1  _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ _ _ -> _ =>
      check_witness_type' ts A witness
 end;
 let H := fresh in
 intro H;
 match goal with | |- @semax ?CS _ _ _ _ _ =>
 let Frame := fresh "Frame" in evar (Frame: list mpred);
 exploit (call_setup2'_i _ _ _ _ _ _ _ _ _ _ _ _ _ _ ts _ _ _ _ _ _ _ _ H witness Frame); clear H;
 simpl functors.MixVariantFunctor._functor;
 [ reflexivity
 | check_prove_local2ptree
 | Forall_pTree_from_elements
 | unfold check_gvars_spec; solve [exact I | reflexivity]
 | try change_compspecs CS; cancel_for_forward_call
 | 
 ]
 end].

Lemma semax_call_aux55:
 forall (cs: compspecs) (Qtemp: PTree.t val) (Qvar: PTree.t (type * val)) GV (a: expr)
     Delta P Q R fs argsig retty (*cc ts A Pre Post NEPre NEPost  *)
    ts (A : rmaps.TypeTree)
         (Pre
          Post : forall ts : list Type,
              functors.MixVariantFunctor._functor
                (rmaps.dependent_type_functor_rec
                   ts (AssertTT A)) mpred) 
    witness Frame bl Ppre Qpre Rpre Qactuals Qpre_temp GV' vl
 (PTREE : local2ptree Q = (Qtemp, Qvar, nil, GV))
 (TC0 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- tc_expr Delta a)
 (TC1 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
             |-- tc_exprlist Delta (argtypes argsig) bl)
 (MSUBST : force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
              (explicit_cast_exprlist (argtypes argsig) bl)) = Some vl)
 (PTREE'' : pTree_from_elements (combine (var_names argsig) vl) = Qactuals)
 (PRE1 : Pre ts witness = PROPx Ppre (LOCALx Qpre (SEPx Rpre)))
 (PTREE' : local2ptree Qpre = (Qpre_temp, PTree.empty _, nil, GV')) 
 (CHECKTEMP : Forall (check_one_temp_spec Qactuals) (PTree.elements Qpre_temp))
 (CHECKG: check_gvars_spec GV GV' )
 (FRAME : fold_right_sepcon R
           |-- fold_right_sepcon Rpre * fold_right_sepcon Frame)
 (PPRE : fold_right_and True Ppre)
 (LEN : length (argtypes argsig) = length bl),
ENTAIL Delta,
(EX v : val,
 lift0 (func_ptr fs v) &&
 local (` (eq v) (eval_expr a))) && |>PROPx P (LOCALx Q (SEPx R))
|-- |> (tc_expr Delta a && tc_exprlist Delta (argtypes argsig) bl) &&
    (|> @liftx (Tarrow environ (LiftEnviron mpred)) (Pre ts witness)
       (make_args' (argsig, retty) (eval_exprlist (argtypes argsig) bl)) *
     ` (func_ptr' fs)
       (eval_expr a) * |>PROPx P (LOCALx Q (SEPx Frame))).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
intros.
pose proof actual_value_not_Vundef _ _ _ _ _ _ _ _ _ _ _ PTREE TC1 MSUBST as VUNDEF.
rewrite !exp_andp1. Intros v.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
rewrite later_andp; repeat apply andp_right; auto.
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
{ eapply derives_trans, later_derives, TC0.
  rewrite later_andp; apply andp_derives; [apply now_later|].
  apply andp_left2, derives_refl. }
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
{ eapply derives_trans, later_derives, TC1.
  rewrite later_andp; apply andp_derives; [apply now_later|].
  apply andp_left2, derives_refl. }
rewrite PRE1.
match goal with |- _ |-- ?A * ?B * ?C => pull_right B end.
rewrite sepcon_comm.
rewrite func_ptr'_func_ptr_lifted.
apply ENTAIL_trans with
 (`(func_ptr fs) (eval_expr a) &&
      |>PROPx P (LOCALx Q (SEPx R))).
apply andp_left2.
apply andp_right; [  | apply andp_left2; auto].
apply andp_left1.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
intro rho; unfold_lift; unfold local, lift0, lift1; simpl. normalize.
apply andp_right.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
apply andp_left2; apply andp_left1; auto.
eapply derives_trans;[ apply andp_derives; [apply derives_refl | apply andp_left2; apply derives_refl] |].
subst Qactuals.
clear - PTREE LEN PTREE' MSUBST FRAME PPRE CHECKTEMP CHECKG VUNDEF.
rewrite <- later_sepcon.
 progress (autorewrite with norm1 norm2).
rewrite PROP_combine.
rewrite (andp_comm (local (fold_right _ _ _))).
rewrite later_andp; apply andp_right.
+
apply andp_left2.
apply later_derives.
apply andp_right.
apply andp_left1.
rewrite fold_right_and_app_low.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
apply prop_derives; intros; split; auto.
 clear - PPRE.
 revert PPRE; induction Ppre; simpl; intuition.
apply andp_left2.
apply andp_derives.
(* Goal: @derives mpred Nveric (f (@Znth A d1 i l1) (@Znth B d2 i l2)) (f (@Znth A d1 i l1) (@Znth B d2 i l2)) *)
apply derives_refl.
intro rho; unfold SEPx.
 rewrite fold_right_sepcon_app.
 assumption.
+
 rewrite VUNDEF.
 apply (local2ptree_soundness P _ R) in PTREE.
 simpl app in PTREE.
 apply msubst_eval_exprlist_eq with (P0:=P)(R0:=R)(GV0:=GV) in MSUBST.
 rewrite PTREE.
 apply later_left2.
 normalize. clear VUNDEF; rename H into VUNDEF.
 apply derives_trans with (local ((` (eq vl)) (eval_exprlist (argtypes argsig) bl)) && PROPx P (LOCALx (LocalD Qtemp Qvar GV) (SEPx R))); [rewrite (add_andp _ _ MSUBST); solve_andp |].
 clear MSUBST.
 intro rho.
 apply (local2ptree_soundness nil _ (TT::nil)) in PTREE'.
 simpl app in PTREE'.
 rewrite !isolate_LOCAL_lem1 in PTREE'.
 unfold local at 1, lift1.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
 simpl.
 apply derives_extract_prop; intro. unfold_lift in H. subst vl.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
 unfold PROPx, LOCALx, SEPx. simpl.
apply andp_left2. apply andp_left1.
 assert (LEN': length (var_names argsig) = length (eval_exprlist (argtypes argsig) bl rho)).
 clear - LEN.
  revert bl LEN; induction argsig as [ | [? ?]]; destruct bl;
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
    simpl; intros; auto.
 inv LEN.
 forget (argtypes argsig) as tys.
 cut (local (fold_right `(and) `(True) (map locald_denote (LocalD Qtemp Qvar GV))) rho |--
            `(local (fold_right `(and) `(True) (map locald_denote Qpre)))
               (fun rho => (make_args (var_names argsig) (eval_exprlist tys bl rho) rho)) rho).
 intro. eapply derives_trans; [apply H  |].
 unfold make_args'. simpl @fst. change (map fst argsig) with (var_names argsig).
 clear.  unfold_lift. unfold local, lift1. apply prop_derives.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
 induction Qpre; simpl; auto.  intros [? ?]. split; auto.
 rewrite PTREE'. clear PTREE' Qpre.
 apply prop_derives; intro. forget (var_names argsig) as fl.
 forget (eval_exprlist tys bl rho) as vl.
 eapply check_specs_lemma; try eassumption.
Qed.

Lemma semax_call_id00_wow:
 forall  
  (cs: compspecs) Qtemp Qvar a GV Delta P Q R R'
   fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
   (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) 
   (Frame: list mpred)
   (bl: list expr)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
   (Qactuals Qpre_temp : PTree.t _) GV'
   (vl : list val)
   (SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness Frame Ppre Qpre Rpre Qpre_temp GV')
  Espec 
             (Post2: environ -> mpred)
             (B: Type)
             (Ppost: B -> list Prop)
             (Rpost: B -> list mpred)
   (RETTY: retty = Tvoid)
   (POST1: Post ts witness = (EX vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret ) (LOCALx Q
             (SEPx (Rpost vret ++ Frame))))
   (PPRE: fold_right_and True Ppre),
   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
    (Scall None a bl)
    (normal_ret_assert Post2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
intros.
destruct SETUP as [[PTREE [Hsub [SPEC [HR' [ATY [TC0 [TC1 [MSUBST PTREE'']]]]]]]]
                            [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]].
apply SPEC. clear SPEC.
eapply semax_pre; [apply andp_right; [apply andp_left2, andp_left1, derives_refl|]|].
{ rewrite <- andp_assoc, andp_comm.
  rewrite <- andp_assoc; apply andp_left1.
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
  rewrite andp_comm.
  eapply derives_trans; [apply andp_derives, HR'; apply derives_refl|].
  apply later_left2.
  apply andp_right, andp_left2, derives_refl.
  apply andp_right, CHECKTEMP.
  eapply derives_trans, tc_exprlist_len; apply TC1. }
rewrite later_andp, andp_comm, andp_assoc.
rewrite <- !prop_and.
apply semax_extract_later_prop; intros [].
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
rewrite andp_comm.
eapply semax_pre_post' ; [ | |
   apply (@semax_call0 Espec cs Delta fs A Pre Post NEPre NEPost 
              ts witness argsig retty cc a bl P Q Frame); auto].
*
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
eapply semax_call_aux55; eauto.
*
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
 subst.
 clear CHECKTEMP TC1 PRE1 PPRE.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
 intros. normalize.
 rewrite POST1; clear POST1.
 unfold ifvoid.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
 go_lowerx. normalize.
 apply exp_right with x.
 rewrite fold_right_and_app_low.
 rewrite fold_right_sepcon_app.
 apply andp_right.
 apply prop_right.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
 split; auto.
 normalize.
Qed.

Lemma semax_call_id1_wow:
 forall  
  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
   (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) 
   (Frame: list mpred)
   (bl: list expr)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
   (Qactuals Qpre_temp : PTree.t _) GV'
   (vl : list val)
   (SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness Frame Ppre Qpre Rpre Qpre_temp GV')
   ret (Post2: environ -> mpred)  (Qnew: list localdef)
    (B: Type) (Ppost: B -> list Prop) (F: B -> val) (Rpost: B -> list mpred) Espec
   (TYret: typeof_temp Delta ret = Some retty)
   (OKretty: check_retty retty)
   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
                              (LOCALx (temp ret_temp (F vret) :: nil)
                              (SEPx (Rpost vret))))
   (DELETE: remove_localdef_temp ret Q = Qnew)
   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
             (SEPx (Rpost vret ++ Frame))))
   (PPRE: fold_right_and True Ppre),
   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
    (Scall (Some ret) a bl)
    (normal_ret_assert Post2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
intros.
destruct SETUP as [[PTREE [Hsub [SPEC [HR' [ATY [TC0 [TC1 [MSUBST PTREE'']]]]]]]]
                            [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]].
apply SPEC. clear SPEC.
eapply semax_pre; [apply andp_right; [apply andp_left2, andp_left1, derives_refl|]|].
{ rewrite <- andp_assoc, andp_comm.
  rewrite <- andp_assoc; apply andp_left1.
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
  rewrite andp_comm.
  eapply derives_trans; [apply andp_derives, HR'; apply derives_refl|].
  apply later_left2.
  apply andp_right, andp_left2, derives_refl.
  apply andp_right, CHECKTEMP.
  eapply derives_trans, tc_exprlist_len; apply TC1. }
rewrite later_andp, andp_comm, andp_assoc.
rewrite <- !prop_and.
apply semax_extract_later_prop; intros [].
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
rewrite andp_comm.
eapply semax_pre_post'; [ | |
   apply (@semax_call1 Espec cs Delta fs A Pre Post NEPre NEPost 
              ts witness ret argsig retty cc a bl P Q Frame); auto];
 [ | 
 | clear - OKretty; destruct retty; inv OKretty; apply I
 | hnf; clear - TYret; unfold typeof_temp in TYret;
      destruct ((temp_types Delta) ! ret); inv TYret; auto
 ].
*
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
eapply semax_call_aux55; eauto.
*
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
 subst.
 clear CHECKTEMP TC1 PRE1 PPRE.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
 intros.
 normalize.
 rewrite POST1; clear POST1.
 apply derives_trans with
   (EX  vret : B,
    `(PROPx (Ppost vret)
     (LOCAL  (temp ret_temp (F vret))
      (SEPx (Rpost vret))))%assert (get_result1 ret)
     * (local (tc_environ Delta) && PROPx P (LOCALx (remove_localdef_temp ret Q) (SEPx Frame)))).
 clear.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
 go_lowerx. normalize. apply exp_right with x; normalize.
 apply exp_left; intro vret. apply exp_right with vret.
 normalize.
 progress (autorewrite with norm1 norm2); normalize.
 rewrite PROP_combine.
 unfold fold_right.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
 go_lowerx.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
 repeat apply andp_right; try apply prop_right; auto.
 rewrite !fold_right_and_app_low.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
 rewrite !fold_right_and_app_low in H4. destruct H4; split; auto.
Qed.

Lemma semax_call_id1_x_wow:
 forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty' cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
   (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) 
   (Frame: list mpred)
   (bl: list expr)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
   (Qactuals Qpre_temp : PTree.t _) GV'
   (vl : list val)
   (SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness Frame Ppre Qpre Rpre Qpre_temp GV')
   retty  Espec ret ret'
             (Post2: environ -> mpred)
             (Qnew: list localdef)
             (B: Type)
             (Ppost: B -> list Prop)
             (F: B -> val)
             (Rpost: B -> list mpred)
   (TYret: typeof_temp Delta ret = Some retty)
   (RETinit: (temp_types Delta) ! ret' = Some retty')
   (OKretty: check_retty retty)
   (OKretty': check_retty retty')
   (NEUTRAL: is_neutral_cast retty' retty = true)
   (NEret: ret <> ret')
   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
                              (LOCALx (temp ret_temp (F vret) :: nil)
                              (SEPx (Rpost vret))))
   (DELETE: remove_localdef_temp ret Q = Qnew)
   (DELETE' : remove_localdef_temp ret' Q = Q)
   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
                   (LOCALx (temp ret (F vret) :: Qnew)
                    (SEPx (Rpost vret ++ Frame))))
   (PPRE: fold_right_and True Ppre),
   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
   (Ssequence (Scall (Some ret') a bl)
      (Sset ret (Ecast (Etempvar ret' retty') retty)))
    (normal_ret_assert Post2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  eapply semax_seq'.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  eapply semax_call_id1_wow; try eassumption; auto.
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (@Zlength A l1))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
  unfold typeof_temp; rewrite RETinit; reflexivity.
  apply extract_exists_pre; intro vret.
  eapply semax_pre_post';
    [ | | apply semax_set_forward].
  + eapply derives_trans; [ | apply now_later ].
    instantiate (1:= (PROPx (P ++ Ppost vret)
      (LOCALx (temp ret' (F vret) :: Qnew) (SEPx (Rpost vret ++ Frame))))).
    apply andp_right; [apply andp_right |].
    - unfold tc_expr.
      simpl typecheck_expr.
      rewrite RETinit.
      simpl @fst.
      replace ((is_neutral_cast retty' retty' || same_base_type retty' retty')%bool)
        with true
        by (clear- OKretty'; destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; unfold is_neutral_cast; rewrite ?eqb_type_refl; reflexivity).
      rewrite denote_tc_assert_andp.
      apply andp_right; [| intros rho; apply neutral_isCastResultType; auto].
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply PQR_denote_tc_initialized; auto.
    - unfold tc_temp_id, typecheck_temp_id.
      unfold typeof_temp in TYret.
      destruct ((temp_types Delta) ! ret); inversion TYret; clear TYret; try subst t.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
      go_lowerx.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
      repeat rewrite denote_tc_assert_andp; simpl.
      rewrite denote_tc_assert_bool.
      assert (is_neutral_cast (implicit_deref retty) retty = true).
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
(* Goal: @derives Triv TrivNatDed (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2))) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred m lP2)) (@Znth mpred Inhabitant_mpred (Z.add i (Zpos xH)) (@cons mpred a lP1))))) (@fash mpred Nveric Iveric Rveric (@andp mpred Nveric (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP1) (@Znth mpred Inhabitant_mpred i lP2)) (@imp mpred Nveric (@Znth mpred Inhabitant_mpred i lP2) (@Znth mpred Inhabitant_mpred i lP1)))) *)
      {
        destruct retty as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; try reflexivity;
        destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; 
        try solve [inv NEUTRAL].
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (@Zlength A l1))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
        unfold implicit_deref, is_neutral_cast. rewrite eqb_type_refl; reflexivity.
      }
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      simpl; apply andp_right. apply prop_right; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply neutral_isCastResultType; auto.
    - rewrite <- !insert_local. apply andp_left2.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply andp_derives; auto.
      subst Qnew; apply derives_remove_localdef_PQR.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  + intros. subst Post2.
    normalize.
    apply exp_right with vret; normalize.
    rewrite <- !insert_local.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    autorewrite with subst.
    rewrite <- !andp_assoc.
    apply andp_derives; [| subst Qnew; apply subst_remove_localdef_PQR].
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
    go_lowerx.
    unfold_lift.
    normalize.
    assert (eqb_ident ret ret' = false)
    by (clear - NEret; pose proof (eqb_ident_spec ret ret');
        destruct (eqb_ident ret ret'); auto;
        contradiction NEret; intuition).
    rewrite H3 in *. apply Pos.eqb_neq in H3.
    unfold_lift in H0.
    assert (tc_val retty' (eval_id ret' rho))
      by (eapply tc_eval'_id_i; try eassumption; congruence).
    assert (H7 := expr2.neutral_cast_lemma); unfold eval_cast in H7.
    rewrite H7 in H0 by auto; clear H7.
(* Goal: @eq (list (prod A B)) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength A l1) l2))) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
    split; congruence.
Qed.

Lemma semax_call_id1_y_wow:
 forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty' cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
   (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) 
   (Frame: list mpred)
   (bl: list expr)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
   (Qactuals Qpre_temp : PTree.t _) GV'
   (vl : list val)
   (SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness Frame Ppre Qpre Rpre Qpre_temp GV')
    Espec ret ret' (retty: type) 
             (Post2: environ -> mpred)
             (Qnew: list localdef)
             (B: Type)
             (Ppost: B -> list Prop)
             (F: B -> val)
             (Rpost: B -> list mpred)
   (TYret: typeof_temp Delta ret = Some retty)
   (RETinit: (temp_types Delta) ! ret' = Some retty')
   (OKretty: check_retty retty)
   (OKretty': check_retty retty')
   (NEUTRAL: is_neutral_cast retty' retty = true)
   (NEret: ret <> ret')
   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
                              (LOCALx (temp ret_temp (F vret) :: nil)
                              (SEPx (Rpost vret))))
   (DELETE: remove_localdef_temp ret Q = Qnew)
   (DELETE' : remove_localdef_temp ret' Q = Q)
   (H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
                   (LOCALx (temp ret (F vret) :: Qnew)
                    (SEPx (Rpost vret ++ Frame))))
   (PPRE: fold_right_and True Ppre),
   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
   (Ssequence (Scall (Some ret') a bl)
      (Sset ret (Etempvar ret' retty')))
    (normal_ret_assert Post2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  intros.
  eapply semax_seq'.
  eapply semax_call_id1_wow; try eassumption; auto;
(* Goal: iff (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (x : Z) (_ : and (Z.le Z0 x) (Z.lt x (@Zlength A l1))), P (@Znth A d1 x l1) (@Znth B d2 x l2))) (and (@eq Z (@Zlength A l1) (@Zlength B l2)) (forall (i : Z) (_ : and (Z.le Z0 i) (Z.lt i (@Zlength A l1))), P (@Znth A d1 i l1) (@Znth B d2 i l2))) *)
    unfold typeof_temp; rewrite RETinit; reflexivity.
  apply extract_exists_pre; intro vret.
  eapply semax_pre_post';
    [ | | apply semax_set_forward].
  + eapply derives_trans; [ | apply now_later ].
    instantiate (1:= (PROPx (P ++ Ppost vret)
      (LOCALx (temp ret' (F vret) :: Qnew) (SEPx (Rpost vret ++ Frame))))).
    apply andp_right; [apply andp_right |].
    - unfold tc_expr.
      match goal with |- _ |-- ?A =>
        set (aa:=A); unfold denote_tc_assert in aa; simpl in aa; subst aa
      end.
      rewrite RETinit.
      simpl @fst.
      replace ((is_neutral_cast retty' retty' || same_base_type retty' retty')%bool)
        with true
        by (clear- OKretty'; destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; unfold is_neutral_cast; rewrite ?eqb_type_refl; reflexivity).
      simpl @snd. cbv iota.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply PQR_denote_tc_initialized; auto.
    - unfold tc_temp_id, typecheck_temp_id.
      unfold typeof_temp in TYret.
      destruct ((temp_types Delta) ! ret); inversion TYret; clear TYret; try subst t.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
      go_lowerx.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
      repeat rewrite denote_tc_assert_andp; simpl.
      rewrite denote_tc_assert_bool.
      assert (is_neutral_cast (implicit_deref retty') retty = true).
      * replace (implicit_deref retty') with retty'
          by (destruct retty' as [ | [ | | |] [| ]| [|] | [ | ] |  | | | | ]; try contradiction; reflexivity).
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
        auto.
      * simpl; apply andp_right. apply prop_right; auto.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
        apply neutral_isCastResultType; auto.
    - rewrite <- !insert_local. apply andp_left2.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
      apply andp_derives; auto.
      subst Qnew; apply derives_remove_localdef_PQR.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
  + intros. subst Post2.
    unfold normal_ret_assert.
    normalize.
    apply exp_right with vret; normalize.
    rewrite <- !insert_local.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
    autorewrite with subst.
    rewrite <- !andp_assoc.
    apply andp_derives; [| subst Qnew; apply subst_remove_localdef_PQR].
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
    go_lowerx.
    unfold_lift.
    normalize.
    assert (eqb_ident ret ret' = false)
    by (clear - NEret; pose proof (eqb_ident_spec ret ret');
        destruct (eqb_ident ret ret'); auto;
        contradiction NEret; intuition).
    rewrite H3 in *. apply Pos.eqb_neq in H3.
(* Goal: @eq (list (prod A B)) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength A l1) l2))) (@app (prod A B) (@combine A B (@sublist A Z0 i l1) (@sublist B Z0 i l2)) (@combine A B (@sublist A (Z.add i (Zpos xH)) (@Zlength A l1) l1) (@sublist B (Z.add i (Zpos xH)) (@Zlength B l2) l2))) *)
    split; congruence.
Qed.

Lemma semax_call_id01_wow:
 forall  
  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
   fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
   (witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred) 
   (Frame: list mpred)
   (bl: list expr)
   (Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
   (Qactuals Qpre_temp : PTree.t _) GV'
   (vl : list val)
   (SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
      witness Frame Ppre Qpre Rpre Qpre_temp GV')
   Espec
             (Post2: environ -> mpred)
             (B: Type)
             (Ppost: B -> list Prop)
             (F: B -> val)
             (Rpost: B -> list mpred)
   (_: check_retty retty)
         (* this hypothesis is not needed for soundness, just for selectivity *)
   (POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
                              (LOCALx (temp ret_temp (F vret) :: nil)
                              (SEPx (Rpost vret))))
   (POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx Q
             (SEPx (Rpost vret ++ Frame))))
   (PPRE: fold_right_and True Ppre),
   @semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
    (Scall None a bl)
    (normal_ret_assert Post2).
Proof.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
intros.
destruct SETUP as [[PTREE [Hsub [SPEC [HR' [ATY [TC0 [TC1 [MSUBST PTREE'']]]]]]]]
                            [PRE1 [PTREE' [CHECKTEMP [CHECKG FRAME]]]]].
apply SPEC. clear SPEC.
eapply semax_pre; [apply andp_right; [apply andp_left2, andp_left1, derives_refl|]|].
{ rewrite <- andp_assoc, andp_comm.
  rewrite <- andp_assoc; apply andp_left1.
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
  rewrite andp_comm.
  eapply derives_trans; [apply andp_derives, HR'; apply derives_refl|].
  apply later_left2.
  apply andp_right, andp_left2, derives_refl.
  apply andp_right, CHECKTEMP.
  eapply derives_trans, tc_exprlist_len; apply TC1. }
rewrite later_andp, andp_comm, andp_assoc.
rewrite <- !prop_and.
apply semax_extract_later_prop; intros [].
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
rewrite andp_comm.
eapply semax_pre_post';
   [ |
   | apply semax_call0 with (fs:=fs)(cc:=cc)(A:= A) (ts := ts)(x:=witness) (P:=P)(Q:=Q)(NEPre :=NEPre) (NEPost := NEPost)(R := Frame); auto
   ];
   try eassumption.
* eapply semax_call_aux55; eauto.
*
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
 subst.
 clear CHECKTEMP TC1 PRE1 PPRE.
(* Goal: forall (cs : compspecs) (Qtemp : PTree.t val) (Qvar : PTree.t (prod type val)) (GV : option globals) (a : expr) (Delta : tycontext) (P : list Prop) (Q : list localdef) (R R' : list mpred) (fs : funspec) (argsig : list (prod ident type)) (retty : type) (cc : calling_convention) (ts : list Type) (A : rmaps.TypeTree) (Pre Post : forall ts0 : list Type, _functor (rmaps.dependent_type_functor_rec ts0 (AssertTT A)) mpred) (NEPre : @super_non_expansive A Pre) (NEPost : @super_non_expansive A Post) (bl : list expr) (vl : list val) (Qactuals : PTree.t val) (_ : call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals) (witness' : _functor (rmaps.dependent_type_functor_rec ts A) mpred) (Frame : list mpred) (Ppre : list Prop) (Qpre : list localdef) (Rpre : list mpred) (Qpre_temp : PTree.t val) (GV' : option globals) (_ : @eq (_functor ((fix dtfr (T : rmaps.TypeTree) : functor := match T with | rmaps.ConstType A0 => fconst A0 | rmaps.Mpred => fidentity | rmaps.DependentType n => fconst (@nth Type n ts unit) | rmaps.ProdType T1 T2 => fpair (dtfr T1) (dtfr T2) | rmaps.ArrowType T1 T2 => ffunc (dtfr T1) (dtfr T2) | rmaps.PiType I0 f => @fpi I0 (fun i : I0 => dtfr (f i)) | rmaps.ListType T0 => flist (dtfr T0) end) (rmaps.ArrowType (rmaps.ConstType environ) rmaps.Mpred)) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (_ : @eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (_ : @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (_ : check_gvars_spec GV GV') (_ : @derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame))), call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals witness' Frame Ppre Qpre Rpre Qpre_temp GV' *)
 intros.
 normalize.
 rewrite POST1; clear POST1.
 match goal with |- context [ifvoid retty ?A ?B] =>
   replace (ifvoid retty A B) with B
   by (destruct retty; try contradiction; auto)
 end.
(* Goal: @derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (@andp (lifted (LiftEnviron mpred)) (@LiftNatDed' mpred Nveric) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx R))) (@liftx (Tarrow val (LiftEnviron mpred)) (func_ptr f) (eval_var id (type_of_funspec f))))) (PROPx (@app Prop Res P) (LOCALx (LocalD T1 T2 (@Some globals gv)) (SEPx (@cons mpred (func_ptr' f (gv id)) R)))) *)
 go_lowerx. normalize. apply exp_right with x0; normalize.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
 apply andp_right; auto.
 apply prop_right.
(* Goal: and (@Forall Z (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (@cons Z Z0 (@nil Z))) (@Forall Z (@Basics.compose Z Z Prop (fun i : Z => P (@Znth A d1 i (@cons A a l1)) (@Znth B d2 i (@cons B b l2))) (fun i : Z => Z.add (Z.of_nat (S O)) i)) (upto (Z.to_nat (@Zlength A l1)))) *)
 rewrite fold_right_and_app_low. split; auto.
 rename x0 into vret.
 clear.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
 rewrite fold_right_sepcon_app. auto.
Qed.

Ltac  forward_call_id1_wow' := 
let H := fresh in intro H;
eapply (semax_call_id1_wow 
             _ _ _ _ _ _ _ _ _ _
             _ _ _ _ _ _ _ _ _ _ 
             _ _ _ _ _ _ _ _ _ H);
 clear H;
 lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
 [check_result_type
 |apply Logic.I
 | cbv beta iota zeta; unfold_post; extensionality rho;
   repeat rewrite exp_uncurry;
   try rewrite no_post_exists; repeat rewrite exp_unfold;
   first [apply exp_congr; intros ?vret; reflexivity
           | give_EX_warning
           ]
 | prove_delete_temp
 | unify_postcondition_exps
 | unfold fold_right_and; repeat rewrite and_True; auto
 ].

Ltac forward_call_id1_x_wow' :=
let H := fresh in intro H;
eapply (semax_call_id1_x_wow 
             _ _ _ _ _ _ _ _ _ _
             _ _ _ _ _ _ _ _ _ _ 
             _ _ _ _ _ _ _ _ _ H); 
 clear H;
 lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
 [ check_result_type | check_result_type
 | apply Coq.Init.Logic.I | apply Coq.Init.Logic.I | reflexivity
 | (clear; let H := fresh in intro H; inversion H)
 | cbv beta iota zeta; unfold_post; extensionality rho;
   repeat rewrite exp_uncurry;
   try rewrite no_post_exists; repeat rewrite exp_unfold;
   first [apply exp_congr; intros ?vret; reflexivity
           | give_EX_warning
           ]
 | prove_delete_temp
 | prove_delete_temp
 | unify_postcondition_exps
 | unfold fold_right_and; repeat rewrite and_True; auto
 ].


Ltac forward_call_id1_y_wow' :=
let H := fresh in intro H;
eapply (semax_call_id1_y_wow 
             _ _ _ _ _ _ _ _ _ _
             _ _ _ _ _ _ _ _ _ _ 
             _ _ _ _ _ _ _ _ _ H); 
 clear H;
 lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
 [ check_result_type | check_result_type
 | apply Coq.Init.Logic.I | apply Coq.Init.Logic.I | reflexivity
 | (clear; let H := fresh in intro H; inversion H)
 | cbv beta iota zeta; unfold_post; extensionality rho;
   repeat rewrite exp_uncurry;
   try rewrite no_post_exists; repeat rewrite exp_unfold;
   first [apply exp_congr; intros ?vret; reflexivity
           | give_EX_warning
           ]
 | prove_delete_temp
 | prove_delete_temp
 | unify_postcondition_exps
 | unfold fold_right_and; repeat rewrite and_True; auto
 ].

Ltac forward_call_id01_wow' :=
let H := fresh in intro H;
eapply (semax_call_id01_wow 
             _ _ _ _ _ _ _ _ _ _
             _ _ _ _ _ _ _ _ _ _ 
             _ _ _ _ _ _ _ _ _ H); 
 clear H;
 lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
 [ apply Coq.Init.Logic.I 
 | cbv beta iota zeta; unfold_post; extensionality rho;
   repeat rewrite exp_uncurry;
   try rewrite no_post_exists; repeat rewrite exp_unfold;
   first [apply exp_congr; intros ?vret; reflexivity
           | give_EX_warning
           ]
 | unify_postcondition_exps
 | unfold fold_right_and; repeat rewrite and_True; auto
 ].

Ltac forward_call_id00_wow'  :=
let H := fresh in intro H;
eapply (semax_call_id00_wow _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H); 
 clear H;
 lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
 [ check_result_type 
 | cbv beta iota zeta; unfold_post; extensionality rho;
    repeat rewrite exp_uncurry;
    try rewrite no_post_exists0;
    repeat rewrite exp_unfold;
    first [reflexivity | extensionality; simpl; reflexivity | give_EX_warning]
 | unify_postcondition_exps
 | unfold fold_right_and; repeat rewrite and_True; auto
 ].

Ltac fwd_call'_dep ts witness :=
lazymatch goal with
| |- semax _ _ (Ssequence (Scall _ _ _) _) _ =>
  eapply semax_seq';
    [prove_call_setup' ts witness;
     clear_Delta_specs; clear_MORE_POST;
     [ .. |
      lazymatch goal with
      | |- _ -> semax _ _ (Scall (Some _) _ _) _ =>
         forward_call_id1_wow'
      | |- call_setup2' _ _ _ _ _ _ _ _ _ _ _ _ ?retty _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> 
                semax _ _ (Scall None _ _) _ =>
        tryif (unify retty Tvoid)
        then forward_call_id00_wow'
        else forward_call_id01_wow'
     end]
   | after_forward_call ]
| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                       (Sset _ (Ecast (Etempvar ?ret'2 _) _))) _) _ =>
       unify ret' ret'2;
       eapply semax_seq';
         [prove_call_setup' ts witness;
          clear_Delta_specs; clear_MORE_POST;
             [ .. | forward_call_id1_x_wow' ]
         |  after_forward_call ]
| |- semax _ _ (Ssequence (Ssequence (Scall (Some ?ret') _ _)
                                       (Sset _ (Etempvar ?ret'2 _))) _) _ =>
       unify ret' ret'2;
       eapply semax_seq';
         [prove_call_setup' ts witness;
          clear_Delta_specs; clear_MORE_POST;
             [ .. | forward_call_id1_y_wow' ]
         |  after_forward_call ]
| |- _ => rewrite <- seq_assoc; fwd_call'_dep ts witness
end.

Ltac fwd_call_dep ts witness :=
 try lazymatch goal with
      | |- semax _ _ (Scall _ _ _) _ => rewrite -> semax_seq_skip
      end;
 repeat lazymatch goal with
  | |- semax _ _ (Ssequence (Ssequence (Ssequence _ _) _) _) _ =>
      rewrite <- seq_assoc
 end;
lazymatch goal with |- @semax ?CS _ ?Delta _ (Ssequence ?C _) _ =>
  lazymatch C with context [Scall _ _ _] =>
         fwd_call'_dep ts witness
    end
end.

Tactic Notation "forward_call_dep" constr(ts) constr(witness) := fwd_call_dep ts witness.

Lemma PROP_into_SEP : forall P Q R, PROPx P (LOCALx Q (SEPx R)) =
  PROPx [] (LOCALx Q (SEPx (!!fold_right and True P && emp :: R))).
Proof.
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec (@pair positive funspec p f)) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec (@pair positive funspec p f))) *)
(* Goal: @eq (option funspec) (@PTree.get funspec (@fst positive funspec a) (@PTree.set funspec p f ((fix make_tycontext_s (G : funspecs) : PTree.tree funspec := match G with | nil => @PTree.Leaf funspec | cons (pair id f as b) r => @PTree.set funspec id f (make_tycontext_s r) end) l))) (@Some funspec (@snd positive funspec a)) *)
  intros; unfold PROPx, LOCALx, SEPx; extensionality; simpl.
  rewrite <- andp_assoc, (andp_comm _ (fold_right_sepcon R)), <- andp_assoc.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite prop_true_andp by auto.
(* Goal: @eq mpred (@andp mpred Nveric (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (local (@fold_right (forall _ : environ, Prop) (forall _ : environ, Prop) (@liftx (Tarrow Prop (Tarrow Prop (LiftEnviron Prop))) and) (@liftx (LiftEnviron Prop) True) (@map localdef (forall _ : environ, Prop) locald_denote Q)) x)) (@andp mpred Nveric (local (@fold_right (forall _ : environ, Prop) (forall _ : environ, Prop) (@liftx (Tarrow Prop (Tarrow Prop (LiftEnviron Prop))) and) (@liftx (LiftEnviron Prop) True) (@map localdef (forall _ : environ, Prop) locald_denote Q)) x) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R))) *)
  rewrite andp_comm; f_equal.
(* Goal: @eq mpred (@andp mpred Nveric (fold_right_sepcon R) (@prop mpred Nveric (@fold_right Prop Prop and True P))) (@sepcon mpred Nveric Sveric (@andp mpred Nveric (@prop mpred Nveric (@fold_right Prop Prop and True P)) (@emp mpred Nveric Sveric)) (fold_right_sepcon R)) *)
  rewrite andp_comm.
(* Goal: call_setup1 cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals *)
(* Goal: and (@eq (_functor (ffunc (fconst environ) fidentity) mpred) (Pre ts witness') (PROPx Ppre (LOCALx Qpre (SEPx Rpre)))) (and (@eq (prod (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals)) (local2ptree Qpre) (@pair (prod (prod (PTree.t val) (PTree.t (prod type val))) (list Prop)) (option globals) (@pair (prod (PTree.t val) (PTree.t (prod type val))) (list Prop) (@pair (PTree.t val) (PTree.t (prod type val)) Qpre_temp (PTree.empty (prod type val))) (@nil Prop)) GV')) (and (@derives (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@andp (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (local (tc_environ Delta)) (PROPx P (LOCALx Q (SEPx R)))) (@prop (forall _ : environ, mpred) (@LiftNatDed' mpred Nveric) (@Forall (prod ident val) (check_one_temp_spec Qactuals) (@PTree.elements val Qpre_temp)))) (and (check_gvars_spec GV GV') (@derives mpred Nveric (fold_right_sepcon R) (@sepcon mpred Nveric Sveric (fold_right_sepcon Rpre) (fold_right_sepcon Frame)))))) *)
  rewrite sepcon_andp_prop', emp_sepcon; auto.
Qed.

Ltac cancel_for_forward_spawn :=
  eapply symbolic_cancel_setup;
   [ construct_fold_right_sepcon
   | construct_fold_right_sepcon
   | fold_abnormal_mpred
   | cbv beta iota delta [before_symbol_cancel]; cancel_for_forward_call].

Ltac forward_spawn id arg wit :=
  match goal with gv : globals |- _ =>
  make_func_ptr id; let f := fresh "f_" in set (f := gv id);
  match goal with |- context[func_ptr' (NDmk_funspec _ _ (val * ?A) ?Pre _) f] =>
    let y := fresh "y" in let Q := fresh "Q" in let R := fresh "R" in
    evar (y : ident); evar (Q : A -> globals); evar (R : A -> val -> mpred);
    replace Pre with (fun '(a, w) => PROPx [] (LOCALx (temp y a :: gvars (Q w) :: nil) (SEPx [R w a])));
    [|let x := fresh "x" in extensionality x; destruct x as (?, x);
      instantiate (1 := fun w a => _ w) in (Value of R);
      repeat (destruct x as (x, ?);
        instantiate (1 := fun '(a, b) => _ a) in (Value of Q);
        instantiate (1 := fun '(a, b) => _ a) in (Value of R));
      etransitivity; [|symmetry; apply PROP_into_SEP]; f_equal; f_equal ; [instantiate (1 := fun _ => _) in (Value of Q); subst y Q; f_equal; simpl; f_equal |
       unfold SEPx; extensionality; simpl; rewrite sepcon_emp; instantiate (1 := fun _ => _); reflexivity]];
  forward_call_dep [A] (f, arg, Q, wit, R); subst Q R; [ .. | subst y f]; try (Exists y; subst y f; simpl; cancel_for_forward_spawn) end end.
