Module R := R0.
Hint Resolve (@subp_sepcon _ Join_rmap Perm_rmap Sep_rmap): contractive.
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.
Arguments resource_at_empty [phi] _ _.
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.
Definition empty_rmap' : rmap' :=
((fun _: AV.address => NO Share.bot bot_unreadable), nil).
Definition empty_rmap (n:nat) : rmap := R.squash (n, empty_rmap').
refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
| conj _ (conj RESOURCE_AT _) => RESOURCE_AT
end).
Qed.
refine (fun f g lev H Hg => match proj2_sig (make_rmap f g lev H Hg) with
| conj LEVEL _ => LEVEL
end).
Qed.
Instance Join_trace : Join (AV.address -> option (rshare * AV.kind)) :=
(Join_fun AV.address (option (rshare * AV.kind))
(Join_lower (Join_prod rshare Join_rshare AV.kind (Join_equiv AV.kind)))).
Ltac uniq_assert name P :=
lazymatch goal with H: P |- _ => fail
| _ => let H1 := fresh "H" name in assert (H1:P) end.
Ltac readable_unreadable_join_prover :=
repeat match goal with
| H: join ?A ?B ?C, H1: ~readable_share ?C |- _ =>
uniq_assert A (~readable_share A);
[ clear - H H1; contradict H1; eapply join_readable1; eauto; fail | ]
| H: join ?A ?B ?C, H1: ~readable_share ?C |- _ =>
uniq_assert B (~readable_share B);
[ clear - H H1; contradict H1; eapply join_readable2; eauto; fail | ]
| H: join ?A ?B ?C, H0: ~readable_share ?B, H1: readable_share ?C |- _ =>
(uniq_assert A (readable_share A);
[ clear - H H0 H1; destruct (readable_share_dec A);
[solve [auto]
|eapply join_unreadable_shares in H; eauto; solve [contradiction]] | ])
| H: join ?A ?B ?C, H0: ~readable_share ?A, H1: readable_share ?C |- _ =>
(uniq_assert B (readable_share B);
[ clear - H H0 H1; destruct (readable_share_dec B);
[solve [auto]
| apply join_comm in H;
eapply join_unreadable_shares in H; eauto; solve [contradiction]] | ])
end.
(*Lemma Cross_resource: Cross_alg resource.  Definition res_retain (r: resource) : Share.t := match r with | NO sh _ => retainer_part sh | YES sh _ _ _ => retainer_part sh | PURE _ _ => Share.bot end.  Lemma fixup_trace_readable: forall a (b: rshare), readable_share (Share.lub (Share.glb Share.Lsh a) (Share.glb Share.Rsh (proj1_sig b))).  (*Definition fixup_trace (retain: AV.address -> Share.t) (trace: AV.address -> option (rshare * AV.kind)) (gtrace: AV.address -> option M) (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 _ (fixup_trace_readable (retain x) sh) k pp | Some (sh,k), YES _ _ _ pp => YES _ (fixup_trace_readable (retain x) sh) k pp | Some (sh, k), NO _ _ => YES _ (fixup_trace_readable (retain x) sh) k NoneP | None, _ => NO _ (@retainer_part_nonreadable (retain x)) end.   Definition fixup_trace_ok (tr: AV.address -> option (rshare * AV.kind)) := forall x, match tr x with None => True | Some(sh,_)=> Share.glb Share.Rsh (proj1_sig sh) = (proj1_sig sh) end.  Lemma fixup_trace_valid: forall retain tr (trace_ok: fixup_trace_ok tr) f, AV.valid tr -> AV.valid (res_option oo (fixup_trace retain tr f)).  Lemma fixup_trace_rmap: forall (retain: AV.address -> Share.t) (tr: sig AV.valid) (trace_ok: fixup_trace_ok (proj1_sig tr)) (f: rmap), {phi: rmap | level phi = level f /\ resource_at phi = fixup_trace retain (proj1_sig tr) (resource_at f)}.  Lemma join_res_retain: forall a b c: rmap , join a b c -> join (res_retain oo resource_at a) (res_retain oo resource_at b) (res_retain oo resource_at c).  Lemma join_fixup_trace_ok: forall (v w: sig AV.valid) a, join v w (exist AV.valid (res_option oo resource_at a) (rmap_valid a)) -> fixup_trace_ok (proj1_sig v).  Instance Perm_foo: Perm_alg {x : AV.address -> option (rshare * AV.kind) | AV.valid x}.  Ltac crtac' := repeat  (simpl in *; ((*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 _ _ |- _ =>  inv H
| H: join _ None _ |- _ => inv H
end; auto)).

Lemma core_PURE: forall k pp, core (PURE k pp) = PURE k pp.