Module R := R.
Hint Resolve (@subp_sepcon _ Join_rmap Perm_rmap Sep_rmap): contractive.
unfold identity_rmap; intros.
rewrite R.unsquash_squash.
simpl.
apply extensionality; intro l.
unfold compose; simpl; auto.
Qed.
(* Lemma make_simple_rmap: forall n (f: AV.address -> resource) , AV.valid (fun l => res_option (f l)) -> (forall l, match f l with YES _ _ (SomeP _ _) => False | _ => True end) -> exists phi:rmap, level phi = n /\ resource_at phi = f. *)
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.
Implicit Arguments resource_at_empty.
Ltac inj_pair_tac :=
match goal with H: (@existT ?U ?P ?p ?x = @existT _ _ _ ?y) |- _ =>
generalize (@inj_pair2 U P p x y H); clear H; intro; try (subst x || subst y)
end.
Definition no_preds (r: resource) :=
match r with NO => True | YES _ _ pp => pp=NoneP | PURE _ pp => pp=NoneP end.
Ltac inv H := (apply join_YES_pfullshare1 in H || apply join_YES_pfullshare2 in H || idtac);
(inversion H; clear H; subst).
Definition empty_rmap' : rmap'.
set (f:= fun _: AV.address => NO).
assert (R.valid f).
red; unfold f; simpl.
apply AV.valid_empty.
exact (exist _ f H).
Defined.
Definition empty_rmap (n:nat) : rmap := R.squash (n, empty_rmap').
refine (fun f V lev H => match proj2_sig (make_rmap f V lev H) with
| conj _ RESOURCE_AT => RESOURCE_AT
end).
Qed.
refine (fun f V lev H => match proj2_sig (make_rmap f V lev H) with
| conj LEVEL _ => LEVEL
end).
Qed.
Instance Join_trace : Join (AV.address -> option (pshare * AV.kind)) :=
(Join_fun AV.address (option (pshare * AV.kind))
(Join_lower (Join_prod pshare Join_pshare AV.kind (Join_equiv AV.kind)))).
Definition fixup_trace (trace: AV.address -> option (pshare * AV.kind))
(f: AV.address -> resource) : AV.address -> resource :=
fun x => match trace x, f x with
| None, PURE k pp => PURE k pp
| Some(sh,k), PURE _ pp => YES sh k pp
| Some (sh,k), YES _ _ pp => YES sh k pp
| Some (sh, k), NO => YES sh k NoneP
| None, _ => NO
end.
Ltac crtac :=
repeat  (solve [constructor; auto] ||
match goal with
| H: None = res_option ?A |- _ => destruct A; inv H
| H: Some _ = res_option ?A |- _ => destruct A; inv H
| H: join NO _ _ |- _ => inv H
| H: join _ NO _ |- _ => inv H
| H: join (YES _ _ _) _ _ |- _ => inv H
| H: join _ (YES _ _ _) _ |- _ => inv H
| H: join (PURE _ _) _ _ |- _ => inv H
| H: join _ (PURE _ _) _ |- _ => inv H
| H: @join _ _ (Some _) _ _ |- _ => inv H
| H: @join _ _ _ (Some _) _ |- _ => inv H
| H: @join _ _ None _ _ |- _ =>
apply join_unit1_e in H; [| apply None_identity]
| H: @join _ _ _ None _ |- _ =>
apply join_unit2_e in H; [| apply None_identity]
| H:  prod pshare AV.kind |- _ => destruct H
| H: @join _ (Join_equiv _) ?a ?b ?c |- _ => destruct H; try subst a; try subst b; try subst c
| H: @join _ (Join_prod _ _ _ _) (_,_) (_,_) (_,_) |- _ => destruct H; simpl fst in *; simpl snd in *
end; auto).
Instance Cross_rmap:
@Cross_alg _ (Join_prop _ Join_trace AV.valid) ->
Cross_alg rmap.

Lemma YES_inj: forall sh k pp sh' k' pp',
YES sh k pp = YES sh' k' pp' ->
sh=sh' /\ k=k' /\ pp=pp'.