Section EVAL_EXPR.
Variable sp: val.
Variable e: env.
Variable m: mem.
Inductive eval_expr: expr -> val -> Prop :=
| eval_Evar: forall id v,
PTree.get id e = Some v ->
eval_expr (Evar id) v
| eval_Econst: forall cst v,
eval_constant sp cst = Some v ->
eval_expr (Econst cst) v
| eval_Eunop: forall op a1 v1 v,
eval_expr a1 v1 ->
eval_unop op v1 = Some v ->
eval_expr (Eunop op a1) v
| eval_Ebinop: forall op a1 a2 v1 v2 v,
eval_expr a1 v1 ->
eval_expr a2 v2 ->
eval_binop op v1 v2 m = Some v ->
eval_expr (Ebinop op a1 a2) v
| eval_Eload: forall chunk addr vaddr v,
eval_expr addr vaddr ->
Mem.loadv chunk m vaddr = Some v ->
eval_expr (Eload chunk addr) v.
Inductive eval_exprlist: list expr -> list val -> Prop :=
| eval_Enil:
eval_exprlist nil nil
| eval_Econs: forall a1 al v1 vl,
eval_expr a1 v1 -> eval_exprlist al vl ->
eval_exprlist (a1 :: al) (v1 :: vl).
End EVAL_EXPR.
(** Pop continuation until a call or stop *)
Fixpoint call_cont (k: cont) : cont :=
match k with
| Kseq s k => call_cont k
| Kblock k => call_cont k
| _ => k
end.
Definition is_call_cont (k: cont) : Prop :=
match k with
| Kstop => True
| Kcall _ _ _ _ _ => True
| _ => False
end.
(** Find the statement and manufacture the continuation corresponding to a label *)
Fixpoint find_label (lbl: label) (s: stmt) (k: cont)
{struct s}: option (stmt * cont) :=
match s with
| Sseq s1 s2 =>
match find_label lbl s1 (Kseq s2 k) with
| Some sk => Some sk
| None => find_label lbl s2 k
end
| Sifthenelse a s1 s2 =>
match find_label lbl s1 k with
| Some sk => Some sk
| None => find_label lbl s2 k
end
| Sloop s1 =>
find_label lbl s1 (Kseq (Sloop s1) k)
| Sblock s1 =>
find_label lbl s1 (Kblock k)
| Slabel lbl' s' =>
if ident_eq lbl lbl' then Some(s', k) else find_label lbl s' k
| _ => None
end.
(** One step of execution *)
Inductive step: state -> trace -> state -> Prop :=
| step_skip_seq: forall f s k sp e m,
step (State f Sskip (Kseq s k) sp e m)
E0 (State f s k sp e m)
| step_skip_block: forall f k sp e m,
step (State f Sskip (Kblock k) sp e m)
E0 (State f Sskip k sp e m)
| step_skip_call: forall f k sp e m m',
is_call_cont k ->
Mem.free m sp 0 f.(fn_stackspace) = Some m' ->
step (State f Sskip k (Vptr sp Ptrofs.zero) e m)
E0 (Returnstate Vundef k m')
| step_assign: forall f id a k sp e m v,
eval_expr sp e m a v ->
step (State f (Sassign id a) k sp e m)
E0 (State f Sskip k sp (PTree.set id v e) m)
| step_store: forall f chunk addr a k sp e m vaddr v m',
eval_expr sp e m addr vaddr ->
eval_expr sp e m a v ->
Mem.storev chunk m vaddr v = Some m' ->
step (State f (Sstore chunk addr a) k sp e m)
E0 (State f Sskip k sp e m')
| step_call: forall f optid sig a bl k sp e m vf vargs fd,
eval_expr sp e m a vf ->
eval_exprlist sp e m bl vargs ->
Genv.find_funct ge vf = Some fd ->
funsig fd = sig ->
step (State f (Scall optid sig a bl) k sp e m)
E0 (Callstate fd vargs (Kcall optid f sp e k) m)
| step_tailcall: forall f sig a bl k sp e m vf vargs fd m',
eval_expr (Vptr sp Ptrofs.zero) e m a vf ->
eval_exprlist (Vptr sp Ptrofs.zero) e m bl vargs ->
Genv.find_funct ge vf = Some fd ->
funsig fd = sig ->
Mem.free m sp 0 f.(fn_stackspace) = Some m' ->
step (State f (Stailcall sig a bl) k (Vptr sp Ptrofs.zero) e m)
E0 (Callstate fd vargs (call_cont k) m')
| step_builtin: forall f optid ef bl k sp e m vargs t vres m',
eval_exprlist sp e m bl vargs ->
external_call ef ge vargs m t vres m' ->
step (State f (Sbuiltin optid ef bl) k sp e m)
t (State f Sskip k sp (set_optvar optid vres e) m')
| step_seq: forall f s1 s2 k sp e m,
step (State f (Sseq s1 s2) k sp e m)
E0 (State f s1 (Kseq s2 k) sp e m)
| step_ifthenelse: forall f a s1 s2 k sp e m v b,
eval_expr sp e m a v ->
Val.bool_of_val v b ->
step (State f (Sifthenelse a s1 s2) k sp e m)
E0 (State f (if b then s1 else s2) k sp e m)
| step_loop: forall f s k sp e m,
step (State f (Sloop s) k sp e m)
E0 (State f s (Kseq (Sloop s) k) sp e m)
| step_block: forall f s k sp e m,
step (State f (Sblock s) k sp e m)
E0 (State f s (Kblock k) sp e m)
| step_exit_seq: forall f n s k sp e m,
step (State f (Sexit n) (Kseq s k) sp e m)
E0 (State f (Sexit n) k sp e m)
| step_exit_block_0: forall f k sp e m,
step (State f (Sexit O) (Kblock k) sp e m)
E0 (State f Sskip k sp e m)
| step_exit_block_S: forall f n k sp e m,
step (State f (Sexit (S n)) (Kblock k) sp e m)
E0 (State f (Sexit n) k sp e m)
| step_switch: forall f islong a cases default k sp e m v n,
eval_expr sp e m a v ->
switch_argument islong v n ->
step (State f (Sswitch islong a cases default) k sp e m)
E0 (State f (Sexit (switch_target n default cases)) k sp e m)
| step_return_0: forall f k sp e m m',
Mem.free m sp 0 f.(fn_stackspace) = Some m' ->
step (State f (Sreturn None) k (Vptr sp Ptrofs.zero) e m)
E0 (Returnstate Vundef (call_cont k) m')
| step_return_1: forall f a k sp e m v m',
eval_expr (Vptr sp Ptrofs.zero) e m a v ->
Mem.free m sp 0 f.(fn_stackspace) = Some m' ->
step (State f (Sreturn (Some a)) k (Vptr sp Ptrofs.zero) e m)
E0 (Returnstate v (call_cont k) m')
| step_label: forall f lbl s k sp e m,
step (State f (Slabel lbl s) k sp e m)
E0 (State f s k sp e m)
| step_goto: forall f lbl k sp e m s' k',
find_label lbl f.(fn_body) (call_cont k) = Some(s', k') ->
step (State f (Sgoto lbl) k sp e m)
E0 (State f s' k' sp e m)
| step_internal_function: forall f vargs k m m' sp e,
Mem.alloc m 0 f.(fn_stackspace) = (m', sp) ->
set_locals f.(fn_vars) (set_params vargs f.(fn_params)) = e ->
step (Callstate (Internal f) vargs k m)
E0 (State f f.(fn_body) k (Vptr sp Ptrofs.zero) e m')
| step_external_function: forall ef vargs k m t vres m',
external_call ef ge vargs m t vres m' ->
step (Callstate (External ef) vargs k m)
t (Returnstate vres k m')
| step_return: forall v optid f sp e k m,
step (Returnstate v (Kcall optid f sp e k) m)
E0 (State f Sskip k sp (set_optvar optid v e) m).
End RELSEM.
(** Execution of whole programs are described as sequences of transitions from an initial state to a final state.  An initial state is a [Callstate] corresponding to the invocation of the ``main'' function of the program without arguments and with an empty continuation. *)
Inductive initial_state (p: program): state -> Prop :=
| initial_state_intro: forall b f m0,
let ge := Genv.globalenv p in
Genv.init_mem p = Some m0 ->
Genv.find_symbol ge p.(prog_main) = Some b ->
Genv.find_funct_ptr ge b = Some f ->
funsig f = signature_main ->
initial_state p (Callstate f nil Kstop m0).
(** A final state is a [Returnstate] with an empty continuation. *)
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall r m,
final_state (Returnstate (Vint r) Kstop m) r.
(** The corresponding small-step semantics. *)
Definition semantics (p: program) :=
Semantics step (initial_state p) final_state (Genv.globalenv p).
(** This semantics is receptive to changes in events. *)
(** This semantics is determinate. *)
Ltac Determ :=
try congruence;
match goal with
| [ |- match_traces _ E0 E0 /\ (_ -> _) ]  =>
split; [constructor|intros _; Determ]
| [ H: is_call_cont ?k |- _ ] =>
contradiction || (clear H; Determ)
| [ H1: eval_expr _ _ _ _ ?a ?v1, H2: eval_expr _ _ _ _ ?a ?v2 |- _ ] =>
assert (v1 = v2) by (eapply eval_expr_determ; eauto);
clear H1 H2; Determ
| [ H1: eval_exprlist _ _ _ _ ?a ?v1, H2: eval_exprlist _ _ _ _ ?a ?v2 |- _ ] =>
assert (v1 = v2) by (eapply eval_exprlist_determ; eauto);
clear H1 H2; Determ
| _ => idtac
end.

Lemma semantics_determinate:
forall (p: program), determinate (semantics p).