Definition type_of_funsig (fsig: funsig) :=
Tfunction (type_of_params (fst fsig)) (snd fsig) cc_default.
Definition fn_funsig (f: function) : funsig := (fn_params f, fn_return f).
Definition tc_fn_return (Delta: tycontext) (ret: option ident) (t: type) :=
match ret with
| None => True
| Some i => match (temp_types Delta) ! i with Some t' => t=t' | _ => False end
end.
Definition globals_only (rho: environ) : environ :=
mkEnviron (ge_of rho) (Map.empty _) (Map.empty _).
Fixpoint make_args (il: list ident) (vl: list val) (rho: environ)  :=
match il, vl with
| nil, nil => globals_only rho
| i::il', v::vl' => env_set (make_args il' vl' rho) i v
| _ , _ => rho
end.
Definition make_args' (fsig: funsig) args rho :=
make_args (map (@fst _ _) (fst fsig)) (args rho) rho.
Definition ret_temp : ident := 1%positive.
Definition get_result1 (ret: ident) (rho: environ) : environ :=
make_args (ret_temp::nil) (eval_id ret rho :: nil) rho.
Definition get_result (ret: option ident) : environ -> environ :=
match ret with
| None => make_args nil nil
| Some x => get_result1 x
end.
Definition maybe_retval (Q: environ -> mpred) retty ret :=
match ret with
| Some id => fun rho => Q (get_result1 id rho)
| None =>
match retty with
| Tvoid => (fun rho => Q (globals_only rho))
| _ => fun rho => EX v: val, Q (make_args (ret_temp::nil) (v::nil) rho)
end
end.
Definition bind_ret (vl: option val) (t: type) (Q: environ -> mpred) : environ -> mpred :=
match vl, t with
| None, Tvoid =>`Q (make_args nil nil)
| Some v, _ => @andp (environ->mpred) _ (!! tc_val t v)
(`Q (make_args (ret_temp::nil) (v::nil)))
| _, _ => FF
end.
Definition overridePost  (Q: environ->mpred)  (R: ret_assert) :=
match R with
{| RA_normal := _; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := Q; RA_break := b; RA_continue := c; RA_return := r |}
end.
Definition existential_ret_assert {A: Type} (R: A -> ret_assert) :=
{| RA_normal := fun rho => EX x:A, (R x).(RA_normal) rho;
RA_break := fun rho => EX x:A, (R x).(RA_break) rho;
RA_continue := fun rho => EX x:A, (R x).(RA_continue) rho;
RA_return := fun vl rho => EX x:A, (R x).(RA_return) vl rho
|}.
Definition normal_ret_assert (Q: environ->mpred) : ret_assert :=
{| RA_normal := Q; RA_break := seplog.FF; RA_continue := seplog.FF; RA_return := fun _ => seplog.FF |}.
Definition frame_ret_assert (R: ret_assert) (F: environ->mpred) : ret_assert :=
match R with
{| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := n * F;
RA_break := b * F;
RA_continue := c * F;
RA_return := fun vl => r vl * F |}
end.
Definition switch_ret_assert (R: ret_assert) : ret_assert :=
match R with
{| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := FF;
RA_break := n;
RA_continue := c;
RA_return := r |}
end.
Definition with_ge (ge: genviron) (G: environ->mpred) : mpred :=
G (mkEnviron ge (Map.empty _) (Map.empty _)).
Fixpoint prog_funct' {F V} (l: list (ident * globdef F V)) : list (ident * F) :=
match l with nil => nil | (i,Gfun f)::r => (i,f):: prog_funct' r | _::r => prog_funct' r
end.
Definition prog_funct (p: program) := prog_funct' (prog_defs p).
Fixpoint prog_vars' {F V} (l: list (ident * globdef F V)) : list (ident * globvar V) :=
match l with nil => nil | (i,Gvar v)::r => (i,v):: prog_vars' r | _::r => prog_vars' r
end.
Definition prog_vars (p: program) := prog_vars' (prog_defs p).
Definition all_initializers_aligned (prog: program) :=
forallb (fun idv => andb (initializers_aligned 0 (gvar_init (snd idv)))
(Zlt_bool (init_data_list_size (gvar_init (snd idv))) Ptrofs.modulus))
(prog_vars prog) = true.
Definition loop1_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
match R with
{| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := Inv;
RA_break := n;
RA_continue := Inv;
RA_return := r |}
end.
Definition loop2_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
match R with
{| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := Inv;
RA_break := n;
RA_continue := seplog.FF;
RA_return := r |}
end.
Definition function_body_ret_assert (ret: type) (Q: environ->mpred) : ret_assert :=
{| RA_normal := seplog.FF;
RA_break := seplog.FF;
RA_continue := seplog.FF;
RA_return := fun vl => bind_ret vl ret Q |}.
Definition loop_nocontinue_ret_assert (Inv: environ->mpred) (R: ret_assert) : ret_assert :=
match R with
{| RA_normal := n; RA_break := b; RA_continue := c; RA_return := r |} =>
{| RA_normal := Inv;
RA_break := n;
RA_continue := seplog.FF;
RA_return := r |}
end.
Definition tc_environ (Delta: tycontext) : environ -> Prop :=
fun rho => typecheck_environ Delta rho.
Definition tc_temp_id  (id: ident)  (ty: type) {CS: compspecs} (Delta: tycontext)
(e:expr): environ -> mpred :=
denote_tc_assert (typecheck_temp_id id ty Delta e).
(* TODO: remove this kind of definitions. *)
Definition typeof_temp (Delta: tycontext) (id: ident) : option type :=
match (temp_types Delta) ! id with
| Some t => Some t
| None => None
end.
Definition tc_expr {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred :=
denote_tc_assert (typecheck_expr Delta e).
Definition tc_exprlist {CS: compspecs} (Delta: tycontext) (t: list type) (e: list expr)  : environ -> mpred :=
denote_tc_assert (typecheck_exprlist Delta t e).
Definition tc_lvalue {CS: compspecs} (Delta: tycontext) (e: expr) : environ -> mpred :=
denote_tc_assert (typecheck_lvalue Delta e).
Definition tc_expropt {CS: compspecs} Delta (e: option expr) (t: type) : environ -> mpred :=
match e with None => `!!(t=Tvoid)
| Some e' => tc_expr Delta (Ecast e' t)
end.
Definition is_comparison op :=
match op with
| Cop.Oeq | Cop.One | Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge => true
| _ => false
end.
Definition blocks_match op v1 v2  :=
match op with Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge =>
match v1, v2 with
Vptr b _, Vptr b2 _ => b=b2
| _, _ => False
end
| _ => True
end.
Definition cmp_ptr_no_mem c v1 v2  :=
match v1, v2 with
Vptr b o, Vptr b1 o1 =>
if peq b b1 then
Val.of_bool (Ptrofs.cmpu c o o1)
else
match Val.cmp_different_blocks c with
| Some b => Val.of_bool b
| None => Vundef
end
| _, _ => Vundef
end.
Definition op_to_cmp cop :=
match cop with
| Cop.Oeq => Ceq | Cop.One =>  Cne
| Cop.Olt => Clt | Cop.Ogt =>  Cgt
| Cop.Ole => Cle | Cop.Oge =>  Cge
| _ => Ceq (*doesn't matter*)
end.
Fixpoint arglist (n: positive) (tl: typelist) : list (ident*type) :=
match tl with
| Tnil => nil
| Tcons t tl' => (n,t):: arglist (n+1)%positive tl'
end.
Definition closed_wrt_modvars c (F: environ->mpred) : Prop :=
closed_wrt_vars (modifiedvars c) F.
Definition initblocksize (V: Type)  (a: ident * globvar V)  : (ident * Z) :=
match a with (id,l) => (id , init_data_list_size (gvar_init l)) end.
Definition main_pre (prog: program) : list Type -> globals -> environ -> mpred :=
(fun nil gv => globvars2pred gv (prog_vars prog)).
Definition main_pre_ext {Espec: OracleKind} (prog: program) (ora: OK_ty) : list Type -> globals -> environ -> mpred :=
(fun nil gv rho => globvars2pred gv (prog_vars prog) rho * has_ext ora).
Definition main_post (prog: program) : list Type -> (ident->val) -> environ->mpred :=
(fun nil _ _ => TT).
Definition main_spec' (prog: program)
(post: list Type -> globals -> environ -> mpred): funspec :=
mk_funspec (nil, tint) cc_default
(rmaps.ConstType globals) (main_pre prog) post
(const_super_non_expansive _ _) (const_super_non_expansive _ _).
Definition main_spec (prog: program): funspec :=
mk_funspec (nil, tint) cc_default
(rmaps.ConstType globals) (main_pre prog) (main_post prog)
(const_super_non_expansive _ _) (const_super_non_expansive _ _).
Definition main_spec_ext' {Espec: OracleKind} (prog: program) (ora: OK_ty)
(post: list Type -> globals -> environ -> mpred): funspec :=
mk_funspec (nil, tint) cc_default
(rmaps.ConstType globals) (main_pre_ext prog ora) post
(const_super_non_expansive _ _) (const_super_non_expansive _ _).
Definition main_spec_ext {Espec: OracleKind} (prog: program) (ora: OK_ty) : funspec :=
mk_funspec (nil, tint) cc_default
(rmaps.ConstType globals) (main_pre_ext prog ora) (main_post prog)
(const_super_non_expansive _ _) (const_super_non_expansive _ _).
Fixpoint match_globvars (gvs: list (ident * globvar type)) (V: varspecs) : bool :=
match V with
| nil => true
| (id,t)::V' => match gvs with
| nil => false
| (j,g)::gvs' => if eqb_ident id j
then andb (eqb_type t (gvar_info g)) (match_globvars gvs' V')
else match_globvars gvs' V
end
end.
Definition int_range (sz: intsize) (sgn: signedness) (i: int) :=
match sz, sgn with
| I8, Signed => -128 <= Int.signed i < 128
| I8, Unsigned => 0 <= Int.unsigned i < 256
| I16, Signed => -32768 <= Int.signed i < 32768
| I16, Unsigned => 0 <= Int.unsigned i < 65536
| I32, Signed => -2147483648 <= Int.signed i < 2147483648
| I32, Unsigned => 0 <= Int.unsigned i < 4294967296
| IBool, _ => 0 <= Int.unsigned i < 256
end.

(* Specifications: *)
Lemma mapsto_value_range:
forall sh v sz sgn i,
readable_share sh ->
mapsto sh (Tint sz sgn noattr) v (Vint i) =
!! int_range sz sgn i && mapsto sh (Tint sz sgn noattr) v (Vint i).
Lemma typecheck_expr_sound {CS: compspecs} :
forall Delta rho e,
typecheck_environ Delta rho ->
tc_expr Delta e rho |-- !! tc_val (typeof e) (eval_expr e rho).