Open Scope logic.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition t_struct_elem := Tstruct _elem noattr.
Definition t_struct_fifo := Tstruct _fifo noattr.
Instance QS: listspec _elem _next (fun _ _ => emp).
Hint Resolve Qsh_not_readable.
Hint Resolve Qsh_nonempty : valid_pointer.
Hint Resolve Qsh_nonidentity : valid_pointer.
Hint Resolve sub_Qsh_Ews: valid_pointer.
Definition surely_malloc_spec :=
DECLARE _surely_malloc
WITH t:type, gv: globals
PRE [ _n OF tuint ]
PROP (0 <= sizeof t <= Int.max_unsigned;
complete_legal_cosu_type t = true;
natural_aligned natural_alignment t = true)
LOCAL (temp _n (Vint (Int.repr (sizeof t))); gvars gv)
SEP (mem_mgr gv)
POST [ tptr tvoid ] EX p:_,
PROP ()
LOCAL (temp ret_temp p)
SEP (mem_mgr gv; malloc_token Ews t p * data_at_ Ews t p).
Definition elemrep (rep: elemtype QS) (p: val) : mpred :=
field_at Ews t_struct_elem [StructField _a] (fst rep) p *
(field_at Ews t_struct_elem [StructField _b] (snd rep) p *
(field_at_ Ews t_struct_elem [StructField _next]) p).
Definition fifo_body (contents: list val) (hd tl: val) :=
(if isnil contents
then (!!(hd=nullval) && emp)
else (EX prefix: list val,
!!(contents = prefix++tl::nil)
&&  (lseg QS Qsh Ews prefix hd tl
* list_cell QS Qsh (Vundef,Vundef) tl
* field_at Ews t_struct_elem [StructField _next] nullval tl)))%logic.
Definition fifo (contents: list val) (p: val) : mpred :=
(EX ht: (val*val), let (hd,tl) := ht in
!! is_pointer_or_null hd && !! is_pointer_or_null tl &&
data_at Ews t_struct_fifo (hd, tl) p * malloc_token Ews t_struct_fifo p *
fifo_body contents hd tl).
Definition fifo_new_spec :=
DECLARE _fifo_new
WITH gv: globals
PRE  [  ]
PROP() LOCAL(gvars gv) SEP (mem_mgr gv)
POST [ (tptr t_struct_fifo) ]
EX v:val, PROP() LOCAL(temp ret_temp v) SEP (mem_mgr gv; fifo nil v).
Definition fifo_put_spec :=
DECLARE _fifo_put
WITH q: val, contents: list val, p: val
PRE  [ _Q OF (tptr t_struct_fifo) , _p OF (tptr t_struct_elem) ]
PROP () LOCAL (temp _Q q; temp _p p)
SEP (fifo contents q;
list_cell QS Qsh (Vundef, Vundef) p;
field_at_ Ews t_struct_elem [StructField _next] p)
POST [ tvoid ]
PROP() LOCAL() SEP (fifo (contents++(p :: nil)) q).
Definition fifo_empty_spec :=
DECLARE _fifo_empty
WITH q: val, contents: list val
PRE  [ _Q OF (tptr t_struct_fifo) ]
PROP() LOCAL (temp _Q q) SEP(fifo contents q)
POST [ tint ]
PROP ()
LOCAL(temp ret_temp (if isnil contents then Vtrue else Vfalse))
SEP (fifo (contents) q).
Definition fifo_get_spec :=
DECLARE _fifo_get
WITH q: val, contents: list val, p: val
PRE  [ _Q OF (tptr t_struct_fifo) ]
PROP() LOCAL (temp _Q q) SEP (fifo (p :: contents) q)
POST [ (tptr t_struct_elem) ]
PROP ()
LOCAL(temp ret_temp p)
SEP (fifo contents q;
list_cell QS Qsh (Vundef, Vundef) p;
field_at_ Ews t_struct_elem [StructField _next] p).
Definition make_elem_spec :=
DECLARE _make_elem
WITH a: int, b: int, gv: globals
PRE  [ _a OF tint, _b OF tint ]
PROP()
LOCAL(temp _a (Vint a); temp _b (Vint b); gvars gv)
SEP(mem_mgr gv)
POST [ (tptr t_struct_elem) ]
@exp (environ->mpred) _ _ (fun p:val =>  (* EX notation doesn't work for some reason *)
PROP()
LOCAL (temp ret_temp p)
SEP (mem_mgr gv;
field_at Qsh' list_struct [StructField _a] (Vint a) p;
field_at Qsh' list_struct [StructField _b] (Vint b) p;
list_cell QS Qsh (Vundef, Vundef) p;
field_at_ Ews t_struct_elem [StructField _next] p;
malloc_token Ews t_struct_elem p)).
Definition main_spec :=
DECLARE _main
WITH gv : globals
PRE  [] main_pre prog tt nil gv
POST [ tint ]
PROP() LOCAL (temp ret_temp (Vint (Int.repr (1+10)))) SEP(TT).
Definition Gprog : funspecs :=
ltac:(with_library prog
[surely_malloc_spec; fifo_new_spec; fifo_put_spec;
fifo_empty_spec; fifo_get_spec; make_elem_spec;
main_spec]).

Lemma fifo_isptr: forall al q, fifo al q |-- !! isptr q.