Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition acquire_spec := DECLARE _acquire acquire_spec.
(*Definition release_spec := DECLARE _release release_spec.*)
Definition makelock_spec := DECLARE _makelock (makelock_spec _).
(*Definition freelock_spec := DECLARE _freelock (freelock_spec _).*)
Definition spawn_spec := DECLARE _spawn spawn_spec.
Definition freelock2_spec := DECLARE _freelock2 (freelock2_spec _).
Definition release2_spec := DECLARE _release2 release2_spec.
(*Definition makecond_spec := DECLARE _makecond (makecond_spec _). Definition freecond_spec := DECLARE _freecond (freecond_spec _). Definition wait_spec := DECLARE _waitcond (wait2_spec _). Definition signal_spec := DECLARE _signalcond (signal_spec _).*)
Notation f_lock_inv lsh gsh gsh1 gsh2 p' p lock t locksp lockt resultsp :=
(EX p1 : val, EX p2 : val, EX p3 : val, EX i1 : int, EX i2 : int, EX i3 : int,
data_at gsh (tptr tqueue_t) p p' *
lqueue lsh tint (tc_val tint) p lock gsh1 gsh2
[QRem p1 (Vint i1); QRem p2 (Vint i2); QRem p3 (Vint i3)] *
data_at gsh (tarray (tptr tlock) 3) (upd_Znth t (repeat Vundef 3) lockt) locksp *
field_at Ews (tarray (tarray tint 3) 3) [ArraySubsc t] [Vint i1; Vint i2; Vint i3] resultsp).
Definition f_lock_pred lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp :=
selflock (f_lock_inv lsh gsh gsh1 gsh2 p' p lock t locksp lockt resultsp) tsh lockt.
Definition f_spec :=
DECLARE _f
WITH tid : val, x : share * share * share * share * share * val * val * val * Z * val * val * val
PRE [ _arg OF (tptr tvoid) ]
let '(lsh, gsh, tsh, gsh1, gsh2, p', p, lock, t, locksp, lockt, resultsp) := x in
PROP ()
LOCAL (temp _arg tid; gvar _q0 p'; gvar _thread_locks locksp; gvar _results resultsp)
SEP (!!(0 <= t < 3 /\ isptr lockt /\ readable_share lsh /\ readable_share gsh /\ readable_share tsh /\
sepalg.join gsh1 gsh2 Tsh) && emp;
data_at gsh (tptr tqueue_t) p p'; lqueue lsh tint (tc_val tint) p lock gsh1 gsh2 [];
data_at Tsh tint (vint t) tid; malloc_token Tsh (sizeof tint) tid;
data_at gsh (tarray (tptr tlock) 3) (upd_Znth t (repeat Vundef 3) lockt) locksp;
field_at_ Ews (tarray (tarray tint 3) 3) [ArraySubsc t] resultsp;
lock_inv tsh lockt (f_lock_pred lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp))
POST [ tptr tvoid ] PROP () LOCAL () SEP (emp).
Definition main_spec :=
DECLARE _main
WITH u : unit
PRE  [] main_pre prog [] u
POST [ tint ] main_post prog [] u.
Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; (*release_spec;*) release2_spec;
makelock_spec; (*freelock_spec;*) freelock2_spec; spawn_spec; (*makecond_spec; freecond_spec; wait_spec; signal_spec;*)
surely_malloc_spec prog; q_new_spec prog; q_del_spec prog; q_add_spec prog; q_remove_spec prog;
(*q_tryremove_spec prog;*) f_spec; main_spec]).  Lemma f_inv_precise : forall lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp, precise (f_lock_pred lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp).  Lemma f_inv_positive : forall lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp, readable_share gsh -> positive_mpred (f_lock_pred lsh gsh tsh gsh1 gsh2 p' p lock t locksp lockt resultsp). Hint Resolve f_inv_precise f_inv_positive.  Lemma lock_struct_array : forall sh z (v : list val) p, data_at sh (tarray (tptr (Tstruct _lock_t noattr)) z) v p = data_at sh (tarray (tptr tlock) z) v p.  (* lookup_and_change_compspecs interacts poorly with polymorphic specs, and in particular the partially applied compspecs-taking functions like reptype and data_at. *)
Ltac forward_call_id1_wow' witness :=
let Frame := fresh "Frame" in
let A := fresh "A" in
let wit := fresh "wit" in
evar (Frame: list (mpred));
evar (A: rmaps.TypeTree);
evar (wit: functors.MixVariantFunctor._functor
(rmaps.dependent_type_functor_rec nil A) mpred);
match goal with |- @semax ?CS _ _ _ _ _ =>
eapply (@semax_call_id1_wow A wit Frame);
[ check_function_name | subst A; reflexivity
| find_spec_in_globals | check_result_type
| apply Coq.Init.Logic.I | check_parameter_types
| check_prove_local2ptree
| check_typecheck
| instantiate (1 := witness) in (Value of wit);
check_funspec_precondition
| check_prove_local2ptree
| check_cast_params | reflexivity
| Forall_pTree_from_elements
| Forall_pTree_from_elements
| unfold fold_right_sepcon at 1 2; cancel
| subst wit; cbv beta iota zeta; extensionality rho;
repeat rewrite exp_uncurry;
try rewrite no_post_exists; repeat rewrite exp_unfold;
first [apply exp_congr; intros ?vret; reflexivity
| give_EX_warning
]
| prove_delete_temp
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto; subst A wit
] end.
Ltac forward_call_id00_wow' witness :=
let Frame := fresh "Frame" in
let A := fresh "A" in
let wit := fresh "wit" in
evar (Frame: list (mpred));
evar (A: rmaps.TypeTree);
evar (wit: functors.MixVariantFunctor._functor
(rmaps.dependent_type_functor_rec nil A) mpred);
match goal with |- @semax ?CS _ _ _ _ _ =>
eapply (@semax_call_id00_wow A wit Frame);
[ check_function_name | subst A; reflexivity
| find_spec_in_globals | check_result_type | check_parameter_types
| check_prove_local2ptree
| check_typecheck
| instantiate (1 := witness) in (Value of wit);
check_funspec_precondition
| check_prove_local2ptree
| check_cast_params | reflexivity
| Forall_pTree_from_elements
| Forall_pTree_from_elements
| unfold fold_right_sepcon at 1 2; cancel
| subst wit; cbv beta iota zeta;
repeat rewrite exp_uncurry;
try rewrite no_post_exists0;
first [reflexivity | extensionality; simpl; reflexivity]
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto; subst A wit
]
end.

Lemma main_loop2 : forall {Espec : OracleKind} (q0 q lock locks results : val)
sh1 sh2 (Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2) (Hsh : sepalg.join sh1 sh2 Tsh)
gshs1 (Hglen1 : Zlength gshs1 = 3)
(Hgshs1 : forall i : Z,
0 <= i < 3 ->
let
'(a, b) := Znth i gshs1 (Ews, Ews) in
readable_share a /\ readable_share b /\ sepalg.join a b (fst (Znth (i + 1) gshs1 (Ews, Ews))))
lshs1 (Hlenl1 : Zlength lshs1 = 3)
(Hlshs1 : forall i : Z,
0 <= i < 3 ->
let
'(a, b) := Znth i lshs1 (Tsh, Tsh) in
readable_share a /\ readable_share b /\ sepalg.join a b (fst (Znth (i + 1) lshs1 (Tsh, Tsh))))
(f_lock := fun x : Z * val =>
f_lock_pred (snd (Znth (2 - fst x) lshs1 (Tsh, Tsh))) (snd (Znth (2 - fst x) gshs1 (Ews, Ews))) sh2 sh1
sh2 q0 q lock (fst x) locks (snd x) results)
flocks (Hfl : Zlength flocks = 3) (Hflocks : Forall isptr flocks)
(Hresults : field_compatible (tarray (tarray tint 3) 3) [] results)
(lsh' := fst (Znth 0 lshs1 (Tsh, Tsh))) (gsh' := fst (Znth 0 gshs1 (Ews, Ews)))
(Hgsh' : readable_share gsh') ptrs (Hptrs : Zlength ptrs = 9) i (Hi : 0 <= i < 3),
semax (initialized_list [_i; _i__1; _q1; _i__2; _i__3; _t'1] (func_tycontext f_main Vprog Gprog))
(PROP ( )
LOCAL (temp _i__3 (vint i); temp _q1 q; temp _t'1 q; gvar _results results; gvar _thread_locks locks;
gvar _q0 q0)
SEP (field_at gsh' (tptr tqueue_t) [] q q0;
fold_right sepcon emp
(sublist 0 i (map (fun sh : Share.t => data_at sh (tptr tqueue_t) q q0) (map snd (rev gshs1))));
data_at gsh' (tarray (tptr (Tstruct _lock_t noattr)) 3) flocks locks;
fold_right sepcon emp
(sublist 0 i
(map (fun sh : Share.t => data_at_ sh (tarray (tptr (Tstruct _lock_t noattr)) 3) locks)
(map snd (rev gshs1))));
fold_right sepcon emp
(sublist i 3 (map (fun x : Z * val => lock_inv sh1 (snd x) (f_lock x)) (combine (upto 3) flocks)));
fold_right sepcon emp (sublist i 3 (map (fun x : val => malloc_token Tsh (sizeof tlock) x) flocks));
lqueue lsh' tint (is_int I32 Signed) q lock sh1 sh2
(map (fun x : val * Z => QAdd (fst x) (vint (snd x))) (combine ptrs (upto (Z.to_nat 9))));
EX vals : list (list (val * int)),
!! (Zlength vals = i /\ Forall (fun l : list (val * int) => Zlength l = 3) vals) &&
(fold_right sepcon emp
(map
(fun x : Share.t * list (val * int) =>
let
'(sh, vals0) := x in
lqueue sh tint (is_int I32 Signed) q lock sh1 sh2
(map (fun x0 : val * int => let '(p, i0) := x0 in QRem p (Vint i0)) vals0))
(combine (sublist 0 i (map snd (rev lshs1))) vals)) *
fold_right sepcon emp
(map
(fun x : Z =>
field_at Ews (tarray (tarray tint 3) 3) [ArraySubsc x] (map Vint (map snd (Znth x vals []))) results)
(upto (Z.to_nat i))))))
(Ssequence
(Sset _l__1
(Ederef
(Ebinop Oadd (Evar _thread_locks (tarray (tptr (Tstruct _lock_t noattr)) 3))
(Etempvar _i__3 tint) (tptr (tptr (Tstruct _lock_t noattr)))) (tptr (Tstruct _lock_t noattr))))
(Ssequence
(Scall None (Evar _acquire (Tfunction (Tcons (tptr tvoid) Tnil) tvoid cc_default))
[Etempvar _l__1 (tptr (Tstruct _lock_t noattr))])
(Ssequence
(Scall None (Evar _freelock2 (Tfunction (Tcons (tptr tvoid) Tnil) tvoid cc_default))
[Etempvar _l__1 (tptr (Tstruct _lock_t noattr))])
(Scall None (Evar _free (Tfunction (Tcons (tptr tvoid) Tnil) tvoid cc_default))
[Etempvar _l__1 (tptr (Tstruct _lock_t noattr))]))))
(normal_ret_assert
(PROP (0 <= i + 1 <= 3)
LOCAL (temp _i__3 (vint i); temp _q1 q; temp _t'1 q; gvar _results results; gvar _thread_locks locks;
gvar _q0 q0)
SEP (field_at gsh' (tptr tqueue_t) [] q q0;
fold_right sepcon emp
(sublist 0 (i + 1) (map (fun sh : Share.t => data_at sh (tptr tqueue_t) q q0) (map snd (rev gshs1))));
data_at gsh' (tarray (tptr (Tstruct _lock_t noattr)) 3) flocks locks;
fold_right sepcon emp
(sublist 0 (i + 1)
(map (fun sh : Share.t => data_at_ sh (tarray (tptr (Tstruct _lock_t noattr)) 3) locks)
(map snd (rev gshs1))));
fold_right sepcon emp
(sublist (i + 1) 3 (map (fun x : Z * val => lock_inv sh1 (snd x) (f_lock x)) (combine (upto 3) flocks)));
fold_right sepcon emp (sublist (i + 1) 3 (map (fun x : val => malloc_token Tsh (sizeof tlock) x) flocks));
lqueue lsh' tint (is_int I32 Signed) q lock sh1 sh2
(map (fun x : val * Z => QAdd (fst x) (vint (snd x))) (combine ptrs (upto (Z.to_nat 9))));
EX vals : list (list (val * int)),
!! (Zlength vals = i + 1 /\ Forall (fun l : list (val * int) => Zlength l = 3) vals) &&
(fold_right sepcon emp
(map
(fun x : Share.t * list (val * int) =>
let
'(sh, vals0) := x in
lqueue sh tint (is_int I32 Signed) q lock sh1 sh2
(map (fun x0 : val * int => let '(p, i0) := x0 in QRem p (Vint i0)) vals0))
(combine (sublist 0 (i + 1) (map snd (rev lshs1))) vals)) *
fold_right sepcon emp
(map
(fun x : Z =>
field_at Ews (tarray (tarray tint 3) 3) [ArraySubsc x] (map Vint (map snd (Znth x vals []))) results)
(upto (Z.to_nat (i + 1)))))))).