Global Opaque denote_tc_test_eq.
Hint Rewrite @sem_add_pi_ptr_special' using (solve [try reflexivity; auto with norm]) : norm.
Hint Rewrite @sem_add_pl_ptr_special' using (solve [try reflexivity; auto with norm]) : norm.
Hint Extern 2 (isptr (force_val (sem_add_ptr_int _ _ _ _))) =>
apply isptr_force_sem_add_ptr_int; [reflexivity | auto with prove_it_now] : core.
(* Done in this tail-recursive style so that "hnf" fully reduces it *)
Fixpoint mk_varspecs' (dl: list (ident * globdef Clight.fundef type)) (el: list (ident * type)) :
list (ident * type) :=
match dl with
| (i,Gvar v)::dl' => mk_varspecs' dl' ((i, gvar_info v) :: el)
| (i, _) :: dl' => mk_varspecs' dl' el
| nil => rev_append el nil
end.
Ltac unfold_varspecs al :=
match al with
| context [gvar_info ?v] =>
let b := eval lazy beta zeta iota delta [gvar_info v] in al
in unfold_varspecs b
| _ => exact al
end.
Ltac mk_varspecs prog :=
let a := constr:(prog)
in let a := eval unfold prog in a
in let d :=  match a with
| Clightdefs.mkprogram _ ?d _ _ _ => constr:(d)
| {| prog_defs := ?d |} => constr:(d)
end
in let e := constr:(mk_varspecs' d nil)
in let e := eval hnf in e
in unfold_varspecs e.
Hint Resolve field_address_isptr : norm.
Hint Resolve field_address_eq_offset' : prove_it_now.
Hint Rewrite <- @prop_and using solve [auto with typeclass_instances]: norm1.
Local Open Scope logic.
Ltac process_stackframe_of :=
match goal with |- semax _ (_ * stackframe_of ?F) _ _ =>
let sf := fresh "sf" in set (sf:= stackframe_of F) at 1;
unfold stackframe_of in sf; simpl map in sf; subst sf
end;
repeat
match goal with |- semax _ (_ * fold_right sepcon emp (var_block _ (?i,_) :: _)) _ _ =>
match goal with
| n: name i |- _ => simple apply var_block_lvar2;
[ reflexivity | reflexivity | reflexivity | reflexivity | clear n; intro n ]
| |- _ =>    simple apply var_block_lvar2;
[ reflexivity | reflexivity | reflexivity | reflexivity | let n := fresh "v" i in intros n ]
end
end;
(* match goal with |- semax _ ?Pre _ _ => let p := fresh "p" in set (p := Pre); rewrite <- (@emp_sepcon (environ->mpred) _ _ _ (fold_right _ _ _)); subst p end; *)
repeat (simple apply postcondition_var_block;
[reflexivity | reflexivity | reflexivity | reflexivity | reflexivity |  ]);
change (fold_right sepcon emp (@nil (environ->mpred))) with
(@emp (environ->mpred) _ _);
rewrite ?sepcon_emp, ?emp_sepcon.
Definition tc_option_val' (t: type) : option val -> Prop :=
match t with Tvoid => fun v => match v with None => True | _ => False end | _ => fun v => tc_val t (force_val v) end.
Hint Rewrite tc_option_val'_eq : norm.
Definition tycontext_subVG Vprog1 Gprog1 Vprog2 Gprog2 :=
(forall id : positive,
sub_option (make_tycontext_g Vprog1 Gprog1) ! id
(make_tycontext_g Vprog2 Gprog2) ! id) /\
(forall id : positive,
subsumespec (make_tycontext_s Gprog1) ! id (make_tycontext_s Gprog2) ! id).
(* Ltac apply_semax_body L := eapply (@semax_body_subsumption' _ _ _ _ _ _ _ _ L); [red; red; apply @sub_option_get; repeat (apply Forall_cons; [reflexivity | ]);  apply Forall_nil | repeat (apply Forall_cons; [ reflexivity | ]); apply Forall_nil | simple apply tycontext_sub_refl || (apply tycontext_sub_i99; assumption)]. *)
Ltac apply_semax_body L :=
eapply (@semax_body_subsumption' _ _ _ _ _ _ _ _ L);
[ first [ apply cspecs_sub_refl
| split3; red; apply @sub_option_get;
repeat (apply Forall_cons; [reflexivity | ]);  apply Forall_nil ]
| repeat (apply Forall_cons; [ reflexivity | ]); apply Forall_nil
| simple apply tycontext_sub_refl ||
(apply tycontext_sub_i99; assumption)].
Ltac try_prove_tycontext_subVG L :=
match goal with |- semax_func ?V2 ?G2 _ _ _ =>
try match type of L with
| semax_body ?V1 ?G1 _ _ =>
lazymatch goal with
| H: tycontext_subVG V1 G1 V2 G2 |- _ => idtac
| _ =>
let H := fresh in
try assert (H: tycontext_subVG V1 G1 V2 G2) by
(split;
[ apply sub_option_get;  repeat (apply Forall_cons; [reflexivity | ]);  apply Forall_nil
| apply subsume_spec_get;
repeat (apply Forall_cons; [apply subsumespec_refl | ]); apply Forall_nil])
end end end.
Ltac semax_func_cons L :=
repeat (eapply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | LookupID | LookupB |]);
try_prove_tycontext_subVG L;
first [eapply semax_func_cons;
[ reflexivity
| repeat apply Forall_cons; try apply Forall_nil; try computable; reflexivity
| unfold var_sizes_ok; repeat constructor; try (simpl; rep_omega)
| reflexivity | LookupID | LookupB
| try solve [apply L]; apply_semax_body L
| ]
| eapply semax_func_cons_ext;
[reflexivity | reflexivity | reflexivity | reflexivity | reflexivity
| left; reflexivity
| semax_func_cons_ext_tc | LookupID | LookupB | apply L |
]
];
repeat (eapply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | LookupID | LookupB |]);
try apply semax_func_nil.
Ltac semax_func_cons_ext :=
repeat (eapply semax_func_cons_ext_vacuous; [reflexivity | reflexivity | LookupID | LookupB | ]);
eapply semax_func_cons_ext;
[ reflexivity | reflexivity | reflexivity | reflexivity | reflexivity
| left; reflexivity
| semax_func_cons_ext_tc;
try solve [apply typecheck_return_value; auto]
| LookupID | LookupB
| solve[ first [eapply semax_ext;
[ (*repeat first [reflexivity | left; reflexivity | right]*) apply from_elements_In; reflexivity
| apply compute_funspecs_norepeat_e; reflexivity
| reflexivity
| reflexivity ]]]
|| fail "Try 'eapply semax_func_cons_ext.'"
"To solve [semax_external] judgments, do 'eapply semax_ext.'"
"Make sure that the Espec declared using 'Existing Instance'
is defined as 'add_funspecs NullExtension.Espec Gprog.'"
|
].
Tactic Notation "forward_seq" :=
first [eapply semax_seq'; [  | abbreviate_semax ]
| eapply semax_post_flipped' ].
Tactic Notation "forward_seq" constr(R) :=
match goal with P := @abbreviate ret_assert _ |- semax _ _ _ ?P' =>
constr_eq P P'; unfold abbreviate in P; subst P;
first [apply semax_seq with R; abbreviate_semax
| apply (semax_post_flipped' R); [abbreviate_semax | ]]
end.
(* old: Ltac forward_seq := first [eapply semax_seq'; [  | abbreviate_semax ] | eapply semax_post_flipped' ]. *)
(* end of "stuff to move elsewhere" *)
Ltac Forall_pTree_from_elements :=
cbv beta;
unfold PTree.elements; simpl PTree.xelements;
go_lower;
repeat (( simple apply derives_extract_prop
|| simple apply derives_extract_prop');
fancy_intros true);
autorewrite with gather_prop;
repeat (( simple apply derives_extract_prop
|| simple apply derives_extract_prop');
fancy_intros true);
repeat erewrite unfold_reptype_elim in * by reflexivity;
try autorewrite with entailer_rewrite in *;
repeat first
[ apply prop_Forall_cons1;
[unfold check_one_temp_spec, check_gvars_spec;
simpl; auto;
solve [normalize]
| ]
| apply prop_Forall_cons'
| apply prop_Forall_cons
| apply prop_Forall_nil'
| apply prop_Forall_nil
];
unfold check_one_temp_spec; simpl PTree.get.

Lemma exp_uncurry3:
forall {T} {ND: NatDed T} A B C D F,
@exp T ND A (fun a => @exp T ND B (fun b => @exp T ND C
(fun c => @exp T ND D (fun d => F a b c d))))
= @exp T ND (A*B*C*D)
(fun x => F (fst (fst (fst x))) (snd (fst (fst x))) (snd (fst x)) (snd x)).