(* *********************************************************************)
(*                                                                     *)
(*              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.     *)
(*                                                                     *)
(* *********************************************************************)
(** Relational specification of expression simplification. *)
Section SPEC.
Local Open Scope gensym_monad_scope.
(** * Relational specification of the translation. *)
(** ** Translation of expressions *)
(** This specification covers: - all cases of [transl_lvalue] and [transl_rvalue]; - two additional cases for [Csyntax.Eparen], so that reductions of [Csyntax.Econdition] expressions are properly tracked; - three additional cases allowing [Csyntax.Eval v] C expressions to match any Clight expression [a] that evaluates to [v] in any environment matching the given temporary environment [le]. *)
Definition final (dst: destination) (a: expr) : list statement :=
match dst with
| For_val => nil
| For_effects => nil
| For_set sd => do_set sd a
end.
Inductive tr_rvalof: type -> expr -> list statement -> expr -> list ident -> Prop :=
| tr_rvalof_nonvol: forall ty a tmp,
type_is_volatile ty = false ->
tr_rvalof ty a nil a tmp
| tr_rvalof_vol: forall ty a t tmp,
type_is_volatile ty = true -> In t tmp ->
tr_rvalof ty a (make_set t a :: nil) (Etempvar t ty) tmp.
Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> expr -> list ident -> Prop :=
| tr_var: forall le dst id ty tmp,
tr_expr le dst (Csyntax.Evar id ty)
(final dst (Evar id ty)) (Evar id ty) tmp
| tr_deref: forall le dst e1 ty sl1 a1 tmp,
tr_expr le For_val e1 sl1 a1 tmp ->
tr_expr le dst (Csyntax.Ederef e1 ty)
(sl1 ++ final dst (Ederef' a1 ty)) (Ederef' a1 ty) tmp
| tr_field: forall le dst e1 f ty sl1 a1 tmp,
tr_expr le For_val e1 sl1 a1 tmp ->
tr_expr le dst (Csyntax.Efield e1 f ty)
(sl1 ++ final dst (Efield a1 f ty)) (Efield a1 f ty) tmp
| tr_val_effect: forall le v ty any tmp,
tr_expr le For_effects (Csyntax.Eval v ty) nil any tmp
| tr_val_value: forall le v ty a tmp,
typeof a = ty ->
(forall tge e le' m,
(forall id, In id tmp -> le'!id = le!id) ->
eval_expr tge e le' m a v) ->
tr_expr le For_val (Csyntax.Eval v ty)
nil a tmp
| tr_val_set: forall le sd v ty a any tmp,
typeof a = ty ->
(forall tge e le' m,
(forall id, In id tmp -> le'!id = le!id) ->
eval_expr tge e le' m a v) ->
tr_expr le (For_set sd) (Csyntax.Eval v ty)
(do_set sd a) any tmp
| tr_sizeof: forall le dst ty' ty tmp,
tr_expr le dst (Csyntax.Esizeof ty' ty)
(final dst (Esizeof ty' ty))
(Esizeof ty' ty) tmp
| tr_alignof: forall le dst ty' ty tmp,
tr_expr le dst (Csyntax.Ealignof ty' ty)
(final dst (Ealignof ty' ty))
(Ealignof ty' ty) tmp
| tr_valof: forall le dst e1 ty tmp sl1 a1 tmp1 sl2 a2 tmp2,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_rvalof (Csyntax.typeof e1) a1 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 -> incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le dst (Csyntax.Evalof e1 ty)
(sl1 ++ sl2 ++ final dst a2)
a2 tmp
| tr_addrof: forall le dst e1 ty tmp sl1 a1,
tr_expr le For_val e1 sl1 a1 tmp ->
tr_expr le dst (Csyntax.Eaddrof e1 ty)
(sl1 ++ final dst (Eaddrof' a1 ty))
(Eaddrof' a1 ty) tmp
| tr_unop: forall le dst op e1 ty tmp sl1 a1,
tr_expr le For_val e1 sl1 a1 tmp ->
tr_expr le dst (Csyntax.Eunop op e1 ty)
(sl1 ++ final dst (Eunop op a1 ty))
(Eunop op a1 ty) tmp
| tr_binop: forall le dst op e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_val e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 -> incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le dst (Csyntax.Ebinop op e1 e2 ty)
(sl1 ++ sl2 ++ final dst (Ebinop op a1 a2 ty))
(Ebinop op a1 a2 ty) tmp
| tr_cast: forall le dst e1 ty sl1 a1 tmp,
tr_expr le For_val e1 sl1 a1 tmp ->
tr_expr le dst (Csyntax.Ecast e1 ty)
(sl1 ++ final dst (Ecast a1 ty))
(Ecast a1 ty) tmp
| tr_seqand_val: forall le e1 e2 ty sl1 a1 tmp1 t sl2 a2 tmp2 tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (sd_seqbool_val t ty)) e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp -> In t tmp ->
tr_expr le For_val (Csyntax.Eseqand e1 e2 ty)
(sl1 ++ makeif a1 (makeseq sl2)
(Sset t (Econst_int Int.zero ty)) :: nil)
(Etempvar t ty) tmp
| tr_seqand_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_effects e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le For_effects (Csyntax.Eseqand e1 e2 ty)
(sl1 ++ makeif a1 (makeseq sl2) Sskip :: nil)
any tmp
| tr_seqand_set: forall le sd e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (sd_seqbool_set ty sd)) e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp -> In (sd_temp sd) tmp ->
tr_expr le (For_set sd) (Csyntax.Eseqand e1 e2 ty)
(sl1 ++ makeif a1 (makeseq sl2)
(makeseq (do_set sd (Econst_int Int.zero ty))) :: nil)
any tmp
| tr_seqor_val: forall le e1 e2 ty sl1 a1 tmp1 t sl2 a2 tmp2 tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (sd_seqbool_val t ty)) e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp -> In t tmp ->
tr_expr le For_val (Csyntax.Eseqor e1 e2 ty)
(sl1 ++ makeif a1 (Sset t (Econst_int Int.one ty))
(makeseq sl2) :: nil)
(Etempvar t ty) tmp
| tr_seqor_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_effects e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le For_effects (Csyntax.Eseqor e1 e2 ty)
(sl1 ++ makeif a1 Sskip (makeseq sl2) :: nil)
any tmp
| tr_seqor_set: forall le sd e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (sd_seqbool_set ty sd)) e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp -> In (sd_temp sd) tmp ->
tr_expr le (For_set sd) (Csyntax.Eseqor e1 e2 ty)
(sl1 ++ makeif a1 (makeseq (do_set sd (Econst_int Int.one ty)))
(makeseq sl2) :: nil)
any tmp
| tr_condition_val: forall le e1 e2 e3 ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 t tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (SDbase ty ty t)) e2 sl2 a2 tmp2 ->
tr_expr le (For_set (SDbase ty ty t)) e3 sl3 a3 tmp3 ->
list_disjoint tmp1 tmp2 ->
list_disjoint tmp1 tmp3 ->
incl tmp1 tmp -> incl tmp2 tmp ->  incl tmp3 tmp -> In t tmp ->
tr_expr le For_val (Csyntax.Econdition e1 e2 e3 ty)
(sl1 ++ makeif a1 (makeseq sl2) (makeseq sl3) :: nil)
(Etempvar t ty) tmp
| tr_condition_effects: forall le e1 e2 e3 ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_effects e2 sl2 a2 tmp2 ->
tr_expr le For_effects e3 sl3 a3 tmp3 ->
list_disjoint tmp1 tmp2 ->
list_disjoint tmp1 tmp3 ->
incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
tr_expr le For_effects (Csyntax.Econdition e1 e2 e3 ty)
(sl1 ++ makeif a1 (makeseq sl2) (makeseq sl3) :: nil)
any tmp
| tr_condition_set: forall le sd t e1 e2 e3 ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le (For_set (SDcons ty ty t sd)) e2 sl2 a2 tmp2 ->
tr_expr le (For_set (SDcons ty ty t sd)) e3 sl3 a3 tmp3 ->
list_disjoint tmp1 tmp2 ->
list_disjoint tmp1 tmp3 ->
incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp -> In t tmp ->
tr_expr le (For_set sd) (Csyntax.Econdition e1 e2 e3 ty)
(sl1 ++ makeif a1 (makeseq sl2) (makeseq sl3) :: nil)
any tmp
| tr_assign_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_val e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le For_effects (Csyntax.Eassign e1 e2 ty)
(sl1 ++ sl2 ++ make_assign a1 a2 :: nil)
any tmp
| tr_assign_val: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 t tmp ty1 ty2,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_val e2 sl2 a2 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
list_disjoint tmp1 tmp2 ->
In t tmp -> ~In t tmp1 -> ~In t tmp2 ->
ty1 = Csyntax.typeof e1 ->
ty2 = Csyntax.typeof e2 ->
tr_expr le dst (Csyntax.Eassign e1 e2 ty)
(sl1 ++ sl2 ++
Sset t (Ecast a2 ty1) ::
make_assign a1 (Etempvar t ty1) ::
final dst (Etempvar t ty1))
(Etempvar t ty1) tmp
| tr_assignop_effects: forall le op e1 e2 tyres ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_val e2 sl2 a2 tmp2 ->
ty1 = Csyntax.typeof e1 ->
tr_rvalof ty1 a1 sl3 a3 tmp3 ->
list_disjoint tmp1 tmp2 -> list_disjoint tmp1 tmp3 -> list_disjoint tmp2 tmp3 ->
incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
tr_expr le For_effects (Csyntax.Eassignop op e1 e2 tyres ty)
(sl1 ++ sl2 ++ sl3 ++ make_assign a1 (Ebinop op a3 a2 tyres) :: nil)
any tmp
| tr_assignop_val: forall le dst op e1 e2 tyres ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 t tmp ty1,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_expr le For_val e2 sl2 a2 tmp2 ->
tr_rvalof ty1 a1 sl3 a3 tmp3 ->
list_disjoint tmp1 tmp2 -> list_disjoint tmp1 tmp3 -> list_disjoint tmp2 tmp3 ->
incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
In t tmp -> ~In t tmp1 -> ~In t tmp2 -> ~In t tmp3 ->
ty1 = Csyntax.typeof e1 ->
tr_expr le dst (Csyntax.Eassignop op e1 e2 tyres ty)
(sl1 ++ sl2 ++ sl3 ++
Sset t (Ecast (Ebinop op a3 a2 tyres) ty1) ::
make_assign a1 (Etempvar t ty1) ::
final dst (Etempvar t ty1))
(Etempvar t ty1) tmp
| tr_postincr_effects: forall le id e1 ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_rvalof ty1 a1 sl2 a2 tmp2 ->
ty1 = Csyntax.typeof e1 ->
incl tmp1 tmp -> incl tmp2 tmp ->
list_disjoint tmp1 tmp2 ->
tr_expr le For_effects (Csyntax.Epostincr id e1 ty)
(sl1 ++ sl2 ++ make_assign a1 (transl_incrdecr id a2 ty1) :: nil)
any tmp
| tr_postincr_val: forall le dst id e1 ty sl1 a1 tmp1 t ty1 tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
incl tmp1 tmp -> In t tmp -> ~In t tmp1 ->
ty1 = Csyntax.typeof e1 ->
tr_expr le dst (Csyntax.Epostincr id e1 ty)
(sl1 ++ make_set t a1 ::
make_assign a1 (transl_incrdecr id (Etempvar t ty1) ty1) ::
final dst (Etempvar t ty1))
(Etempvar t ty1) tmp
| tr_comma: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 tmp,
tr_expr le For_effects e1 sl1 a1 tmp1 ->
tr_expr le dst e2 sl2 a2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le dst (Csyntax.Ecomma e1 e2 ty) (sl1 ++ sl2) a2 tmp
| tr_call_effects: forall le e1 el2 ty sl1 a1 tmp1 sl2 al2 tmp2 any tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_exprlist le el2 sl2 al2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le For_effects (Csyntax.Ecall e1 el2 ty)
(sl1 ++ sl2 ++ Scall None a1 al2 :: nil)
any tmp
| tr_call_val: forall le dst e1 el2 ty sl1 a1 tmp1 sl2 al2 tmp2 t tmp,
dst <> For_effects ->
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_exprlist le el2 sl2 al2 tmp2 ->
list_disjoint tmp1 tmp2 -> In t tmp ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_expr le dst (Csyntax.Ecall e1 el2 ty)
(sl1 ++ sl2 ++ Scall (Some t) a1 al2 :: final dst (Etempvar t ty))
(Etempvar t ty) tmp
| tr_builtin_effects: forall le ef tyargs el ty sl al tmp1 any tmp,
tr_exprlist le el sl al tmp1 ->
incl tmp1 tmp ->
tr_expr le For_effects (Csyntax.Ebuiltin ef tyargs el ty)
(sl ++ Sbuiltin None ef tyargs al :: nil)
any tmp
| tr_builtin_val: forall le dst ef tyargs el ty sl al tmp1 t tmp,
dst <> For_effects ->
tr_exprlist le el sl al tmp1 ->
In t tmp -> incl tmp1 tmp ->
tr_expr le dst (Csyntax.Ebuiltin ef tyargs el ty)
(sl ++ Sbuiltin (Some t) ef tyargs al :: final dst (Etempvar t ty))
(Etempvar t ty) tmp
| tr_paren_val: forall le e1 tycast ty sl1 a1 t tmp,
tr_expr le (For_set (SDbase tycast ty t)) e1 sl1 a1 tmp ->
In t tmp ->
tr_expr le For_val (Csyntax.Eparen e1 tycast ty)
sl1
(Etempvar t ty) tmp
| tr_paren_effects: forall le e1 tycast ty sl1 a1 tmp any,
tr_expr le For_effects e1 sl1 a1 tmp ->
tr_expr le For_effects (Csyntax.Eparen e1 tycast ty) sl1 any tmp
| tr_paren_set: forall le t sd e1 tycast ty sl1 a1 tmp any,
tr_expr le (For_set (SDcons tycast ty t sd)) e1 sl1 a1 tmp ->
In t tmp ->
tr_expr le (For_set sd) (Csyntax.Eparen e1 tycast ty) sl1 any tmp
with tr_exprlist: temp_env -> Csyntax.exprlist -> list statement -> list expr -> list ident -> Prop :=
| tr_nil: forall le tmp,
tr_exprlist le Csyntax.Enil nil nil tmp
| tr_cons: forall le e1 el2 sl1 a1 tmp1 sl2 al2 tmp2 tmp,
tr_expr le For_val e1 sl1 a1 tmp1 ->
tr_exprlist le el2 sl2 al2 tmp2 ->
list_disjoint tmp1 tmp2 ->
incl tmp1 tmp -> incl tmp2 tmp ->
tr_exprlist le (Csyntax.Econs e1 el2) (sl1 ++ sl2) (a1 :: al2) tmp.
Scheme tr_expr_ind2 := Minimality for tr_expr Sort Prop
with tr_exprlist_ind2 := Minimality for tr_exprlist Sort Prop.
Combined Scheme tr_expr_exprlist from tr_expr_ind2, tr_exprlist_ind2.
(** Useful invariance properties. *)

(* Specifications: *)
Lemma tr_expr_invariant:
forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
forall le', (forall x, In x tmps -> le'!x = le!x) ->
tr_expr le' dst r sl a tmps
with tr_exprlist_invariant:
forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
forall le', (forall x, In x tmps -> le'!x = le!x) ->
tr_exprlist le' rl sl al tmps.
Lemma tr_rvalof_monotone:
forall ty a sl b tmps, tr_rvalof ty a sl b tmps ->
forall tmps', incl tmps tmps' -> tr_rvalof ty a sl b tmps'.
Lemma tr_expr_monotone:
forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
forall tmps', incl tmps tmps' -> tr_expr le dst r sl a tmps'
with tr_exprlist_monotone:
forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
forall tmps', incl tmps tmps' -> tr_exprlist le rl sl al tmps'.