(*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 *)
Program Definition freelock2_spec cs: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * share * share)) rmaps.Mpred) rmaps.Mpred)
(fun _ x =>
match x with
| (v, sh, sh', Q, R) =>
PROP (writable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp; lock_inv sh v R)
end)
(fun _ x =>
match x with
| (v, sh, sh', Q, R) =>
PROP ()
LOCAL ()
SEP (@data_at_ cs sh tlock v)
end)
_
_
.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[[[v sh] sh'] Q] R]; simpl in *.
apply (nonexpansive2_super_non_expansive
(fun Q R => (PROP (writable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp; lock_inv sh v R)) rho));
[ clear Q R; intros Q;
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => writable_share sh) :: nil)
(temp _lock v :: nil)
((fun R => weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp)%logic :: (fun R => lock_inv sh v R) :: nil))
| clear Q R; intros R;
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => writable_share sh) :: nil)
(temp _lock v :: nil)
((fun Q => weak_exclusive_mpred R && weak_rec_inv sh' v Q R && emp)%logic :: (fun _ => lock_inv sh v R) :: nil))];
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply (conj_nonexpansive (fun R => weak_exclusive_mpred R && weak_rec_inv sh' v Q R)%logic); [apply (conj_nonexpansive weak_exclusive_mpred) |].
- apply exclusive_mpred_nonexpansive.
- apply rec_inv1_nonexpansive.
- apply const_nonexpansive.
+ apply nonexpansive_lock_inv.
+ apply const_nonexpansive.
+ apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R && weak_rec_inv sh' v Q R)%logic); [apply (conj_nonexpansive (fun _ => weak_exclusive_mpred R)) |].
- apply const_nonexpansive.
- apply rec_inv2_nonexpansive.
- apply const_nonexpansive.
+ apply const_nonexpansive.
Qed.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[[[v sh] sh'] Q] R]; simpl in *.
auto.
Qed.
Program Definition release2_spec: funspec := mk_funspec
((_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * share)) rmaps.Mpred) rmaps.Mpred)
(fun _ x =>
match x with
| (v, sh, Q, R) =>
PROP (readable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp; R)
end)
(fun _ x =>
match x with
| (v, sh, Q, R) =>
PROP ()
LOCAL ()
SEP (emp)
end)
_
_
.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[[v sh] Q] R]; simpl in *.
apply (nonexpansive2_super_non_expansive
(fun Q R => (PROP (readable_share sh)
LOCAL (temp _lock v)
SEP (weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp; R)) rho));
[ clear Q R; intros Q;
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => readable_share sh) :: nil)
(temp _lock v :: nil)
((fun R => weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp)%logic :: (fun R => R) :: nil))
| clear Q R; intros R;
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => readable_share sh) :: nil)
(temp _lock v :: nil)
((fun Q => weak_exclusive_mpred R && weak_rec_inv sh v Q R && emp)%logic :: (fun _ => R) :: nil))];
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply (conj_nonexpansive (fun R => weak_exclusive_mpred R && weak_rec_inv sh v Q R)%logic); [apply (conj_nonexpansive (fun R => weak_exclusive_mpred R)%logic) |].
- apply exclusive_mpred_nonexpansive.
- apply rec_inv1_nonexpansive.
- apply const_nonexpansive.
+ apply identity_nonexpansive.
+ apply const_nonexpansive.
+ apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R && weak_rec_inv sh v Q R)%logic); [apply (conj_nonexpansive (fun Q => weak_exclusive_mpred R)%logic) |].
- apply const_nonexpansive.
- apply rec_inv2_nonexpansive.
- apply const_nonexpansive.
+ apply const_nonexpansive.
Qed.
Next Obligation.
intro cs; hnf.
intros.
destruct x as [[[v sh] Q] R]; simpl in *.
auto.
Qed.
(* condition variables *)
Definition makecond_spec cs :=
WITH v : val, sh : share
PRE [ _cond OF tptr tcond ]
PROP (writable_share sh)
LOCAL (temp _cond v)
SEP (@data_at_ cs sh tcond v)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (cond_var sh v).
Definition freecond_spec cs :=
WITH v : val, sh : share
PRE [ _cond OF tptr tcond ]
PROP (writable_share sh)
LOCAL (temp _cond v)
SEP (@cond_var cs sh v)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (@data_at_ cs sh tcond v).
Program Definition wait_spec cs: funspec := mk_funspec
((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
(fun _ x =>
match x with
| (c, l, shc, shl, R) =>
PROP (readable_share shc)
LOCAL (temp _cond c; temp _lock l)
SEP (@cond_var cs shc c; lock_inv shl l R; R)
end)
(fun _ x =>
match x with
| (c, l, shc, shl, R) =>
PROP ()
LOCAL ()
SEP (cond_var shc c; lock_inv shl l R; R)
end)
_
_
.
Next Obligation.
intros cs; hnf.
intros.
destruct x as [[[[c l] shc] shl] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP (readable_share shc)
LOCAL (temp _cond c; temp _lock l)
SEP (cond_var shc c; lock_inv shl l R; R)) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => readable_share shc) :: nil)
(temp _cond c :: temp _lock l :: nil)
((fun R => cond_var shc c) :: (fun R => lock_inv shl l R) :: (fun R => R) :: nil));
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply const_nonexpansive.
+ apply nonexpansive_lock_inv.
+ apply identity_nonexpansive.
Qed.
Next Obligation.
intros cs; hnf.
intros.
destruct x as [[[[c l] shc] shl] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP ()
LOCAL ()
SEP (cond_var shc c; lock_inv shl l R; R)) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
nil
nil
((fun R => cond_var shc c) :: (fun R => lock_inv shl l R) :: (fun R => R) :: nil));
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply nonexpansive_lock_inv.
+ apply identity_nonexpansive.
Qed.
Program Definition wait2_spec cs: funspec := mk_funspec
((_cond OF tptr tcond)%formals :: (_lock OF tptr Tvoid)%formals :: nil, tvoid)
cc_default
(rmaps.ProdType (rmaps.ConstType (val * val * share * share)) rmaps.Mpred)
(fun _ x =>
match x with
| (c, l, shc, shl, R) =>
PROP (readable_share shc)
LOCAL (temp _cond c; temp _lock l)
SEP (lock_inv shl l R; R && (@cond_var cs shc c * TT))
end)
(fun _ x =>
match x with
| (c, l, shc, shl, R) =>
PROP ()
LOCAL ()
SEP (lock_inv shl l R; R)
end)
_
_
.
Next Obligation.
intros cs; hnf.
intros.
destruct x as [[[[c l] shc] shl] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP (readable_share shc)
LOCAL (temp _cond c; temp _lock l)
SEP (lock_inv shl l R; R && (@cond_var cs shc c * TT))) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
((fun _ => readable_share shc) :: nil)
(temp _cond c :: temp _lock l :: nil)
((fun R => lock_inv shl l R) :: (fun R => R && (@cond_var cs shc c * TT))%logic :: nil));
repeat apply Forall_cons; try apply Forall_nil.
+ apply const_nonexpansive.
+ apply nonexpansive_lock_inv.
+ apply (conj_nonexpansive (fun R => R) (fun _ => (cond_var shc c * TT)%logic)).
- apply identity_nonexpansive.
- apply const_nonexpansive.
Qed.
Next Obligation.
intros cs; hnf.
intros.
destruct x as [[[[c l] shc] shl] R]; simpl in *.
apply (nonexpansive_super_non_expansive
(fun R => (PROP ()
LOCAL ()
SEP (lock_inv shl l R; R)) rho)).
apply (PROP_LOCAL_SEP_nonexpansive
nil
nil
((fun R => lock_inv shl l R) :: (fun R => R) :: nil));
repeat apply Forall_cons; try apply Forall_nil.
+ apply nonexpansive_lock_inv.
+ apply identity_nonexpansive.
Qed.
Definition signal_spec cs :=
WITH c : val, shc : share
PRE [ _cond OF tptr tcond ]
PROP (readable_share shc)
LOCAL (temp _cond c)
SEP (@cond_var cs shc c)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (@cond_var cs shc c).
(* Notes about spawn_thread:  The spawned function has for argument name [_y], which is existentially quantified.  The function also can use a list of global variables [globals].  For now, the specification of the spawned function has to be exactly of the form that you can see below (inside the "match ..."). Cao Qinxiang is working on a notion of sub-specification that might enable us to have smoother specifications.  The postcondition might not be emp, so we have potential memory leaks when a thread exists (those maps are still handled by the concurrent machine).  To enable joinable threads, the postcondition would be [tptr tthread] with a type [tthread] related to the postcondition through a [thread] predicate in the logic.  The [join] would then also be implemented using the oracle, as [acquire] is.  The postcondition would be [match PrePost with existT ty (w, pre, post) => thread th (post w b) end] *)
Local Open Scope logic.
(* @Qinxiang: it would be great to complete the annotation *)
Definition spawn_arg_type := rmaps.ProdType (rmaps.ProdType (rmaps.ProdType (rmaps.ConstType (val * val))
(rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ConstType globals))) (rmaps.DependentType 0))
(rmaps.ArrowType (rmaps.DependentType 0) (rmaps.ArrowType (rmaps.ConstType val) rmaps.Mpred)).
Definition spawn_pre :=
(fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
(nth 0 ts unit -> val -> mpred)) =>
match x with
| (f, b, gv, w, pre) =>
PROP (tc_val (tptr Tvoid) b)
(LOCALx (temp _f f :: temp _args b :: gvars (gv w) :: nil)
(SEP (
EX _y : ident,
(func_ptr'
(WITH y : val, x : nth 0 ts unit
PRE [ _y OF tptr tvoid ]
PROP ()
(LOCALx (temp _y y :: gvars (gv x) :: nil)
(SEP   (pre x y)))
POST [tptr tvoid]
PROP  ()
LOCAL ()
SEP   ())
f);
pre w b)))
end).
Definition spawn_post :=
(fun (ts: list Type) (x: val * val * (nth 0 ts unit -> globals) * nth 0 ts unit *
(nth 0 ts unit -> val -> mpred)) =>
match x with
| (f, b, w, pre) =>
PROP ()
LOCAL ()
SEP ()
end).
Definition spawn_spec := mk_funspec
((_f OF tptr voidstar_funtype)%formals :: (_args OF tptr tvoid)%formals :: nil, tvoid)
cc_default
spawn_arg_type
spawn_pre
spawn_post
spawn_pre_nonexpansive
spawn_post_nonexpansive.
(*+ Adding the specifications to a void ext_spec *)
Definition concurrent_simple_specs (cs : compspecs) (ext_link : string -> ident) :=
(ext_link "acquire"%string, acquire_spec) ::
(ext_link "release"%string, release_spec) ::
nil.
Definition concurrent_simple_ext_spec Z (cs : compspecs) (ext_link : string -> ident) :=
add_funspecs_rec
ext_link
(ok_void_spec Z).(@OK_ty)
(ok_void_spec Z).(@OK_spec)
(concurrent_simple_specs cs ext_link).
Definition Concurrent_Simple_Espec Z cs ext_link :=
Build_OracleKind
Z
(concurrent_simple_ext_spec Z cs ext_link).

Lemma strong_nat_ind (P : nat -> Prop) (IH : forall n, (forall i, lt i n -> P i) -> P n) n : P n.