(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Compile-time evaluation of initializers for global C variables. *)
Open Scope error_monad_scope.
Section SOUNDNESS.
Variable ge: genv.
(** * Simple expressions and their big-step semantics *)
(** An expression is simple if it contains no assignments and no function calls. *)
Fixpoint simple (a: expr) : Prop :=
match a with
| Eloc _ _ _ => True
| Evar _ _ => True
| Ederef r _ => simple r
| Efield l1 _ _ => simple l1
| Eval _ _ => True
| Evalof l _ => simple l
| Eaddrof l _ => simple l
| Eunop _ r1 _ => simple r1
| Ebinop _ r1 r2 _ => simple r1 /\ simple r2
| Ecast r1 _ => simple r1
| Eseqand r1 r2 _ => simple r1 /\ simple r2
| Eseqor r1 r2 _ => simple r1 /\ simple r2
| Econdition r1 r2 r3 _ => simple r1 /\ simple r2 /\ simple r3
| Esizeof _ _ => True
| Ealignof _ _ => True
| Eassign _ _ _ => False
| Eassignop _ _ _ _ _ => False
| Epostincr _ _ _ => False
| Ecomma r1 r2 _ => simple r1 /\ simple r2
| Ecall _ _ _ => False
| Ebuiltin _ _ _ _ => False
| Eparen r1 _ _ => simple r1
end.
(** A big-step semantics for simple expressions.  Similar to the big-step semantics from [Cstrategy], with the addition of conditionals, comma and paren operators.  It is a pity we do not share definitions with [Cstrategy], but such sharing raises technical difficulties. *)
Section SIMPLE_EXPRS.
Variable e: env.
Variable m: mem.
Inductive eval_simple_lvalue: expr -> block -> ptrofs -> Prop :=
| esl_loc: forall b ofs ty,
eval_simple_lvalue (Eloc b ofs ty) b ofs
| esl_var_local: forall x ty b,
e!x = Some(b, ty) ->
eval_simple_lvalue (Evar x ty) b Ptrofs.zero
| esl_var_global: forall x ty b,
e!x = None ->
Genv.find_symbol ge x = Some b ->
eval_simple_lvalue (Evar x ty) b Ptrofs.zero
| esl_deref: forall r ty b ofs,
eval_simple_rvalue r (Vptr b ofs) ->
eval_simple_lvalue (Ederef r ty) b ofs
| esl_field_struct: forall r f ty b ofs id co a delta,
eval_simple_rvalue r (Vptr b ofs) ->
typeof r = Tstruct id a -> ge.(genv_cenv)!id = Some co -> field_offset ge f (co_members co) = OK delta ->
eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta))
| esl_field_union: forall r f ty b ofs id a,
eval_simple_rvalue r (Vptr b ofs) ->
typeof r = Tunion id a ->
eval_simple_lvalue (Efield r f ty) b ofs
with eval_simple_rvalue: expr -> val -> Prop :=
| esr_val: forall v ty,
eval_simple_rvalue (Eval v ty) v
| esr_rvalof: forall b ofs l ty v,
eval_simple_lvalue l b ofs ->
ty = typeof l ->
deref_loc ge ty m b ofs E0 v ->
eval_simple_rvalue (Evalof l ty) v
| esr_addrof: forall b ofs l ty,
eval_simple_lvalue l b ofs ->
eval_simple_rvalue (Eaddrof l ty) (Vptr b ofs)
| esr_unop: forall op r1 ty v1 v,
eval_simple_rvalue r1 v1 ->
sem_unary_operation op v1 (typeof r1) m = Some v ->
eval_simple_rvalue (Eunop op r1 ty) v
| esr_binop: forall op r1 r2 ty v1 v2 v,
eval_simple_rvalue r1 v1 -> eval_simple_rvalue r2 v2 ->
sem_binary_operation ge op v1 (typeof r1) v2 (typeof r2) m = Some v ->
eval_simple_rvalue (Ebinop op r1 r2 ty) v
| esr_cast: forall ty r1 v1 v,
eval_simple_rvalue r1 v1 ->
sem_cast v1 (typeof r1) ty m = Some v ->
eval_simple_rvalue (Ecast r1 ty) v
| esr_sizeof: forall ty1 ty,
eval_simple_rvalue (Esizeof ty1 ty) (Vptrofs (Ptrofs.repr (sizeof ge ty1)))
| esr_alignof: forall ty1 ty,
eval_simple_rvalue (Ealignof ty1 ty) (Vptrofs (Ptrofs.repr (alignof ge ty1)))
| esr_seqand_true: forall r1 r2 ty v1 v2 v3,
eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some true ->
eval_simple_rvalue r2 v2 ->
sem_cast v2 (typeof r2) type_bool m = Some v3 ->
eval_simple_rvalue (Eseqand r1 r2 ty) v3
| esr_seqand_false: forall r1 r2 ty v1,
eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some false ->
eval_simple_rvalue (Eseqand r1 r2 ty) (Vint Int.zero)
| esr_seqor_false: forall r1 r2 ty v1 v2 v3,
eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some false ->
eval_simple_rvalue r2 v2 ->
sem_cast v2 (typeof r2) type_bool m = Some v3 ->
eval_simple_rvalue (Eseqor r1 r2 ty) v3
| esr_seqor_true: forall r1 r2 ty v1,
eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some true ->
eval_simple_rvalue (Eseqor r1 r2 ty) (Vint Int.one)
| esr_condition: forall r1 r2 r3 ty v v1 b v',
eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some b ->
eval_simple_rvalue (if b then r2 else r3) v' ->
sem_cast v' (typeof (if b then r2 else r3)) ty m = Some v ->
eval_simple_rvalue (Econdition r1 r2 r3 ty) v
| esr_comma: forall r1 r2 ty v1 v,
eval_simple_rvalue r1 v1 -> eval_simple_rvalue r2 v ->
eval_simple_rvalue (Ecomma r1 r2 ty) v
| esr_paren: forall r tycast ty v v',
eval_simple_rvalue r v -> sem_cast v (typeof r) tycast m = Some v' ->
eval_simple_rvalue (Eparen r tycast ty) v'.
End SIMPLE_EXPRS.
(** * Correctness of the big-step semantics with respect to reduction sequences *)
(** In this section, we show that if a simple expression [a] reduces to some value (with the transition semantics from module [Csem]), then it evaluates to this value (with the big-step semantics above). *)
Definition compat_eval (k: kind) (e: env) (a a': expr) (m: mem) : Prop :=
typeof a = typeof a' /\
match k with
| LV => forall b ofs, eval_simple_lvalue e m a' b ofs -> eval_simple_lvalue e m a b ofs
| RV => forall v, eval_simple_rvalue e m a' v -> eval_simple_rvalue e m a v
end.

Lemma compat_eval_steps_aux f r e m r' m' s2 :
simple r ->
star step ge s2 nil (ExprState f r' Kstop e m') ->
estep ge (ExprState f r Kstop e m) nil s2 ->
exists r1,
s2 = ExprState f r1 Kstop e m /\
compat_eval RV e r r1 m /\ simple r1.