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.
Ltac  unify_postcondition_exps :=
first [ reflexivity
| rewrite exp_uncurry;
apply exp_congr; intros [? ?]; simpl; reflexivity
| rewrite exp_uncurry2;
apply exp_congr; intros [[? ?] ?]; simpl; reflexivity
| rewrite exp_uncurry3;
apply exp_congr; intros [[[? ?] ?] ?]; simpl; reflexivity
].
Ltac change_compspecs' cs cs' :=
match goal with
| |- context [@data_at cs' ?sh ?t ?v1] => erewrite (@data_at_change_composite cs' cs _ sh t); [| apply JMeq_refl | reflexivity]
| |- context [@field_at cs' ?sh ?t ?gfs ?v1] => erewrite (@field_at_change_composite cs' cs _ sh t gfs); [| apply JMeq_refl | reflexivity]
| |- context [@data_at_ cs' ?sh ?t] => erewrite (@data_at__change_composite cs' cs _ sh t); [| reflexivity]
| |- context [@field_at_ cs' ?sh ?t ?gfs] => erewrite (@field_at__change_composite cs' cs _ sh t gfs); [| reflexivity]
| |- context [?A cs'] => change (A cs') with (A cs)
| |- context [?A cs' ?B] => change (A cs' B) with (A cs B)
| |- context [?A cs' ?B ?C] => change (A cs' B C) with (A cs B C)
| |- context [?A cs' ?B ?C ?D] => change (A cs' B C D) with (A cs B C D)
| |- context [?A cs' ?B ?C ?D ?E] => change (A cs' B C D E) with (A cs B C D E)
| |- context [?A cs' ?B ?C ?D ?E ?F] => change (A cs' B C D E F) with (A cs B C D E F)
end.
(* TODO: use CCE as arguments to gain CS' *)
Ltac change_compspecs cs :=
match goal with |- context [?cs'] =>
match type of cs' with compspecs =>
try (constr_eq cs cs'; fail 1);
change_compspecs' cs cs';
repeat change_compspecs' cs cs'
end
end.
Definition Warning_perhaps_funspec_postcondition_needs_EX_outside_PROP_LOCAL_SEP (p: Prop) := p.
Ltac give_EX_warning :=
match goal with |- ?A => change
(Warning_perhaps_funspec_postcondition_needs_EX_outside_PROP_LOCAL_SEP A)
end.
Ltac check_parameter_types :=
first [reflexivity | elimtype  Parameter_types_in_funspec_different_from_call_statement].
Ltac check_result_type :=
first [reflexivity | elimtype  Result_type_in_funspec_different_from_call_statement].
Inductive Cannot_find_function_spec_in_Delta (id: ident) := .
Inductive Global_function_name_shadowed_by_local_variable := .
Ltac check_function_name :=
first [reflexivity | elimtype Global_function_name_shadowed_by_local_variable].
Inductive Actual_parameters_cannot_be_coerced_to_formal_parameter_types := .
Ltac check_cast_params :=
reflexivity +
(simpl explicit_cast_exprlist;
match goal with |- force_list (map ?F ?A) = _ =>
let el := constr:(A) in
let bl := constr:(map F A) in
let cl := eval simpl in bl in
fail 100 "Some of the argument expressions in your function call do not evaluate (sometimes this is caused by missing LOCALs in your precondition).  Your argument expressions are:"
el "They evaluate (or fail) as follows:" cl
end).
Inductive Witness_type_of_forward_call_does_not_match_witness_type_of_funspec:
Type -> Type -> Prop := .
Ltac find_spec_in_globals' :=
match goal with |- ?X = _ => let x := fresh "x" in set (x:=X); hnf in x; subst x end;
try reflexivity.
Inductive Cannot_analyze_LOCAL_definitions : Prop := .
Ltac check_prove_local2ptree :=
first [prove_local2ptree | elimtype Cannot_analyze_LOCAL_definitions].
Inductive Funspec_precondition_is_not_in_PROP_LOCAL_SEP_form := .
Ltac check_funspec_precondition :=
first [reflexivity | elimtype  Funspec_precondition_is_not_in_PROP_LOCAL_SEP_form].
Ltac lookup_spec id :=
tryif apply f_equal_Some
then
match goal with
| |- vacuous_funspec _ = _ => fail 100 "Your Gprog contains no funspec with the name" id
| |- ?fs = _ => check_canonical_funspec (id,fs);
first [reflexivity |
match goal with
| |- mk_funspec _ _ ?t1 _ _ = mk_funspec _ _ ?t2 _ _ =>
first [unify t1 t2
| elimtype False; elimtype (Witness_type_of_forward_call_does_not_match_witness_type_of_funspec
t2 t1)]
end]
end
else elimtype  (Cannot_find_function_spec_in_Delta id).
Inductive Function_arguments_include_a_memory_load_of_type (t:type) := .
Ltac goal_has_evars :=
match goal with |- ?A => has_evar A end.
Ltac delete_FRZR_from_SEP :=
match goal with
| |- ENTAIL _, PROPx _ (LOCALx _ (SEPx ?R)) |-- _ =>
match R with context [FRZR] =>
eapply drop_SEP_tc;
[ first [apply extend_tc.extend_tc_expr
| apply extend_tc.extend_tc_exprlist
| apply extend_tc.extend_tc_lvalue]
| apply split_FRZ_in_SEP_spec; prove_split_FRZ_in_SEP
| ]
end end.
Ltac check_typecheck :=
try delete_FRZR_from_SEP;
first [goal_has_evars; idtac |
try apply local_True_right;
entailer!;
match goal with
| |- typecheck_error (deref_byvalue ?T) =>
elimtype (Function_arguments_include_a_memory_load_of_type T)
| |- _ => idtac
end].
Ltac prove_delete_temp := match goal with |- ?A = _ =>
let Q := fresh "Q" in set (Q:=A); hnf in Q; subst Q; reflexivity
end.
Ltac cancel_for_forward_call := cancel_for_evar_frame.
Ltac default_cancel_for_forward_call := cancel_for_evar_frame.
Ltac unfold_post := match goal with |- ?Post = _ => let A := fresh "A" in let B := fresh "B" in first
[evar (A : Type); evar (B : A -> environ -> mpred); unify Post (@exp _ _ ?A ?B);
change Post with (@exp _ _ A B); subst A B |
evar (A : list Prop); evar (B : environ -> mpred); unify Post (PROPx ?A ?B);
change Post with (PROPx A B); subst A B | idtac] end.

Lemma PROP_LOCAL_SEP_ext :
forall P P' Q Q' R R', P=P' -> Q=Q' -> R=R' ->
PROPx P (LOCALx Q (SEPx R)) = PROPx P' (LOCALx Q' (SEPx R')).