Require Export VST.veric.base.
Local Open Scope pred.
Program Definition kind_at (k: kind) (l: address) : pred rmap :=
fun m => exists rsh, exists sh, exists pp, m @ l = YES rsh sh k pp.
Next Obligation.
try intro; intros.
destruct H0 as [rsh [sh [pp ?]]].
generalize (eq_sym (resource_at_approx a l)); intro.
generalize (age1_resource_at a a'  H l (a@l) H1); intro.
rewrite H0 in H2. simpl in H2. eauto.
Qed.
Definition spec : Type :=  forall (sh: Share.t) (l: AV.address), pred rmap.
Program Definition yesat_raw (pp: preds) (k: kind)
(sh: share) (rsh: readable_share sh) (l: address) : pred rmap :=
fun phi => phi @ l = YES sh rsh k (preds_fmap (approx (level phi)) (approx (level phi)) pp).
Next Obligation.
try intro; intros.
apply (age1_resource_at a a' H l (YES sh rsh k pp) H0).
Qed.
Obligation Tactic := idtac.
Program Definition yesat (pp: preds) (k: kind) : spec :=
fun (sh: share) (l: AV.address) (m: rmap) =>
exists rsh, yesat_raw pp k sh rsh l m.
Next Obligation.
intros; intro; intros.
destruct H0 as [p ?]; exists p.
apply pred_hereditary with a; auto.
Qed.
Program Definition pureat (pp: preds) (k: kind) (l: AV.address): pred rmap :=
fun phi => phi @ l = PURE k (preds_fmap (approx (level phi)) (approx (level phi)) pp).
Next Obligation.
intros; intro; intros.
apply (age1_resource_at a a' H l (PURE k pp) H0).
Qed.
Ltac do_map_arg :=
match goal with |- ?a = ?b =>
match a with context [map ?x _] =>
match b with context [map ?y _] => replace y with x; auto end end end.

(* Specifications: *)
Lemma yesat_raw_eq_aux:
forall pp k rsh sh l,
hereditary age
(fun phi : rmap =>
resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) =
resource_fmap (approx (level phi)) (approx (level phi)) (YES rsh sh k pp)).
Lemma yesat_raw_eq: yesat_raw =
fun pp k rsh sh l =>
((exist (hereditary age)
(fun phi =>
resource_fmap (approx (level phi)) (approx (level phi)) (phi @ l) =
resource_fmap (approx (level phi)) (approx (level phi)) (YES rsh sh k pp))
(yesat_raw_eq_aux pp k rsh sh l)) : pred rmap).
Lemma yesat_eq_aux:
forall pp k sh l,
hereditary age
(fun m : rmap =>
exists rsh,
resource_fmap (approx (level m)) (approx (level m)) (m @ l) =
resource_fmap (approx (level m)) (approx (level m)) (YES sh rsh k pp)).
Lemma yesat_eq: yesat = fun pp k sh l =>
exist (hereditary age)
(fun m =>
exists rsh,
resource_fmap (approx (level m)) (approx (level m)) (m @ l) =
resource_fmap (approx (level m)) (approx (level m)) (YES sh rsh k pp))
(yesat_eq_aux pp k sh l).
Lemma map_compose_approx_succ_e:
forall A n pp pp',
map (compose (A:=A) (approx (S n))) pp =
map (compose (A:=A) (approx (S n))) pp' ->
map (compose (A:=A) (approx n)) pp = map (compose (A:=A) (approx n)) pp'.