Ltac check_witness_type' ts A witness :=
(unify A (rmaps.ConstType Ridiculous); (* because [is_evar A] doesn't seem to work *)
elimtype False)
||
let TA := constr:(functors.MixVariantFunctor._functor
(rmaps.dependent_type_functor_rec ts A) mpred) in
let TA' := eval cbv
[functors.MixVariantFunctor._functor
functors.MixVariantFunctorGenerator.fpair
functors.MixVariantFunctorGenerator.fconst
functors.MixVariantFunctorGenerator.fidentity
rmaps.dependent_type_functor_rec
functors.GeneralFunctorGenerator.CovariantBiFunctor_MixVariantFunctor_compose
functors.CovariantFunctorGenerator.fconst
functors.CovariantFunctorGenerator.fidentity
functors.CovariantBiFunctor._functor
functors.CovariantBiFunctorGenerator.Fpair
functors.GeneralFunctorGenerator.CovariantFunctor_MixVariantFunctor
functors.CovariantFunctor._functor
functors.MixVariantFunctor.fmap
] in TA
in let TA'' := eval simpl in TA'
in match type of witness with ?T =>
unify T TA''
+ (fail "Type of witness does not match type required by funspec WITH clause.
Witness value: " witness "
Witness type: " T "
Funspec type: " TA'')
end.
Ltac prove_call_setup' ts witness :=
prove_call_setup1 subsume_funspec_refl;
[ .. |
match goal with |- call_setup1  _ _ _ _ _ _ _ _ _ _ _ _ _ _ ?A _ _ _ _ _ _ _ -> _ =>
check_witness_type' ts A witness
end;
let H := fresh in
intro H;
match goal with | |- @semax ?CS _ _ _ _ _ =>
let Frame := fresh "Frame" in evar (Frame: list mpred);
exploit (call_setup2'_i _ _ _ _ _ _ _ _ _ _ _ _ _ _ ts _ _ _ _ _ _ _ _ H witness Frame); clear H;
simpl functors.MixVariantFunctor._functor;
[ reflexivity
| check_prove_local2ptree
| Forall_pTree_from_elements
| unfold check_gvars_spec; solve [exact I | reflexivity]
| try change_compspecs CS; cancel_for_forward_call
|
]
end].

(* Specifications: *)
Lemma semax_call_aux55:
forall (cs: compspecs) (Qtemp: PTree.t val) (Qvar: PTree.t (type * val)) GV (a: expr)
Delta P Q R fs argsig retty (*cc ts A Pre Post NEPre NEPost  *)
ts (A : rmaps.TypeTree)
(Pre
Post : forall ts : list Type,
functors.MixVariantFunctor._functor
(rmaps.dependent_type_functor_rec
ts (AssertTT A)) mpred)
witness Frame bl Ppre Qpre Rpre Qactuals Qpre_temp GV' vl
(PTREE : local2ptree Q = (Qtemp, Qvar, nil, GV))
(TC0 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R)) |-- tc_expr Delta a)
(TC1 : ENTAIL Delta, PROPx P (LOCALx Q (SEPx R))
|-- tc_exprlist Delta (argtypes argsig) bl)
(MSUBST : force_list (map (msubst_eval_expr Delta Qtemp Qvar GV)
(explicit_cast_exprlist (argtypes argsig) bl)) = Some vl)
(PTREE'' : pTree_from_elements (combine (var_names argsig) vl) = Qactuals)
(PRE1 : Pre ts witness = PROPx Ppre (LOCALx Qpre (SEPx Rpre)))
(PTREE' : local2ptree Qpre = (Qpre_temp, PTree.empty _, nil, GV'))
(CHECKTEMP : Forall (check_one_temp_spec Qactuals) (PTree.elements Qpre_temp))
(CHECKG: check_gvars_spec GV GV' )
(FRAME : fold_right_sepcon R
|-- fold_right_sepcon Rpre * fold_right_sepcon Frame)
(PPRE : fold_right_and True Ppre)
(LEN : length (argtypes argsig) = length bl),
ENTAIL Delta,
(EX v : val,
lift0 (func_ptr fs v) &&
local (` (eq v) (eval_expr a))) && |>PROPx P (LOCALx Q (SEPx R))
|-- |> (tc_expr Delta a && tc_exprlist Delta (argtypes argsig) bl) &&
(|> @liftx (Tarrow environ (LiftEnviron mpred)) (Pre ts witness)
(make_args' (argsig, retty) (eval_exprlist (argtypes argsig) bl)) *
` (func_ptr' fs)
(eval_expr a) * |>PROPx P (LOCALx Q (SEPx Frame))).
Lemma semax_call_id00_wow:
forall
(cs: compspecs) Qtemp Qvar a GV Delta P Q R R'
fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
(Frame: list mpred)
(bl: list expr)
(Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
(Qactuals Qpre_temp : PTree.t _) GV'
(vl : list val)
(SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
witness Frame Ppre Qpre Rpre Qpre_temp GV')
Espec
(Post2: environ -> mpred)
(B: Type)
(Ppost: B -> list Prop)
(Rpost: B -> list mpred)
(RETTY: retty = Tvoid)
(POST1: Post ts witness = (EX vret:B, PROPx (Ppost vret) (LOCALx nil (SEPx (Rpost vret)))))
(POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret ) (LOCALx Q
(SEPx (Rpost vret ++ Frame))))
(PPRE: fold_right_and True Ppre),
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
(Scall None a bl)
(normal_ret_assert Post2).
Lemma semax_call_id1_wow:
forall
(cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
(Frame: list mpred)
(bl: list expr)
(Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
(Qactuals Qpre_temp : PTree.t _) GV'
(vl : list val)
(SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
witness Frame Ppre Qpre Rpre Qpre_temp GV')
ret (Post2: environ -> mpred)  (Qnew: list localdef)
(B: Type) (Ppost: B -> list Prop) (F: B -> val) (Rpost: B -> list mpred) Espec
(TYret: typeof_temp Delta ret = Some retty)
(OKretty: check_retty retty)
(POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
(LOCALx (temp ret_temp (F vret) :: nil)
(SEPx (Rpost vret))))
(DELETE: remove_localdef_temp ret Q = Qnew)
(H0: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx (temp ret (F vret) :: Qnew)
(SEPx (Rpost vret ++ Frame))))
(PPRE: fold_right_and True Ppre),
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
(Scall (Some ret) a bl)
(normal_ret_assert Post2).
Lemma semax_call_id1_x_wow:
forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
fs argsig retty' cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
(Frame: list mpred)
(bl: list expr)
(Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
(Qactuals Qpre_temp : PTree.t _) GV'
(vl : list val)
(SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl Qactuals
witness Frame Ppre Qpre Rpre Qpre_temp GV')
retty  Espec ret ret'
(Post2: environ -> mpred)
(Qnew: list localdef)
(B: Type)
(Ppost: B -> list Prop)
(F: B -> val)
(Rpost: B -> list mpred)
(TYret: typeof_temp Delta ret = Some retty)
(RETinit: (temp_types Delta) ! ret' = Some retty')
(OKretty: check_retty retty)
(OKretty': check_retty retty')
(NEUTRAL: is_neutral_cast retty' retty = true)
(NEret: ret <> ret')
(POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
(LOCALx (temp ret_temp (F vret) :: nil)
(SEPx (Rpost vret))))
(DELETE: remove_localdef_temp ret Q = Qnew)
(DELETE' : remove_localdef_temp ret' Q = Q)
(H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
(LOCALx (temp ret (F vret) :: Qnew)
(SEPx (Rpost vret ++ Frame))))
(PPRE: fold_right_and True Ppre),
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
(Ssequence (Scall (Some ret') a bl)
(Sset ret (Ecast (Etempvar ret' retty') retty)))
(normal_ret_assert Post2).
Lemma semax_call_id1_y_wow:
forall  (cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
fs argsig retty' cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
(Frame: list mpred)
(bl: list expr)
(Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
(Qactuals Qpre_temp : PTree.t _) GV'
(vl : list val)
(SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty' cc ts A Pre Post NEPre NEPost bl vl Qactuals
witness Frame Ppre Qpre Rpre Qpre_temp GV')
Espec ret ret' (retty: type)
(Post2: environ -> mpred)
(Qnew: list localdef)
(B: Type)
(Ppost: B -> list Prop)
(F: B -> val)
(Rpost: B -> list mpred)
(TYret: typeof_temp Delta ret = Some retty)
(RETinit: (temp_types Delta) ! ret' = Some retty')
(OKretty: check_retty retty)
(OKretty': check_retty retty')
(NEUTRAL: is_neutral_cast retty' retty = true)
(NEret: ret <> ret')
(POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
(LOCALx (temp ret_temp (F vret) :: nil)
(SEPx (Rpost vret))))
(DELETE: remove_localdef_temp ret Q = Qnew)
(DELETE' : remove_localdef_temp ret' Q = Q)
(H0: Post2 = EX vret:B, PROPx (P++ Ppost vret)
(LOCALx (temp ret (F vret) :: Qnew)
(SEPx (Rpost vret ++ Frame))))
(PPRE: fold_right_and True Ppre),
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
(Ssequence (Scall (Some ret') a bl)
(Sset ret (Etempvar ret' retty')))
(normal_ret_assert Post2).
Lemma semax_call_id01_wow:
forall
(cs: compspecs) Qtemp Qvar GV a Delta P Q R R'
fs argsig retty cc ts (A: rmaps.TypeTree)  Pre Post NEPre NEPost
(witness: functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts A) mpred)
(Frame: list mpred)
(bl: list expr)
(Ppre: list Prop) (Qpre : list localdef) (Rpre: list mpred)
(Qactuals Qpre_temp : PTree.t _) GV'
(vl : list val)
(SETUP: call_setup2' cs Qtemp Qvar GV a Delta P Q R R' fs argsig retty cc ts A Pre Post NEPre NEPost bl vl Qactuals
witness Frame Ppre Qpre Rpre Qpre_temp GV')
Espec
(Post2: environ -> mpred)
(B: Type)
(Ppost: B -> list Prop)
(F: B -> val)
(Rpost: B -> list mpred)
(_: check_retty retty)
(POST1: Post ts witness = EX vret:B, PROPx (Ppost vret)
(LOCALx (temp ret_temp (F vret) :: nil)
(SEPx (Rpost vret))))
(POST2: Post2 = EX vret:B, PROPx (P++ Ppost vret) (LOCALx Q
(SEPx (Rpost vret ++ Frame))))
(PPRE: fold_right_and True Ppre),
@semax cs Espec Delta (PROPx P (LOCALx Q (SEPx R')))
(Scall None a bl)
(normal_ret_assert Post2).