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)).

(* Specifications: *)
Lemma join_fixup_trace:
forall (Rc Rd: AV.address -> Share.t)
(c d: AV.address -> option (rshare * AV.kind))
(z a: rmap) (l: AV.address),
join_sub (a @ l) (z @ l) ->
join (Rc l) (Rd l) (res_retain (a @ l)) ->
@join (option (rshare * AV.kind))
(@Join_lower (rshare * AV.kind)
(Join_prod rshare Join_rshare AV.kind
(Join_equiv AV.kind)))
(c l) (d l) (res_option (a @ l)) ->
join (fixup_trace Rc c (resource_at z) l) (fixup_trace Rd d (resource_at z) l) (a @ l).
Lemma identity_resource: forall r: resource, identity r <->
match r with YES _ _ _ _ => False | NO sh rsh => identity sh | PURE _ _ => True end.
Lemma resource_at_core_identity:  forall m i, identity (core m @ i).
Lemma YES_inj: forall sh rsh k pp sh' rsh' k' pp',
YES sh rsh k pp = YES sh' rsh' k' pp' ->
(sh,k,pp) = (sh',k',pp').
Lemma PURE_inj: forall T x x' y y', PURE x (SomeP T y) = PURE x' (SomeP T y') -> x=x' /\ y=y'.
Lemma core_resource_at: forall w i, core (w @ i) = core w @ i.
Lemma core_ghost_of: forall w, core (ghost_of w) = ghost_of (core w).
Lemma ghost_of_core_identity: forall m, identity (ghost_of (core m)).
Lemma resource_at_identity: forall (m: rmap) (loc: AV.address),
identity m -> identity (m @ loc).
Lemma ghost_of_identity: forall (m : rmap),
identity m -> identity (ghost_of m).
Lemma core_YES: forall sh rsh k pp, core (YES sh rsh k pp) = NO Share.bot bot_unreadable.
Lemma core_NO: forall sh nsh, core (NO sh nsh) = NO Share.bot bot_unreadable.
Lemma core_PURE: forall k pp, core (PURE k pp) = PURE k pp.
Lemma core_not_YES: forall {w loc rsh sh k pp},
core w @ loc = YES rsh sh k pp -> False.
Lemma resource_at_empty2:
forall phi: rmap, (forall l, identity (phi @ l)) -> identity (ghost_of phi) -> identity phi.
Lemma resource_fmap_core:
forall w loc, resource_fmap (approx (level w)) (approx (level w)) (core (w @ loc)) = core (w @ loc).