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 resource_fmap_core:
forall w loc, resource_fmap (approx (level w)) (approx (level w)) (core (w @ loc)) = core (w @ loc).