(*Require Import VST.concurrency.permjoin.*)
Set Bullet Behavior "Strict Subproofs".
Local Open Scope Z_scope.
Ltac app_pred_unfold :=
match goal with
H : context[app_pred (exist ?F ?f ?p) ?phi] |- _ =>
change (app_pred (exist F f p) phi) with (f phi) in H; cbv beta in H
| |- context[app_pred (exist ?F ?f ?p) ?phi] =>
change (app_pred (exist F f p) phi) with (f phi); cbv beta
end.
(* Lemma writable_unique_right sh : writable_share sh -> forall p, mk_lifted (Share.unrel Share.Rsh sh) p = pfullshare.  Lemma data_at_unfold CS sh b ofs phi length : forall (Hw: writable0_share sh), app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) (Z.of_nat length) noattr) (Vptr b ofs)) phi -> forall loc, if adr_range_dec (b, Ptrofs.intval ofs) (size_chunk Mptr * Z.of_nat length)%Z loc then exists v, phi @ loc = YES sh (writable0_readable Hw) (VAL v) NoneP else identity (phi @ loc).  Lemma data_at_unfold_weak CS sh b ofs phi z z' loc : readable_share sh -> app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) z noattr) (Vptr b ofs)) phi -> adr_range (b, Ptrofs.intval ofs) z' loc -> z' <= size_chunk Mptr * z -> exists p v, phi @ loc = YES sh p (VAL v) NoneP.  Lemma data_at_noghost CS sh b ofs phi : app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) 2 noattr) (Vptr b ofs)) phi -> noghost phi.  Definition rmap_makelock phi phi' loc R length := (level phi = level phi') /\ (forall x, ~ adr_range loc length x -> phi @ x = phi' @ x) /\ (forall x, adr_range loc length x -> exists val sh Psh, phi @ x = YES sh Psh (VAL val) NoneP /\ writable0_share sh /\ phi' @ x = YES sh Psh (LK length (snd x - snd loc)) (pack_res_inv (approx (level phi) R))) /\  (ghost_of phi = ghost_of phi').  (* rmap_freelock phi phi' is ALMOST rmap_makelock phi' phi but we specify that the VAL will be the dry memory's *)
Definition rmap_freelock phi phi' m loc R length :=
(level phi = level phi') /\
(forall x, ~ adr_range loc length x -> phi @ x = phi' @ x) /\
(forall x,
adr_range loc length x ->
exists sh Psh,
phi' @ x = YES sh Psh (VAL (contents_at m x)) NoneP /\
writable0_share sh /\
phi @ x =
YES sh Psh (LK length  (snd x - snd loc)) (pack_res_inv (approx (level phi) R))) /\
(ghost_of phi = ghost_of phi').
Definition makelock_f phi loc R length : address -> resource :=
fun x =>
if adr_range_dec loc length x then
match phi @ x with
| YES sh sh' (VAL _) _ =>
YES sh sh' (LK length (snd x - snd loc)) (pack_res_inv (approx (level phi) R))
| YES _ _ _ _
| PURE _ _
| NO _ _ => NO Share.bot bot_unreadable
end
else
phi @ x.
Definition freelock_f phi m loc length : address -> resource :=
fun x =>
if adr_range_dec loc length x then
match phi @ x with
| YES sh sh' (LK _ _) _ => YES sh sh' (VAL (contents_at m x)) NoneP
| YES _ _ _ _
| PURE _ _
| NO _ _ => NO Share.bot bot_unreadable
end
else
phi @ x.
(*The name is legacy. Comes from the time there was two shares. Then * The contradiction would look like * forall (sh2 sh3:pshares) -> join pfullshare sh2 sh3 -> False. *)
Local Ltac pfulltac := try solve [exfalso; eapply join_writable0_readable; eauto].
(* TODO those definitions are also in sync_preds_defs, see if we can include without changing the dep DAG too badly *)
(* The TT branch of the jam below might seem too weak, but we already keep enough control over joining with other rmaps that it should be enough *)
Definition LKspec_ext (R: pred rmap) lksize : spec :=
fun (sh: Share.t) (l: AV.address)  =>
allp (jam (adr_range_dec l lksize)
(fun l' => yesat (SomeP rmaps.Mpred (fun _ => R)) (LK lksize (snd l' - snd l)) sh l')
(fun _ => TT)).
Definition LK_at R lksize sh :=
LKspec_ext R lksize sh.
Definition pures_same phi1 phi2 := forall loc k pp, phi1 @ loc = PURE k pp <-> phi2 @ loc = PURE k pp.
Definition noyes phi := forall x sh rsh k pp, phi @ x <> YES sh rsh k pp.
Definition getYES_aux (phi : rmap) (loc : address) : resource :=
match phi @ loc with
YES sh Psh k pp => YES (Share.glb Share.Rsh sh) (readable_glb Psh) k pp
| NO sh _ => NO Share.bot bot_unreadable
| PURE k pp => PURE k pp
end.
Definition getNO_aux (phi : rmap) (loc : address) : resource :=
match phi @ loc with
YES sh Psh k pp => NO (Share.glb Share.Lsh sh) (glb_Lsh_unreadable sh)
| NO sh Psh => NO sh Psh
| PURE k pp => PURE k pp
end.
Program Definition getYES (phi : rmap) := proj1_sig (make_rmap (getYES_aux phi) (ghost_of phi) (level phi) _ _).
Next Obligation.
pose proof resource_at_approx phi as V.
extensionality l. specialize (V l).
unfold getYES_aux, "oo" in *.
destruct (phi @ _); simpl in *; auto.
congruence.
Qed.
Next Obligation.
apply ghost_of_approx.
Qed.
Program Definition getNO (phi : rmap) := proj1_sig (make_rmap (getNO_aux phi) (core (ghost_of phi)) (level phi) _ _).
Next Obligation.
pose proof resource_at_approx phi as V.
extensionality l. specialize (V l).
unfold getNO_aux, "oo" in *.
destruct (phi @ _); simpl in *; auto.
Qed.
Next Obligation.
rewrite ghost_core; auto.
Qed.

Lemma getYES_getNO_join phi : join (getYES phi) (getNO phi) phi.