Ltac match_postcondition :=
cbv beta iota zeta; unfold_post;  extensionality rho;
repeat rewrite exp_uncurry;
try rewrite no_post_exists; repeat rewrite exp_unfold;
tryif apply exp_congr
then (intros ?vret;
apply equal_f;
apply PROP_LOCAL_SEP_ext; [reflexivity | | reflexivity];
(reflexivity || fail "The funspec of the function has a POSTcondition
that is ill-formed.  The LOCALS part of the postcondition
should be (temp ret_temp ...), but it is not"))
else fail "The funspec of the function should have a POSTcondition that starts
with an existential, that is,  EX _:_, PROP...LOCAL...SEP".
(* Ltac match_postcondition := cbv beta iota zeta; unfold_post; extensionality rho; repeat rewrite exp_uncurry; try rewrite no_post_exists; repeat rewrite exp_unfold; first [apply exp_congr; intros ?vret; reflexivity | give_EX_warning ]. *)
Ltac  forward_call_id1_wow :=
let H := fresh in intro H;
eapply (semax_call_id1_wow _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H);
clear H;
lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
[check_result_type
|apply Logic.I
| match_postcondition
| prove_delete_temp
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto
].
Ltac forward_call_id1_x_wow :=
let H := fresh in intro H;
eapply (semax_call_id1_x_wow
_ _ _ _ _ _ _ _ _ _
_ _ _ _ _ _ _ _ _ _
_ _ _ _ _ _ _ _ _ H);
clear H;
lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
[ check_result_type | check_result_type
| apply Coq.Init.Logic.I | apply Coq.Init.Logic.I | reflexivity
| (clear; let H := fresh in intro H; inversion H)
| match_postcondition
| prove_delete_temp
| prove_delete_temp
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto
].
Ltac forward_call_id1_y_wow :=
let H := fresh in intro H;
eapply (semax_call_id1_y_wow
_ _ _ _ _ _ _ _ _ _
_ _ _ _ _ _ _ _ _ _
_ _ _ _ _ _ _ _ _ H);
clear H;
lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
[ check_result_type | check_result_type
| apply Coq.Init.Logic.I | apply Coq.Init.Logic.I | reflexivity
| (clear; let H := fresh in intro H; inversion H)
| match_postcondition
| prove_delete_temp
| prove_delete_temp
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto
].
Ltac forward_call_id01_wow :=
let H := fresh in intro H;
eapply (semax_call_id01_wow _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H);
clear H;
lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
[ apply Coq.Init.Logic.I
| match_postcondition
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto
].
Ltac forward_call_id00_wow  :=
let H := fresh in intro H;
eapply (semax_call_id00_wow _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H);
clear H;
lazymatch goal with Frame := _ : list mpred |- _ => try clear Frame end;
[ check_result_type
| cbv beta iota zeta; unfold_post; (* extensionality rho; *)
repeat rewrite exp_uncurry;
try rewrite no_post_exists0;
(* apply equal_f; *)
apply exp_congr; intros ?vret;
apply PROP_LOCAL_SEP_ext; [reflexivity | | reflexivity];
(reflexivity || fail "The funspec of the function has a POSTcondition
that is ill-formed.  The LOCALS part of the postcondition
should be empty, but it is not")
| unify_postcondition_exps
| unfold fold_right_and; repeat rewrite and_True; auto
].
Ltac simpl_strong_cast :=
try match goal with |- context [strong_cast ?t1 ?t2 ?v] =>
first [change (strong_cast t1 t2 v) with v
| change (strong_cast t1 t2 v) with
(force_val (sem_cast t1 t2 v))
]
end.
Ltac fwd_skip :=
match goal with |- semax _ _ Sskip _ =>
normalize_postcondition;
first [eapply semax_pre | eapply semax_pre_simple];
[ | apply semax_skip]
end.
Definition BINDER_NAME := tt.
Ltac find_postcond_binder_names :=
match goal with |- semax ?Delta _ ?c _ =>
match c with context [Scall _ (Evar ?id _) _] =>
let x := constr:((glob_specs Delta) ! id) in
let x' := eval hnf in x in
match x' with
| Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => exp (fun y3 => exp (fun y4 => _)))))) =>
let y4' := fresh y4 in  pose (y4' := BINDER_NAME);
let y3' := fresh y3 in  pose (y3' := BINDER_NAME);
let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
| Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => exp (fun y3 => _))))) =>
let y3' := fresh y3 in  pose (y3' := BINDER_NAME);
let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
| Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => exp (fun y2 => _)))) =>
let y2' := fresh y2 in  pose (y2' := BINDER_NAME);
let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
| Some (mk_funspec _ _ _ _ (fun _ => exp (fun y1 => _))) =>
let y1' := fresh y1 in  pose (y1' := BINDER_NAME)
| _ => idtac
end
end
end.
Ltac after_forward_call_binders :=
repeat match goal with
| r := BINDER_NAME |- _ =>
clear r; apply extract_exists_pre; intro r
| |- _ => apply extract_exists_pre; intros ?vret
end.
Ltac cleanup_no_post_exists :=
match goal with |-  context[eq_no_post] =>
let vret := fresh "vret" in let H := fresh in
apply extract_exists_pre; intro vret;
apply semax_extract_PROP; intro H;
change (eq_no_post vret) with (eq vret) in H;
subst vret
end
|| unfold eq_no_post.
Ltac factor_out_v L :=
match L with
| temp _ ?v :: ?L' => factor_out_v' v L'
| lvar _ _ ?v :: ?L' => factor_out_v' v L'
| _ => constr:(@nil val)
end
with factor_out_v' v L' := let x := fresh "v" in set (x:=v);
let y :=factor_out_v L'
in constr:(x::y).
Ltac factor_back L :=
match L with
| ?x :: ?y => subst x; factor_back y
| nil => idtac
end.
Ltac simplify_remove_localdef_temp :=
match goal with |- context [remove_localdef_temp ?i ?L]  =>
let L' := factor_out_v L in
simpl remove_localdef_temp;
factor_back L'
end.
Ltac after_forward_call :=
check_POSTCONDITION;
try match goal with |- context [remove_localdef_temp] =>
simplify_remove_localdef_temp
end;
unfold_app;
try (apply extract_exists_pre; intros _);
match goal with
| |- semax _ _ _ _ => idtac
| |- unit -> semax _ _ _ _ => intros _
end;
match goal with
| |- @semax ?CS _ _ _ _ _ => try change_compspecs CS
end;
repeat (apply semax_extract_PROP; intro);
cleanup_no_post_exists;
abbreviate_semax;
try fwd_skip.
Ltac clear_MORE_POST :=
try match goal with POSTCONDITION := @abbreviate ret_assert _ |- _ =>
clear POSTCONDITION
end;
try match goal with MORE_COMMANDS := @abbreviate statement _ |- _ =>
clear MORE_COMMANDS
end.
Inductive Ridiculous: Type := .
Ltac check_witness_type 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 nil 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.

(* Specifications: *)
Lemma trivial_Forall_inclusion:
forall {A} (G: list A), Forall (fun x => In x G) G.
Lemma trivial_Forall_inclusion0:
forall {A} (G: list A), Forall (fun x => In x G) nil.