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.
(** * Soundness of the compile-time evaluator *)
(** A global environment [ge] induces a memory injection mapping our symbolic pointers [Vptr id ofs] to run-time pointers [Vptr b ofs] where [Genv.find_symbol ge id = Some b]. *)
Definition inj (b: block) :=
match Genv.find_symbol ge b with
| Some b' => Some (b', 0)
| None => None
end.
(** Soundness of [constval] with respect to the big-step semantics *)
(** Soundness of [constval] with respect to the reduction semantics. *)
(** * Relational specification of the translation of initializers *)
Definition tr_padding (frm to: Z) : list init_data :=
if zlt frm to then Init_space (to - frm) :: nil else nil.
Inductive tr_init: type -> initializer -> list init_data -> Prop :=
| tr_init_sgl: forall ty a d,
transl_init_single ge ty a = OK d ->
tr_init ty (Init_single a) (d :: nil)
| tr_init_arr: forall tyelt nelt attr il d,
tr_init_array tyelt il (Z.max 0 nelt) d ->
tr_init (Tarray tyelt nelt attr) (Init_array il) d
| tr_init_str: forall id attr il co d,
lookup_composite ge id = OK co -> co_su co = Struct ->
tr_init_struct (Tstruct id attr) (co_members co) il 0 d ->
tr_init (Tstruct id attr) (Init_struct il) d
| tr_init_uni: forall id attr f i1 co ty1 d,
lookup_composite ge id = OK co -> co_su co = Union -> field_type f (co_members co) = OK ty1 ->
tr_init ty1 i1 d ->
tr_init (Tunion id attr) (Init_union f i1)
(d ++ tr_padding (sizeof ge ty1) (sizeof ge (Tunion id attr)))
with tr_init_array: type -> initializer_list -> Z -> list init_data -> Prop :=
| tr_init_array_nil_0: forall ty,
tr_init_array ty Init_nil 0 nil
| tr_init_array_nil_pos: forall ty sz,
0 < sz ->
tr_init_array ty Init_nil sz (Init_space (sz * sizeof ge ty) :: nil)
| tr_init_array_cons: forall ty i il sz d1 d2,
tr_init ty i d1 -> tr_init_array ty il (sz - 1) d2 ->
tr_init_array ty (Init_cons i il) sz (d1 ++ d2)
with tr_init_struct: type -> members -> initializer_list -> Z -> list init_data -> Prop :=
| tr_init_struct_nil: forall ty pos,
tr_init_struct ty nil Init_nil pos (tr_padding pos (sizeof ge ty))
| tr_init_struct_cons: forall ty f1 ty1 fl i1 il pos d1 d2,
let pos1 := align pos (alignof ge ty1) in
tr_init ty1 i1 d1 ->
tr_init_struct ty fl il (pos1 + sizeof ge ty1) d2 ->
tr_init_struct ty ((f1, ty1) :: fl) (Init_cons i1 il)
pos (tr_padding pos pos1 ++ d1 ++ d2).

Lemma transl_padding_spec:
forall frm to k, padding frm to k = rev (tr_padding frm to) ++ k.