Local Open Scope logic.
Fixpoint argtypes (al: list (ident * type)) : list type :=
match al with (_,t)::al' => t :: argtypes al' | nil => nil end.
Definition maybe_retval (Q: environ -> mpred) retty ret :=
match ret with
| Some id => fun rho => Q (get_result1 id rho)
| None =>
match retty with
| Tvoid => (fun rho => Q (globals_only rho))
| _ => fun rho => EX v: val, Q (make_args (ret_temp::nil) (v::nil) rho)
end
end.
Definition removeopt_localdef (ret: option ident) (l: list localdef) : list localdef :=
match ret with
| Some id => remove_localdef_temp id l
| None => l
end.
(*   (HAB: forall ts : list Type, Inhabitant (functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (withtype_of_funspec fs)) mpred)) *), @semax cs Espec Delta ((*|>*)(tc_expr Delta a && tc_exprlist Delta (argtypes argsig) bl) && (|>`(Pre ts x: environ -> mpred) ( (make_args' (argsig,retsig) (eval_exprlist (argtypes argsig) bl))) * `(func_ptr' fs) (eval_expr a) * |>PROPx P (LOCALx Q (SEPx R)))) (Scall ret a bl) (normal_ret_assert (maybe_retval (Post ts x) retsig ret * PROPx P (LOCALx (removeopt_localdef ret Q) (SEPx R)))).  Lemma semax_call1: forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost ts x id argsig retsig cc a bl P Q R (Hsub: funspec_sub fs (mk_funspec (argsig,retsig) cc A Pre Post NEPre NEPost)), Cop.classify_fun (typeof a) = Cop.fun_case_f (type_of_params argsig) retsig cc -> match retsig with | Tvoid => False | _ => True end -> tc_fn_return Delta (Some id) retsig -> @semax cs Espec Delta ((*|>*)(tc_expr Delta a && tc_exprlist Delta (argtypes argsig) bl) && (|>`(Pre ts x: environ -> mpred) ( (make_args' (argsig,retsig) (eval_exprlist (argtypes argsig) bl))) * `(func_ptr' fs) (eval_expr a) * |>PROPx P (LOCALx Q (SEPx R)))) (Scall (Some id) a bl) (normal_ret_assert (`(Post ts x: environ -> mpred) (get_result1 id) * PROPx P (LOCALx (remove_localdef_temp id Q) (SEPx R)))).  Definition ifvoid {T} t (A B: T) := match t with Tvoid => A | _ => B end.  Lemma semax_call0: forall Espec {cs: compspecs} Delta fs A Pre Post NEPre NEPost ts x argsig retty cc a bl P Q R (Hsub: funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost)), Cop.classify_fun (typeof a) = Cop.fun_case_f (type_of_params argsig) retty cc -> @semax cs Espec Delta ((*|>*)(tc_expr Delta a && tc_exprlist Delta (argtypes argsig) bl) && (|>`(Pre ts x: environ -> mpred) ( (make_args' (argsig,retty) (eval_exprlist (argtypes argsig) bl))) * `(func_ptr' fs) (eval_expr a) * |>PROPx P (LOCALx Q (SEPx R)))) (Scall None a bl) (normal_ret_assert (ifvoid retty (`(Post ts x: environ -> mpred) (make_args nil nil)) (EX v:val, `(Post ts x: environ -> mpred) (make_args (ret_temp::nil) (v::nil))) * PROPx P (LOCALx Q (SEPx R)))).  Lemma semax_fun_id': forall id f TC Espec {cs: compspecs} Delta (PQR: environ->mpred) PostCond c (GLBL: (var_types Delta) ! id = None), (glob_specs Delta) ! id = Some f -> (glob_types Delta) ! id = Some (type_of_funspec f) -> @semax cs Espec Delta ((*|>*)TC && (local (tc_environ Delta) && (`(func_ptr' f) (eval_var id (type_of_funspec f)) * |>PQR))) c PostCond -> (*       @semax cs Espec Delta (|>(TC && PQR)) c PostCond.*)
apply andp_right.
{ rewrite <- andp_assoc. apply andp_left1.
apply andp_right.
* apply andp_left1. intro rho; unfold tc_expr; simpl.
subst.
norm_rewrite. apply prop_left; intro.
unfold get_var_type. rewrite GLBL. rewrite H0.
rewrite denote_tc_assert_bool; simpl. apply prop_right.
simpl.
rewrite (type_of_funspec_sub _ _ Hsub).
simpl; auto.
rewrite eqb_typelist_refl.
simpl. auto.
unfold_lift; auto.
rewrite eqb_type_refl. simpl.
apply eqb_calling_convention_refl.
* apply andp_left2; auto. }
apply andp_left2, andp_left2, andp_left2.
intro; simpl.
rewrite later_sepcon, <- sepcon_assoc.
apply sepcon_derives; auto.
rewrite (type_of_funspec_sub _ _ Hsub).
rewrite sepcon_comm; apply derives_refl.
Qed.
Inductive extract_trivial_liftx {A}: list (environ->A) -> list A -> Prop :=
| ETL_nil: extract_trivial_liftx nil nil
| ETL_cons: forall a al bl,
extract_trivial_liftx al bl ->
extract_trivial_liftx (`a :: al) (a::bl).
Definition check_one_temp_spec (Q: PTree.t val) (idv: ident * val) : Prop :=
(Q ! (fst idv)) = Some (snd idv).
Definition check_gvars_spec (GV: option globals) (GV': option globals) : Prop :=
match GV' with Some _ => GV = GV' | _ => True end.
Definition strong_cast (t1 t2: type) (v: val) : val :=
force_val (sem_cast t1 t2 v).
Inductive Parameter_types_in_funspec_different_from_call_statement : Prop := .
Inductive Result_type_in_funspec_different_from_call_statement : Prop := .
Definition check_retty t :=
match t with Tvoid => Result_type_in_funspec_different_from_call_statement
|  Tarray _ _ _ => Result_type_in_funspec_different_from_call_statement
| _ => True
end.
Hint Rewrite PROP_LOCAL_SEP_f: norm2.
Definition global_funspec Delta id argsig retty cc A Pre Post NEPre NEPost :=
(var_types Delta) ! id = None /\
(glob_specs Delta) ! id = Some (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
(glob_types Delta) ! id = Some (type_of_funspec (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost)).
Definition can_assume_funcptr cs Delta P Q R a fs :=
forall Espec c Post,
@semax cs Espec Delta ((EX v: val, (lift0 (func_ptr fs v) && local (`(eq v) (eval_expr a)))) &&
PROPx P (LOCALx Q (SEPx R))) c Post ->
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R))) c Post.
Definition OLDcall_setup1
(cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(bl: list expr) (vl : list val)
(Qactuals : PTree.t _)
:=
local2ptree Q = (Qtemp, Qvar, nil, GV) /\
funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
can_assume_funcptr  cs Delta P Q R' a fs /\
PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) /\
Cop.classify_fun (typeof a) = Cop.fun_case_f (type_of_params argsig) retty cc /\
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|-- (tc_expr Delta a)  /\
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|--  (tc_exprlist Delta (argtypes argsig) bl) /\
force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
(explicit_cast_exprlist (argtypes argsig) bl))
= Some vl /\
pTree_from_elements (List.combine (var_names argsig) vl) = Qactuals.
Definition call_setup1
(cs: compspecs) Qtemp Qvar GV a Delta P Q R (*R'*)
fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(bl: list expr) (vl : list val)
(Qactuals : PTree.t _)
:=
local2ptree Q = (Qtemp, Qvar, nil, GV) /\
funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) /\
(*can_assume_funcptr  cs Delta P Q R' a fs /\ PROPx P (LOCALx Q (SEPx R')) |-- |> PROPx P (LOCALx Q (SEPx R)) /\*)
can_assume_funcptr  cs Delta P Q R a fs /\
Cop.classify_fun (typeof a) = Cop.fun_case_f (type_of_params argsig) retty cc /\
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|-- (tc_expr Delta a)  /\
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|--  (tc_exprlist Delta (argtypes argsig) bl) /\
force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
(explicit_cast_exprlist (argtypes argsig) bl))
= Some vl /\
pTree_from_elements (List.combine (var_names argsig) vl) = Qactuals.
(*fold_right_sepcon R' |--  func_ptr fs v ->*)
(*fold_right_sepcon R' |-- |> fold_right_sepcon R ->*)
(*trivial fold_right_sepcon R |-- |> fold_right_sepcon R ->*)

Lemma call_setup1_i2:
forall (cs: compspecs) Delta P Q R (*R'*) (id: ident) (ty: type) (bl: list expr)
Qtemp Qvar GV
fs argsig retty cc (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(vl : list val)
(Qactuals : PTree.t _),
local2ptree Q = (Qtemp, Qvar, nil, GV) ->
can_assume_funcptr  cs Delta P Q R (Evar id ty) fs ->
funspec_sub fs (mk_funspec (argsig,retty) cc A Pre Post NEPre NEPost) ->
Cop.classify_fun ty = Cop.fun_case_f (type_of_params argsig) retty cc ->
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|-- (tc_expr Delta (Evar id ty))  ->
ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|--  (tc_exprlist Delta (argtypes argsig) bl) ->
force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
(explicit_cast_exprlist (argtypes argsig) bl))
= Some vl ->
pTree_from_elements (List.combine (var_names argsig) vl) = Qactuals ->
call_setup1 cs Qtemp Qvar GV (Evar id ty) Delta P Q R (*R'*) fs argsig retty cc A Pre Post NEPre NEPost bl vl Qactuals.