Section statement_ind.
Variables
(P: statement -> Prop)
(Hskip: P Sskip)
(Hassign: forall e e0, P (Sassign e e0))
(Hset : forall (i : ident) (e : expr), P (Sset i e))
(Hcall : forall (o : option ident) (e : expr) (l : list expr), P (Scall o e l))
(Hbuiltin : forall o e t l, P (Sbuiltin o e t l))
(Hsequence : forall s : statement, P s -> forall s0 : statement, P s0 -> P (Ssequence s s0))
(Hifthenelse : forall e s, P s -> forall s0, P s0 -> P (Sifthenelse e s s0))
(Hloop : forall s : statement, P s -> forall s0 : statement, P s0 -> P (Sloop s s0))
(Hbreak : P Sbreak)
(Hcontinue : P Scontinue)
(Hreturn : forall o : option expr, P (Sreturn o))
(Hswitch : forall e L, all_suf_of_labeled_statements (fun L => P (seq_of_labeled_statement L)) L -> P (Sswitch e L))
(Hlabel : forall (l : label) (s : statement), P s -> P (Slabel l s))
(Hgoto : forall l : label, P (Sgoto l)).
Fixpoint statement_ind (s: statement): P s :=
match s as s0 return (P s0) with
| Sskip => Hskip
| Sassign e e0 => Hassign e e0
| Sset i e => Hset i e
| Scall o e l => Hcall o e l
| Sbuiltin o e t l => Hbuiltin o e t l
| Ssequence s0 s1 => Hsequence s0 (statement_ind s0) s1 (statement_ind s1)
| Sifthenelse e s0 s1 => Hifthenelse e s0 (statement_ind s0) s1 (statement_ind s1)
| Sloop s0 s1 => Hloop s0 (statement_ind s0) s1 (statement_ind s1)
| Sbreak => Hbreak
| Scontinue => Hcontinue
| Sreturn o => Hreturn o
| Sswitch e l => Hswitch e l (labeled_statements_ind l)
| Slabel l s0 => Hlabel l s0 (statement_ind s0)
| Sgoto l => Hgoto l
end
with labeled_statements_ind (L: labeled_statements): all_suf_of_labeled_statements (fun L => P (seq_of_labeled_statement L)) L :=
match L with
| LSnil => Hskip
| LScons _ s L' => conj (Hsequence _ (statement_ind s) _ (all_suf_self _ _ (labeled_statements_ind L'))) (labeled_statements_ind L')
end.
End statement_ind.
Ltac induction_stmt s :=
revert dependent s;
let s1 := fresh s "1" in
let s2 := fresh s "2" in
let IHs := fresh "IH" s in
let IHs1 := fresh "IH" s1 in
let IHs2 := fresh "IH" s2 in
refine (statement_ind _ _ _ _ _ _ _ _ _ _ _ _ _ _ _);
[
| intros ?e ?e
| intros ?i ?e
| intros ?o ?e ?l
| intros ?o ?e ?t ?l
| intros s1 IHs1 s2 IHs2
| intros ?e s1 IHs1 s2 IHs2
| intros s1 IHs1 s2 IHs2
|
|
| intros ?o
| intros ?e ?l ?IH; specialize (all_suf_select_switch _ _ IH); clear IH; intro IH; cbv beta in IH
| intros ?l s IHs
| intros ?l ].
Module AuxDefs.
Section AuxDefs.
Variable semax_external: forall {Hspec: OracleKind} (ids: list ident) (ef: external_function)
(A: rmaps.TypeTree)
(P Q: forall ts, functors.MixVariantFunctor._functor (rmaps.dependent_type_functor_rec ts (AssertTT A)) mpred),
Prop.
Inductive semax {CS: compspecs} {Espec: OracleKind} (Delta: tycontext): (environ -> mpred) -> statement -> ret_assert -> Prop :=
| semax_ifthenelse :
forall P (b: expr) c d R,
@semax CS Espec Delta (P && local (`(typed_true (typeof b)) (eval_expr b))) c R ->
@semax CS Espec Delta (P && local (`(typed_false (typeof b)) (eval_expr b))) d R ->
@semax CS Espec Delta (!! (bool_type (typeof b) = true) && tc_expr Delta (Eunop Cop.Onotbool b (Tint I32 Signed noattr)) && P) (Sifthenelse b c d) R
| semax_seq:
forall R P Q h t,
@semax CS Espec Delta P h (overridePost Q R) ->
@semax CS Espec Delta Q t R ->
@semax CS Espec Delta P (Ssequence h t) R
| semax_break: forall Q,
@semax CS Espec Delta (RA_break Q) Sbreak Q
| semax_continue: forall Q,
@semax CS Espec Delta (RA_continue Q) Scontinue Q
| semax_loop: forall Q Q' incr body R,
@semax CS Espec Delta  Q body (loop1_ret_assert Q' R) ->
@semax CS Espec Delta Q' incr (loop2_ret_assert Q R) ->
@semax CS Espec Delta Q (Sloop body incr) R
| semax_switch: forall (Q: environ->mpred) a sl R,
(forall rho, Q rho |-- tc_expr Delta a rho) ->
(forall n,
@semax CS Espec Delta
(local (`eq (eval_expr a) `(Vint n)) &&  Q)
(seq_of_labeled_statement (select_switch (Int.unsigned n) sl))
(switch_ret_assert R)) ->
@semax CS Espec Delta (!! (is_int_type (typeof a) = true) && Q) (Sswitch a sl) R
| semax_call_backward: forall ret a bl R,
@semax CS Espec Delta
(EX argsig: _, EX retsig: _, EX cc: _,
EX A: _, EX P: _, EX Q: _, EX NEP: _, EX NEQ: _, EX ts: _, EX x: _,
!! (Cop.classify_fun (typeof a) =
Cop.fun_case_f (type_of_params argsig) retsig cc /\
(retsig = Tvoid -> ret = None) /\
tc_fn_return Delta ret retsig) &&
(|>((tc_expr Delta a) && (tc_exprlist Delta (snd (split argsig)) bl)))  &&
`(func_ptr (mk_funspec  (argsig,retsig) cc A P Q NEP NEQ)) (eval_expr a) &&
|>((`(P ts x: environ -> mpred) (make_args' (argsig,retsig) (eval_exprlist (snd (split argsig)) bl))) * oboxopt Delta ret (maybe_retval (Q ts x) retsig ret -* R)))
(Scall ret a bl)
(normal_ret_assert R)
| semax_return: forall (R: ret_assert) ret ,
@semax CS Espec Delta
( (tc_expropt Delta ret (ret_type Delta)) &&
`(RA_return R : option val -> environ -> mpred) (cast_expropt ret (ret_type Delta)) (@id environ))
(Sreturn ret)
R
| semax_set_ptr_compare_load_cast_load_backward: forall (P: environ->mpred) id e,
@semax CS Espec Delta
((|> ( (tc_expr Delta e) &&
(tc_temp_id id (typeof e) Delta e) &&
subst id (eval_expr e) P)) ||
(EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
EX ty: type, EX sh1: share, EX sh2: share,
!! (e = Ebinop cmp e1 e2 ty /\
sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
is_comparison cmp = true /\
eqb_type (typeof e1) int_or_ptr_type = false /\
eqb_type (typeof e2) int_or_ptr_type = false /\
typecheck_tid_ptr_compare Delta id = true) &&
( |> ( (tc_expr Delta e1) &&
(tc_expr Delta e2)  &&
local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
(`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
(`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
subst id (eval_expr (Ebinop cmp e1 e2 ty)) P))) ||
(EX sh: share, EX t2: type, EX v2: val,
!! (typeof_temp Delta id = Some t2 /\
is_neutral_cast (typeof e) t2 = true /\
readable_share sh) &&
|> ( (tc_lvalue Delta e) &&
local (`(tc_val (typeof e) v2)) &&
(`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
subst id (`v2) P)) ||
(EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
!! (e = Ecast e1 t1 /\
typeof_temp Delta id = Some t1 /\
cast_pointer_to_bool (typeof e1) t1 = false /\
readable_share sh) &&
|> ( (tc_lvalue Delta e1) &&
local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
(`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
subst id (`(force_val (sem_cast (typeof e1) t1 v2))) P)))
(Sset id e) (normal_ret_assert P)
| semax_store_backward: forall e1 e2 P,
@semax CS Espec Delta
(EX sh: share, !! writable_share sh && |> ( (tc_lvalue Delta e1) &&  (tc_expr Delta (Ecast e2 (typeof e1)))  &&
((`(mapsto_ sh (typeof e1)) (eval_lvalue e1)) * (`(mapsto sh (typeof e1)) (eval_lvalue e1) (`force_val (`(sem_cast (typeof e2) (typeof e1)) (eval_expr e2))) -* P))))
(Sassign e1 e2)
(normal_ret_assert P)
| semax_skip: forall P, @semax CS Espec Delta P Sskip (normal_ret_assert P)
| semax_builtin: forall P opt ext tl el, @semax CS Espec Delta FF (Sbuiltin opt ext tl el) P
| semax_label: forall (P:environ -> mpred) (c:statement) (Q:ret_assert) l,
@semax CS Espec Delta P c Q -> @semax CS Espec Delta P (Slabel l c) Q
| semax_goto: forall P l, @semax CS Espec Delta FF (Sgoto l) P
| semax_conseq: forall P' (R': ret_assert) P c (R: ret_assert) ,
local (tc_environ Delta) && ((allp_fun_id Delta) && P) |-- |==> |> FF || P' ->
local (tc_environ Delta) && ((allp_fun_id Delta) && RA_normal R') |-- |==> |> FF || RA_normal R ->
local (tc_environ Delta) && ((allp_fun_id Delta) && RA_break R') |-- |==> |> FF || RA_break R ->
local (tc_environ Delta) && ((allp_fun_id Delta) && RA_continue R') |-- |==> |> FF || RA_continue R ->
(forall vl, local (tc_environ Delta) && ((allp_fun_id Delta) && RA_return R' vl) |-- |==> |> FF || RA_return R vl) ->
@semax CS Espec Delta P' c R' -> @semax CS Espec Delta P c R.
Definition semax_body
(V: varspecs) (G: funspecs) {C: compspecs} (f: function) (spec: ident * funspec): Prop :=
match spec with (_, mk_funspec _ cc A P Q NEP NEQ) =>
forall Espec ts x, (*exists Ann,*)
@semax C Espec (func_tycontext f V G nil (*Ann*))
(P ts x *  stackframe_of f)
(Ssequence f.(fn_body) (Sreturn None))
(frame_ret_assert (function_body_ret_assert (fn_return f) (Q ts x)) (stackframe_of f))
end.
Inductive semax_func: forall {Espec: OracleKind} (V: varspecs) (G: funspecs) {C: compspecs} (fdecs: list (ident * Clight.fundef)) (G1: funspecs), Prop :=
| semax_func_nil:   forall {Espec: OracleKind},
forall V G C, @semax_func Espec V G C nil nil
| semax_func_cons:
forall {Espec: OracleKind},
forall fs id f cc A P Q NEP NEQ (V: varspecs) (G G': funspecs) {C: compspecs},
andb (id_in_list id (map (@fst _ _) G))
(andb (negb (id_in_list id (map (@fst ident Clight.fundef) fs)))
(semax_body_params_ok f)) = true ->
Forall
(fun it : ident * type =>
complete_type cenv_cs (snd it) =
true) (fn_vars f) ->
var_sizes_ok (f.(fn_vars)) ->
f.(fn_callconv) = cc ->
precondition_closed f P ->
semax_body V G f (id, mk_funspec (fn_funsig f) cc A P Q NEP NEQ)->
semax_func V G fs G' ->
semax_func V G ((id, Internal f)::fs)
((id, mk_funspec (fn_funsig f) cc A P Q NEP NEQ)  :: G')
| semax_func_cons_ext:
forall {Espec: OracleKind},
forall (V: varspecs) (G: funspecs) {C: compspecs} fs id ef argsig retsig A P Q NEP NEQ
argsig'
(G': funspecs) cc (ids: list ident),
ids = map fst argsig' -> (* redundant but useful for the client,
to calculate ids by reflexivity *)
argsig' = zip_with_tl ids argsig ->
ef_sig ef =
mksignature
(typlist_of_typelist (type_of_params argsig'))
(opttyp_of_type retsig) cc ->
id_in_list id (map (@fst _ _) fs) = false ->
length ids = length (typelist2list argsig) ->
(forall gx ts x (ret : option val),
(Q ts x (make_ext_rval gx ret)
&& !!step_lemmas.has_opttyp ret (opttyp_of_type retsig)
|-- !!tc_option_val retsig ret)) ->
@semax_external Espec ids ef A P Q ->
semax_func V G fs G' ->
semax_func V G ((id, External ef argsig retsig cc)::fs)
((id, mk_funspec (argsig', retsig) cc A P Q NEP NEQ)  :: G').
End AuxDefs.
End AuxDefs.
Module DeepEmbedded
(Def: CLIGHT_SEPARATION_HOARE_LOGIC_DEF)
(MinimumLogic: MINIMUM_CLIGHT_SEPARATION_HOARE_LOGIC with Module CSHL_Def := Def).
Module DeepEmbeddedDef <: CLIGHT_SEPARATION_HOARE_LOGIC_DEF.
Definition semax := @AuxDefs.semax.
Definition semax_func := @AuxDefs.semax_func (@Def.semax_external).
Definition semax_external := @Def.semax_external.
End DeepEmbeddedDef.
Module DeepEmbeddedDefs := DerivedDefs (DeepEmbeddedDef).
Module CConseq: CLIGHT_SEPARATION_HOARE_LOGIC_COMPLETE_CONSEQUENCE with Module CSHL_Def := DeepEmbeddedDef.
Module CSHL_Def := DeepEmbeddedDef.
Definition semax_conseq := @AuxDefs.semax_conseq.
End CConseq.
Module CConseqFacts := GenCConseqFacts (DeepEmbeddedDef) (CConseq).
Module Conseq := GenConseq (DeepEmbeddedDef) (CConseq).
Module ConseqFacts := GenConseqFacts (DeepEmbeddedDef) (Conseq).

Lemma semax_Sset_inv: forall {CS: compspecs} {Espec: OracleKind} Delta P R id e,
@semax CS Espec Delta P (Sset id e) R ->
local (tc_environ Delta) && (allp_fun_id Delta && P) |-- |==> |> FF ||
( (|> ( (tc_expr Delta e) &&
(tc_temp_id id (typeof e) Delta e) &&
subst id (eval_expr e) (|==> |> FF || RA_normal R))) ||
(EX cmp: Cop.binary_operation, EX e1: expr, EX e2: expr,
EX ty: type, EX sh1: share, EX sh2: share,
!! (e = Ebinop cmp e1 e2 ty /\
sepalg.nonidentity sh1 /\ sepalg.nonidentity sh2 /\
is_comparison cmp = true /\
eqb_type (typeof e1) int_or_ptr_type = false /\
eqb_type (typeof e2) int_or_ptr_type = false /\
typecheck_tid_ptr_compare Delta id = true) &&
( |> ( (tc_expr Delta e1) &&
(tc_expr Delta e2)  &&
local (`(blocks_match cmp) (eval_expr e1) (eval_expr e2)) &&
(`(mapsto_ sh1 (typeof e1)) (eval_expr e1) * TT) &&
(`(mapsto_ sh2 (typeof e2)) (eval_expr e2) * TT) &&
subst id (eval_expr (Ebinop cmp e1 e2 ty)) (|==> |> FF || RA_normal R)))) ||
(EX sh: share, EX t2: type, EX v2: val,
!! (typeof_temp Delta id = Some t2 /\
is_neutral_cast (typeof e) t2 = true /\
readable_share sh) &&
|> ( (tc_lvalue Delta e) &&
local (`(tc_val (typeof e) v2)) &&
(`(mapsto sh (typeof e)) (eval_lvalue e) (`v2) * TT) &&
subst id (`v2) (|==> |> FF || RA_normal R))) ||
(EX sh: share, EX e1: expr, EX t1: type, EX v2: val,
!! (e = Ecast e1 t1 /\
typeof_temp Delta id = Some t1 /\
cast_pointer_to_bool (typeof e1) t1 = false /\
readable_share sh) &&
|> ( (tc_lvalue Delta e1) &&
local (`(tc_val t1) (`(eval_cast (typeof e1) t1 v2))) &&
(`(mapsto sh (typeof e1)) (eval_lvalue e1) (`v2) * TT) &&
subst id (`(force_val (sem_cast (typeof e1) t1 v2))) (|==> |> FF || RA_normal R)))).