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].

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).