Module RML := Rmaps_Lemmas R.
Export RML. Export R.
Instance Cross_rmap : Cross_alg rmap := Cross_rmap_simple (fun _ => I).
Obligation Tactic := idtac.
(******  MAPSTO AND RELATED OPERATORS *****)
Program Definition mapsto (v1 v2: adr) : pred rmap :=
fun w => forall i,
if eq_dec i v1 then w @ i = YES pfullshare (VAL v2) NoneP else identity (w @ i).
Next Obligation.
intros. intros ? ? ? ?.
intro i; specialize (H0 i).
destruct (eq_dec i v1).
apply (age1_YES _ _ _ _ _ H); auto.
destruct (identity_resource (a @ i)) as [? _]. specialize (H1 H0).
apply identity_resource.
generalize (age1_resource_at _ _ H i (a @ i)); intro.
generalize (resource_at_approx a i); intro.
destruct (a @ i); try contradiction.
rewrite H2; simpl in *; auto.
rewrite H2; simpl in *; auto.
Qed.
Definition singleton_rmap  (v v': adr) (m: rmap) : rmap :=
proj1_sig
(make_rmap (fun i => if eq_dec i v then YES pfullshare (VAL v') NoneP  else core m @ i )
I (level m) (singleton_rmap_OK _ _ m)).
Local Open Scope pred.
Definition assert := env -> pred rmap.
Bind Scope pred with assert.
(****** PROGRAM SAFETY AS A SEPARATION-LOGIC PREDICATE *)
Program Definition cohere (concrete: heap) : pred rmap :=
fun w =>
forall p v, heap_get (concrete) p = Some v  <->
w @ p = YES pfullshare (VAL v) NoneP.
Next Obligation.
unfold hereditary; intros.
rewrite H0.
apply age1_YES; auto.
Qed.
Program Definition assert_safe
(p: program) (vars: varset) (ctl: control) : assert :=
fun s w => forall s' h, varcompat vars s' ->
locals2env s' = s -> cohere h w -> safeN p (s',h,ctl) (level w).
Next Obligation.
unfold hereditary; intros.
eapply safeN_less; [ | apply H0]; auto. subst.
apply age_level in H.   rewrite H. change R.rmap with rmap. omega.
clear - H H3. hnf in H3|-*. intros. rewrite H3.
generalize (age1_YES _ _ p pfullshare (VAL v) H); intros.
intuition.
Qed.
(******* FUNASSERT, MAKE_WORLD ********************)
Definition funspec := (list var * assert)%type.
Definition funspecs := table adr funspec.
Definition unpack (P: list adr -> pred rmap) (vl: listprod (@cons Type (list adr) nil)):  pred rmap := P (fst vl).
Definition call (P: list var * assert) (vl: list adr) : pred rmap :=
(!! (length vl = length (fst P)) && snd P (arguments (fst P) vl)).
Program Definition cont (nP: funspec)  (v: adr) : pred rmap :=
fun w => w @ v = PURE (FUN (fst nP)) (preds_fmap (approx (level w)) (SomeP (list adr::nil)
(unpack (call nP)))).
Next Obligation.
intros; intro; intros.
apply (age1_resource_at a a' H v (PURE (FUN (fst nP)) _));   simpl; auto.
Qed.
Definition funassert (G: funspecs) : pred rmap :=
(ALL  i:_, ALL P:_,  !! (table_get G i = Some P) --> cont P i)  &&
(ALL  i:_, ALL P:_,  cont P i --> !! exists P', table_get G i = Some P').
Definition make_world_aux (G: funspecs) (h: heap) (n: nat) (a: adr) : resource :=
match table_get G a with
| Some P => PURE (FUN (fst P))
(preds_fmap (approx n)
(SomeP (@cons Type (list adr) nil) (unpack (call P))))
| None => match heap_get h a with
| Some v => YES pfullshare (VAL v) NoneP
| None => NO
end
end.
Definition make_world (G: funspecs) (h: heap) (n: nat) : rmap :=
proj1_sig (make_rmap (make_world_aux G h n) I n (make_world_aux_OK _ _ _)).
Inductive match_specs: forall (p: program) (G: funspecs), Prop :=
| match_specs_nil: match_specs nil nil
| match_specs_cons: forall i vars f p' P G',
not (In i (map (@fst _ _) p')) ->
match_specs p' G' ->
typecheck vars f = true ->
match_specs ((i,(vars,f))::p') ((i,P)::G').
(**************** ALLOCPOOL ***************************)
Program Definition allocpool (b: adr) : pred rmap :=
fun w => b>0 /\ forall i, if lt_dec i b then identity (w @ i) else w @ i = YES pfullshare (VAL 0) NoneP.
Next Obligation.
intros. intro; intros.
destruct H0; split; auto.
intro i; specialize (H1 i).
destruct (lt_dec i b).
eapply age1_resource_at_identity; eauto.
apply (age1_YES _ _ _ _ _ H); auto.
Qed.

Lemma allocpool_make_world: forall p G n,
match_specs p G ->
app_pred (allocpool (boundary p)) (make_world G (initial_heap p) n).