Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition tqueue := Tstruct _queue noattr.
Definition tqueue_t := Tstruct _queue_t noattr.
Definition MAX := 10.
(* Ghost histories in the style of History-based Verification of Functional Behaviour of Concurrent Programs, Blom, Huisman, and Zharieva-Stojanovski (VerCors) Twente tech report, 2015 *)
Inductive hist_el {A} := QAdd (p : val) (v : A) | QRem (p : val) (v : A).
Notation hist A := (list (@hist_el A)).
Fixpoint consistent {A} (h : hist A) a b :=
match h with
| [] => a = b
| QAdd p v :: h' => consistent h' (a ++ [(p, v)]) b
| QRem p v :: h' => match a with [] => False | v' :: q' => v' = (p, v) /\ consistent h' q' b end
end.
Notation feasible h := (exists b, consistent h [] b).
Parameter ghost : forall (sh : share) {t} (f : share * hist t) (p : val), mpred.
(*Parameter ghost_factory : mpred.  Axiom ghost_alloc : forall Espec D P Q R C P', semax(Espec := Espec) D (PROPx P (LOCALx Q (SEPx (ghost_factory :: R)))) C P' -> semax D (PROPx P (LOCALx Q (SEPx R))) C P'. Axiom new_ghost : forall Espec D P Q R C P' t v, semax(Espec := Espec) D (PROPx P (LOCALx Q (SEPx (ghost_factory :: (EX p : val, ghost Tsh t v p) :: R)))) C P' -> semax D (PROPx P (LOCALx Q (SEPx (ghost_factory :: R)))) C P'. Axiom alloc_conflict : ghost_factory * ghost_factory |-- FF.*)
(* In effect, we want two different ways of splitting/combining history shares. One combines the histories as well; the other guarantees injectivity on histories. *)
Inductive list_incl {A} : list A -> list A -> Prop :=
| incl_nil l : list_incl [] l
| incl_skip l1 a l2 (Hincl : list_incl l1 l2) : list_incl l1 (a :: l2)
| incl_cons a l1 l2 (Hincl : list_incl l1 l2) : list_incl (a :: l1) (a :: l2).
Hint Constructors list_incl.
Inductive interleave {A} : list (list A) -> list A -> Prop :=
| interleave_nil ls (Hnil : Forall (fun l => l = []) ls) : interleave ls []
| interleave_cons ls i a l l' (Hcons : Znth i ls [] = a :: l) (Hrest : interleave (upd_Znth i ls l) l') :
interleave ls (a :: l').
(* We would prefer to let the queue hold arbitrarily complex data, not necessarily associated with a C type. For now, the mpred embedding can't handle type application, so we have to default to data_at instead of taking a general predicate for the queue, and that means the data is always of a C type. *)
Definition q_lock_pred' (t : type) P p (vals : list (val * reptype t)) head (addc remc : val) lock gsh h :=
!!(Zlength vals <= MAX /\ 0 <= head < MAX /\ consistent h [] vals) &&
(data_at Tsh tqueue (rotate (complete MAX (map fst vals)) head MAX, (vint (Zlength vals),
(vint head, (vint ((head + Zlength vals) mod MAX), (addc, remc))))) p *
cond_var Tsh addc * cond_var Tsh remc * malloc_token Tsh (sizeof tqueue_t) p *
malloc_token Tsh (sizeof tcond) addc * malloc_token Tsh (sizeof tcond) remc *
malloc_token Tsh (sizeof tlock) lock * ghost gsh (Tsh, h) p *
fold_right sepcon emp (map (fun x => let '(p, v) := x in
!!(P v) && (data_at Tsh t v p * malloc_token Tsh (sizeof t) p)) vals)).
Definition q_lock_pred A P p lock gsh := EX vals : list (val * reptype A), EX head : Z,
EX addc : val, EX remc : val, EX h : hist _, q_lock_pred' A P p vals head addc remc lock gsh h.
Definition lqueue lsh t P p lock gsh1 gsh2 (h : hist (reptype t)) :=
!!(sepalg.join gsh1 gsh2 Tsh /\ field_compatible tqueue_t [] p) &&
(field_at lsh tqueue_t [StructField _lock] lock p *
lock_inv lsh lock (q_lock_pred t P p lock gsh2) * ghost gsh1 (lsh, h) p).

Lemma lqueue_feasible : forall A P p lock gsh1 gsh2 (h : hist (reptype A)),
lqueue Tsh A P p lock gsh1 gsh2 h = !!(feasible h) && lqueue Tsh A P p lock gsh1 gsh2 h.