(*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.

Lemma lock_inv_rmap_freelock CS sh b ofs R phi m :
(align_chunk Mptr | Ptrofs.unsigned ofs) ->
Ptrofs.unsigned ofs + LKSIZE < Ptrofs.modulus ->
writable0_share sh ->
app_pred (@lock_inv sh (Vptr b ofs) R) phi ->
exists phi',
rmap_freelock phi phi' m (b, Ptrofs.unsigned ofs) R LKSIZE /\
app_pred (@data_at_ CS sh (Tarray (Tpointer Tvoid noattr) (LKSIZE/size_chunk Mptr) noattr) (Vptr b ofs)) phi'.