Module Sep := SepExpr.Make VericSepLogic.
Hint Resolve link_local_facts : saturate_local.
Hint Resolve link__local_facts : saturate_local.
Definition Delta :=
@abbreviate tycontext
(initialized _h
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@Some (type * bool) (tptr t_struct_elem, false))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool))))) (@None (type * bool))
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool)
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@Some (type * bool) (tptr t_struct_fifo, true))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool)))), PTree.empty type, tint,
@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tvoid),
(2%positive, tptr tvoid), (3%positive, tuint),
(4%positive, tuint)](fun _ : environ => !!False)
POST  [tvoid](fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  p0 : val * list val, p : val PRE
[(_Q, tptr t_struct_fifo),
(_p, tptr t_struct_elem)]
(let (q0, contents0) := p0 in
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q);
`(@eq val p) (eval_id _p))
SEP  (`(fifo contents0 q0); `(link_ p))) POST
[tvoid]
(let (q0, contents0) := p0 in
`(fifo (contents0 ++ p :: @nil val) q0)))))
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  []
(fun _ : environ => @emp mpred Nveric Sveric)
POST  [tptr t_struct_fifo]
`(fifo (@nil val)) retval)))
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  a : int, b : int PRE  [(_a, tint),
(_b, tint)]
PROP  ()
LOCAL  (`(@eq val (Vint a)) (eval_id _a);
`(@eq val (Vint b)) (eval_id _b))  SEP() POST
[tptr t_struct_elem]`(elemrep (a, b)) retval)))
(@PTree.Leaf global_spec)))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH n : int PRE  [(1%positive, tint)]
PROP  (4 <= Int.signed n)
LOCAL  (`(@eq val (Vint n)) (eval_id 1%positive))
SEP() POST  [tptr tvoid]`(memory_block Tsh n) retval)))
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tschar),
(2%positive, tint)](fun _ : environ => !!False)
POST  [tint](fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  q0 : val, contents0 : list val PRE
[(_Q, tptr t_struct_fifo)]
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q))
SEP  (`(fifo contents0 q0)) POST  [tint]
(fun x0 : environ =>
local
(`(@eq val
(if @isnil val contents0
then Vtrue
else Vfalse)) retval) x0 &&
`(fifo contents0 q0) x0))))
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tvoid),
(2%positive, tint)]
PROP  ()
LOCAL ()
SEP
(`(memory_block Tsh)
(`force_int (eval_id 2%positive))
(eval_id 1%positive)) POST  [tvoid]
(fun _ : environ => @emp mpred Nveric Sveric))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  p0 : val * list val, p : val PRE
[(_Q, tptr t_struct_fifo)]
(let (q0, contents0) := p0 in
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q))
SEP  (`(fifo (p :: contents0) q0))) POST
[tptr t_struct_elem]
(let (q0, contents0) := p0 in
fun rho : environ =>
local (`(@eq val p) retval) rho &&
`(fifo contents0 q0) rho * `link_ retval rho))))
(@PTree.Leaf global_spec)))
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tdouble)]
(fun _ : environ => !!False) POST  [tdouble]
(fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@None global_spec)
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH u : unit PRE  []main_pre prog u POST  [tint]
main_post prog u))) (@PTree.Leaf global_spec))))))).
Parameter tycontext_eq : tycontext -> tycontext -> bool.
Definition tycontext_type :=
({| Expr.Impl := tycontext
; Expr.Eqb := tycontext_eq
; Expr.Eqb_correct := typecontext_eq_correct
|}).
Parameter expr_eq : option expr -> option expr -> bool.
Definition c_option_expr_type :=
({| Expr.Impl := option expr
; Expr.Eqb := expr_eq
; Expr.Eqb_correct := expr_eq_correct |}).
SearchAbout type.
Definition c_type_type :=
({| Expr.Impl := type
; Expr.Eqb := type_eq
; Expr.Eqb_correct := environ_lemmas.type_eq_true |}).
Parameter environ_eq : environ -> environ -> bool.
Definition environ_type :=
({| Expr.Impl := environ
; Expr.Eqb := environ_eq
; Expr.Eqb_correct := environ_eq_correct |}).
Definition environ2prop_type : Expr.type.
refine ({| Expr.Impl := environ -> Prop
; Expr.Eqb := fun _ _ => false
; Expr.Eqb_correct := _
|}).
intros. congruence.
Defined.
Definition our_types := cons tycontext_type
(cons c_option_expr_type
(cons c_type_type
(cons environ_type
(cons Expr.Prop_type
(cons environ2prop_type nil))))).
Definition tycontext_type_var := Expr.tvType 0.
Definition c_option_expr_type_var := Expr.tvType 1.
Definition c_type_type_var := Expr.tvType 2.
Definition environ_type_var := Expr.tvType 3.
Definition prop_type_var := Expr.tvType 4.
Definition environ2prop_type_var := Expr.tvType 5.
Definition delta_const := @Expr.Const our_types tycontext_type_var Delta.
(*above preconstructed, below constructed by entailer *)
Definition c_option_expr_const := @Expr.Const our_types c_option_expr_type_var
(@Some expr
(Ebinop Oeq (Etempvar _h (tptr t_struct_elem))
(Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint)).
Definition ret_type_signature :=
Expr.Sig our_types (cons tycontext_type_var nil)
c_type_type_var ret_type.
Definition tc_expropt_signature_lifted : Expr.signature our_types :=
Expr.Sig our_types (cons tycontext_type_var (cons c_option_expr_type_var (cons c_type_type_var nil))) environ2prop_type_var tc_expropt.
Definition tc_expropt_signature : Expr.signature our_types :=
Expr.Sig our_types (cons tycontext_type_var (cons c_option_expr_type_var (cons c_type_type_var (cons environ_type_var nil)))) prop_type_var tc_expropt.
Definition environ_signature (rho: environ) : Expr.signature our_types :=
Expr.Sig our_types (nil) (environ_type_var) (rho).
Definition functions (rho:environ) := cons ret_type_signature
(cons tc_expropt_signature
(cons tc_expropt_signature_lifted
(cons (environ_signature rho) nil))).
Definition ret_type_delta : Expr.expr our_types.
eapply Expr.Func. apply 0%nat. apply (cons delta_const nil).
Defined.
Definition tc_expropt_application_lifted : Expr.expr our_types.
eapply Expr.Func.
apply 2%nat.
apply (cons delta_const (cons c_option_expr_const (cons ret_type_delta nil))).
Defined.
Definition tc_expropt_application_unlifted : Expr.expr our_types.
eapply Expr.Func.
apply 1%nat.
apply (cons delta_const (cons c_option_expr_const (cons ret_type_delta
(cons (Expr.Func 3%nat nil) nil)))).
Defined.
Definition reflected_tc_expropt :=
(tc_expropt Delta
(@Some expr
(Ebinop Oeq (Etempvar _h (tptr t_struct_elem))
(Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint))
(ret_type Delta)).
Definition reflected_tc_expropt_unlifted :=
forall rho,
(tc_expropt Delta
(@Some expr
(Ebinop Oeq (Etempvar _h (tptr t_struct_elem))
(Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint))
(ret_type Delta) rho).
assert ((prove_goal tc_expropt_application_unlifted = true)) by admit.
eapply prove_goal_sound.
apply H1.
symmetry in H0. apply H0.
Qed.

Lemma goal_1 :
name _Q ->
name _h ->
forall (q : val) (contents : list val) (hd tl : val),
let Delta :=
@abbreviate tycontext
(initialized _h
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@Some (type * bool) (tptr t_struct_elem, false))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool))))) (@None (type * bool))
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@None (type * bool))
(@PTree.Node (type * bool)
(@PTree.Node (type * bool)
(@PTree.Node (type * bool) (@PTree.Leaf (type * bool))
(@Some (type * bool) (tptr t_struct_fifo, true))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool))) (@None (type * bool))
(@PTree.Leaf (type * bool)))), PTree.empty type, tint,
@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tvoid),
(2%positive, tptr tvoid), (3%positive, tuint),
(4%positive, tuint)](fun _ : environ => !!False)
POST  [tvoid](fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  p0 : val * list val, p : val PRE
[(_Q, tptr t_struct_fifo),
(_p, tptr t_struct_elem)]
(let (q0, contents0) := p0 in
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q);
`(@eq val p) (eval_id _p))
SEP  (`(fifo contents0 q0); `(link_ p))) POST
[tvoid]
(let (q0, contents0) := p0 in
`(fifo (contents0 ++ p :: @nil val) q0)))))
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  []
(fun _ : environ => @emp mpred Nveric Sveric)
POST  [tptr t_struct_fifo]
`(fifo (@nil val)) retval)))
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  a : int, b : int PRE  [(_a, tint),
(_b, tint)]
PROP  ()
LOCAL  (`(@eq val (Vint a)) (eval_id _a);
`(@eq val (Vint b)) (eval_id _b))  SEP() POST
[tptr t_struct_elem]`(elemrep (a, b)) retval)))
(@PTree.Leaf global_spec)))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH n : int PRE  [(1%positive, tint)]
PROP  (4 <= Int.signed n)
LOCAL  (`(@eq val (Vint n)) (eval_id 1%positive))
SEP() POST  [tptr tvoid]`(memory_block Tsh n) retval)))
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tschar),
(2%positive, tint)](fun _ : environ => !!False)
POST  [tint](fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  q0 : val, contents0 : list val PRE
[(_Q, tptr t_struct_fifo)]
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q))
SEP  (`(fifo contents0 q0)) POST  [tint]
(fun x0 : environ =>
local
(`(@eq val
(if @isnil val contents0
then Vtrue
else Vfalse)) retval) x0 &&
`(fifo contents0 q0) x0))))
(@PTree.Leaf global_spec))) (@None global_spec)
(@PTree.Leaf global_spec)) (@None global_spec)
(@PTree.Node global_spec
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tptr tvoid),
(2%positive, tint)]
PROP  ()
LOCAL ()
SEP
(`(memory_block Tsh)
(`force_int (eval_id 2%positive))
(eval_id 1%positive)) POST  [tvoid]
(fun _ : environ => @emp mpred Nveric Sveric))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH  p0 : val * list val, p : val PRE
[(_Q, tptr t_struct_fifo)]
(let (q0, contents0) := p0 in
PROP  ()
LOCAL  (`(@eq val q0) (eval_id _Q))
SEP  (`(fifo (p :: contents0) q0))) POST
[tptr t_struct_elem]
(let (q0, contents0) := p0 in
fun rho : environ =>
local (`(@eq val p) retval) rho &&
`(fifo contents0 q0) rho * `link_ retval rho))))
(@PTree.Leaf global_spec)))
(@Some global_spec
(Global_func
(WITH _ : unit PRE  [(1%positive, tdouble)]
(fun _ : environ => !!False) POST  [tdouble]
(fun _ : environ => !!False))))
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@None global_spec)
(@PTree.Node global_spec (@PTree.Leaf global_spec)
(@Some global_spec
(Global_func
(WITH u : unit PRE  []main_pre prog u POST  [tint]
main_post prog u))) (@PTree.Leaf global_spec))))))) in
PROP  ()
LOCAL  (tc_environ Delta; `(@eq val hd) (eval_id _h);
`(@eq val q) (eval_id _Q))
SEP  (`(field_at Tsh t_struct_fifo _head q hd);
`(field_at Tsh t_struct_fifo _tail q tl);
`(if @isnil val contents
then !!(hd = nullval) && @emp mpred Nveric Sveric
else
EX  prefix : list val,
!!(contents = prefix ++ tl :: @nil val) &&
(@links t_struct_elem _next QS Tsh prefix hd tl * link tl nullval)))
|-- local
(tc_expropt Delta
(@Some expr
(Ebinop Oeq (Etempvar _h (tptr t_struct_elem))
(Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint))
(ret_type Delta)) &&
`(function_body_ret_assert tint
(local
(`(@eq val (if @isnil val contents then Vtrue else Vfalse)) retval) &&
`(fifo contents q)) EK_return)
(cast_expropt
(@Some expr
(Ebinop Oeq (Etempvar _h (tptr t_struct_elem))
(Ecast (Econst_int (Int.repr 0) tint) (tptr tvoid)) tint))
(ret_type Delta)) (@id environ)
. Proof. intros Q h.