(*Require Import VST.veric.Clight_new.*)
Set Bullet Behavior "Strict Subproofs".
(* Variables to be instantiated once the program is known. *)
Definition _f := 1%positive.      (* alpha-convertible *)
Definition _args := 2%positive.   (* alpha-convertible *)
Definition _lock := 1%positive.   (* alpha-convertible *)
Definition _cond := 2%positive.   (* alpha-convertible *)
(*Definition _lock_t := 2%positive. (* 2 (* or sometimes 3 -WM *) is the number given by clightgen when threads.h is included first *)*)
Definition voidstar_funtype := Tfunction (Tcons (tptr tvoid) Tnil) (tptr tvoid) cc_default.
(* Definition tlock := Tstruct _lock_t noattr. *)
Definition tlock := (Tarray (Tpointer Tvoid noattr) 2 noattr).
(* Notation tlock := tuint (only parsing). *)
Goal forall (cenv: composite_env), @sizeof cenv tlock = LKSIZE.
(* In fact we need locks to two resources: 1) the resource invariant, for passing the resources 2) the join resource invariant, for returning all resources, including itself for this we need to define them in a mutually recursive fashion: *)
Definition res_invariants_fun Q sh1 p1 sh2 p2 : (bool -> mpred) -> (bool -> mpred) :=
fun R b =>
if b then
(Q * lock_inv sh2 p2 (|> R false))%logic
else
(Q * lock_inv sh1 p1 (|> R true) * lock_inv sh2 p2 (|> R false))%logic.
Definition res_invariants Q sh1 p1 sh2 p2 : bool -> mpred := HORec (res_invariants_fun Q sh1 p1 sh2 p2).
Definition res_invariant Q sh1 p1 sh2 p2 : mpred := res_invariants Q sh1 p1 sh2 p2 true.
Definition join_res_invariant Q sh1 p1 sh2 p2 : mpred := res_invariants Q sh1 p1 sh2 p2 false.
(* Condition variables *)
(*Definition _cond_t := 4%positive.*)
Definition tcond := tint.
(* Does this need to be anything special? *)
Definition cond_var {cs} sh v := @data_at_ cs sh tcond v.
(*+ Specification of each concurrent primitive *)
(* Lemma nonexpansive_2super_non_expansive: forall {A B: Type} (F: (A -> B -> mpred) -> mpred), (forall a b, nonexpansive (fun Q => F P Q)) -> (forall Q, nonexpansive (fun P => F P Q)) -> forall P Q n, approx n (F P Q) = approx n (F (approx n P) (approx n Q)). *)
Definition acquire_arg_type: rmaps.TypeTree := rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred.
Definition acquire_pre: val * share * mpred -> environ -> mpred :=
fun args =>
match args with
| (v, sh, R) =>
PROP (readable_share sh)
LOCAL (temp _lock v)
SEP (lock_inv sh v R)
end.
Notation acquire_post :=
(fun args =>
match args with
| (v, sh, R) =>
PROP ()
LOCAL ()
SEP (lock_inv sh v R; R)
end).
Definition acquire_spec: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
acquire_arg_type
(fun _ => acquire_pre)
(fun _ => acquire_post)
NP_acquire_pre
NP_acquire_post
.
Definition release_arg_type: rmaps.TypeTree := rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred.
Definition release_pre: val * share * mpred -> environ -> mpred :=
fun args =>
match args with
| (v, sh, R) =>
PROP (readable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)
end.
Notation release_post :=
(fun args =>
match args with
| (v, sh, R) =>
PROP ()
LOCAL ()
SEP (lock_inv sh v R)
end).
Definition release_spec: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
release_arg_type
(fun _ => release_pre)
(fun _ => release_post)
NP_release_pre
NP_release_post
.
Program Definition makelock_spec cs: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred)
(fun _ x =>
match x with
| (v, sh, R) =>
PROP (writable_share sh)
LOCAL (temp _lock v)
SEP (@data_at_ cs sh tlock v)
end)
(fun _ x =>
match x with
| (v, sh, R) =>
PROP ()
LOCAL ()
SEP (lock_inv sh v R)
end)
_
_
.
Next Obligation.
intros cs; hnf.
intros.
destruct x as [[v sh] R]; simpl in *.
auto.
Qed.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[v sh] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP ()  LOCAL ()  SEP (lock_inv sh v R)) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
nil
nil
((fun R => lock_inv sh v R) :: nil));
repeat apply Forall_cons; try apply Forall_nil.
apply nonexpansive_lock_inv.
Qed.
Program Definition freelock_spec cs: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred)
(fun _ x =>
match x with
| (v, sh, R) =>
PROP (writable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && emp; lock_inv sh v R; R)
end)
(fun _ x =>
match x with
| (v, sh, R) =>
PROP ()
LOCAL ()
SEP (@data_at_ cs sh tlock v; R)
end)
_
_
.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[v sh] R]; simpl in *.
Admitted. (* super_non_expansive obligation of freelock_spec' *)
(* apply (nonexpansive_super_non_expansive (fun R => (PROP (writable_share sh) LOCAL (temp _lock v) SEP (weak_positive_mpred R && emp; lock_inv sh v R; R)) rho)). apply (PROP_LOCAL_SEP_nonexpansive ((fun _ => writable_share sh) :: nil) (temp _lock v :: nil) ((fun R => weak_positive_mpred R && emp)%logic :: (fun R => lock_inv sh v R) :: (fun R => R) :: nil)); repeat apply Forall_cons; try apply Forall_nil. + apply const_nonexpansive. + apply (conj_nonexpansive weak_positive_mpred). - apply positive_mpred_nonexpansive. - apply const_nonexpansive. + apply nonexpansive_lock_inv. + apply identity_nonexpansive. Qed. *)
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[v sh] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP ()  LOCAL ()  SEP (data_at_ sh tlock v; R)) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
nil
nil
((fun _ => data_at_ sh tlock v) :: (fun R => R) :: nil));
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply identity_nonexpansive.
Qed.
(* versions that give away all their resources *)

Lemma selflock_rec : forall sh v R, rec_inv sh v R (selflock R sh v).