Ltac make_func_ptr id :=
eapply (make_func_ptr id);
[ (reflexivity || fail 99  "Local variable " id " is shadowing the global variable" id)
| (reflexivity || fail 99 "No specification of function " id " in Delta")
| (reflexivity || fail 99 "No global variable " id " in Delta, i.e., in your extern declarations")
| split; reflexivity | ].
Ltac change_mapsto_gvar_to_data_at :=
match goal with gv: globals |- semax _ (PROPx _ (LOCALx ?L (SEPx ?S))) _ _ =>
match S with
| context [mapsto ?sh ?t (offset_val 0 (gv ?i)) ?v] =>
assert_PROP (headptr (offset_val 0 (gv i)));
[entailer!;  apply <- headptr_offset_zero; auto |];
erewrite (mapsto_data_at'' _ _ _ _ (offset_val _ (gv i)));
[| reflexivity | assumption | apply JMeq_refl ];
match goal with H: _ |- _ => clear H end;
rewrite <- ? data_at_offset_zero
| context [mapsto ?sh ?t (gv ?i) ?v] =>
assert_PROP (headptr (gv i));
[entailer! |];
erewrite (mapsto_data_at'' _ _ _ _ (gv i));
[| reflexivity | assumption | apply JMeq_refl ];
match goal with H: _ |- _ => clear H end
end
end.
Ltac type_lists_compatible al bl :=
match al with
| Ctypes.Tcons ?a ?al' => match bl with Ctypes.Tcons ?b ?bl' =>
first [unify a b | unify (classify_cast a b) cast_case_pointer];
type_lists_compatible al' bl'
end
| Ctypes.Tnil => match bl with Ctypes.Tnil => idtac end
end.
Ltac function_types_compatible t1 t2 :=
match t1 with
| Tfunction ?al1 ?r1 _ =>
match t2 with Tfunction ?al2 ?r2 _ =>
type_lists_compatible al1 al2;
first [unify r1 r2 | unify (classify_cast r1 r2) cast_case_pointer]
end end.
Ltac check_parameter_vals Delta al :=
(* Work very carefully here to avoid simplifying or computing v, in case v contains something that will blow up *)
match al with
| temp ?i ?v :: ?al' =>
let ti := constr:((temp_types Delta) ! i) in
let ti := eval compute in ti in
match ti with
| Some ?t =>
let w := constr:(tc_val_dec t v) in
let y := eval cbv beta iota delta [is_int_dec is_long_dec
is_float_dec is_single_dec is_pointer_or_integer_dec
is_pointer_or_null_dec isptr_dec tc_val_dec] in w in
match y with
| right _ => fail 4 "Local variable" i "cannot hold the value" v "(wrong type)"
| left _ => idtac
(*  optionally, give warning | _ => let W := fresh "Warning_could_not_prove_this_if_its_false_then_the_caller_wont_be_able_satisfy_the_function_precondition" in pose (W := tc_val t v) *)
| _ => idtac (* no optional warning *)
end
| None => fail 3 "Identifer" i "is not a local variable of this function"
end;
check_parameter_vals Delta al'
| _ :: ?al' => check_parameter_vals Delta al'
| nil => idtac
end.
Fixpoint find_expressions {A: Type} (f: expr -> A -> A) (c: statement) (x: A) : A :=
match c with
| Sskip => x
| Sassign e1 e2 => f e1 (f e2 x)
| Sset _ e => f e x
| Scall _ (Evar _ _) el => fold_right f x el
| Scall _ e el => f e (fold_right f x el)
| Sbuiltin _ _ _ el => fold_right f x el
| Ssequence c1 c2 => find_expressions f c1 (find_expressions f c2 x)
| Sifthenelse e c1 c2 => f e (find_expressions f c1 (find_expressions f c2 x))
| Sloop c1 c2 => find_expressions f c1 (find_expressions f c2 x)
| Sbreak => x
| Scontinue => x
| Sreturn (Some e) => f e x
| Sreturn None => x
| Sswitch e cl => f e (find_expressions_sl f cl x)
| Slabel _ c => find_expressions f c x
| Sgoto _ => x
end
with find_expressions_sl {A: Type} (f: expr -> A -> A) (c: labeled_statements) (x: A) : A :=
match c with
| LSnil => x
| LScons _ c1 c2 => find_expressions f c1 (find_expressions_sl f c2 x)
end.
Fixpoint find_vars {A: Type} (f: ident -> A -> A) (e: expr) (x: A) : A :=
match e with
| Evar i _ => f i x
| Ederef e _ => find_vars f e x
| Eaddrof e _ => find_vars f e x
| Eunop _ e _ => find_vars f e x
| Ebinop _ e1 e2 _ => find_vars f e1 (find_vars f e2 x)
| Ecast e _ => find_vars f e x
| Efield e _ _ => find_vars f e x
| _ => x
end.
Fixpoint find_lvars (locals: list localdef)  (m: PTree.t unit) : PTree.t unit :=
match locals with
| lvar i _ _ :: locals'=> find_lvars locals' (PTree.set i tt m)
| _ :: locals' => find_lvars locals' m
| nil => m
end.
Definition another_gvar (i: ident) (ml: PTree.t unit * list ident) : (PTree.t unit * list ident) :=
match ml with (t,il) =>
match PTree.get i t with Some _ => ml | None =>  (PTree.set i tt t, i :: il) end
end.
Arguments another_gvar i !ml .
Ltac start_function_hint := idtac. (* "Hint: at any time, try the 'hint' tactic.  To disable this message, 'Ltac start_function_hint ::= idtac.' ". *)
Definition firstopt {A} (e1 e2: option A) :=
match e1 with None => e2 | Some x => Some x end.
Fixpoint check_norm_expr (e: expr) : option expr :=
match e with
| Evar _ ty => match access_mode ty with
| By_reference => None
| _ => Some e
end
| Ederef a ty => match access_mode ty with
| By_reference => if is_pointer_type (typeof a)
then check_norm_expr a
else Some e
| _ => Some e
end
| Eunop _ e _ => check_norm_expr e
| Ebinop _ e1 e2 _ => firstopt (check_norm_expr e1) (check_norm_expr e2)
| Ecast e _ => check_norm_expr e
| Efield a _ ty => match access_mode ty with
| By_reference => check_norm_lvalue a
| _ => Some e
end
| Eaddrof e _ => check_norm_lvalue e
| _ => None
end
with check_norm_lvalue (e: expr) : option expr :=
match e with
| Ederef a _ => if is_pointer_type (typeof a)
then check_norm_expr a
else Some e
| Ecast e _ => check_norm_lvalue e
| Efield e _ _ => check_norm_lvalue e
| Eunop _ e _ => check_norm_expr e
| Ebinop _ e1 e2 _ => firstopt (check_norm_expr e1) (check_norm_expr e2)
| _ => None
end.
Fixpoint check_norm_stmt (s: statement) : option expr :=
match s with
| Sassign e1 e2 => firstopt (check_norm_lvalue e1) (check_norm_expr e2)
| Sset _ e1 => check_norm_lvalue e1
| Scall _ (Evar _ _) el => fold_right firstopt None (map check_norm_expr el)
| Scall _ e el => fold_right firstopt None (map check_norm_expr (e::el))
| Sbuiltin _ _ _ el => fold_right firstopt None (map check_norm_expr el)
| Ssequence s1 s2 => firstopt (check_norm_stmt s1) (check_norm_stmt s2)
| Sifthenelse e s1 s2 => firstopt (check_norm_expr e) (firstopt (check_norm_stmt s1) (check_norm_stmt s2))
| Sloop s1 s2 => firstopt (check_norm_stmt s1) (check_norm_stmt s2)
| Sreturn (Some e) => check_norm_expr e
| Sswitch e ls => firstopt (check_norm_expr e)
(check_norm_ls ls)
| _ => None
end
with
check_norm_ls (ls: labeled_statements) : option expr :=
match ls with
| LSnil => None
| LScons _ s1 sr => firstopt (check_norm_stmt s1) (check_norm_ls sr)
end.
Ltac check_normalized f :=
let x := constr:(check_norm_stmt (fn_body f)) in
let x := eval hnf in x in
match x with
| None => idtac
| Some ?e => fail 99 "The expression " e " contains internal memory dereferences, which suggests that you ran clightgen without the -normalize flag.  Print Info.normalized and make sure it has the value 'true'"
end.
Ltac start_function :=
match goal with |- semax_body _ _ ?F ?spec =>
let D := constr:(type_of_function F) in
let S := constr:(type_of_funspec (snd spec)) in
let D := eval hnf in D in let D := eval simpl in D in
let S := eval hnf in S in let S := eval simpl in S in
tryif (unify D S) then idtac else
tryif function_types_compatible D S
then idtac "Warning: the function-body parameter/return types are not identical to the funspec types, although they are compatible:
Function body:" D "
Function spec:" S
else
(fail "Function signature (param types, return type) from function-body does not match function signature from funspec
Function body: " D "
Function spec: " S);
check_normalized F
end;
match goal with |- semax_body ?V ?G ?F ?spec =>
let s := fresh "spec" in
pose (s:=spec); hnf in s;
match goal with
| s :=  (DECLARE _ WITH _: globals
PRE  [] main_pre _ nil _
POST [ tint ] _) |- _ => idtac
| s := ?spec' |- _ => check_canonical_funspec spec'
end;
change (semax_body V G F s); subst s
end;
let DependedTypeList := fresh "DependedTypeList" in
match goal with |- semax_body _ _ _ (pair _ (NDmk_funspec _ _ _ ?Pre _)) =>
match Pre with
| (fun x => match _ with (a,b) => _ end) => intros Espec DependedTypeList [a b]
| (fun i => _) => intros Espec DependedTypeList i
end;
simpl fn_body; simpl fn_params; simpl fn_return
end;
simpl functors.MixVariantFunctor._functor in *;
simpl rmaps.dependent_type_functor_rec;
clear DependedTypeList;
repeat match goal with |- @semax _ _ _ (match ?p with (a,b) => _ end * _) _ _ =>
destruct p as [a b]
end;
simplify_func_tycontext;
repeat match goal with
| |- context [Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s) Sskip] =>
fold (Swhile e s)
| |- context [Ssequence ?s1 (Sloop (Ssequence (Sifthenelse ?e Sskip Sbreak) ?s2) ?s3) ] =>
match s3 with
| Sset ?i _ => match s1 with Sset ?i' _ => unify i i' | Sskip => idtac end
end;
fold (Sfor s1 e s2 s3)
end;
try expand_main_pre;
process_stackframe_of;
repeat change_mapsto_gvar_to_data_at;  (* should really restrict this to only in main,
but it needs to come after process_stackframe_of *)
repeat rewrite <- data_at__offset_zero;
try apply start_function_aux1;
repeat (apply semax_extract_PROP;
match goal with
| |- _ ?sh -> _ =>
match type of sh with
| share => intros ?SH
| Share.t => intros ?SH
| _ => intro
end
| |- _ => intro
end);
first [ eapply eliminate_extra_return'; [ reflexivity | reflexivity | ]
| eapply eliminate_extra_return; [ reflexivity | reflexivity | ]
| idtac];
abbreviate_semax;
lazymatch goal with
| |- semax ?Delta (PROPx _ (LOCALx ?L _)) _ _ => check_parameter_vals Delta L
| _ => idtac
end;
start_function_hint.
Opaque sepcon.
Opaque emp.
Opaque andp.
Arguments overridePost Q R / .
Arguments eq_dec A EqDec / a a' .
Arguments EqDec_exitkind !a !a'.
(**** make_compspecs ****)

(* Specifications: *)
Lemma composite_env_consistent_i':
forall (f: composite -> Prop) (env: composite_env),
Forall (fun idco => f (snd idco)) (PTree.elements env) ->
(forall id co, env ! id = Some co -> f co).
Lemma composite_env_consistent_i:
forall (f: composite_env -> composite -> Prop) (env: composite_env),
Forall (fun idco => f env (snd idco)) (PTree.elements env) ->
(forall id co, env ! id = Some co -> f env co).
Lemma legal_alignas_env_consistency': forall (cenv : composite_env) (ha_env : PTree.t Z) (la_env: PTree.t legal_alignas_obs),
composite_env_consistent cenv ->
la_env = legal_alignas_env cenv ha_env ->
legal_alignas_env_consistent cenv ha_env la_env.
Lemma legal_alignas_env_completeness': forall (cenv : composite_env) (ha_env : PTree.t Z) (la_env: PTree.t legal_alignas_obs),
la_env = legal_alignas_env cenv ha_env ->
legal_alignas_env_complete cenv la_env.
Lemma Zgeb0_ge0: forall n, Z.geb n 0 = true -> n >= 0.
Lemma prove_alignof_two_p (i: Z) :
i = two_power_nat (Z.to_nat (log_sup (Z.to_pos i))) ->
exists n: nat, i = two_power_nat n.
Lemma prove_Zdivide (a b: Z): b = Z.mul (Z.div b a) a -> Z.divide a b.
Ltac simplify_composite_of_def d :=
let d := eval hnf in d in
match d with
Errors.OK
{|  co_su := ?su;
co_members := ?m;
co_attr := ?a;
co_sizeof := ?sz;
co_alignof := ?al;
co_rank := ?rank;
co_sizeof_pos := _;
co_alignof_two_p := _;
co_sizeof_alignof := _ |}  =>
let sz := eval compute in sz in
let al := eval compute in al in
let rank := eval compute in rank in
let sp := constr:(Zgeb0_ge0 sz (eq_refl _)) in
let altwo := constr:(prove_alignof_two_p al (eq_refl _)) in
let sa := constr:(prove_Zdivide al sz (eq_refl _)) in
let d := constr:({|  co_su := su;
co_members := m;
co_attr := a;
co_sizeof := sz;
co_alignof := al;
co_rank := rank;
co_sizeof_pos := sp;
co_alignof_two_p := altwo;
co_sizeof_alignof := sa |})
in
d
end.