(*Clight-specific: Require Import VST.veric.extend_tc. Require Import VST.veric.Clight_seplog. Require Import VST.veric.Clight_assert_lemmas. Require Import VST.veric.tycontext. Require Import VST.veric.expr2. Require Import VST.veric.expr_lemmas. *)
Local Open Scope pred.
Obligation Tactic := idtac.
Ltac destruct_cjoin phi HH :=
match goal with
|   |- context [@proj1_sig rmap _ ?X] => destruct X as [phi HH]; simpl
|  H: context [@proj1_sig rmap _ ?X] |- _ => destruct X as [phi HH]; simpl in H
end.
(* b > 0 -> *)
(*Lemma mem_alloc_juicy: forall m lo hi m' b, Mem.alloc m lo hi = (m',b) -> forall w P IOK IOK', (app_pred P (m_phi (initial_mem m w IOK))) -> (app_pred (P * VALspec_range (hi-lo) Share.top (b,lo)) (m_phi (initial_mem m' w IOK'))).  Lemma fold_right_rev_left: forall (A B: Type) (f: A -> B -> A) (l: list B) (i: A), fold_left f l i = fold_right (fun x y => f y x) i (rev l).  Definition initblocksize (V: Type)  (a: ident * globvar V)  : (ident * Z) := match a with (id,l) => (id , init_data_list_size (gvar_init l)) end.  Lemma initblocksize_name: forall V a id n, initblocksize V a = (id,n) -> fst a = id.  Lemma find_id_i {A}: forall id fs G, In (id,fs) G -> list_norepet (map (@fst _ _) G) -> @find_id A id G = Some fs.  Lemma find_id_e {A}: forall id G fs, @find_id A id G = Some fs -> In (id,fs) G.  Lemma find_id_In_map_fst {A} i t: forall V (Hi: @find_id A i V = Some t), In i (map fst V).  Lemma find_id_app {A} i fs: forall G1 G2 (G: find_id i (G1 ++ G2) = Some fs), @find_id A i G1 = Some fs \/ find_id i G2 = Some fs.  Lemma find_id_app1 {A} i x G2: forall G1, find_id i G1 = Some x -> @find_id A i (G1++G2) = Some x.  Lemma find_id_app2 {A} i x G2: forall G1, list_norepet (map fst (G1++G2)) -> find_id i G2 = Some x -> @find_id A i (G1++G2) = Some x.  Definition initial_core' {F} (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat) (loc: address) : resource := if Z.eq_dec (snd loc) 0 then match Genv.invert_symbol ge (fst loc) with | Some id => match find_id id G with | Some (mk_funspec fsig cc A P Q _ _) => PURE (FUN fsig cc) (SomeP (SpecTT A) (fun ts => fmap _ (approx n) (approx n) (packPQ P Q ts))) | None => NO Share.bot bot_unreadable end | None => NO Share.bot bot_unreadable end else NO Share.bot bot_unreadable.  (* This version starts with an empty ghost. *)
Program Definition initial_core {F} (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat): rmap :=
proj1_sig (make_rmap (initial_core' ge G n) nil n _ eq_refl).
Next Obligation.
intros.
extensionality loc; unfold compose, initial_core'.
if_tac; [ | simpl; auto].
destruct (Genv.invert_symbol ge (fst loc)); [ | simpl; auto].
destruct (find_id i G); [ | simpl; auto].
destruct f.
unfold resource_fmap.
f_equal.
simpl.
f_equal.
change R.approx with approx.
extensionality i0 ts b rho.
rewrite fmap_app.
pattern (approx n) at 7 8 9.
rewrite <- approx_oo_approx.
auto.
Qed.
(* We can also start with knowledge of the external state. Requirements for this PCM: 1. It must not allow the holding thread to change the value. 2. It must allow the holding thread to know the value. 3. The holding thread must be able to synchronize with the outside world to change the value. For this purpose, we use the reference PCM. *)
Program Definition initial_core_ext {F Z} (ora : Z) (ge: Genv.t (fundef F) type) (G: funspecs) (n: nat): rmap :=
proj1_sig (make_rmap (initial_core' ge G n) (Some (ext_ghost ora, NoneP) :: nil) n _ eq_refl).
Next Obligation.
intros.
extensionality loc; unfold compose, initial_core'.
if_tac; [ | simpl; auto].
destruct (Genv.invert_symbol ge (fst loc)); [ | simpl; auto].
destruct (find_id i G); [ | simpl; auto].
destruct f.
unfold resource_fmap.
f_equal.
simpl.
f_equal.
change R.approx with approx.
extensionality i0 ts b rho.
rewrite fmap_app.
pattern (approx n) at 7 8 9.
rewrite <- approx_oo_approx.
auto.
Qed.
Open Scope pred.

Lemma writable_blocks_app:
forall bl bl' rho, writable_blocks (bl++bl') rho = writable_blocks bl rho * writable_blocks bl' rho.