(*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.
Fixpoint prog_funct' {F V} (l: list (ident * globdef F V)) : list (ident * F) :=
match l with nil => nil | (i,Gfun f)::r => (i,f):: prog_funct' r | _::r => prog_funct' r
end.
Definition prog_funct {F} (p: program F) := prog_funct' (prog_defs p).
(*Prior to block := Z, the lemma as like this: Lemma find_symbol_add_globals: forall {F V} i g id dl, ~ In i (map fst dl) -> list_norepet (map fst dl) -> (Genv.find_symbol (Genv.add_globals (Genv.empty_genv F V) (dl ++ (i, g) :: nil)) id = Some (1 + Zlength dl) <-> i = id). *)
Instance EqDec_Z : EqDec Z := zeq.
Fixpoint alloc_globals_rev {F V} (ge: Genv.t F V) (m: mem) (vl: list (ident * globdef F V))
{struct vl} : option mem :=
match vl with
| nil => Some m
| v :: vl' =>
match alloc_globals_rev ge m vl' with
| Some m' => Genv.alloc_global ge m' v
| None => None
end
end.
Program Definition set_ghost (m : rmap) (g : ghost) (Hg : _) :=
proj1_sig (make_rmap (resource_at m) g (level m) _ Hg).
Next Obligation.
Fixpoint prog_vars' {F V} (l: list (ident * globdef F V)) : list (ident * globvar V) :=
match l with nil => nil | (i,Gvar v)::r => (i,v):: prog_vars' r | _::r => prog_vars' r
end.
Definition prog_vars {F} (p: program F) := prog_vars' (prog_defs p).
Definition no_locks phi :=
forall addr sh sh' z z' P,
phi @ addr <> YES sh sh' (LK z z') P.
(* How to relate Gamma to funspecs in memory, once we are outside the semax proofs?  We define 'matchfunspecs' which will be satisfied by the initial memory, and preserved under resource_decay / pures_eq / aging. *)
Definition cond_approx_eq n A P1 P2 :=
(forall ts,
fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P1 ts) =
fmap (dependent_type_functor_rec ts (AssertTT A)) (approx n) (approx n) (P2 ts)).

Lemma cond_approx_eq_trans n A P1 P2 P3 :
cond_approx_eq n A P1 P2 ->
cond_approx_eq n A P2 P3 ->
cond_approx_eq n A P1 P3.